seppdroid/Digital-Research-Source-Code
1
0
Fork 0
mirror of https://github.com/SEPPDROID/Digital-Research-Source-Code.git synced 2025-10-26 01:44:21 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

Upload

Browse Source 
Digital Research
This commit is contained in:
Sepp J Morris
2020-11-06 18:50:37 +01:00
parent 621ed8ccaf
commit 31738079c4
8481 changed files with 1888323 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/c068/Buildfile Normal file
View File

@@ -0,0 +1,3 @@
c68 -L -e *.c -o c068.68 -l6
c68 -L -r -n -e *.c -o c068.st -l6
cc -f *.c -o c068.11 -lP -lx

968
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/c068/decl.c Normal file
View File

@@ -0,0 +1,968 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
#include "parser.h"
#define DREG 0100 /*data loadable into D-register?*/
char dinfo[] {
0, /*TYPELESS=0*/
1|DREG, /*CHAR=1*/
2|DREG, /*SHORT=2*/
2|DREG, /*INT=3*/
4|DREG, /*LONG=4*/
1|DREG, /*UCHAR=5*/
2|DREG, /*USHORT=6*/
2|DREG, /*UNSIGNED=7*/
4|DREG, /*ULONG=8*/
4|DREG, /*FLOAT=9[vlh]*/
4|DREG, /*DOUBLE=10[vlh]*/
0, /*STRUCT=11*/
0, /*FRSTRUCT=12*/
0, /*LLABEL=13*/
0, /*INVALID=14*/
0, /*INVALID=15*/
};
char aregtab[] { AREG5, AREG4, AREG3, 0 };
char dregtab[] { DREG7, DREG6, DREG5, DREG4, DREG3, 0 };
int inittype;
/*
* doextdef - external definition syntax
* This is fairly complicated since you do not know if you are
* parsing a external function declaration or a real function
* until after you've already scanned the argument list for the
* function. Basically you start off scanning an external declaration
* or function in the same way by collecting attributes, scanning
* the declarator, then scanning the function arguments if a function.
* At that point you look at the next token and if its a '{', keyword
* proceed accordingly.
* The C Syntax handled by this routine is (roughly):
* external_definition:
* function_definition
* data_definition
* function_definition:
* type_specifier function_declarator function_body
* function_declarator:
* declarator ( parameter_list )
* data_definition:
* EXTERNAL type_specifier init_declarator_list ;
* STATIC type_specifier init_declarator_list ;
*/
doextdef() /* returns 0 for EOF or 1*/
{
register struct symbol *sp;
register int dflag;
int sc, type;
long size;
if(!next(SEMI)) {
opap = exprp = exprarea;
sc = EXTERNAL;
type = (xflag?LONG:INT);
dflag = gettype(&sc,&type,&size);
if(type==STRUCT) /* deal with forward ref structures */
chksyms();
while( dodecl(sc,type,0,size), (sp=dsp) != 0 ) {
if( !dflag && notfunction(sp->s_type) ) {
synerr("external definition syntax");
return;
}
if( !stypedef(sp) && sc != STATIC )
if (notfunction(sp->s_type)) /*[vlh] .globl ext. vars*/
outextdef(sp->s_symbol);
if( notfunction(sp->s_type) ) { /*not function, check init*/
if( !stypedef(sp) ) {
doinit(sp);
if (sc == STATIC)
chksyms();
}
}
else if( peek(RESWORD) || peek(LCURBR) ||
(peek(SYMBOL) && stypedef(csp)) ) {
if(!stypedef(sp) && sc!=STATIC) /*[vlh] .globl local proc*/
outextdef(sp->s_symbol);
funcbody(sp);
return;
}
dsp = 0;
if( !next(COMMA) )
break;
}
if( gettok() != SEMI )
synerr("external definition syntax");
}
}
/*
* gettype - get attribute types in attribute list
* Handles single word keywords, such as int, char, etc. and also
* handles the declarations of structures and unions.
*/
gettype(defsc,deftype,size) /* returns 0 for no type, 1 otherwise*/
int *defsc; /* default storage class*/
int *deftype; /* default data type*/
long *size; /* size of data element 3.4 int=>long*/
{
register int dtype, sc;
register int sflag, uflag, lflag, decflag;
register int token, stdflag, sbits;
long tsize;
register struct symbol *sp, *parent;
tdp = 0; tdflag = uflag = decflag = lflag = sflag = 0; tsize = 0L;
dtype = TYPELESS;
sc = *defsc;
for( ; ; decflag++ ) {
if( (token=gettok()) == SYMBOL && stypedef(csp) ) {
dtype = 0;
tdp = csp;
continue;
}
if( token != RESWORD )
break;
switch( cvalue ) {
case R_TYPEDEF:
if( tdflag )
error("invalid typedef statement");
tdflag++;
continue;
case R_STATIC:
if( sc && sc != STATIC && sc != EXTERNAL )
error("invalid storage class");
sc = STATIC;
continue;
case R_AUTO:
if( sc && sc != AUTO )
error("invalid storage class");
sc = AUTO;
continue;
case R_EXTERNAL:
if( sc && sc != EXTERNAL )
error("invalid storage class");
sc = EXTERNAL;
continue;
case R_REGISTER:
if( sc && sc != REGISTER && sc != PDECLIST )
error("invalid register specification");
sc = REGISTER;
continue;
case R_LONG:
lflag++;
continue;
case R_SHORT:
sflag++;
continue;
case R_UNSIGNED:
uflag++;
continue;
case R_STRUCT:
cvalue = STRUCT;
case R_UNION:
stdflag = tdflag;
tdflag = 0; sp = 0;
token = cvalue;
smember++;
if( next(SYMBOL) ) { /*struct [symbol] { ... }*/
sp = csp;
parent = csp;
strucptr[smember+instruct] = sp;
if( !sp->s_sc ) {
sp->s_attrib =| SDEFINED;
if(!infunc)
sp->s_attrib =| SGLOBAL;
sp->s_sc = STRPROTO;
sp->s_type = STRUCT;
sp->s_ssp = dalloc(0L);
}
if( sp->s_sc != STRPROTO )
error("redeclaration: %.8s",sp->s_symbol);
}
else parent = 0;
smember = 0;
if( next(LCURBR) ) {
instruct++;
strucptr[smember+instruct] = sp;
sbits = boffset;
boffset = 0;
tsize = dlist(token==STRUCT?STELCL:UNELCL);
boffset = sbits;
if(!next(RCURBR))
synerr("structure declaration syntax");
else if( sp ) {
if( dtab[sp->s_ssp] )
error("redeclaration: %.8s",sp->s_symbol);
dtab[sp->s_ssp] = tsize;
}
instruct--;
}
else if( !sp )
error("no structure name");
else if( sp->s_sc != STRPROTO )
error("invalid structure prototype: %.8s",sp->s_symbol);
else if( !dtab[sp->s_ssp] ) { /* FRSTRUCT */
token = FRSTRUCT;
if( ++frstp >= NFRSTR )
ferror("structure table overflow");
frstab[frstp] = sp;
}
else
tsize = dtab[sp->s_ssp];
tdflag = stdflag;
if( dtype != TYPELESS )
error("invalid type declaration");
dtype = (token == R_UNION) ? STRUCT : token;
continue;
case R_INT:
if( dtype != TYPELESS )
error("invalid type declaration");
dtype = INT;
continue;
case R_CHAR:
if( dtype != TYPELESS )
error("invalid type declaration");
dtype = CHAR;
continue;
case R_FLOAT: /*[vlh] ver. 3.4*/
case R_DOUBLE:
if( dtype != TYPELESS )
error("invalid type declaration");
dtype = FLOAT;
continue;
}
break;
}
pbtok(token);
if( dtype == TYPELESS )
dtype = INT;
if(!sc)
sc = AUTO;
if( lflag ) { /*allow: long float, long int*/
if( dtype == INT )
dtype = LONG;
/* else if( dtype == FLOAT ) */
/* dtype = DOUBLE; */
else
error("invalid long declaration");
}
if( sflag ) {
if( dtype != INT )
error("invalid short declaration");
}
if( uflag ) {
if( dtype != INT ) /*allow: unsigned int*/
error("invalid unsigned declaration");
else
dtype = UNSIGNED;
}
if( !sflag && xflag && dtype == INT )
dtype = LONG;
*defsc = sc;
*deftype = dtype;
*size = tsize;
if (dtype == STRUCT || dtype == FRSTRUCT)
csp->s_struc = parent;
return(decflag);
}
/*
* dodecl - process a single declarator
* This does all the grubby handling of a single declarator given
* the attributes for the declarator. Handles typedef attributes
* adjusts offsets for structure elements, allocates register
* variables, etc.
*/
long /* [vlh] 3.4 int => long */
dodecl(sc,type,offset,size) /* returns size of declarator*/
int sc; /* storage class*/
int type; /* data type*/
int offset; /* offset if in structure or union*/
long size; /* size of single data item 3.4 i=> l*/
{
register struct symbol *sp;
register int redecf, stype, dtype, i, j;
if( peek(SEMI) || peek(RPAREN) )
return(0);
if( instruct && next(COLON) ) { /*handle bit filler field*/
if(!(i=cexpr()))
size = salign(INT,offset);
else
size = falign(type,i);
}
else if( (type=|declarator(0)) >= 0 && (sp=dsp) != 0 ) {
if( tdp ) /*typedef name in declaration*/
type = addtdtype(tdp,type,sp->s_dp,&(sp->s_ssp));
else if( btype(type) == STRUCT ) {
if( size )
sp->s_ssp = dalloc(size);
else
error("invalid structure declaration: %.8s",sp->s_symbol);
}
else if( btype(type) == FRSTRUCT )
sp->s_ssp = frstp;
redecf = 0;
switch( sp->s_sc ) { /*check for redeclarations.*/
case 0:
break;
case PARMLIST:
if( sc != PDECLIST && sc != REGISTER )
goto redec;
break;
case BFIELDCL:
if( sc != STELCL && sc != UNELCL )
goto redec;
break;
case STELCL:
case UNELCL:
redecf++;
break; /* [vlh] get rid of redecf entirely ?? */
case EXTERNAL:
if (sp->s_type == type) {
if (sc == sp->s_sc) break;
if (sc == AUTO && suptype(type) == FUNCTION) {
sc = EXTERNAL;
break;
}
}
default:
redec:
error("redeclaration: %.8s",sp->s_symbol);
return(size);
}
sp->s_type = type;
dtype = suptype(type);
type = btype(type);
if( tdflag ) /*we are declaring typedef?*/
sp->s_attrib =| STYPEDEF;
if( instruct ) {
if( next(COLON) ) { /*handle bit field*/
sc = BFIELDCL;
i = cexpr();
j = (boffset<<8)|i;
if( redecf && sp->s_dp != j ) /* ??? */
goto redec;
sp->s_dp = j;
size = j = falign(type,i);
}
else
size = dsize(sp->s_type,sp->s_dp,sp->s_ssp) +
(j=salign(type,offset));
offset =+ j;
/* if( redecf && sp->s_offset != offset )
goto redec; */ /* [vlh] */
sp->s_offset = offset;
}
if( dtype == FUNCTION ) {
if( sc != AUTO && sc != EXTERNAL && sc != STATIC )
error("illegal function declaration");
if( sc != STATIC )
sc = EXTERNAL;
}
else if( sc == REGISTER ) {
if( !dtype ) {
if( !(dinfo[type]&DREG) ) { /* ignore reg specification */
/* error("illegal register specification"); */
sc = AUTO;
}
else if( !dregtab[ndregs] )
sc = AUTO;
else
sp->s_offset = dregtab[ndregs++];
}
else if( dtype != POINTER ) {
error("illegal register specification");
sc = AUTO; /*no more regs, make it auto*/
}
else if( !aregtab[naregs] )
sc = AUTO;
else
sp->s_offset = aregtab[naregs++];
}
if( sc == AUTO ) {
localsize =+ walign(dsize(sp->s_type,sp->s_dp,sp->s_ssp));
sp->s_offset = -localsize;
}
else if( sc == STATIC )
sp->s_offset = nextlabel++;
sp->s_sc = sc;
sp->s_attrib =| SDEFINED;
if(!infunc)
sp->s_attrib =| SGLOBAL;
}
return(size);
}
/*
* doinit - do external definition initialization
* Handles following C syntax:
* initializer:
* = constant_expression
* = { initializer_list }
* = { initializer_list , }
* initializer_list:
* constant_expression
* initializer_list , initializer_list
* { initializer_list }
*/
doinit(sp) /* returns number of elements init'ed*/
struct symbol *sp; /* pointer to symbol to init*/
{
register int type;
long isize, datasize, elsize;
type = sp->s_type;
datasize = dsize(type,sp->s_dp,sp->s_ssp);
if( peek(COMMA) || peek(SEMI) ) { /*no initialization*/
isize = walign(datasize);
if( sp->s_sc == EXTERNAL )
outcommon(sp->s_symbol,isize);
else {
outbss(); /*bss segment*/
outlab(sp->s_offset);
outresmem(isize);
outtext(); /*resume text segment*/
}
}
else {
next(ASSIGN); /*ignore '=' if there*/
if( type == LONG || pointer(type) )
outldata();
else if(type == DOUBLE || type == FLOAT) /*[vlh] 3.4*/
outfpdata();
else
outdata();
if( sp->s_sc == EXTERNAL )
outdlab(sp->s_symbol);
else
outlab(sp->s_offset);
isize = initlist(sp->s_type,sp->s_dp,sp->s_ssp);
if( isize < datasize ) {
outresmem(datasize-isize);
isize = datasize;
}
if( walign(isize) != isize )
outpad();
if( isize > datasize ) {
if( array(sp->s_type) ) {
for( type = sp->s_type; array(type); type = delsp(type) )
;
dtab[sp->s_dp] = isize / dsize(type,sp->s_dp,sp->s_ssp);
}
else
error("too many initializers");
}
if( sp->s_sc == STATIC )
outtext();
}
}
/*
* initlist - handles initializer lists
* This handles multi-level braces, and a character pointer pointing
* to a string. Most of the work is in keeping track of how many
* bytes are left on the current "row", and outputting padding if
* necessary.
*/
long
initlist(type,dp,sp) /* returns size of initializers in*/
/* bytes*/
int type; /* type of data*/
int dp; /* dimension pointer*/
int sp; /* structure pointer*/
{
register int nrows;
long datasize, i, elsize, nbleft, nbout; /* [vlh] 3.4 int=>long */
register int onetype;
for( onetype = type; array(onetype); onetype = delsp(onetype) )
;
nbout = 0;
datasize = dsize(type,dp,sp);
nbleft = 0; /*keep track of no. of bytes left*/
if( type == (ARRAY|CHAR) && next(STRING) ) {
nbout = cstrsize;
outstr();
if( datasize > nbout )
nbleft = datasize - nbout;
}
else if( array(type) || (btype(type)==STRUCT && notpointer(type)) ) {
elsize = datasize / dsize(delsp(type),dp+1,sp);
elsize = datasize / elsize;
if(!next(LCURBR))
error("missing { in initialization");
if( type == (ARRAY|CHAR) && next(STRING) ) {
nbout = cstrsize;
outstr();
if( datasize > nbout )
nbleft = datasize - nbout;
}
else {
do { /*in current row.*/
if( peek(SEMI) || peek(EOF) )
break;
if( peek(LCURBR) ) { /*recurse down one level?*/
if( nbleft ) {
outresmem(nbleft); /*pad rest of current row*/
nbout =+ nbleft;
nbleft = 0;
}
i = initlist(delsp(type),dp+1,sp);
if( i > elsize )
error("initializer list too long");
else if( i < elsize )
outresmem(elsize-i);
nbout =+ elsize;
}
else if( peek(RCURBR) )
break;
else {
i = oneinit(onetype);
nbout =+ i;
if(!nbleft)
nbleft = elsize;
if( i > nbleft )
error("initializer alignment");
nbleft = (i >= nbleft) ? 0 : nbleft - i;
}
} while( next(COMMA) );
}
if(!next(RCURBR))
synerr("missing }");
}
else {
i = next(LCURBR); /*pull of optional {*/
nbout = oneinit(onetype);
if( i && !next(RCURBR) )
synerr("missing }");
}
if( nbleft ) { /*pad current row*/
outresmem(nbleft);
nbout =+ nbleft;
}
return(nbout);
}
/*
* oneinit - get one initializer expression or constant
* This checks the type of the data item expected against the
* type obtained from expr. Note that there is no attempt to
* match structure initializations against the elements of the
* structure, hence, anything goes in a structure.
*/
oneinit(type) /* returns size of initializer*/
int type; /* type of initializer*/
{
register int op, value;
register struct tnode *tp;
commastop++;
tp = expr();
commastop--;
op = tp->t_op;
value = tp->t_value;
switch( alltype(type) ) {
case CHAR:
case ARRAY|CHAR:
if( op != CINT )
break;
outc(CHAR,value);
return(1);
case INT:
case ARRAY|INT:
if( op == CLONG || op == ADDR )
if (op == CLONG && clvalue == -32768) { /*[vlh] 4.0*/
op = CINT;
value = -32768;
}
else
break;
if( op == CINT )
outc(INT,value);
else
outinit(tp,inittype);
return(2);
case UNSIGNED: /* [vlh] 4.0 split from INT... */
case ARRAY|UNSIGNED:
if (op == ADDR)
break;
if( op == CLONG ) { /* get unsigned values > legit pos ints */
if (clvalue < 0L || clvalue > 65535L)
break;
op = CINT;
value = clvalue & 0x7fff;
if (clvalue > 32767)
value = -value;
}
else if (op == CINT && value < 0)
break;
if( op == CINT )
outc(INT,value);
else
outinit(tp,inittype);
return(2);
case LONG:
case ARRAY|LONG:
case POINTER|CHAR:
case POINTER|INT:
case POINTER|LONG:
case POINTER|STRUCT:
case POINTER|UNSIGNED:
if( op == CINT ) {
clvalue = value; /*[vlh] fix ??? MC ??? */
outlong(clvalue);
}
else if( op == CLONG )
outlong(clvalue);
else
outinit(tp,inittype);
return(4);
case DOUBLE: /* [vlh] 3.4 */
case FLOAT:
outfp(clvalue);
return(4);
case STRUCT:
case ARRAY|STRUCT:
if( op == CINT ) {
if( xflag ) {
clvalue = value;
outlong(clvalue);
return(4);
}
outc(INT,value);
return(2);
}
if( op == CLONG ) {
outlong(clvalue);
return(4);
}
outinit(tp,inittype);
if (xflag || op==ADDR)
return(4);
if ((op=tp->t_right->t_op)==ADDR || op==CLONG) /*[vlh]*/
return(4);
if ((op=tp->t_left->t_op)==ADDR || op==CLONG) /*[vlh]*/
return(4);
return(2);
}
error("invalid initializer");
return(0);
}
/*
* funcbody - do function body declaration
* Basically handles function after we have scanned the parameter
* list, which is now set up in fargs array. We now proceed to
* look for any declarations for the function arguments, then the
* function declaration list, followed by the function statement list.
* The C syntax is:
* function_body:
* type_decl_list function_statement
* function_statement:
* { declaration_list statement_list }
*/
funcbody(fsp)
struct symbol *fsp;
{
register int olddp;
register struct symbol *sp;
register struct farg *fp;
register int offset, toff;
infunc++;
sp = fsp;
opap = exprp;
frp = snalloc(delsp(sp->s_type),sp->s_sc,sp->s_type,sp->s_dp,
sp->s_ssp);
exprp = opap;
outtext();
outflab(sp->s_symbol);
olddp = cdp;
dlist(PDECLIST);
rlabel = nextlabel++;
if(!next(LCURBR))
synerr("function body syntax");
else {
localsize = 0; /*end of first auto offset from l.e.p.*/
offset = 8; /*first arg offset from l.e.p.*/
for( fp = &fargtab[0]; sp = fp->f_sp; fp++ ) {
toff = offset;
if( sp->s_type == CHAR ) /*char argument*/
toff++; /*offset of lower byte in word*/
if( sp->s_sc == REGISTER )
fp->f_offset = toff;
else {
fp->f_offset = 0; /*really is auto arg*/
sp->s_offset = toff;
sp->s_sc = AUTO;
}
if( array(sp->s_type) ) { /*change array ref to pointer*/
sp->s_type = addsp(delsp(sp->s_type),POINTER);
sp->s_dp++;
}
offset =+ walign(dsize(sp->s_type,sp->s_dp,sp->s_ssp));
}
dlist(0);
chksyms();
outbentry(localsize,ndregs,naregs);
copyargs(); /*copy args to registers where required*/
while(!next(RCURBR)) {
if( next(EOF) ) {
error("{ not matched by }");
break;
}
stmt();
}
}
outlab(rlabel);
outbexit(ndregs,naregs);
cdp = olddp;
infunc--;
freesyms();
}
/*
* copyargs - copy args to register where required
* fargtab has been set so that args declared to be registers have a
* non-zero offset value and the register number is in the symbol
* table pointed to by symbol.
*/
copyargs() /* returns - none*/
{
register struct symbol *sp;
register struct farg *fp;
for( fp = &fargtab[0]; sp = fp->f_sp; fp++ ) {
if( fp->f_offset ) /*was declared register*/
outassign(snalloc(sp->s_type,sp->s_sc,sp->s_offset,0,0),
snalloc(sp->s_type,AUTO,fp->f_offset,0,0));
}
}
/*
* dlist - declaration list
* Handles declaration lists in the following places:
* function parameter list declarations, structure or union member
* declarations and local declarations in functions.
*/
long
dlist(defsc) /* returns length of declarators*/
int defsc; /* default storage class*/
{
register int offset;
register struct symbol *sp;
register long i, ddsize;
long size; /* [vlh] 3.4 int => long */
int type, sc, isize;
offset = 0; ddsize = 0L;
do {
sc = defsc;
type = INT;
if( !gettype(&sc,&type,&size) )
break;
do {
i = dodecl(sc,type,offset,size);
if( defsc != UNELCL ) {
isize = i;
offset =+ isize;
ddsize =+ i;
}
else if( i > ddsize )
ddsize = i;
if( sc == STATIC && dsp && !stypedef(dsp) )
doinit(dsp); /*process any initializer*/
dsp = 0;
} while ( next(COMMA) );
if (next(ASSIGN)) {
synerr("auto initialization not implemented");
break;
}
if(!next(SEMI)) {
synerr("declaration syntax");
break;
}
} while( 1 );
isize = ddsize;
ddsize =+ salign(INT,isize);
return(ddsize);
}
/*
* declarator - get one declarator
* Basically uses getdecl, which returns the declaration types
* reversed in the type word.
*/
declarator(castflg) /* returns type or -1*/
int castflg;
{
register int type, t;
dsp = 0;
if( (type=getdecl(castflg)) >= 0 )
return( revsp(type) );
return(type);
}
/*
* getdecl - get one declarator, handling *, (), etc.
* The significance of the value returned by declarator is: the
* least significant two bits represent the values (POINTER,FUNCTION,
* ARRAY), these values are repeated through the word. For example,
* the declarations result in the following values for declarator:
* *x() => (POINTER,FUNCTION)
* (*x)() => (FUNCTION,POINTER)
* *(*x)() => (POINTER,FUNCTION,POINTER)
* The following C syntax is handled here:
* function_declarator:
* declarator ( parameter_list )
* declarator:
* identifier
* ( declarator )
* * declarator
* declarator [ constant-expression ]
*/
getdecl(castflg) /* returns special type of declarator*/
int castflg; /* casting flag, 1=>allow no declarator*/
{
register int type, i, value, sdp;
register struct symbol *sp, *tsp;
register struct farg *fp;
register char *p;
long lvalue;
type = 0;
if( next(LPAREN) ) { /*( declarator ) ...*/
type = getdecl(castflg);
if(!next(RPAREN))
goto baddec;
}
if( next(MULT) )
return(addsp(getdecl(castflg),POINTER));
sdp = cdp;
if( next(SYMBOL) ) {
sp = dsp = csp;
type = 0;
sp->s_dp = sdp;
}
while( 1 ) {
if( next(LPAREN) ) { /*declarator ( ... )*/
if(!infunc) {
ndregs = naregs = 0;
for( fp = &fargtab[0]; next(SYMBOL); ) {
p = csp;
if( p->s_attrib & SDEFINED )
error("redeclaration: %.8s",p->s_symbol);
else if( fp >= &fargtab[NFARGS-1] ) {
synerr("too many params");
break;
}
else {
p->s_attrib =| SDEFINED;
p->s_sc = PARMLIST;
p->s_type = INT; /*default to int*/
fp->f_sp = p;
fp++;
}
if(!next(COMMA))
break;
}
fp->f_sp = 0;
}
if(!next(RPAREN))
break;
type = addsp(type,FUNCTION);
continue;
}
if( next(LBRACK) ) { /*declarator [ cexpr ]*/
if( next(RBRACK) )
dalloc(1L);
else {
tsp = dsp; /* [vlh] 3.4 save in case of reset */
value = cexpr(); /* recurses on sizeof.... resets dsp */
dsp = tsp; /* [vlh] 3.4 */
lvalue = value; /* [vlh] 3.4 */
for( i = sdp; i < cdp; )
dtab[i++] =* lvalue;
dalloc(lvalue);
if( !next(RBRACK) )
break;
}
type = addsp(type,ARRAY);
continue;
}
if( castflg || dsp )
return(type);
break;
}
baddec:
synerr("invalid declarator");
return(-1);
}
/*
* addtdtype - add typedef info into declarator
* here we very carefully add in the dimensions for an array typedef
* declaration. Note that declarator has already allocated the
* declarator-specific dimensions, now we allocate the typedef
* dimensions and adjust the size of the declarator's dimensions.
* Note that this must be done before the dalloc for the structure,
* otherwise we would mix up array and structure sizes.
*/
addtdtype(tddp,type,dp,ssp) /* returns type*/
struct symbol *tddp;
int type;
int dp;
int *ssp;
{
register int ntype, t, i, tdf;
for( tdf = 0, t = tddp->s_type; suptype(t); t = delsp(t) )
if( array(t) ) {
tdf++;
break;
}
ntype = 0;
for( t = type, i = dp; suptype(t); t = delsp(t) ) {
ntype = addsp(ntype,t);
if( tdf && array(t) )
dtab[i++] =* dtab[tddp->s_dp];
}
for( t = tddp->s_type, i = tddp->s_dp; suptype(t); t = delsp(t) )
if( array(t) )
dalloc(dtab[i++]);
for( t = tddp->s_type; suptype(ntype); ntype = delsp(ntype) )
t = addsp(t,ntype);
if( (ntype=btype(t)) == STRUCT )
*ssp = tddp->s_ssp;
else if( ntype == FRSTRUCT )
*ssp = frstp;
return(t);
}

910
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/c068/expr.c Normal file
View File

@@ -0,0 +1,910 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
#include "parser.h"
int opdontop;
int strassign;
/*
* expr - expression evaluator
* This handles all the expression syntax in C. This is a straight-
* forward operator-stack/oppri scheme for translating infix into
* a binary expression tree.
*/
char *expr() /* returns 0 or ptr to node*/
{
register char *p;
register char *opdsave, *oprsave;
register int token, op, oppri, i, opdotsave;
int type, sc;
long size;
opdsave = opdp;
strassign = 0;
oprsave = opp;
opdotsave = opdontop;
if( !opp || !opdp ) {
opp = opstack;
opdp = opdstack;
}
else
opp++;
opp->o_op = STACKEND;
opp->o_pri = STKPRI;
opap = exprp;
opdontop = 0;
while( (token=gettok()) != EOF ) {
switch( token ) {
/*
* the following are the terminal nodes of the expresion tree,
* note that when we see a terminal node, we push it and then go
* and get the next token. When we see an operator, we need to
* check the operator stack to see if we can do a reduction.
*/
case CINT:
if( doopd(cnalloc(INT,cvalue)) ) {
exprerr:
if( token == SEMI || token == RCURBR )
pbtok(token);
error("invalid expression");
opdp = opdsave;
opp = oprsave;
opdontop = opdotsave;
return(0);
}
continue;
case CFLOAT: /*[vlh] 3.4*/
if( doopd(fpcnalloc(FLOAT,clvalue)) )
goto exprerr;
continue;
case CLONG:
if( doopd(lcnalloc(LONG,clvalue)) )
goto exprerr;
continue;
case SYMBOL:
if( !((p=csp)->s_attrib&SDEFINED) ) {
if( peek(LPAREN) ) { /*assume function call*/
p->s_sc = EXTERNAL;
p->s_type = FUNCTION|INT;
}
else if( commastop ) /*in initialization?*/
p->s_sc = EXTERNAL;
else
error("undefined symbol: %.8s",p->s_symbol);
p->s_attrib =| SDEFINED;
}
if (p->s_sc==EXTERNAL || function(p->t_type)) {
if (!reducep || p->s_sc==EXTERNAL || peek(LPAREN)) {
p = enalloc(p);
p->t_sc = EXTERNAL;
}
else { /* [vlh] 3.4 if (main).... */
p = cnalloc(CINT,1); /* eval function name */
}
}
else
p=snalloc(p->s_type,p->s_sc,p->s_offset,p->s_dp,p->s_ssp);
if( doopd(p) )
goto exprerr;
continue;
case STRING:
outtstr(cvalue);
if( doopd(snalloc(ARRAY|CHAR,STATIC,cvalue,0,0)) )
goto exprerr;
continue;
/*
* do special checking for unary ops and operators that can be
* either unary or binary operators, such as -, &, *, etc.
*/
case RESWORD:
if( cvalue != R_SIZEOF ) {
goto exprerr;
}
token = SIZEOF;
case COMPL:
case NOT:
if( opdontop ) /*can't have: operand unary-op*/
goto exprerr;
break;
case LBRACK:
opdontop = 0;
break;
case RBRACK:
case RPAREN:
if( !opdontop ) /*can't be: operator )*/
goto exprerr;
break;
case PREINC:
if( opdontop ) /*assume its lvalue++*/
token = POSTINC;
break;
case PREDEC:
if( opdontop ) /*assume its lvalue--*/
token = POSTDEC;
break;
case SUB:
if(!opdontop) { /*if no operand, assume unary*/
if( peek(CINT) ) {
cvalue = -cvalue;
continue;
}
if( peek(CLONG) ) {
clvalue = -clvalue;
continue;
}
if( peek(CFLOAT) ) { /*[vlh] 3.4*/
if (!fflag) { /* IEEE format */
if (clvalue & 0x80000000)
clvalue =& 0x7fffffff;
else
clvalue =| 0x80000000;
}
else /* FFP format */
if (clvalue & 0x80)
clvalue =& 0xffffff7f;
else
clvalue =| 0x80;
continue;
}
token = UMINUS;
}
break;
case AND:
if(!opdontop)
token = ADDR;
break;
case MULT:
if( !opdontop )
token = INDR;
break;
/*
* for left parenthesis, we need to see if this is a casting operator.
*/
case LPAREN:
if( !opdontop ) { /*see if casting or abstract declarator*/
sc = type = 0;
if( gettype(&sc,&type,&size) ) {
sc = (type == STRUCT) ? dalloc(size) : cdp;
p = snalloc(type,STATIC,0,sc,sc);
p->t_type =| declarator(1);
if( !next(RPAREN) )
goto exprerr;
if( tdp )
p->t_type=addtdtype(tdp,p->t_type,p->t_dp,
&(p->t_ssp));
pushopd(p);
token = CAST;
if( opp->o_op == SIZEOF ) {
opdontop++;
continue;
}
}
}
else /*we've seen (), look for NACALL*/
token = (next(RPAREN)) ? MPARENS : CALL;
break;
case PERIOD:
case APTR:
smember++; /*next token needs to be struct membr*/
strucptr[smember+instruct] = csp->s_struc;
break;
}
/*
* we have seen an operator, get its info and then check the operator
* stack.
*/
if( binop(token) ) {
/*
* handle special binary operators, such as CAST and post-inc and
* post-dec.
*/
if(!opdontop) {
if( token != PREDEC && token != PREINC && token != CAST )
goto exprerr;
}
if( token != POSTDEC && token != POSTINC && token != MPARENS )
opdontop = 0; /*this fixes x++ op problem.*/
}
oppri = oppriority(token);
if( commastop && token == COMMA ) /*need to stop at comma(init)*/
oppri = COLPRI;
if( colonstop && token == COLON ) /*need to stop at colon(case)*/
oppri = COLPRI;
while( 1 ) {
if( oppri > opp->o_pri ||
(oppri == opp->o_pri && rasop(token)) ) {
/*
* we have encountered a higher priority (or right-associative)
* operator, hence we need to stack it.
*/
if( ++opp >= &opstack[OPSSIZE] )
ferror("expression too complex");
if( token == POSTINC || token == POSTDEC )
oppri = PSTPRI;
else if( token == LPAREN || token == LBRACK ||
token == CALL )
oppri = CALPRI;
opp->o_op = token;
opp->o_pri = oppri;
break;
}
/*
* we have encountered a lower priority operator, hence we need to
* do a reduction.
*/
op = opp->o_op;
opp--;
type = CINT;
switch( op ) {
case STACKEND: /*we accept the expression...*/
pbtok(token);
if (!strassign) {
if (!maketree(0))
goto exprerr;
}
if (!(p=popopd()))
goto exprerr;
opdp = opdsave;
opp = oprsave;
opdontop = opdotsave;
return(p);
case LPAREN: /*assure these have matching )*/
case CALL:
if( token != RPAREN )
goto exprerr;
break;
case MPARENS:
if( !maketree(NACALL) )
goto exprerr;
continue;
case LBRACK:
if( token != RBRACK )
goto exprerr;
if(!maketree(ADD)) /*array[index]->*(array+index)*/
goto exprerr;
op = INDR;
break;
case PREINC: /*turn these into binary operators*/
case POSTINC: /*which in reality they are...*/
case PREDEC:
case POSTDEC:
pushopd(cnalloc(INT,1));
default:
if(!maketree(op))
goto exprerr;
continue; /*see if we can reduce some more...*/
}
if( op != LPAREN && !maketree(op) )
goto exprerr;
break;
}
}
error("unexpected EOF");
return(0);
}
/* doopd - handle constant or symbol node operand*/
/* Pushes node onto operand stack and handles opdontop flag.*/
doopd(tp) /* returns 1 if syntax error, 0 for ok*/
struct tnode *tp; /* pointer to tree node*/
{
pushopd(tp);
if( opdontop )
return(1);
opdontop++;
return(0);
}
/*
* This indicates if a conversion operator is needed given the types
* of the two operands. The upper diagonal is applied ONLY if this
* is an assignment operator and the indexes are swapped so the lower
* diagonal is used otherwise.
*INT UNSN LONG DOUB PTR
*/
char cvmap[5][5] {
0, UNSN_INT, LONG_INT, DOUB_INT, PTR_INT,
INT_UNSN, 0, LONG_UNSN, DOUB_UNSN, PTR_UNSN,
INT_LONG, UNSN_LONG, 0, DOUB_LONG, PTR_LONG,
INT_DOUB, UNSN_DOUB, LONG_DOUB, 0, BADCONV,
INT_PTR, UNSN_PTR, LONG_PTR, BADCONV, PTR_PTR,
};
/*
* maketree - given operator, takes operands and builds up tree
* This takes the given operator, allocates a node for it
* and links up the subtrees on the operand stack. A lot of
* work is in inserting the proper conversions.
*/
maketree(op) /* returns success or failure */
int op; /* new root operator*/
{
register struct tnode *ltp, *rtp, *p;
register int type, ltype, rtype, lconv, conv, pconv, ilen, docast;
#ifdef DEBUG
printf("maketree op = %d\n",op);
#endif
if( binop(op) ) {
if(!(rtp=popopd()))
return(0);
rtype = (rtp=funcref(arrayref(rtp)))->t_type;
#ifdef DEBUG
putexpr("maketree r",rtp);
#endif
}
if(!(ltp=popopd()))
return(0);
#ifdef DEBUG
putexpr("maketree l",ltp);
#endif
if( op == SIZEOF ) { /* [vlh] 3.4 ilen */
ilen = dsize(ltp->t_type,ltp->t_dp,ltp->t_ssp);
pushopd(cnalloc(INT,ilen));
return(1);
}
if( op != ADDR ) {
ltp = arrayref(ltp);
if( op != CALL && op != NACALL )
ltp = funcref(ltp);
}
else { /* [vlh] 4.0 &p->array */
if (ltp->t_op == ADD) /* there must be a better way... */
if (ltp->t_left->t_op==SYMBOL && ltp->t_right->t_op==CINT) {
pushopd(ltp);
return(1);
}
}
if( specops(op,ltp,rtp) )
return( 1 );
ltype = ltp->t_type;
if( lintegral(op) )
integral(ltp,LONG);
if( rintegral(op) )
integral(rtp,LONG);
if( lvalop(op) && ltp->t_op != SYMBOL && ltp->t_op != INDR &&
ltp->t_op != BFIELD )
error("assignable operand required");
if( unaryop(op) ) {
if(!unopeval(op,ltp))
pushopd(tnalloc(op,ltype,ltp->t_dp,ltp->t_ssp,ltp,0L));
return;
}
if( ltype == STRUCT || rtype == STRUCT ) {
if (ltype==STRUCT && rtype==STRUCT && op==ASSIGN) { /*[vlh]*/
pushopd(ltp);
maketree(ADDR);
pushopd(rtp);
maketree(ADDR);
maketree(STASSIGN);
strassign = 1;
return(1);
}
ltype = rtype = INT;
error("illegal structure operation");
}
type = ltype;
if( rtype == TYPELESS ) {
rtp->t_type = rtype = INT;
lconv = conv = 0;
}
else {
lconv = ttoconv(ltype);
conv = ttoconv(rtype);
if (!asgop(op) && conv > lconv) {
conv = cvmap[conv][lconv];
lconv = 1;
type = rtype;
}
else {
conv = cvmap[lconv][conv];
lconv = 0;
}
}
if( asgop(op) ) {
if( (op == ASSIGN || op == FRETURN) && (conv == INT_PTR ||
conv == UNSN_PTR) && rtp->t_op != CINT )
error("short assigned to pointer");
if( op == ASSIGN || op == CAST ) {
switch( conv ) {
case INT_PTR:
case UNSN_PTR:
case PTR_PTR:
case PTR_LONG:
case LONG_PTR:
conv = 0;
break;
}
}
}
else if( op == COLON && suptype(ltype) != 0 && ltype == rtype )
conv = 0;
else if( relop(op) && conv == PTR_PTR )
conv = 0;
pconv = 0;
if ((relop(op) || op==FRETURN) && alltype(ltype) == (STRUCT | POINTER)
&& (conv == INT_PTR || conv == LONG_PTR)) /* [vlh] 3.4 */
conv = 0; /* int compare to struct pointer, no conversion */
if( conv == PTR_PTR ) {
conv = 0;
if( op == SUB ) {
type = LONG;
pconv++;
}
else if(op != FRETURN && ( (alltype(ltype) != alltype(rtype) ||
alltype(ltype) != (POINTER|CHAR)) ) )
conv = BADCONV;
}
docast=(ltp->t_type==CHAR && rtp->t_sc!=REGISTER && rtp->t_sc<=STATIC);
if( conv ) {
if( conv == BADCONV )
error("illegal type conversion");
else if( lconv )
ltp = cvopgen(ltp,type,conv,psize(rtp),op);
else
rtp = cvopgen(rtp,type,conv,psize(ltp),op);
}
if( op == CAST ) { /* [vlh] 4.0 */
if ( docast ) /* predefined to handle conv/cast ops */
rtp = tnalloc(TOCHAR,CHAR,0,0,rtp,0L);
else if ( rtp->t_type != CHAR && !conv ) {
rtp->t_type = ltp->t_type;
rtp->t_ssp = ltp->t_ssp; /* [vlh] 3.4 */
rtp->t_dp = ltp->t_dp; /* [vlh] 3.4 */
}
pushopd(rtp);
}
if( relop(op) )
type = INT;
if(op != CAST && !binopeval(op,ltp,rtp)) {
if( btype(ltype) == STRUCT || btype(rtype) != STRUCT )
p = ltp;
else
p = rtp;
pushopd(tnalloc(op,type,p->t_dp,p->t_ssp,ltp,rtp));
}
if( pconv && ltype != (POINTER|CHAR) ) {
if(!(ltp=popopd()))
return(0);
pushopd(cvopgen(ltp,LONG,PTR_LONG,psize(ltp->t_left),op));
}
return(1);
}
/* specops - handle special operators in building tree*/
specops(op,ltp,rtp) /* returns 1 if op special, 0 otherwise*/
int op; /* operator*/
struct tnode *ltp; /* left subtree pointer*/
struct tnode *rtp; /* right subtree pointer*/
{
register int type, sr_size, sl_size;
type = ltp->t_type;
#ifdef DEBUG
putexpr("specops l",ltp);
putexpr("specops r",rtp);
#endif
switch (op) {
case 0:
break;
default:
return(0);
case APTR: /*expr -> name*/
integral(ltp,LONG); /*we need to turn expr into a*/
ltp->t_type = POINTER|STRUCT; /*pointer to a struct, then use*/
pushopd(ltp); /*expr . name stuff*/
maketree(INDR);
ltp = popopd(); /*ltp cannot be 0*/
case PERIOD: /*expr . name*/
if( !(isstel(rtp)) )
error("invalid structure member name");
type = rtp->t_type;
if( array(type) ) {
type = delspchk(type);
rtp->t_dp++;
}
tadjust(ltp,type,rtp->t_dp,rtp->t_ssp);
pushopd(ltp);
maketree(ADDR);
pushopd(cnalloc(TYPELESS,rtp->t_offset));
maketree(ADD);
if( notarray(rtp->t_type) )
maketree(INDR);
ltp = popopd();
if( rtp->t_sc == BFIELDCL ) /*ltp cannot be 0*/
ltp = tnalloc(BFIELD,type,rtp->t_dp,rtp->t_ssp,ltp,0L);
break;
case QMARK:
if( rtp->t_op != COLON )
error("invalid ?: operator syntax");
if( ltp->t_op == CINT && rtp->t_left->t_op == CINT &&
rtp->t_right->t_op == CINT )
ltp->t_value = (ltp->t_value ? rtp->t_left->t_value :
rtp->t_right->t_value);
else
ltp = tnalloc(op,rtp->t_type,0,0,ltp,rtp);
break;
case LAND:
case LOR:
case COMMA: /*don't need conversions here*/
ltp = tnalloc(op,INT,0,0,ltp,rtp);
break;
case INDR:
if( ltp->t_op == ADDR ) /**& is null op*/
ltp = ltp->t_left;
else {
if( function(type) )
error("indirection on function invalid");
ltp = tnalloc(INDR,delspchk(type),ltp->t_dp,ltp->t_ssp,ltp,0L);
}
break;
case STASSIGN: /*[vlh]*/
sr_size = psize(rtp);
sl_size = psize(ltp);
if( sl_size >= sr_size )
ltp = tnalloc(STASSIGN,sr_size,0,0,ltp,rtp);
else
error("invalid structure assignment");
break;
case NACALL:
case CALL:
if( notfunction(type) )
error("illegal call");
ltp = tnalloc(op,delspchk(type),ltp->t_dp,ltp->t_ssp,ltp,rtp);
break;
case ADDR:
if( ltp->t_op == INDR ) { /*&* is null op*/
/* ltp->t_left->t_type = addsp(type,POINTER);*/
/* ltp->t_left->t_dp = ltp->t_dp;*/
/* ltp->t_left->t_ssp = ltp->t_ssp;*/
ltp = ltp->t_left;
}
else if( ltp->t_op == SYMBOL ) {
if( ltp->t_sc == REGISTER )
error("address of register");
ltp = tnalloc(ADDR,addsp(type,POINTER),ltp->t_dp,ltp->t_ssp,
ltp,0L);
}
else
error("& operator illegal");
break;
}
pushopd(ltp);
return(1);
}
/* cvopgen - generate a conversion operator*/
/* Generates conversions necessary for integers, pointers and longs.*/
char *cvopgen(tp,type,conv,len,op) /* returns pointer to conv node*/
struct tnode *tp; /* pointer to node to do conversion*/
int type; /* type to convert to*/
int conv; /* specified conversion*/
long len; /* object length [vlh] 3.4 i=>l */
int op; /* for cast operator*/
{
register struct tnode *rtp;
register int cop, ilen;
switch(conv) {
case INT_PTR:
case UNSN_PTR:
if (type == (POINTER|CHAR) && op == CAST ) { /* [vlh] 4.0 */
cop = INT2L;
break;
}
else
if( op == CAST || op == FRETURN ) {
cop = INT2L; /*of the ptd to objects length plus*/
if( len != 1L ) { /*an integer to long covnversion*/
ilen = len;
rtp = cnalloc(INT,ilen);
tp = tnalloc(MULT,type,0,0,tp,rtp);
}
break;
}
case PTR_LONG: /*need to generate mult or div*/
case LONG_PTR: /*of the ptd to objects length*/
if( len == 1 )
return(tp);
ilen = len;
cop = (conv == PTR_LONG ? DIV : MULT);
rtp = cnalloc(INT,ilen);
break;
case INT_LONG:
case UNSN_LONG:
cop = INT2L;
break;
case INT_DOUB: /*[vlh] 3.4*/
case UNSN_DOUB:
cop = INT2F;
break;
case LONG_DOUB: /*[vlh] 3.4*/
cop = LONG2F;
break;
case DOUB_LONG: /*[vlh] 3.4*/
cop = FLOAT2L;
break;
case DOUB_INT: /*[vlh] 3.4*/
case DOUB_UNSN:
cop = FLOAT2I;
break;
case LONG_INT:
case LONG_UNSN:
cop = LONG2I;
break;
default:
error("invalid conversion");
return(tp);
}
return( tnalloc(cop,type,0,0,tp,rtp) );
}
/* tadjust - expression tree type adjustment*/
/* Adjusts the types of subtrees to agree with the top of the tree.*/
tadjust(tp,type,dp,ssp) /* returns - none*/
struct tnode *tp; /* pointer to tree*/
int type; /* type to adjust to*/
int dp; /* dimension pointer or info*/
int ssp; /* structure pointer*/
{
register int op;
tp->t_type = type;
if( dp >= 0 ) {
tp->t_dp = dp;
tp->t_ssp = ssp;
}
if( (op=tp->t_op) == ADDR )
type = delspchk(type);
else if( op == INDR )
type = addsp(type,POINTER);
else if( op != ADD && op != SUB )
return;
tadjust(tp->t_left,type,dp,ssp);
}
/* funcref - handle tree function reference*/
/* Turns a reference to a function into the address of the function.*/
char *funcref(tp) /* returns pointer to node*/
struct tnode *tp; /* pointer to old node*/
{
if( function(tp->t_type) )
tp = tnalloc(ADDR,addsp(tp->t_type,POINTER),tp->t_dp,
tp->t_ssp,tp,0L);
return(tp);
}
/* arrayref - handle tree array reference*/
/* Turns a reference to an array into the address of the array.*/
char *arrayref(tp) /* returns pointer to tree node*/
struct tnode *tp; /* tree node pointer*/
{
if( array(tp->t_type) && !(isstel(tp)) ) {
tp->t_dp++;
pushopd(tp);
tadjust(tp,delspchk(tp->t_type),-1,0);
maketree(ADDR);
tp = popopd(); /*tp cannot be 0*/
}
return(tp);
}
/* integral - checks operand for integral type*/
/* This checks for needing an integral operand.*/
integral(tp,atype) /* returns - none*/
struct tnode *tp; /* pointer to tree node*/
int atype; /* alternate type allowable*/
{
register int type;
if( (type=tp->t_type) != INT && type != UNSIGNED && type != CHAR &&
!suptype(type) && type != atype )
error("invalid operand type");
}
/* ttoconv - maps normal type into conversion table type*/
ttoconv(type) /* returns conversion type*/
int type; /* type to convert*/
{
switch(type) {
case CHAR:
case INT:
return(0);
case UNSIGNED:
return(1);
case LONG:
return(2);
case FLOAT:
case DOUBLE:
return(3);
default:
return(4);
}
}
/* binopeval - does binary operator constant expression evaluation*/
/* Does the constant expression evaluation for binary operators.*/
binopeval(op,ltp,rtp) /* returns 1 if done, 0 if not*/
int op; /* operator to evaluate*/
struct tnode *ltp; /* pointer to left subtree*/
struct tnode *rtp; /* pointer to right subtree*/
{
register int lvalue, rvalue;
if( ltp->t_op != CINT )
return(0);
lvalue = ltp->t_value;
if( rtp->t_op != CINT )
return(0);
rvalue = rtp->t_value;
switch (op) {
case ADD:
lvalue =+ rvalue;
break;
case SUB:
lvalue =- rvalue;
break;
case MULT:
lvalue =* rvalue;
break;
case DIV:
lvalue =/ rvalue;
break;
case MOD:
lvalue =% rvalue;
break;
case AND:
lvalue =& rvalue;
break;
case OR:
lvalue =| rvalue;
break;
case XOR:
lvalue =^ rvalue;
break;
case LSH:
lvalue =<< rvalue;
break;
case RSH:
lvalue =>> rvalue;
break;
case EQUALS:
lvalue = (lvalue == rvalue);
break;
case NEQUALS:
lvalue = (lvalue != rvalue);
break;
case GREAT:
lvalue = (lvalue > rvalue);
break;
case LESS:
lvalue = (lvalue < rvalue);
break;
case GREATEQ:
lvalue = (lvalue >= rvalue);
break;
case LESSEQ:
lvalue = (lvalue <= rvalue);
break;
default:
return(0);
}
ltp->t_value = lvalue;
pushopd(ltp);
return(1);
}
/* unopeval - unary operator constant expression evaluation*/
/* Does constant expression evaluation for unary operators.*/
unopeval(op,tp) /* returns 1 if done, 0 otherwise*/
int op; /* operator to evaluate*/
struct tnode *tp; /* pointer to subexpression*/
{
register int value;
if( tp->t_op != CINT )
return(0);
value = tp->t_value;
switch( op ) {
case COMPL:
value = ~ value;
break;
case UMINUS:
value = - value;
break;
case NOT:
value = ! value;
break;
default:
return(0);
}
tp->t_value = value;
pushopd(tp);
return(1);
}
/* cexpr - evaluate a constant integer expression*/
/* Used in evaluating array bounds, bit field numbers, etc.*/
cexpr()
{
register struct tnode *tp;
register char *savep;
savep = exprp;
exprp = opap;
commastop++;
if( (tp=expr()) && tp->t_op != CINT )
error("constant required");
commastop--;
exprp = savep;
return( tp->t_value );
}

311
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/c068/icode.c Normal file
View File

@@ -0,0 +1,311 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
#include "parser.h"
int bol 1;
int inittype;
int begseq;
/* int onepass; */
/*
This interfaces the Parser and the Code Generator, note that these
allow you to link together the Parser and the Code Generator.
*/
/* outbdata - set up for byte data*/
outbdata() /* returns - none*/
{
inittype = CHAR;
printf("\t.dc.b ");
}
/* outc - output a constant*/
outc(type,value) /* returns - none*/
int type;
int value;
{
if( type == CHAR )
outbdata();
else
outwdata();
printf("%d\n",value);
}
/* outwdata - set up for word data*/
outwdata() /* returns - none*/
{
inittype = INT;
printf("\t.dc.w ");
}
/* outdata - set up for data output*/
outdata() /* returns - none*/
{
inittype = INT;
printf("\t.data\n");
}
/* outldata - set up for long data output*/
outldata() /* returns - none*/
{
inittype = LONG;
printf("\t.data\n");
}
/* outfpdata - set up for floating point data output*/
outfpdata() /*[vlh] 3.4 returns - none*/
{
inittype = FLOAT;
printf("\t.data\n");
}
/* outbentry - outputs block/function entry code*/
outbentry(nlocs,nds,nas) /* returns - none*/
int nlocs; /* local size*/
int nds; /* number of D registers*/
int nas; /* number of A registers*/
{
if( !nds && !nas ) /* adjust for 1 arg*/
nlocs =+ 4;
printf("\tlink R14,#%d\n",-nlocs);
if( nds || nas ) {
printf("\tmovem.l R%d-R7",7-nds); /*7 for one arg*/
if( nas ) {
putchar('/');
printf("R%d-R13",14-nas);
}
printf(",-(sp)\n");
}
}
/* outbexit - output function exit code*/
outbexit(nds,nas) /* returns - none*/
int nds; /* number of D registers*/
int nas; /* number of A registers*/
{
if( nds || nas ) {
printf("\ttst.l (sp)+\n\tmovem.l (sp)+,"); /*1 arg stuff*/
if( nds ) {
printf("R%d-R7",8-nds);
if( nas )
putchar('/');
}
if( nas )
printf("R%d-R13",14-nas);
putchar('\n');
}
printf("\tunlk R14\n\trts\n");
}
/* outlocal - output local symbol for debugger*/
outlocal(type,sc,sym,val)
int type; /* local name type*/
int sc; /* storage type*/
char *sym; /* symbol name*/
int val;
{
switch( sc ) {
case STATIC:
if( notfunction(type) )
printf("\t~%.8s=L%d\n",sym,val);
break;
case REGISTER:
printf("\t~%.8s=R%d\n",sym,val);
break;
case AUTO:
printf("\t~%.8s=%d\n",sym,val);
break;
}
}
/* outswitch - output switch table info*/
outswitch(ncases,deflab,sp) /* returns - none*/
int ncases; /* number of cases in switch*/
int deflab; /* default label*/
struct swtch *sp; /* switch table pointer*/
{
register int vdif, val, hval, i, tlab;
register struct swtch *s;
val = sp->sw_value;
hval = sp[ncases-1].sw_value;
vdif = hval - val;
if( ncases <= 4 ) {
/*
*simple switch, do compares and brances, followed by branch to default
*/
for( s = sp; --ncases >= 0; s++ ) {
if( !s->sw_value )
printf("\ttst R0\n");
else
printf("\tcmp #%d,R0\n",s->sw_value);
printf("\tbeq L%d\n",s->sw_label);
}
outgoto(deflab);
}
else if( vdif > 0 && vdif <= ncases*3 ) {
/*jump switch, uses value in R0 to index into table of labels*/
if( val )
printf("\tsub #%d,R0\n",val);
tlab = nextlabel++;
printf("\tcmp #%d,R0\n\tbhi L%d\n",vdif,deflab); /*check for max*/
printf("\tasl #2,R0\n\tmove R0,R8\n\tadd.l #L%d,R8\n",tlab);
printf("\tmove.l (R8),R8\n\tjmp (R8)\n");
outdata();
outlab(tlab);
for( s = sp; val <= hval; val++ ) {
if( val == s->sw_value ) {
outclab(s->sw_label);
s++;
}
else
outclab(deflab);
}
outtext();
}
else {
/*
* direct switch, searches down table of values for match, if match
* found, branches to corresponding label in label table.
*/
tlab = nextlabel++;
printf("\text.l R0\n\tmove.l #L%d,R8\n\tmove #%d,R1\n",tlab,ncases);
i = nextlabel++;
outlab(i); /*loop label*/
printf("\tcmp.l (R8)+,R0\n\tdbeq R1,L%d\n",i);
printf("\tmove.l %d(R8),R8\n\tjmp (R8)\n",ncases*4);
outdata();
outlab(tlab);
for( s = sp, i = ncases; --i >= 0; s++ )
outlcon(s->sw_value);
outlcon(0); /* mark for default label*/
for( s = sp, i = ncases; --i >= 0; s++ )
outclab(s->sw_label);
outclab(deflab);
outtext();
}
}
outeof()
{
register int c;
v6flush(&sbuf);
v6flush(&obuf);
}
/* copysfile - copy string file to end of output file*/
copysfile(fname)
char *fname;
{
register int c;
close(sbuf.io_fd);
if( fopen(fname,&sbuf,0) < 0 ) /* 3rd arg for versados */
ferror("can't copy %s",fname);
while( (c=getc(&sbuf)) > 0 )
putc(c,&obuf);
v6flush(&obuf);
}
/* outword - output a word of data*/
outword(w) /* word expression*/
int w;
{
if( begseq )
putchar(',');
begseq++;
printf("%d",w);
}
/* outlong - output a long data*/
outlong(l) /* returns - none*/
long l; /* long data to output*/
{
outwdata();
outword(l.hiword);
outword(l.loword);
outendseq();
}
/* outfp - output floating point data*/
outfp(l) /*[vlh] 3.4 returns - none*/
long l; /* floating point data to output*/
{
outwdata();
outword(l.hiword);
outword(l.loword);
outendseq();
}
outendseq() /* returns - none*/
{
begseq = 0;
putchar('\n');
}
/*
* outtstr - output text string
* This outputs a string to the string file, this is used wherever
* you cannot output the string directly to data space, such as in
* the middle of expressions.
*/
outtstr(lab)
int lab;
{
char *savep;
int sbol;
savep = obp; /*save to restore later...*/
obp = &sbuf;
sbol = bol;
bol = 1;
printf("\tL%d:",lab);
outstr();
obp = savep;
bol = sbol;
}
/* outstr - output a string as a sequence of bytes*/
/* Outputs ".dc.b <byte1>,<byte2>,...,<0>*/
outstr()
{
register char *s;
register int i;
outbdata();
for( s = cstr, i = cstrsize; i > 0; i-- )
outword(*s++ & 0xff);
outendseq();
}
/*
* putchar - handle outputting to intermediate or error files
* This catches tabs to allow for the integration of the parser
* and code generator into one pass. By merely throwing away the
* tabs here, the output will be OK for the assembler.
*/
putchar(c)
char c;
{
if( !obp )
write(1,&c,1);
else if( c == '\t' ) {
if( bol ) /* not used && !onepass ) */
putc('(',obp); /*for code generator*/
}
else {
bol = (c == '\n');
putc(c,obp);
}
}

86
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/c068/interf.c Normal file
View File

@@ -0,0 +1,86 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
#include "parser.h"
int bol;
outinit(tp,type) /* returns - none*/
struct tnode *tp;
{
outexpr(tnalloc(INIT,type,0,0,tp));
}
outcforreg(tp)
struct tnode *tp;
{
outexpr(tnalloc(CFORREG,tp->t_type,0,0,tp));
}
outifgoto(tp,dir,lab)
struct tnode *tp;
int dir;
int lab;
{
outexpr(tnalloc(IFGOTO,dir,lab,0,tp));
}
outexpr(tp)
struct tnode *tp;
{
if( !bol )
putchar('\n');
printf(".%x\n",lineno);
outtree(tp);
}
outtree(tp)
struct tnode *tp;
{
if( !tp )
return;
printf("%x.%x",tp->t_op,tp->t_type);
switch( tp->t_op ) {
case CINT:
printf(".%x\n",tp->t_value);
break;
case CLONG:
printf(".%x.%x\n",tp->t_lvalue.hiword,tp->t_lvalue.loword);
break;
case CFLOAT: /*[vlh] 3.4*/
printf(".%x.%x\n",tp->t_lvalue.hiword,tp->t_lvalue.loword);
break;
case SYMBOL:
printf(".%x",tp->t_sc);
if( tp->t_sc == EXTERNAL )
printf(".%.8s\n",tp->t_symbol);
else
printf(".%x\n",tp->t_offset);
break;
case 0:
putchar('\n');
break;
case IFGOTO:
case BFIELD:
printf(".%x\n",tp->t_dp);
outtree(tp->t_left);
break;
default:
putchar('\n');
outtree(tp->t_left);
if( binop(tp->t_op) )
outtree(tp->t_right);
break;
}
}

830
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/c068/lex.c Normal file
View File

@@ -0,0 +1,830 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
#include "parser.h"
#define SOI '\01'
#define STEL HSIZE/2
/*
* the following are the cases within gettok, all other cases are
* single character unambiguous tokens. Note that we need to take
* special care not to interfere with the single character unambiguous
* operators, this is why there is a gap between WHITSP and EXCLAM.
*/
#define BADC 0 /*bad character*/
#define WHITSP 101 /*white space*/
#define EXCLAM 102 /*exlamation point*/
#define DQUOTE 103 /*double quote*/
#define PERCNT 104 /*percent sign*/
#define AMPER 105 /*ampersand*/
#define SQUOTE 106 /*single quote*/
#define STAR 107 /*asterisk or mult sign*/
#define PLUS 108 /*plus sign*/
#define MINUS 109 /*minus sign*/
#define SLASH 110 /*divide sign*/
#define DIGIT 111 /*0..9*/
#define LCAROT 112 /*less than sign*/
#define EQUAL 113 /*equals sign*/
#define RCAROT 114 /*greater than*/
#define ALPHA 115 /*a..z,A..Z and underbar*/
#define CAROT 116 /*^*/
#define BAR 117 /*vertical bar*/
char ctype[] {
BADC, BADC, BADC, BADC, BADC, BADC, BADC, BADC,
BADC, WHITSP, WHITSP, WHITSP, WHITSP, BADC, BADC, BADC,
BADC, BADC, BADC, BADC, WHITSP, BADC, BADC, BADC,
BADC, BADC, BADC, BADC, BADC, BADC, BADC, BADC,
WHITSP, EXCLAM, DQUOTE, BADC, BADC, PERCNT, AMPER, SQUOTE,
LPAREN, RPAREN, STAR, PLUS, COMMA, MINUS, PERIOD, SLASH,
DIGIT, DIGIT, DIGIT, DIGIT, DIGIT, DIGIT, DIGIT, DIGIT,
DIGIT, DIGIT, COLON, SEMI, LCAROT, EQUAL, RCAROT, QMARK,
BADC, ALPHA, ALPHA, ALPHA, ALPHA, ALPHA, ALPHA, ALPHA,
ALPHA, ALPHA, ALPHA, ALPHA, ALPHA, ALPHA, ALPHA, ALPHA,
ALPHA, ALPHA, ALPHA, ALPHA, ALPHA, ALPHA, ALPHA, ALPHA,
ALPHA, ALPHA, ALPHA, LBRACK, BADC, RBRACK, CAROT, ALPHA,
BADC, ALPHA, ALPHA, ALPHA, ALPHA, ALPHA, ALPHA, ALPHA,
ALPHA, ALPHA, ALPHA, ALPHA, ALPHA, ALPHA, ALPHA, ALPHA,
ALPHA, ALPHA, ALPHA, ALPHA, ALPHA, ALPHA, ALPHA, ALPHA,
ALPHA, ALPHA, ALPHA, LCURBR, BAR, RCURBR, COMPL, BADC
};
/*key word table*/
struct resword {
char *r_name;
int r_value;
} reswords[] {
"auto", R_AUTO,
"break", R_BREAK,
"case", R_CASE,
"char", R_CHAR,
"continue", R_CONTINUE,
"do", R_DO,
"default", R_DEFAULT,
"double", R_DOUBLE,
"goto", R_GOTO,
"else", R_ELSE,
"extern", R_EXTERNAL,
"float", R_FLOAT,
"for", R_FOR,
"if", R_IF,
"int", R_INT,
"long", R_LONG,
"register", R_REGISTER,
"return", R_RETURN,
"short", R_SHORT,
"sizeof", R_SIZEOF,
"static", R_STATIC,
"struct", R_STRUCT,
"switch", R_SWITCH,
"typedef", R_TYPEDEF,
"union", R_UNION,
"unsigned", R_UNSIGNED,
"while", R_WHILE,
0,
};
#define SELFMOD 0200
#define ASMASK 0177
/*
* this table is used to check for an operator after an equals sign.
* note that =-, =* and =& may all have an ambiguous meaning if not
* followed by a space, this is checked for in gettok.
*/
char asmap[] {
EQUALS, /*==*/
EQADD, /*=+*/
EQSUB|SELFMOD, /*=-*/
EQMULT|SELFMOD, /*=**/
EQDIV, /*=/*/
EQOR, /*=|*/
EQAND|SELFMOD, /*=&*/
EQXOR, /*=^*/
EQMOD, /*=%*/
};
char escmap[] "\b\n\r\t";
int pbchar; /*pushed back character*/
struct symbol *symtab[HSIZE]; /*hash table*/
struct symbol *symbols; /*pointer to next avail symbol buf*/
int nsyms; /*number of symbol bufs in memory*/
/*
* getdec - get a decimal number
* Uses Horner's method to get decimal number. Note that
* multiplication by 10 is cleverly programmed as two shifts and two
* adds. This is because long multiplies are painful on both the
* PDP-11 and 68000.
*/
long getdec() /* returns number*/
{
register long value;
register char c;
for( value = 0; (c=ngetch()) >= '0' && c <= '9'; ) {
value =<< 1; /*value = value*2*/
value =+ value << 2; /*value*2 + value*8 = value*10*/
value =+ (c-'0');
}
putback(c);
return(value);
}
#define BIAS 127L
#define EXPSIZ 4
#define FRACSIZ 20
long toieee();
long toffp();
float power10();
/*
* getfp - get a floating point constant
* we've already gotten the significant digits, now build a
* floating point number with possible decimal digits and an
* exponent, yields an ieee formated floating point number,
* unless the fflag is on, then a ffp constant is generated.
*/
long
getfp(significant)
long significant;
{
register char c;
register long places; /* decimal places */
int esign;
float exp, fraction, fp;
places = 0L; esign = 0; fraction = significant; exp = 0.0;
if ((c = ngetch()) == '.') /* get decimal places */
for( ; (c=ngetch()) >= '0' && c <= '9';) {
fraction = fraction * 10.0;
fraction = fraction + (c - '0');
places++;
}
if (c=='e' || c=='E') { /* exponent exists */
esign = (peekis('-')) ? 1 : (peekis('+')) ? 0 : 0;
for( ; (c=ngetch()) >= '0' && c <= '9'; ) {
exp = exp * 10.0;
exp = exp + (c - '0');
}
}
putback(c);
if (esign)
exp = -exp;
places = exp - places;
fp = fraction * power10(places);
if (fflag)
return( toffp(fp) );
else
return ( toieee(fp) );
}
float
power10(pwr) /* used by getfp, 10^pwr */
long pwr;
{
float f;
if (pwr < 0L) /* negative power */
for (f = 1.0; pwr < 0L; pwr++)
f = f / 10.0;
else /* positive power */
for (f = 1.0; pwr > 0L; pwr--)
f = f * 10.0;
return(f);
}
long
toffp(f) /* converts current machine float to ffp rep */
float f;
{
register long exp;
register int sign, count;
long l;
if (f == 0.0)
return(0L);
if (f < 0.0) {
sign = 1;
f = -f;
}
else
sign = 0;
exp = 0L;
for( ; f >= 1.0; f = f / 2.0)
exp++;
for( ; f < 0.5; f = f * 2.0)
exp--;
f = f * 16777216.0; /* 2 ^ 24 */
l = f;
l =<< 8;
if (sign)
l =| 0x80;
exp =+ 0x40;
l =| (exp & 0x7f);
return(l);
}
long
toieee(f) /* converts current machine float to ieee rep */
float f;
{
register long exp;
register int sign, count;
long l;
if (f == 0.0)
return(0L);
if (f < 0.0) {
sign = 1;
f = -f;
}
else
sign = 0;
exp = 0L;
for( ; f >= 2.0; f = f / 2.0)
exp++;
for( ; f < 1.0; f = f * 2.0)
exp--;
f = f - 1.0;
f = f * 8388608.0; /* 2 ^ 23 */
l = f;
if (sign)
l =| 0x80000000;
exp = (exp + BIAS)<<23;
l =| (exp & 0x7f800000);
return(l);
}
#define toupper(c) ((c) & ~32)
/* gethex - get an hexidecimal number*/
/* Uses Horner's method to get hexidecimal number*/
long gethex() /* returns number*/
{
register long value;
register char c, ch;
value = 0;
while( 1 ) {
if( (c=ngetch()) >= '0' && c <= '9' )
c =- '0';
else if((ch=toupper(c)) >= 'A' && ch <= 'F' ) /* [vlh] */
c = ch - ('A'-10);
else
break;
value = (value<<4) + c;
}
putback(c);
return(value);
}
/* getoct - get an octal number*/
/* Uses Horner's method to get octal number*/
long getoct(flag) /* returns number*/
int flag; /* string flag 1=>in string, else 0*/
{
register long value;
register char c;
register int count;
count = 0;
for( value = 0; (c=ngetch()) >= '0' && c <= '7'; ) {
if( flag && ++count > 3 )
break;
value = (value<<3) + (c-'0');
}
putback(c);
return(value);
}
/*
* gettok - get next token from input
* Checks pushed-packed token buffer, supresses / * * / comments,
* folds multiple character special symbols into single word token.
*/
gettok() /* returns token type*/
{
register int c, nextc, i;
register char *p;
register long value;
char sym[SSIZE];
if( peektok ) {
i = peektok;
peektok = 0;
return(i);
}
while( (c=ngetch()) != EOF ) {
switch(ctype[c]) {
case BADC: /*bad character*/
error("invalid character");
break;
case SEMI:
cvalue = 0; /* [vlh] not reserved word... */
default:
return( ctype[c] );
case WHITSP: /*skip all white space*/
break;
case EXCLAM: /*!= or !*/
return( peekis('=') ? NEQUALS : NOT );
case DQUOTE: /*quoted string*/
getstr(cstr,STRSIZE,'"');
cvalue = nextlabel++;
return(STRING);
case PERCNT: /*%= or %*/
return( peekis('=') ? EQMOD : MOD );
case AMPER: /*&=, && or &*/
return( peekis('=') ? EQAND : peekis('&') ? LAND : AND );
case SQUOTE: /*character constant*/
getstr(cstr,STRSIZE,'\'');
if( cstrsize > CHRSPWORD+1 ) {
error("character constant too long");
cstrsize = CHRSPWORD + 1;
}
cvalue = 0;
for( p = cstr; --cstrsize > 0; ) {
cvalue =<< BITSPCHAR;
cvalue =| (*p++ & 0377);
}
return(CINT);
case STAR: /**= or **/
return( peekis('=') ? EQMULT : MULT );
case PLUS: /*+=, ++ or +*/
return( peekis('=') ? EQADD : peekis('+') ? PREINC : ADD );
case MINUS: /*-=, --, -> or -*/
return( peekis('=') ? EQSUB : peekis('-') ? PREDEC :
peekis('>') ? APTR : SUB );
case SLASH: /*/ *..* /, //..., /= or /*/
if( peekis('*') ) {
while( (c=ngetch()) != EOF )
if( c == '*' && peekis('/') )
break;
if( c == EOF ) {
error("no */ before EOF");
return(EOF);
}
continue;
}
if( peekis('/') ) {
while( (c=ngetch()) != EOF && c != EOLC )
;
continue;
}
return( peekis('=') ? EQDIV : DIV );
case DIGIT: /*number constant (long or reg)*/
i = 0; /*flags if long constant*/
if( c != '0' ) {
putback(c);
dofp:
value = getdec();
if ((c=ngetch())=='.' || c=='e' || c=='E') { /*[vlh] 3.4 */
putback(c);
clvalue = getfp(value);
return(CFLOAT);
}
putback(c);
if( value > 32767 || value < -32768 )
i++;
}
else if( peekis('x') || peekis('X') ) {
value = gethex();
if( value < 0 || value >= 0x10000L )
i++;
}
else {
if (peekis('.')) {
putback('.');
goto dofp;
}
value = getoct(0);
if( value < 0 || value >= 0x10000L )
i++;
}
if( peekis('l') || peekis('L') || i ) {
clvalue = value;
return(CLONG);
}
cvalue = value;
return(CINT);
case LCAROT: /*<=, <<, <<= or <*/
return( peekis('=') ? LESSEQ : peekis('<') ?
(peekis('=') ? EQLSH : LSH) : LESS );
case EQUAL: /*==, =<<, =>>, =+, ..., =*/
if( peekis('<') ) {
if( peekis('<') )
return(EQLSH);
}
else if( peekis('>') ) {
if( peekis('>') )
return(EQRSH);
}
else if( (i=index("=+-*/|&^%",(c=ngetch()))) >= 0 ) {
i = asmap[i];
if( i & SELFMOD ) {
if( (nextc=ngetch()) != ' ' )
if (!wflag) /*[vlh] old fashion initialization*/
error("=%c assumed",c);
putback(nextc);
}
return( i & ASMASK );
}
else
putback(c);
return(ASSIGN);
case RCAROT: /*>=, >>, >>= or >*/
return( peekis('=') ? GREATEQ : peekis('>') ?
(peekis('=') ? EQRSH : RSH) : GREAT );
case ALPHA: /*[A-Za-z][A-Za-z0-9]**/
p = &sym[0];
i = SSIZE;
for(; ctype[c] == ALPHA || ctype[c] == DIGIT; c=ngetch(),i-- )
if( i > 0 )
*p++ = c;
if( i > 0 )
*p = '\0';
putback(c);
csp = lookup(sym);
if( csp->s_attrib & SRESWORD ) {
cvalue = csp->s_offset;
return(RESWORD);
}
smember = 0;
return(SYMBOL);
case CAROT: /*^= or ^*/
return( peekis('=') ? EQXOR : XOR );
case BAR: /*|=, || or |*/
return( peekis('=') ? EQOR : peekis('|') ? LOR : OR );
}
}
return(EOF);
}
/*
* peekis - peeks at next character for specific character
* Gets next (possibly pushed back) character, if it matches
* the given character 1 is returned, otherwise the character
* is put back.
*/
peekis(tc) /* returns 1 if match, 0 otherwise*/
int tc; /* test character*/
{
register int c;
if( (c=ngetch()) == tc )
return(1);
putback(c);
return(0);
}
/* ngetch - get a possibly pushed back character*/
/* Checks pbchar variable, returns it if non-zero, handles counting*/
/* of new lines and whether you are in an include or not.*/
ngetch() /* returns character read or EOF*/
{
register int c;
register char *ifile;
if( pbchar ) {
c = pbchar;
pbchar = 0;
}
else if( (c=getc(&ibuf)) == EOLC ) {
if( inclflag )
inclflag = 0;
else
lineno++;
}
else if( c == SOI) { /*[vlh]add incl filename & line # */
inclflag++;
ifile = &inclfile;
while ((c=getc(&ibuf)) != SOI)
*ifile++ = c&0377;
*ifile = 0;
inclline = getdec() & 077777;
c = ' ';
}
else if( c < 0 )
c = EOF;
return(c);
}
/*
* peekc - peek at the next non-whitespace character after token
* This allows for the problem of having to look at two tokens
* at once. The second token is always a semi-colon or colon,
* so we only look at the single character, rather than going
* thru gettok.
*/
peekc(tc) /* returns 1 if match, 0 otherwise*/
int tc; /* character to look for*/
{
register int c;
while( ctype[(c=ngetch())] == WHITSP) ;
if( c == tc )
return(1);
putback(c);
return(0);
}
/* putback - puts back a single character*/
/* Checks pbchar for error condition.*/
putback(c) /* returns - none*/
int c;
{
if( pbchar )
error("too many chars pushed back");
else
pbchar = c;
}
/* getstr - get a quoted (single or double) character string*/
/* Gets specified number of characters, handling escapes.*/
getstr(str,nchars,endc) /* returns - none*/
char *str; /* pointer to string buffer*/
int nchars; /* max number of characters*/
char endc; /* ending string character*/
{
register char *p;
register int i;
register int c;
register int j;
cstrsize = 1;
p = str;
for( i = nchars; (c=ngetch()) != endc; i-- ) {
if( c == EOF || c == EOLC ) {
error("string cannot cross line");
break;
}
if( c == '\\' ) {
if( (c=ngetch()) >= '0' && c <= '7' ) {
putback(c);
if( (c=getoct(1)) < 0 || c > 255 ) {
error("bad character constant");
continue;
}
}
else if( (j=index("bnrt",c)) >= 0 )
c = escmap[j];
else if( c == EOLC ) /*escape followed by nl->ignore*/
continue;
}
if( i > 0 ) { /*room left in string?*/
cstrsize++;
*p++ = c;
}
else if( !i ) /*only say error once...*/
error("string too long");
}
if( i <= 0 ) /*string overflow?*/
p--;
*p = '\0';
}
/* syminit - initialize the symbol table, install reswords*/
/* Goes thru the resword table and installs them into the symbol*/
/* table.*/
syminit() /* returns - none*/
{
register struct resword *rp;
for( rp = &reswords[0]; rp->r_name != 0; rp++ )
install(rp->r_name,SRESWORD|SDEFINED,rp->r_value);
}
/* install - install a symbol in the symbol table*/
/* Allocates a symbol entry, copies info into it and links it*/
/* into the hash table chain.*/
char *
install(sym,attrib,offset) /* returns pointer to symbol struct*/
char *sym; /* symbol to install*/
int attrib; /* attribues of symbol*/
int offset; /* symbol offset (resword value)*/
{
register struct symbol *sp;
register int i;
while( (sp=symbols) <= 0 ) {
if( (sp=sbrk(SYMSIZE)) <= 0 )
ferror("symbol table overflow");
for( i = SYMSIZE/(sizeof *symbols); --i >= 0; ) {
if (sp <= 0)
ferror("bad symbol table");
sp->s_next = symbols;
symbols = sp++;
}
}
symbols = sp->s_next;
sp->s_attrib = attrib;
sp->s_sc = 0; sp->s_type = 0; sp->s_dp = 0; sp->s_ssp = 0;
sp->s_offset = offset;
sp->s_struc = (instruct) ? strucptr[smember+instruct] : 0;
symcopy(sym,sp->s_symbol); /*copy symbol to symbol struct*/
i = symhash(sym,instruct|smember); /*link into chain list*/
sp->s_next = symtab[i];
symtab[i] = sp;
return(sp);
}
/* lookup - looks up a symbol in symbol table*/
/* Hashes symbol, then goes thru chain, if not found, then*/
/* installs the symbol.*/
char *lookup(sym) /* returns pointer to symbol buffer*/
char *sym; /* pointer to symbol*/
{
register struct symbol *sp, *hold;
register char *p;
int exact; /* same name, diff type or offset */
p = sym;
for( sp = symtab[symhash(p,0)]; sp != 0; sp = sp->s_next )
if((sp->s_attrib&(SRESWORD|STYPEDEF)) && symequal(p,sp->s_symbol))
return(sp);
if (!(smember|instruct)) { /*[vlh]*/
for( sp=symtab[symhash(p,0)]; sp!=0; sp=sp->s_next )
if( symequal(p,sp->s_symbol) ) return(sp);
}
else { /* doing a declaration or an expression */
hold = 0; exact = 0;
for( sp=symtab[symhash(p,instruct|smember)]; sp!=0; sp=sp->s_next )
if( symequal(p,sp->s_symbol) )
if (symsame(sp,hold,&exact)) return(sp);
else if (!hold && !exact) hold = sp;
if (hold && !exact) return(hold);
}
return(install(p,0,0));
}
/* freesyms - frees all local symbols at end of function declaration*/
/* Searches thru symbol table, deleting all symbols marked as locals*/
freesyms() /* returns - none*/
{
register int i, tinfo;
register struct symbol *sp, *tp, *nextp, **htp;
for( htp = &symtab[0], i = HSIZE; --i >= 0; htp++ )
for( tp = 0, sp = *htp; sp != 0; sp = nextp ) {
nextp = sp->s_next;
if( !(sp->s_attrib&SDEFINED) ) {
error("undefined label: %.8s",sp->s_symbol);
sp->s_attrib =| SDEFINED;
}
if( sp->s_attrib & (SGLOBAL|SRESWORD) )
tp = sp;
else {
if( tp )
tp->s_next = sp->s_next;
else
*htp = sp->s_next;
sp->s_next = symbols;
symbols = sp;
}
}
}
/* chksyms - checks symbol table for undefined symbols, etc.*/
/* Goes thru the symbol table checking for undeclared forward*/
/* referenced structures, and outputs local symbols for debugger.*/
chksyms() /* returns - none*/
{
register struct symbol **htp, *sp;
register int i, sc;
for( htp = &symtab[0], i = HSIZE; --i >= 0; htp++ )
for( sp = *htp; sp != 0; sp = sp->s_next ) {
sc = sp->s_sc;
if(sc!=0 && sp->s_ssp>=0 && (btype(sp->s_type))==FRSTRUCT) {
sp->s_ssp = frstab[sp->s_ssp]->s_ssp; /* 3.4 ssp>0 */
sp->s_type = (sp->s_type&~TYPE) | STRUCT;
}
if( sc == PDECLIST ) {
error("not in parameter list: %.8s",sp->s_symbol);
sp->s_sc = AUTO;
}
if( infunc )
outlocal(sp->s_type,sp->s_sc,sp->s_symbol,sp->s_offset);
}
}
/* symhash - compute hash value for symbol*/
/* Sums the symbols characters and takes that modulus the hash table*/
/* size.*/
symhash(sym,stel) /* returns hash value for symbol*/
char *sym; /* pointer to symbol*/
int stel; /* structure element flag*/
{
register char *p;
register int hashval, i;
hashval = (stel ? STEL : 0 );
for( p = sym, i = SSIZE; *p != '\0' && i > 0; i-- )
hashval =+ *p++;
return( hashval % HSIZE );
}
/* symequal - check for symbol equality*/
/* Does comparison between two symbols.*/
symequal(sym1,sym2) /* returns 1 if equal, 0 otherwise*/
char *sym1; /* pointer to first symbol*/
char *sym2; /* pointer to second symbol*/
{
register char *p, *q;
register int i;
for( p = sym1, q = sym2, i = SSIZE; *p == *q++; )
if( *p++ == '\0' || --i == 0 )
return(1);
return(0);
}
/* symsame - symbol member same as declared */
symsame(sp,hold,exact) /* [vlh] */
struct symbol *sp, *hold;
int *exact;
{
if (strucptr[smember+instruct])
if (strucptr[smember+instruct]==sp->s_struc) return(1);
if (hold)
if (sp->s_type != hold->s_type || sp->s_offset != hold->s_offset)
*exact = 1;
return(0);
}
/* symcopy - symbol copy*/
/* Copies one symbol to another.*/
symcopy(sym1,sym2) /* returns - none*/
char *sym1; /* pointer to symbol to copy*/
char *sym2; /* pointer to area to copy to*/
{
register char *p, *q;
register int i;
for( p = sym1, q = sym2, i = SSIZE; --i >= 0; )
*q++ = ( *p ? *p++ : '\0');
}
/* index - find the index of a character in a string*/
/* This is identical to Software Tools index.*/
index(str,chr) /* returns index of c in str or -1*/
char *str; /* pointer to string to search*/
char chr; /* character to search for*/
{
register char *s;
register int i;
for( s = str, i = 0; *s != '\0'; i++ )
if( *s++ == chr )
return(i);
return(-1);
}
/* next - if next token matches given token, skip and return success*/
/* This allows for clean parsing of declarations.*/
next(tok) /* returns 1 if matched, 0 otherwise*/
int tok;
{
register int token;
if( (token=gettok()) == tok )
return(1);
peektok = token;
return(0);
}
/* pbtok - put back the given token*/
/* This merely sets the peektok variable*/
pbtok(tok) /* returns - none*/
int tok;
{
if( peektok )
error("too many tokens pushed back");
peektok = tok;
}

159
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/c068/main.c Normal file
View File

@@ -0,0 +1,159 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
char *version "@(#) c068 parser 4.0 - Mar 18, 1983";
/*
ALCYON C Compiler for the Motorola 68000 - Parser
Called from c68:
c068 source icode strings
source: input source code, preprocessed with comments stripped
icode: contains the intermediate code for the code generator,
for a detailed explanaion see ../doc/icode.
strings: contains all the string constants.
The basic structure of the parser is as follows:
main main driver for parser
syminit initializes symbol table
doextdef external definition syntax
getatt get type attributes
dlist declaration list for structures/unions
getatt recursive gettype call
dodecl do one declaration
declarator handle declarator syntax
dodecl do one external declaraion
initlist external initialization list
cexpr constant expressions
expr arithmetic expressions
maketree build operator tree
funcbody function body
dlist declaration list
stmt function statements
stmt recursive stmt call
expr arithmetic expressions
*/
#include "parser.h"
int nextlabel 1;
int lineno;
char *exprp &exprarea[0];
/*
* main - main routine for parser
* Checks arguments, opens input and output files, does main loop
* for external declarations and blocks.
*/
main(argc,argv) /* returns - none*/
int argc; /* argument count*/
char *argv[]; /* argument pointers*/
{
register char *q;
register int i;
for( i = 4; i < argc; i++ ) {
q = argv[i];
if( *q++ != '-' )
usage();
while( 1 ) {
switch( *q++ ) {
case 'f':
fflag++;
continue;
case 'e':
eflag++;
continue;
case 'w':
wflag++;
continue;
case '\0':
break;
default:
usage();
}
break;
}
}
if( argc < 4 )
usage();
if( fopen(argv[1],&ibuf,0) < 0 ) /* 3rd arg for versados */
ferror("can't open %s",argv[i]);
if( fcreat(argv[2],&obuf,0) < 0 || fcreat(argv[3],&sbuf,0) < 0 )
ferror("temp creation error");
obp = &obuf;
lineno++;
frstp = -1; /* [vlh] 3.4 - initialize only once */
syminit();
while( !peek(EOF) )
doextdef();
outeof();
outdata();
copysfile(argv[3]);
exit(errcnt!=0);
}
/* usage - output usage error message and die*/
usage()
{
ferror("usage: c068 source icode str [-e] [-f] [-w]");
}
/* error - report an error message*/
/* outputs current line number and error message*/
error(s,x1,x2,x3,x4,x5,x6) /* returns - none*/
char *s; /* error message*/
int x1, x2, x3, x4, x5, x6; /* args for printf*/
{
register char *savep;
savep = obp;
obp = 0;
errcnt++;
if (!inclflag) {
if( lineno )
printf("* %d: ",lineno);
}
else /*[vlh] generate filename and approp line #*/
printf("%s: * %d: ",inclfile,inclline);
printf(s,x1,x2,x3,x4,x5,x6);
printf("\n");
obp = savep;
}
/* ferror - fatal error*/
/* Outputs error message and exits*/
ferror(s,x1,x2,x3,x4,x5,x6) /* returns - none*/
char *s; /* error message*/
int x1, x2, x3, x4, x5, x6; /* args for printf*/
{
error(s,x1,x2,x3,x4,x5,x6);
exit(1);
}
v6flush(v6buf)
struct iobuf *v6buf;
{
register i;
i = BLEN - v6buf->nunused;
v6buf->nunused = BLEN;
v6buf->xfree = &(v6buf->buff[0]);
if(write(v6buf->fildes,v6buf->xfree,i) != i)
return(-1);
return(0);
}

168
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/c068/misc.c Normal file
View File

@@ -0,0 +1,168 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
/* alignment, node type altering routines, dimension table allocating */
/* routine, and routines to determine elements actual size */
#include "parser.h"
#define DTSIZE 077 /*data size in bytes*/
char dinfo[];
/* dalloc - dimension table allocation*/
/* Allocates an entry in the dimension table.*/
dalloc(dimsize) /* returns ptr to dimension allocated*/
long dimsize; /* dimension size [vlh] 3.4 i=>l*/
{
register int i;
if( (i=cdp++) >= DSIZE-1 )
ferror("dimension table overflow");
dtab[i] = dimsize;
return(i);
}
/* addsp - add special type to special type info*/
/* Takes given special type and adds it into the special type field.*/
addsp(type,nsptype) /* returns resulting type*/
int type; /* old type field*/
int nsptype; /* special type to be added*/
{
register int dtype;
dtype = btype(type);
type =& (~TYPE);
return( (type<<SUTYPLEN) | suptype(nsptype) | dtype );
}
/* delsp - delete one special type info field from special type info*/
/* Takes given special type field and deletes least sign.*/
delsp(type) /* returns resulting type*/
int type; /* old special type*/
{
register int dtype;
dtype = btype(type);
type =& (~(ALLTYPE));
return( (type>>SUTYPLEN) | dtype );
}
/*
* revsp - reverse special type info
* This allows for the processing of the super-type info in
* the reverse order, which is necessary for initializations.
*/
revsp(type) /* returns reversed type info*/
int type; /* type to reverse*/
{
register int t;
for( t = btype(type); suptype(type) != 0; type = delsp(type) )
t = addsp(t,type);
return(t);
}
/* falign - handle bit field alignments*/
falign(type,flen) /* returns number of bytes padded*/
int type; /* data type*/
int flen; /* field length*/
{
register int off;
off = 0;
if( flen <= 0 ) {
error("invalid field size");
flen = 0;
}
switch( type ) {
case INT:
case UNSIGNED:
if( flen > BITSPWORD )
error("field overflows word");
if( flen + boffset > BITSPWORD )
off = CHRSPWORD;
break;
case CHAR:
if( flen > BITSPCHAR )
error("field overflows byte");
if( flen + boffset > BITSPCHAR )
off = 1;
break;
default:
error("invalid field type description");
return(0);
}
if( off )
boffset = 0;
boffset =+ flen;
return(off);
}
/* salign - structure alignment*/
salign(type,offset) /* returns bytes of padding*/
int type; /* data type to align*/
int offset; /* current structure offset*/
{
register int off;
off = offset;
if( boffset ) { /*remaining bit fields, flush 'em*/
off =+ (boffset+(BITSPCHAR-1))/BITSPCHAR;
boffset = 0;
}
while( array(type) ) /*get base type*/
type = delsp(type);
if( type != CHAR ) /*need word boundary*/
off = walign(off);
return( off - offset );
}
/* delspchk - delete one special reference and check if non-zero*/
delspchk(type) /*returns new special type*/
int type; /* type to modify*/
{
if(!(suptype(type)))
error("bad indirection");
return( delsp(type) );
}
/* psize - return size of object ptd at by pointer*/
long /* [vlh] 3.4 int => long */
psize(tp) /* returns size of object in bytes*/
struct tnode *tp; /* pointer to tree node*/
{
if ( !(suptype(tp->t_type)) ) /* what case ??? */
return(1);
return( dsize(delsp(tp->t_type),tp->t_dp,tp->t_ssp) );
}
/* dsize - returns size of data object in bytes*/
long /* [vlh] 3.4 */
dsize(type,dp,sp) /* returns number of bytes*/
int type; /* type of node*/
int dp; /* dimension pointer*/
int sp; /* size pointer if structure*/
{
register long nel, size;
nel = 1;
for( ; array(type); type = delsp(type) )
nel = dtab[dp];
if( function(type) )
return(0);
size = (pointer(type)) ? PTRSIZE : (type == STRUCT) ?
dtab[sp] : dinfo[type]&DTSIZE;
if(!size)
error("invalid data type");
return( size * nel );
}

165
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/c068/node.c Normal file
View File

@@ -0,0 +1,165 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
/* node allocation, node stack manipulation routines */
#include "parser.h"
int opdontop;
int strassign;
/* talloc - expression area tree node allocation
* Allocates area and checks for overflow.*/
char *talloc(size) /* returns pointer to node*/
int size; /* size of node to alloc*/
{
register char *p;
p = opap;
if( p + size >= &exprarea[EXPSIZE] )
ferror("expression too complex");
opap = p + size;
return(p);
}
/*
* enalloc - external name alloc
* Allocates an expression tree node for an external name and
* copies symbol table info and symbol into tree node.
*/
char *enalloc(sp) /* returns - none*/
struct symbol *sp; /* pointer to symbol table entry*/
{
register struct extnode *ep;
ep = talloc(sizeof(*ep));
ep->t_op = SYMBOL;
ep->t_sc = sp->s_sc;
ep->t_type = sp->s_type;
ep->t_dp = sp->s_dp;
ep->t_ssp = sp->s_ssp;
ep->t_offset = sp->s_offset;
symcopy(sp->s_symbol,ep->t_symbol);
return(ep);
}
/* cnalloc - constant node allocation
* Allocates a constant tree node and fills the info fields.*/
char *cnalloc(type,value) /* returns pointer to node*/
int type; /* data type*/
int value; /* constant value*/
{
register struct conode *cp;
cp = talloc(sizeof(*cp));
cp->t_op = CINT;
cp->t_type = type;
cp->t_dp = 0;
cp->t_ssp = 0;
cp->t_value = value;
return(cp);
}
/* lcnalloc - long constant node allocation*/
/* Allocates a constant tree node and fills the info fields.*/
char *lcnalloc(type,value) /* returns pointer to node*/
int type; /* data type*/
long value; /* constant value*/
{
register struct lconode *cp;
cp = talloc(sizeof(*cp));
cp->t_op = CLONG;
cp->t_type = type;
cp->t_dp = 0;
cp->t_ssp = 0;
cp->t_lvalue = value;
return(cp);
}
/* fpcnalloc - floating point constant node allocation*/
/* Allocates a constant tree node and fills the info fields.*/
char *fpcnalloc(type,value) /*[vlh] 3.4 returns pointer to node*/
int type; /* data type*/
long value; /* constant value*/
{
register struct lconode *cp;
cp = talloc(sizeof(*cp));
cp->t_op = CFLOAT;
cp->t_type = type;
cp->t_dp = 0;
cp->t_ssp = 0;
cp->t_lvalue = value;
return(cp);
}
/* tnalloc - tree node allocation*/
/* Allocates an operator tree node and fills the info fields*/
char *tnalloc(op,type,dp,ssp,left,right) /* returns pointer to node*/
int op; /* operator*/
int type; /* operator type*/
int dp; /* dimension pointer or other info*/
int ssp; /* structure length pointer*/
char *left; /* left subtree*/
char *right; /* right subtree*/
{
register struct tnode *tp;
tp = talloc(sizeof(*tp));
tp->t_op = op;
tp->t_type = type;
tp->t_dp = dp;
tp->t_ssp = ssp;
tp->t_left = left;
tp->t_right = right;
return(tp);
}
/* snalloc - symbol node allocation*/
/* Allocates a tree symbol node and sets the info in it*/
char *snalloc(type,sc,off,dp,ssp) /* returns pointer to node alloc'ed*/
int type; /* symbol type*/
int sc; /* storage class*/
int off; /* offset*/
int dp; /* dimension pointer or other info*/
int ssp; /* structure size pointer*/
{
register struct symnode *snp;
snp = talloc(sizeof(*snp));
snp->t_op = SYMBOL;
snp->t_sc = sc;
snp->t_type = type;
snp->t_dp = dp;
snp->t_ssp = ssp;
snp->t_offset = off;
return(snp);
}
/* pushopd - put operand node onto operand stack*/
/* Checks for operand stack overflow.*/
pushopd(tp) /* returns - none*/
struct tnode *tp; /* pointer to tree node to push*/
{
if( opdp >= &opdstack[OPDSIZE] )
ferror("expression too complex");
*opdp++ = tp;
}
/* popopd - pop operand stack*/
/* Checks for stack underflow*/
char *popopd() /* returns ptr to top operand*/
{
register struct tnode *tp;
if( opdp <= &opdstack[0] )
return(0);
tp = *--opdp;
return(tp);
}

316
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/c068/parser.h Normal file
View File

@@ -0,0 +1,316 @@
/*#define DEBUG 1*/
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
/*
C68 Parser - include file
*/
#include "../icode.h"
/*symbol attribute fields*/
#define SRESWORD 001 /*is symbol a reserved word?*/
#define SGLOBAL 002 /*is symbol global?*/
#define STYPEDEF 004 /*typedef declaration?*/
#define SDEFINED 010 /*symbol defined?*/
/*reserved words*/
#define R_AUTO 1
#define R_BREAK 2
#define R_CASE 3
#define R_CHAR 4
#define R_CONTINUE 5
#define R_DO 6
#define R_DEFAULT 7
#define R_DOUBLE 8
#define R_GOTO 9
#define R_ELSE 10
#define R_EXTERNAL 11
#define R_FLOAT 12
#define R_FOR 13
#define R_IF 14
#define R_INT 15
#define R_LONG 16
#define R_REGISTER 17
#define R_RETURN 18
#define R_SHORT 19
#define R_SIZEOF 20
#define R_STATIC 21
#define R_STRUCT 22
#define R_SWITCH 23
#define R_TYPEDEF 24
#define R_UNION 25
#define R_UNSIGNED 26
#define R_WHILE 27
/*
* mixed-mode conversions, entries in 2-d array indexed by:
* (int,unsn,long,doub,ptr)
*/
#define INT_CHAR 1
#define UNSN_CHAR 1
#define LONG_CHAR 1
#define DOUB_CHAR 1
#define PTR_CHAR 1
#define INT_UNSN 0 /*no conversion is generated*/
#define INT_LONG 2
#define INT_DOUB 3
#define INT_PTR 4
#define UNSN_INT 0 /*no conversion is generated*/
#define UNSN_LONG 6
#define UNSN_DOUB 7
#define UNSN_PTR 8
#define LONG_INT 9
#define LONG_UNSN 10
#define LONG_DOUB 11
#define LONG_PTR 12
#define DOUB_INT 13
#define DOUB_UNSN 14
#define DOUB_LONG 15
#define PTR_INT 16
#define PTR_UNSN 17
#define PTR_LONG 18
#define PTR_PTR 19
#define BADCONV 20
/* miscellaneous constants */
#define OPSSIZE 40 /*operator stack size*/
#define OPDSIZE 80 /*operand stack size*/
#define HSIZE 517 /*hash table size, 3.4 made prime */
/* [vlh] 4.1 was 1024, but 1144 is divisible evenly on the 11 and 68000 */
#define SYMSIZE 1144 /*size to alloc for symbol structures*/
#define SWSIZE 256 /*max no. of cases in a switch*/
#define DSIZE 1000 /*dimension table size*/
#define BITSPWORD 16 /*bits per word*/
#define AREGLO 010 /*A reg flag*/
#define HICREG 2 /*highest reg # used for code generation*/
#define BITSPCHAR 8 /*bits per char*/
#define CHRSPWORD 2 /*chars per word*/
#define STRSIZE 300 /*max string length*/
#define NFARGS 40 /*max no. of args to function*/
#define NFRSTR 20 /*max no. of forward ref struct proto*/
/*symbol table node*/
struct symbol {
char s_attrib; /* defined, resword, global, typedef */
char s_sc; /* auto, static, external, register */
int s_type; /* 4bits specified, 2 bit fields for ptr... */
int s_dp; /* index into dimension table */
int s_ssp; /* dimension table/function arg table */
int s_offset; /* offset inside of structure */
char s_symbol[SSIZE]; /* symbol identifier, to SSIZE chars */
struct symbol *s_struc; /* if struct, ptr to parent (sys III) */
struct symbol *s_next; /* next symbol table entry */
};
/*expression tree operator node*/
struct tnode {
int t_op;
int t_type;
int t_dp;
int t_ssp;
struct tnode *t_left;
struct tnode *t_right;
};
/*expression tree node for symbol - only keeps location*/
struct symnode {
int t_op;
int t_type; /*data type of symbol*/
int t_dp; /*dimension pointer of symbol*/
int t_ssp; /*structure size index to dtab*/
int t_sc; /*storage class of symbol*/
int t_offset; /*offset of symbol*/
int t_label;
};
/*expressioon tree node for external symbol - need to keep name*/
struct extnode {
int t_op;
int t_type;
int t_dp;
int t_ssp;
int t_sc;
int t_offset;
int t_reg;
int t_symbol[SSIZE]; /*symbol name*/
};
/*expression tree node for integer constant*/
struct conode {
int t_op;
int t_type;
int t_dp;
int t_ssp;
int t_value; /*constant value*/
};
struct lconode {
int t_op;
int t_type;
int t_dp;
int t_ssp;
long t_lvalue; /*constant value*/
};
struct swtch {
int sw_label;
int sw_value;
} swtab[SWSIZE];
/*operator and operand stack used by expr*/
struct ops { /*operator stack*/
int o_op; /*operator*/
int o_pri; /*priority*/
} opstack[OPSSIZE], *opp;
char *opdstack[OPDSIZE]; /*operand stack*/
char **opdp; /*operand stack pointer*/
char *opap; /*ptr to next available loc in exprarea*/
char *exprp; /*place to start building expression*/
int opinfo[]; /*operator info table*/
struct tnode *frp; /*pointer to function return info node*/
int swp; /*current entry in switch table*/
int cswp; /*current low switch table index*/
int nextlabel; /*generates unique label numbers*/
int clabel; /*continue label*/
int blabel; /*break label*/
int rlabel; /*return label*/
int dlabel; /*default label*/
int lineno; /*current line number of input*/
int errcnt; /*count of errors*/
int inclflag; /*in include file, don't incr line #'s*/
int inclline; /*[vlh]line# in incl file for err rpting*/
char inclfile[13]; /*[vlh]include filename for err rpting*/
int equalstop; /*stop lex at '=', used for external init*/
int commastop; /*stop parse @ comma(used for const expr)*/
int colonstop; /*stop parse @ colon(used for case value)*/
int instruct; /*set when in structure declaration*/
int smember; /*set when seen . or ->*/
int infunc; /*set when in function body*/
int tdflag; /*declaration is a typedef proto*/
char *tdp; /*points to typedef prototype*/
int localsize; /*length of local variables*/
int naregs; /*keeps track of ptr registers alloc'd*/
int ndregs; /*keep track of data registers alloc'd*/
int loadreg; /*need to load registers...*/
int boffset; /*current bit offset in structure*/
int eflag; /*[vlh] 3.4 IEEE floats */
int fflag; /*[vlh] 3.4 FFP floats */
int xflag; /*translate int's to long's*/
int wflag; /*[vlh] don't generate warning mesgs*/
int reducep; /*[vlh] if(procid); reduction*/
int peektok; /*peeked at token*/
/*dimension table*/
long dtab[DSIZE]; /* [vlh] 3.4 int => long */
int cdp; /*next entry in dtab to alloc*/
/*lexical analyzer values*/
int cvalue; /*current token value if keyword or CINT*/
int cstrsize; /*current string size*/
long clvalue; /*current token value if long constant*/
struct symbol *csp; /*current token symbol ptr if SYMBOL*/
char cstr[STRSIZE]; /*current token value if CSTRING*/
struct symbol *dsp; /*declarator symbol pointer*/
/* -1 -> not instruct, 0 -> unnamed struct */
struct symbol *strucptr[10]; /*[vlh] ptrs to struc symbols*/
/*function argument table, used to collect function parameters*/
struct farg {
struct symbol *f_sp;
int f_offset;
} fargtab[NFARGS];
/*forward referenced structure prototype names*/
struct symbol *frstab[NFRSTR];
int frstp;
/*output buffers for intermediate code and strings*/
struct io_buf obuf, sbuf, ibuf, *obp;
#define stypedef(sp) (sp->s_attrib&STYPEDEF)
#define walign(add) ((add+1)&(~1))
#define array(type) ((type&SUPTYP)==ARRAY)
#define function(type) ((type&SUPTYP)==FUNCTION)
#define pointer(type) ((type&SUPTYP)==POINTER)
#define notarray(type) ((type&SUPTYP)!=ARRAY)
#define notfunction(type) ((type&SUPTYP)!=FUNCTION)
#define notpointer(type) ((type&SUPTYP)!=POINTER)
#define btype(type) (type&TYPE)
#define suptype(type) (type&SUPTYP)
#define alltype(type) (type&(SUPTYP|TYPE))
#define asgop(op) ((opinfo[op]&OPASSIGN)!=0)
#define relop(op) ((opinfo[op]&OPREL)!=0)
#define lintegral(op) ((opinfo[op]&OPLWORD)!=0)
#define rintegral(op) ((opinfo[op]&OPRWORD)!=0)
#define rasop(op) ((opinfo[op]&OPRAS)!=0)
#define binop(op) ((opinfo[op]&OPBIN)!=0)
#define unaryop(op) ((opinfo[op]&OPBIN)==0)
#define leaf(op) ((opinfo[op]&OPTERM)!=0)
#define lvalop(op) ((opinfo[op]&OPLVAL)!=0)
#define oppriority(op) (opinfo[op]&OPPRI)
#define makeiop(op) (op|(0254<<8))
/* checks for symbol with structure element storage class */
#define isstel(tp) (tp->t_op==SYMBOL && (sesc(tp)))
#define sesc(t) (t->t_sc==STELCL||t->t_sc==UNELCL||t->t_sc==BFIELDCL)
/* peek at next token, if not read token put back, else delete */
/* 1 if matched, 0 otherwise */
#define peek(tok) ( (peektok=gettok()) == tok )
#define outcommon(sym,size) printf("\t.comm _%.8s,%ld\n",sym,size)
#define outgoto(lab) if( lab > 0 ) printf("\tbra L%d\n",lab)
/* change to text segment */
#define outtext() printf("\t.text\n")
/* change segment to bss */
#define outbss() printf("\t.bss\n")
/* output global symbol references */
#define outextdef(sym) printf("\t.globl _%.8s\n",sym)
/* outputs reserved memory [vlh] 3.4 %d => %ld */
#define outresmem(size) printf("\t.ds.b %ld\n",size)
/* output padding for word alignments */
#define outpad() printf("\t.even\n")
/* output long constant to assembler */
#define outlcon(val) printf("\t.dc.l %d\n",val)
/* output label constant */
#define outclab(lab) printf("\t.dc.l L%d\n",lab)
/* output a label */
#define outlab(lab) printf("\tL%d:",lab)
/* output function label */
#define outflab(sym) printf("\t_%.8s:\n\t~~%.8s:\n",sym,sym)
/* output data label */
#define outdlab(sym) printf("\t_%.8s:\n",sym)
/*functions returning pointers*/
char *expr();
char *talloc();
char *tnalloc();
char *enalloc();
char *snalloc();
char *cnalloc();
char *lcnalloc();
char *fpcnalloc();
char *popopd();
char *cvopgen();
char *arrayref();
char *funcref();
char *install();
char *lookup();
char *balpar();
char *sbrk();
long initlist();
long dsize();
long psize();
long dodecl();
long dlist();
long getdec();
long gethex();
long getoct();
long getfp();
long toieee();
long toffp();

255
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/c068/putexpr.c Normal file
View File

@@ -0,0 +1,255 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
#include "parser.h"
#ifdef DEBUG
char invalid[] "INVALID";
char *opname[] {
invalid, /*0*/
"+", /*1*/
"-", /*2*/
"*", /*3*/
"/", /*4*/
"%", /*5*/
">>", /*6*/
"<<", /*7*/
"&", /*8*/
"|", /*9*/
"^", /*10*/
"!", /*11*/
"U-", /*12*/
"~", /*13*/
"--p", /*14*/
"++p", /*15*/
"p--", /*16*/
"p++", /*17*/
"=", /*18*/
"+=", /*19*/
"-=", /*20*/
"*=", /*21*/
"/=", /*22*/
"%=", /*23*/
">>=", /*24*/
"<<=", /*25*/
"&=", /*26*/
"|=", /*27*/
"^=", /*28*/
"jsr", /*29*/
"==", /*30*/
"!=", /*31*/
">", /*32*/
">=", /*33*/
"<", /*34*/
"<=", /*35*/
"int->long", /*36*/
"long->int", /*37*/
"btst", /*38*/
"load", /*39*/
"long*", /*40*/
"long/", /*41*/
"long%", /*42*/
"long*=", /*43*/
"long/=", /*44*/
"long%=", /*45*/
"=addr", /*46*/
"=not", /*47*/
"=neg", /*48*/
"docast", /*49*/
"st=", /*50*/
"ltof", /*51*/
"ftol", /*52*/
"itof", /*53*/
"ftoi", /*54*/
"tochar", /*55*/
invalid, /*56*/
invalid, /*57*/
invalid, /*58*/
invalid, /*59*/
"U&", /*60*/
"U*", /*61*/
"&&", /*62*/
"||", /*63*/
"?", /*64*/
":", /*65*/
",", /*66*/
"cint", /*67*/
"clong", /*68*/
"symbol", /*69*/
"++a", /*70*/
"a--", /*71*/
"call", /*72*/
"call()", /*73*/
"bitfield", /*74*/
"if", /*75*/
"init", /*76*/
"loadR0", /*77*/
"divlong", /*78*/
};
char *types[] {
invalid, /*0=TYPELESS*/
"char", /*1=CHAR*/
invalid, /*2=SHORT*/
"int", /*3=INT*/
"long", /*4=LONG*/
invalid, /*5=UCHAR*/
invalid, /*6=USHORT*/
"uint", /*7=UINT*/
invalid, /*8=ULONG*/
"float", /*9=FLOAT*/
invalid, /*10=DOUBLE*/
"struct", /*11=STRUCT*/
invalid, /*12=undefined*/
invalid, /*13=undefined*/
invalid, /*14=undefined*/
invalid, /*15=undefined*/
};
char *suvals[] {
"zero",
"one",
"quick",
"small",
"constant",
"Areg",
"Dreg",
"addressable",
"loadable",
"easy",
"hard",
"veryhard",
};
int level;
putexpr(name,tp)
char *name;
struct tnode *tp;
{
printf("%s\n",name);
putsexpr(tp);
}
putsexpr(tp)
struct tnode *tp;
{
register struct tnode *ltp;
level++;
ltp = tp->t_left;
outlevel();
printf("%s ",opname[tp->t_op]);
puttsu(tp);
if (tp->t_op < 0 || tp->t_op > 78) {
printf("INVALID op\n");
return;
}
switch( tp->t_op ) {
case DCLONG:
case CLONG:
case CFLOAT: /*[vlh] 3.4 */
printf(" %x.%x\n",tp->t_lvalue.hiword,tp->t_lvalue.loword);
break;
case CINT:
printf(" %d\n",tp->t_value);
break;
case AUTODEC:
case AUTOINC:
printf("Autodec or Autoinc");
break;
case SYMBOL:
switch( tp->t_sc ) {
case REGISTER:
printf(" Register");
break;
case CINDR:
printf(" %d\n",tp->t_offset);
break;
case CLINDR:
case CFINDR: /* [vlh] 3.4 */
printf(" %x.%x\n",tp->t_offset,tp->t_ssp);
break;
case REGOFF:
printf(" Regoffset");
break;
case EXTERNAL:
case EXTOFF:
printf(" %s+%d",tp->t_symbol,tp->t_offset);
if( tp->t_sc == EXTOFF )
printf("Ext offset");
break;
case STATIC:
case STATOFF:
printf(" STATIC or STATOFF");
if( tp->t_sc == STATOFF )
printf("STATOFF");
break;
case INDEXED:
printf(" %d indexed",tp->t_offset);
break;
}
putchar('\n');
break;
case IFGOTO:
putsexpr(tp->t_left);
break;
default:
putchar('\n');
putsexpr(tp->t_left);
if( binop(tp->t_op) )
putsexpr(tp->t_right);
break;
}
level--;
}
outlevel()
{
register int i;
for( i = 0; i < level; i++ )
printf(" ");
}
puttsu(tp)
struct tnode *tp;
{
register int i;
switch( suptype(tp->t_type) ) {
case FUNCTION:
printf("()");
break;
case ARRAY:
printf("[]");
break;
case POINTER:
printf("*");
break;
}
printf("%s ",types[btype(tp->t_type)]);
}
#endif

524
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/c068/stmt.c Normal file
View File

@@ -0,0 +1,524 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
#include "parser.h"
#define labgen(l,sl) sl=l;l=nextlabel++
int swp -1;
/* stmt - process a single statement*/
stmt() /* returns - none*/
{
register int token, lab, i;
register struct tnode *tp;
register char *p;
while( 1 ) {
switch(token=gettok()) {
case LCURBR: /*handle { ... }*/
while( !next(EOF) ) {
if( next(RCURBR) )
return;
stmt();
}
case EOF:
error("{ not matched by }");
case SEMI: /*null statement*/
return;
case RCURBR:
pbtok(token);
return;
case SYMBOL: /*symbol: statement*/
if( peekc(':') ) {
dolabel();
continue;
}
default: /*anything else...*/
pbtok(token);
outexpr(expr());
break;
case RESWORD:
switch(cvalue) {
case R_BREAK:
lab = brklabel();
outgoto(lab); /*branch to break label*/
break;
case R_CASE:
docase();
continue;
case R_CONTINUE:
lab = contlabel(); /*branch to continue label*/
outgoto(lab);
break;
case R_DEFAULT:
dodefault();
continue;
case R_DO:
dodo();
break;
case R_FOR:
dofor();
return;
case R_GOTO:
lab = gotolabel();
outgoto(lab);
break;
case R_IF:
doif();
return;
case R_RETURN:
doreturn();
break;
case R_SWITCH:
doswitch();
return;
case R_WHILE:
dowhile();
return;
default:
synerr("invalid keyword");
return;
}
}
if( !next(SEMI) )
synerr("missing semicolon");
return;
}
}
/* balpar - handle expression within parenthesis for while and if*/
/* Merely checks for left and right parens and builds expression.*/
char *balpar() /* returns pointer to expression*/
{
register struct tnode *tp;
if( next(LPAREN) ) {
reducep = 1;
tp = expr();
reducep = 0;
if( next(RPAREN) )
return(tp);
}
synerr("parenthesized expression syntax");
return(0);
}
/* synerr - syntax error*/
/* Outputs error message and tries to resyncronize input.*/
synerr(s,x1,x2,x3,x4,x5,x6) /* returns - none*/
char *s; /* printf format string*/
int x1, x2, x3, x4, x5, x6; /* printf arguments*/
{
register int token;
error(s,x1,x2,x3,x4,x5,x6);
while( (token=gettok()) != SEMI && token != EOF && token != LCURBR &&
token != RCURBR )
;
pbtok(token);
}
/* gotolabel - gets label id for goto*/
/* This is used for both: goto symbol and if(...)goto symbol*/
gotolabel() /* returns 0 if not, else label id*/
{
register struct symbol *sp;
if( !next(SYMBOL) )
synerr("expected label");
else {
sp = csp;
if( !(sp->s_sc) ) {
sp->s_type = LLABEL;
if( !sp->s_offset )
sp->s_offset = nextlabel++;
}
if( (!sp->s_sc || sp->s_sc == STATIC ) && sp->s_type == LLABEL )
return(sp->s_offset);
synerr("invalid label");
}
return(0);
}
/* dolabel - do statement label*/
/* Checks current symbol for already being defined, then sets*/
/* symbol attributes for label.*/
dolabel() /* returns - none*/
{
register struct symbol *sp;
sp = csp;
if( sp->s_sc )
error("label redeclaration: %.8s",sp->s_symbol);
else {
sp->s_attrib =| SDEFINED;
sp->s_sc = STATIC;
sp->s_type = LLABEL;
if( !sp->s_offset )
sp->s_offset = nextlabel++;
outlab(sp->s_offset);
}
}
/* brklabel - generate break label*/
/* Checks if break label is undefined, and if so, generates message*/
brklabel() /* returns label number*/
{
if( !blabel )
error("invalid break statement");
return(blabel);
}
/* contlabel - generate continue label*/
/* Checks if continue label is undefined, and if so, generates message*/
contlabel() /* returns label number*/
{
if( !clabel )
error("invalid continue statement");
return(clabel);
}
/* docase - handles: case constant : statement*/
/* Checks for being in a switch statement, adds entry to switch table*/
docase() /* returns - none*/
{
register int value, lab;
colonstop++;
value = cexpr(); /*get case value*/
colonstop--;
if( !next(COLON) ) /*check for colon*/
synerr("missing colon");
if( swp < 0 )
error("case not inside a switch block");
else if( swp >= (SWSIZE-1) )
error("too many cases in switch");
else {
addswitch(&swtab[cswp],swp-cswp,value,lab=nextlabel++);
outlab(lab);
swp++;
}
}
/* dodefault - handles: default : statement*/
/* Checks for colon and being in a switch statement*/
dodefault() /* returns - none*/
{
if( !next(COLON) )
error("missing colon");
if( swp < 0 )
error("default not inside a switch block");
else {
dlabel = nextlabel++; /*allocate default label*/
outlab(dlabel); /*output default label*/
}
}
/* dodo - handles: do statement while ( expression )*/
dodo() /* returns - none*/
{
register int lab, saveblab, saveclab;
labgen(blabel,saveblab);
labgen(clabel,saveclab);
lab = nextlabel++;
outlab(lab); /*branch back to here*/
stmt(); /*do statement*/
outlab(clabel); /*continue label*/
if( !nextrw(R_WHILE) ) {
error("missing while"); /*only advisory...*/
outgoto(lab);
}
else
outifgoto(balpar(),TRUE,lab); /*while expression*/
outlab(blabel); /*break label*/
blabel = saveblab; /*restore labels*/
clabel = saveclab;
}
#define dobody(l) stmt();outlab((l));clno=lineno;lineno=rinit
/*
* dofor - handle: for ( expression ; expression ; expression ) statement
* Hard part is handling re-initialization expression, which is
* parsed and saved, then the statement is parsed, then the reinit
* clause expression tree is output.
*/
dofor() /* returns - none*/
{ /* [vlh] 4.0 reordered */
register int testlab, stmtlab, saveblab, saveclab;
register struct tnode *rip, *cp;
register char *savep;
int rinit, clno, iscond;
labgen(blabel,saveblab);
labgen(clabel,saveclab);
if( !next(LPAREN) ) {
forerr:
synerr("invalid for statement");
return;
}
if( !next(SEMI) ) { /*do init expression*/
outexpr(expr());
if( !next(SEMI) )
goto forerr;
}
savep = exprp; /* save ptr to exprarea */
if( !next(SEMI) ) { /* do for condition */
testlab = nextlabel++; /* if condition, get a label */
outgoto(testlab); /* only goto cond expr if exists*/
iscond = 1;
cp = expr();
exprp = opap;
if( !next(SEMI) )
goto forerr;
}
else
iscond = 0;
stmtlab = nextlabel++;
outlab(stmtlab); /* branch back to here */
rinit = lineno;
if( next(RPAREN) ) { /*no re-init - easy case*/
dobody(clabel); /*output statement*/
}
else { /*there is a re-init clause*/
rip = expr(); /*save re-init tree until done*/
exprp = opap;
if( !next(RPAREN) )
goto forerr;
dobody(clabel); /*do statment*/
outexpr(rip); /*output re-init clause*/
}
if (iscond) {
outlab(testlab); /* branch for test */
outifgoto(cp,TRUE,stmtlab);
}
else
outgoto(stmtlab); /* unconditional branch */
exprp = savep;
lineno = clno;
outlab(blabel); /* break label */
blabel = saveblab;
clabel = saveclab; /*restore labels*/
}
/* doif - handles: if ( expression ) statement [ else statement ]*/
/* Handles special cases for goto, break, continue and return.*/
doif() /* returns - none*/
{
register struct tnode *tp;
register int elselab, exitlab;
tp = balpar(); /*if( expr )...*/
exitlab = 0;
if( nextrw(R_GOTO) )
exitlab = gotolabel();
else if( nextrw(R_BREAK) )
exitlab = brklabel();
else if( nextrw(R_CONTINUE) )
exitlab = contlabel();
else if( nextrw(R_RETURN) ) {
if( peekc(';') ) {
exitlab = rlabel;
putback(';');
}
else
pbtok(RESWORD);
}
if( exitlab ) { /*easy goto, do branch if true*/
outifgoto(tp,TRUE,exitlab);
if( !next(SEMI) )
synerr("missing semicolon");
if( nextrw(R_ELSE) ) /*else clause, just output it*/
stmt();
}
else { /*hard goto, branch over statement*/
elselab = nextlabel++;
outifgoto(tp,FALSE,elselab);
stmt();
if( nextrw(R_ELSE) ) {
exitlab = nextlabel++; /*branches over else clause*/
outgoto(exitlab); /*branch out of then clause*/
outlab(elselab); /*label to start else clause*/
stmt(); /*else statement*/
outlab(exitlab);
}
else
outlab(elselab); /*no else, just branch out*/
}
}
/*
* doreturn - handles: return [ expression ] ;
* Expression is the hard part, must create an assignment expression
* to assign expression to the type of the function, then get it
* loaded into a specific register.
*/
doreturn() /* returns - none*/
{
register struct tnode *tp;
if( !peekc(';') ) /*need to compute return?*/
outforreg(FRETURN,frp,expr());
else
putback(';');
outgoto(rlabel); /*branch to the return label*/
}
/*
* doswitch - handles: switch ( expression ) statement
* Evaluates the expression, forces the result into a known register
* collects the case statements in swtab, then outputs the switch
* operator and switch cases.
*/
doswitch() /* returns - none*/
{
register int saveblab, swlab, savedlab, saveswp, i;
register struct tnode *tp;
labgen(blabel,saveblab);
tp = balpar();
integral(tp,-1); /*must be integral type result*/
outforreg(ASSIGN,snalloc(INT,AUTO,0,0,0),tp);
saveswp = swp; /*remember old switch pointer*/
if( saveswp < 0 )
swp++;
i = cswp;
cswp = swp; /*remember real first entry*/
swlab = nextlabel++;
outgoto(swlab); /*branch to switch code*/
savedlab = dlabel;
dlabel = 0;
stmt(); /*do switch statement*/
outgoto(blabel); /*output branch just in case*/
outlab(swlab); /*here we now do the switch code*/
if( !dlabel )
dlabel = blabel;
outswitch(swp-cswp,dlabel,&swtab[cswp]);
outlab(blabel); /*break to here*/
cswp = i;
swp = saveswp;
blabel = saveblab;
dlabel = savedlab;
}
/* dowhile - handles: while ( expression ) statement*/
/* This is fairly straight-forward.*/
dowhile() /* returns - none*/
{ /* [vlh] 4.0 reworked */
register int saveclab, saveblab, lab;
register char *savep;
register struct tnode *tp;
labgen(blabel,saveblab);
labgen(clabel,saveclab);
labgen(clabel,lab);
savep = exprp;
if((tp = balpar()) != 0) /*get condition clause*/
outgoto(clabel); /*condition label*/
exprp = opap;
outlab(lab);
stmt(); /*statement*/
outlab(clabel); /*condition test*/
outifgoto(tp,TRUE,lab); /* branch back to top of loop */
outlab(blabel); /*break to here*/
exprp = savep;
blabel = saveblab;
clabel = saveclab; /*restore labels*/
}
/* nextrw - is next token the specified reserved word?*/
nextrw(rw) /* returns 1 if match, 0 otherwise*/
int rw; /* reserved word to match*/
{
register int token;
if( (token=gettok()) != RESWORD || cvalue != rw ) {
pbtok(token);
return(0);
}
return(1);
}
/*
* addswitch - add an entry into current switch table, bubble sorting
* This makes it easier on the code generator and also checks for
* duplicate labels at the "right" time.
*/
addswitch(sp,ncases,nval,nlab) /* returns - none*/
struct swtch *sp; /* switch table pointer*/
int ncases; /* number of cases in switch*/
int nval; /* new value*/
int nlab; /* new label*/
{
register struct swtch *nswp, *s;
register int temp, i;
nswp = &sp[ncases];
nswp->sw_value = nval;
nswp->sw_label = nlab;
s = nswp--;
for( ; --ncases >= 0; s--, nswp-- ) {
if( s->sw_value == nswp->sw_value )
error("duplicate case value");
if( s->sw_value < nswp->sw_value ) {
temp = s->sw_value;
s->sw_value = nswp->sw_value;
nswp->sw_value = temp;
temp = s->sw_label;
s->sw_label = nswp->sw_label;
nswp->sw_label = temp;
}
}
}
/* outforreg - generate assignment for switch and return*/
outforreg(op,ltp,rtp) /*returns - none*/
int op; /*operator for build tree*/
struct tnode *ltp; /*left expression tree*/
struct tnode *rtp; /*right expression tree*/
{
register struct tnode *tp;
opp = opstack;
opdp = opdstack;
pushopd(ltp);
pushopd(rtp);
maketree(op);
if( tp = popopd() )
outcforreg(tp->t_right);
opp = opdp = 0;
}
/* outassign - generate assignment for function args*/
outassign(ltp,rtp) /*returns - none*/
struct tnode *ltp; /*left expression tree*/
struct tnode *rtp; /*right expression tree*/
{
opp = opstack;
opdp = opdstack;
pushopd(ltp);
pushopd(rtp);
maketree(ASSIGN);
outexpr(popopd());
opp = opdp = 0;
}

119
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/c068/tabl.c Normal file
View File

@@ -0,0 +1,119 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
#include "parser.h"
#define ASGOP OPRAS|OPASSIGN|OPLVAL|OPBIN
/*info on operators:*/
/*000077-- OPPRI - priority*/
/*000100-- OPBIN - binary operator*/
/*000200-- OPLVAL - left operand must be lvalue*/
/*000400-- OPREL - relational operator*/
/*001000-- OPASSIGN - assignment operator*/
/*002000-- OPLWORD - int required on left*/
/*004000-- OPRWORD - int required on right*/
/*010000-- OPCOM commutative*/
/*020000-- OPRAS - right associative*/
/*040000-- OPTERM - termination node*/
/*100000 - OPCONVS - conversion operator*/
int opinfo[] {
TRMPRI, /*EOF*/
ADDPRI|OPCOM|OPBIN, /*ADD - expr + expr*/
ADDPRI|OPBIN, /*SUB - expr - expr*/
MULPRI|OPCOM|OPBIN, /*MULT - expr * expr*/
MULPRI|OPBIN, /*DIV - expr / expr*/
MULPRI|OPBIN, /*MOD - expr % expr*/
SHFPRI|OPLWORD|OPRWORD|OPBIN, /*RSH - expr >> expr*/
SHFPRI|OPLWORD|OPRWORD|OPBIN, /*LSH - expr << expr*/
ANDPRI|OPCOM|OPLWORD|OPRWORD|OPBIN, /*AND - expr & expr*/
ORPRI|OPCOM|OPLWORD|OPRWORD|OPBIN, /*OR - expr | expr*/
ORPRI|OPCOM|OPLWORD|OPRWORD|OPBIN, /*XOR - expr ^ expr*/
UNOPRI|OPRAS|OPLWORD, /*NOT - ! expr*/
UNOPRI|OPRAS, /*UMINUS - - expr*/
UNOPRI|OPRAS|OPLWORD, /*COMPL - ~ expr*/
UNOPRI|OPRAS|OPLVAL|OPBIN, /*PREDEC - --lvalue*/
UNOPRI|OPRAS|OPLVAL|OPBIN, /*PREINC - ++lvalue*/
UNOPRI|OPRAS|OPLVAL|OPBIN, /*POSTDEC - lvalue--*/
UNOPRI|OPRAS|OPLVAL|OPBIN, /*POSTINC - lvalue++*/
ASGPRI|ASGOP, /*ASSIGN - lvalue = expr*/
ASGPRI|ASGOP, /*EQADD - lvalue += expr*/
ASGPRI|ASGOP, /*EQSUB - lvalue -= expr*/
ASGPRI|ASGOP, /*EQMULT - lvalue *= expr*/
ASGPRI|ASGOP, /*EQDIV - lvalue /= expr*/
ASGPRI|ASGOP, /*EQMOD - lvalue %= expr*/
ASGPRI|ASGOP|OPLWORD|OPRWORD, /*EQRSH - lvalue >>= expr*/
ASGPRI|ASGOP|OPLWORD|OPRWORD, /*EQLSH - lvalue <<= expr*/
ASGPRI|ASGOP|OPLWORD|OPRWORD, /*EQAND - lvalue &= expr*/
ASGPRI|ASGOP|OPLWORD|OPRWORD, /*EQOR - lvalue |= expr*/
ASGPRI|ASGOP|OPLWORD|OPRWORD, /*EQXOR - lvalue ^= expr*/
TRMPRI, /*FJSR - generate function jsr*/
EQLPRI|OPREL|OPBIN, /*EQUALS - expr == expr*/
EQLPRI|OPREL|OPBIN, /*NEQUALS - expr != expr*/
RELPRI|OPREL|OPBIN, /*GREAT - expr > expr*/
RELPRI|OPREL|OPBIN, /*GREATEQ - expr >= expr*/
RELPRI|OPREL|OPBIN, /*LESS - expr < expr*/
RELPRI|OPREL|OPBIN, /*LESSEQ - expr <= expr*/
TRMPRI|OPCONVS, /*INT2L*/
TRMPRI|OPCONVS, /*LONG2I*/
TRMPRI|OPBIN, /*BTST*/
TRMPRI, /*LOAD*/
TRMPRI|OPBIN, /*LMULT*/
TRMPRI|OPBIN, /*LDIV*/
TRMPRI|OPBIN, /*LMOD*/
TRMPRI|OPBIN, /*LEQMULT*/
TRMPRI|OPBIN, /*LEQDIV*/
TRMPRI|OPBIN, /*LEQMOD*/
TRMPRI|ASGOP, /*EQADDR*/
TRMPRI, /*EQNOT*/
TRMPRI, /*EQNEG*/
TRMPRI|OPBIN, /*DOCAST*/
ASGPRI|ASGOP, /*STASSIGN [vlh]*/
TRMPRI|OPCONVS, /*LONG2F [vlh] 3.4*/
TRMPRI|OPCONVS, /*FLOAT2L [vlh] 3.4*/
TRMPRI|OPCONVS, /*INT2F [vlh] 3.4*/
TRMPRI|OPCONVS, /*FLOAT2I [vlh] 3.4*/
UNOPRI|OPRAS, /*TOCHAR [vlh] 4.0*/
TRMPRI, /*unused - 56*/
TRMPRI, /*unused - 57*/
TRMPRI, /*unused - 58*/
TRMPRI, /*unused - 59*/
UNOPRI|OPRAS|OPLVAL, /*ADDR - & expr*/
UNOPRI|OPRAS|OPLWORD, /*INDR - * expr*/
LNDPRI|OPBIN, /*LAND - expr && expr*/
LORPRI|OPBIN, /*LOR - expr || expr*/
QMKPRI|OPRAS|OPBIN, /*QMARK - expr ? expr : expr*/
QMKPRI|OPRAS|OPBIN, /*COLON*/
COMPRI|OPBIN, /*COMMA*/
TRMPRI|OPTERM, /*CINT*/
TRMPRI|OPTERM, /*CLONG*/
TRMPRI|OPTERM, /*SYMBOL*/
TRMPRI|OPTERM, /*AUTOINC*/
TRMPRI|OPTERM, /*AUTODEC*/
LPNPRI|OPBIN, /*CALL - call with arguments*/
LPNPRI, /*NACALL - no argument call*/
TRMPRI, /*BFIELD - field selection*/
TRMPRI, /*IFGOTO*/
TRMPRI, /*INIT*/
TRMPRI, /*CFORREG*/
TRMPRI, /*unused - 78*/
TRMPRI|OPTERM, /*CFLOAT [vlh] 3.4*/
UNOPRI|OPRAS|OPASSIGN|OPBIN, /*CAST*/
TRMPRI, /*SEMI*/
TRMPRI, /*LCURBR - {*/
TRMPRI, /*RCURBR - }*/
LPNPRI, /*LBRACK - [*/
RPNPRI, /*RBRACK - ]*/
LPNPRI, /*LPAREN - )*/
RPNPRI, /*RPAREN - )*/
TRMPRI|OPTERM, /*STRING*/
TRMPRI, /*RESWORD*/
LPNPRI|OPBIN, /*APTR - expr -> symbol*/
LPNPRI|OPBIN, /*PERIOD - expr . symbol*/
UNOPRI|OPRAS, /*SIZEOF - sizeof expr*/
LPNPRI|OPBIN, /*MPARENS - matching parens ()*/
UNOPRI|OPRAS|OPASSIGN|OPBIN, /*FRETURN*/
};

1
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/al40/c068/version.c Normal file
View File

@@ -0,0 +1 @@
char *compiled "@(#) parser - Fri Mar 18 11:33 1983";