seppdroid/Digital-Research-Source-Code
1
0
Fork 0
mirror of https://github.com/SEPPDROID/Digital-Research-Source-Code.git synced 2025-10-25 01:14: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

17
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/build.m68 Normal file
View File

@@ -0,0 +1,17 @@
c68 -L -r -f -DMC68000 -DDEBUG -c decl.c
c68 -L -r -f -DMC68000 -DDEBUG -c expr.c
c68 -L -r -f -DMC68000 -DDEBUG -c icode.c
c68 -L -r -f -DMC68000 -DDEBUG -c init.c
c68 -L -r -f -DMC68000 -DDEBUG -c interf.c
c68 -L -r -f -DMC68000 -DDEBUG -c lex.c
c68 -L -r -f -DMC68000 -DDEBUG -c main.c
c68 -L -r -f -DMC68000 -DDEBUG -c stmt.c
c68 -L -r -f -DMC68000 -DDEBUG -c tabl.c
c68 -L -r -f -DMC68000 -DDEBUG -c putexpr.c
c68 -L -r -f -DMC68000 -DDEBUG -c misc.c
c68 -L -r -f -DMC68000 -DDEBUG -c node.c
c68 -L -r -f -DMC68000 -DDEBUG -c symt.c
c68 -L -r -f -DMC68000 -DDEBUG -c tree.c
mkver -f "parser -"
c68 -n -L -r -f -DMC68000 -DDEBUG -r decl.o expr.o icode.o init.o interf.o lex.o main.o stmt.o tabl.o putexpr.o misc.o node.o symt.o tree.o version.c -o c068.4k -l6
setstack c068.4k 8192 8192

20
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/build.pdp Normal file
View File

@@ -0,0 +1,20 @@
mkver -e "parser -"
cc -w -DPDP11 -DDEBUG -c decl.c
cc -w -DPDP11 -DDEBUG -c expr.c
cc -w -DPDP11 -DDEBUG -c icode.c
cc -w -DPDP11 -DDEBUG -c init.c
cc -w -DPDP11 -DDEBUG -c interf.c
cc -P -DPDP11 -DDEBUG -c lex.c
mv lex.i nlex.c
cc6 -f -c nlex.c
mv nlex.o lex.o
cc -w -DPDP11 -DDEBUG -c main.c
cc -w -DPDP11 -DDEBUG -c stmt.c
cc -w -DPDP11 -DDEBUG -c tabl.c
cc -w -DPDP11 -DDEBUG -c putexpr.c
cc -w -DPDP11 -DDEBUG -c misc.c
cc -w -DPDP11 -DDEBUG -c node.c
cc -w -DPDP11 -DDEBUG -c symt.c
cc -w -DPDP11 -DDEBUG -c tree.c
cc -w -DPDP11 -DDEBUG -c version.c
cc -f decl.o expr.o icode.o init.o interf.o lex.o main.o stmt.o tabl.o putexpr.o misc.o node.o symt.o tree.o version.o -o c068.pdp -l6 -lC

17
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/build.vax Normal file
View File

@@ -0,0 +1,17 @@
mkver -e "parser -"
cc -O -w -f -DVAX11 -DDEBUG -c decl.c
cc -O -w -f -DVAX11 -DDEBUG -c expr.c
cc -O -w -f -DVAX11 -DDEBUG -c icode.c
cc -O -w -f -DVAX11 -DDEBUG -c init.c
cc -O -w -f -DVAX11 -DDEBUG -c interf.c
cc -O -w -f -DVAX11 -DDEBUG -c lex.c
cc -O -w -f -DVAX11 -DDEBUG -c main.c
cc -O -w -f -DVAX11 -DDEBUG -c stmt.c
cc -O -w -f -DVAX11 -DDEBUG -c tabl.c
cc -O -w -f -DVAX11 -DDEBUG -c putexpr.c
cc -O -w -f -DVAX11 -DDEBUG -c misc.c
cc -O -w -f -DVAX11 -DDEBUG -c node.c
cc -O -w -f -DVAX11 -DDEBUG -c symt.c
cc -O -w -f -DVAX11 -DDEBUG -c tree.c
cc -O -w -f -DVAX11 -DDEBUG -c version.c
cc -n decl.o expr.o icode.o init.o interf.o lex.o main.o stmt.o tabl.o putexpr.o misc.o node.o symt.o tree.o version.o ../binary/libV.a -o c068.vax

16
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/build.vdo Normal file
View File

@@ -0,0 +1,16 @@
mkver -f "C68 Parser -"
c68 -f -L -S -DVERSADOS -DMC68000 decl.c
c68 -f -L -S -DVERSADOS -DMC68000 expr.c
c68 -f -L -S -DVERSADOS -DMC68000 icode.c
c68 -f -L -S -DVERSADOS -DMC68000 interf.c
c68 -f -L -S -DVERSADOS -DMC68000 lex.c
c68 -f -L -S -DVERSADOS -DMC68000 main.c
c68 -f -L -S -DVERSADOS -DMC68000 misc.c
c68 -f -L -S -DVERSADOS -DMC68000 node.c
c68 -f -L -S -DVERSADOS -DMC68000 putexpr.c
c68 -f -L -S -DVERSADOS -DMC68000 stmt.c
c68 -f -L -S -DVERSADOS -DMC68000 tabl.c
c68 -f -L -S -DVERSADOS -DMC68000 version.c
mv *.s vst
c68 -f -L -S -DVERSADOS -DMC68000 -DFFLAG main.c
mv main.s vst/mainf.s

783
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/decl.c Normal file
View File

@@ -0,0 +1,783 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
#include "parser.h"
/*
* 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 short dflag;
short sc, type;
long size;
tdflag = 0; /* [vlh] 4.2.b reset on sighting a semicolon */
if(!next(SEMI)) {
opap = exprp = exprarea;
sc = EXTERNAL;
type = (xflag?LONG:INT);
dflag = gettype(&sc,&type,&size,1);
if(type==STRUCT) /* deal with forward ref structures */
chksyms(0);
while( dodecl(sc,type,0,size), (sp=dsp) != 0 ) {
if (type==STRUCT) { /* [vlh] 4.2 */
sp->s_par = struc_parent[0];
sp->s_child = struc_parent[0];
}
if( !dflag && NOTFUNCTION(sp->s_type) ) {
synerr("external definition syntax");
return;
}
if( !ISTYPEDEF(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( !ISTYPEDEF(sp) ) {
doinit(sp);
if (sc == STATIC)
chksyms(0);
}
}
else if( PEEK(RESWORD) || PEEK(LCURBR) ||
(PEEK(SYMBOL) && ISTYPEDEF(csp)) ) {
if(!ISTYPEDEF(sp) && sc!=STATIC) /*[vlh] .globl local proc*/
OUTEXTDEF(sp->s_symbol);
funcbody(sp);
return;
}
dsp = 0;
if( !next(COMMA) )
break;
}
if( gettok(0) != SEMI ) {
#ifdef DEBUG
if (symdebug) printf("external definition syntax due to lost comma...\n");
#endif
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,declok) /* returns 0 for no type, 1 otherwise*/
short *defsc; /* default storage class*/
short *deftype; /* default data type*/
long *size; /* size of data element 3.4 int=>long*/
int declok; /* as opposed to casting op */
{
register short token, sc;
short dtype, sflag, uflag, lflag, decflag;
long tsize;
struct symbol *sp, *parent;
tdp = 0; uflag = decflag = lflag = sflag = 0; tsize = 0L;
dtype = TYPELESS;
sc = *defsc;
indecl = 0; /* start off at 0 !!!! */
for( ; ; decflag++ ) {
if( (token=gettok(0)) == SYMBOL && ISTYPEDEF(csp) ) {
dtype = 0;
indecl = declok; /* if not trying for casting operator */
tdp = csp;
continue;
}
if( token != RESWORD )
break;
indecl = declok; /* if not trying for casting operator */
switch( cvalue ) {
default: /* not a declaration type reserved word */
indecl = 0;
break;
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:
token = get_s_or_u(sp,&parent,&tsize,&dtype);
if (token != FRSTRUCT) /* [vlh] 4.2.e */
struc_parent[0] = parent;
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 ) /* [vlh] 4.2 legal from now on... */
if (dtype == LONG) {
dtype = LONG;
warning("unsigned long unimplemented, signed long assumed");
}
else if (dtype == CHAR) {
dtype = CHAR;
warning("unsigned char unimplemented, signed char assumed");
}
else
dtype = UNSIGNED;
if( !sflag && xflag && dtype == INT )
dtype = LONG;
*defsc = sc;
*deftype = dtype;
*size = tsize;
return(decflag);
}
/**
* get_s_or_u - get attribute types from a union or structure declaration
* This routine parses a structure or union. It is called by
* "gettype" and returns the token parsed.
**/
get_s_or_u(sp,parent,ptsize,pdtype) /* returns token */
struct symbol *sp, **parent;
long *ptsize;
short *pdtype;
{
char sym[8];
register short token, stdflag, sbits, fake;
stdflag = tdflag;
tdflag = 0; sp = 0;
token = cvalue;
smember++;
if (!next(SYMBOL)) { /* force fake struct name into symbol table */
fake=1;
sym[0] = ' '; /* no symbol could start with space */
genunique(sym);
csp = (struct symbol *)lookup(sym,1); /* [vlh] 4.2 */
}
else
fake=0;
/*struct [symbol] { ... }*/
sp = csp;
*parent = csp;
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);
smember = 0;
if( next(LCURBR) ) {
struc_sib[in_struct] = hold_sib; /* [vlh] 4.2.e */
if (hold_sib) { /* [vlh] 4.2, not struct element yet... */
hold_sib->s_sib = hold_sib->s_par = 0;
}
in_struct++;
struc_parent[in_struct] = sp;
struc_sib[in_struct] = 0;
sbits = boffset;
boffset = 0;
*ptsize = 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] = *ptsize;
}
struc_parent[in_struct] = 0;
struc_sib[in_struct] = 0;
--in_struct;
if (!in_struct)
hold_sib = 0;
}
else if (fake)
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 */
if (struc_sib[in_struct]->s_type == STRUCT) { /* [vlh] 4.2.e */
struc_sib[in_struct] = hold_sib;
if (hold_sib)
hold_sib->s_sib = hold_sib->s_par = 0;
}
token = FRSTRUCT;
if( ++frstp >= NFRSTR )
ferror("structure table overflow");
frstab[frstp] = sp;
}
else
*ptsize = dtab[sp->s_ssp];
tdflag = stdflag;
if( *pdtype != TYPELESS )
error("invalid type declaration");
*pdtype = (token == R_UNION) ? STRUCT : token;
return(token);
}
/*
* 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 short => 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 short dtype, j;
long constval;
if( PEEK(SEMI) || PEEK(RPAREN) )
return(0);
if( in_struct && next(COLON) ) { /*handle bit filler field*/
if(!(constval=cexpr()))
size = salign(INT,offset);
else
size = falign(type,(int)constval,offset);
}
else if( (type |= declarator(0)) >= 0 && (sp=dsp) != 0 ) {
if (ISFUNCTION(type)) /* [vlh] 4.2 */
sp->s_scope = GLOB_SCOPE;
if (tdp) { /*typedef name in declaration*/
type = addtdtype(tdp,type,sp->s_dp,&(sp->s_ssp));
if (BTYPE(type)==STRUCT) /* [vlh] 4.2 */
sp->s_child = sp->s_par = tdp->s_par;
}
else if( BTYPE(type) == STRUCT ) {
sp->s_par = struc_parent[0]; /* [vlh] 4.2 */
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;
switch( sp->s_sc ) { /*check for redeclarations.*/
case STELCL:
case UNELCL:
case 0:
break;
case PARMLIST:
if( sc != PDECLIST && sc != REGISTER )
goto redec;
break;
case BFIELDCL:
if( sc != STELCL && sc != UNELCL )
goto redec;
break;
case STATIC: /* [vlh] 4.2, incomplete handling */
if (ISFUNCTION(sp->s_type))
break;
goto redec;
case EXTERNAL:
if (sp->s_type == type) {
if (sc == sp->s_sc)
break;
if (ISFUNCTION(sp->s_type) && sc == STATIC) /* [vlh] 4.2 */
break;
if (sc == AUTO && SUPTYPE(type) == FUNCTION) {
sc = EXTERNAL;
break;
}
}
default:
redec:
#ifdef DEBUG
if (treedebug)
printf("redec typ %d %d sc %d %d\n",sp->s_type,type,sp->s_sc,sc);
#endif
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( in_struct ) {
if( next(COLON) ) { /*handle bit field*/
sc = BFIELDCL;
constval = cexpr();
sp->s_dp = (boffset<<8) | ((int)constval);
size = j = falign(type,(int)constval,offset);
if (j) /* [vlh] 4.2 implies move to new word.... */
sp->s_dp = (int)constval;
}
else {
j=salign(sp->s_type,offset); /* [vlh] 4.1 type is not enough */
size = dsize(sp->s_type,sp->s_dp,sp->s_ssp) + j;
}
offset += j;
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) || !dregtab[ndregs] )
sc = AUTO;/* ignore reg specification */
else
sp->s_offset = dregtab[ndregs++];
}
else if( !aregtab[naregs] || dtype!=POINTER )
sc = AUTO; /*no more regs, make it 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;
/* trying to output locals in the appropriate order.... */
if (infunc && scope_level==FUNC_SCOPE)
if (sc==STATIC || sc==REGISTER || sc==AUTO)
outlocal(type,sc,sp->s_symbol,sp->s_offset);
}
return(size);
}
/*
* 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 short olddp, offset, toff;
register struct symbol *sp;
register struct farg *fp;
infunc++;
sp = fsp;
opap = exprp;
frp = (struct farg *)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 {
scope_level = FUNC_SCOPE; /* [vlh] 4.2 */
scope_decls[FUNC_SCOPE] = 1; /* [vlh] 4.2, force at this level */
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( ISARRAY(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));
/* [vlh] 4.2, output argument list for debugger */
if (sp->s_sc==STATIC || sp->s_sc==AUTO) /* [vlh] not register... */
outlocal(sp->s_type,sp->s_sc,sp->s_symbol,sp->s_offset);
}
OUTBENTRY(); /* [vlh] 4.2, must be before declarations */
dlist(TYPELESS); /* [vlh] 4.1 was just a zero... */
chksyms(0);
copyargs(); /*copy args to registers where required*/
while(!next(RCURBR)) {
if( next(EOF) ) {
error("{ not matched by }");
break;
}
instmt=1;
stmt();
instmt=0;
}
}
OUTLAB(rlabel);
outbexit(localsize,ndregs,naregs);
freesyms(FUNC_SCOPE);
cdp = olddp;
infunc--;
}
/*
* 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 short offset;
register long lret, ddsize;
struct tnode *tp;
char *p;
long size; /* [vlh] 3.4 short => long */
short type, sc;
offset = 0; ddsize = 0L;
do {
sc = defsc;
type = INT;
if( !gettype(&sc,&type,&size,1) )
break;
indecl = 1;
do {
lret = dodecl(sc,type,offset,size);
if( defsc != UNELCL ) {
offset += (int)lret;
ddsize += lret;
}
else if( lret > ddsize )
ddsize = lret;
if( sc == STATIC && dsp && !ISTYPEDEF(dsp) )
doinit(dsp); /*process any initializer*/
dsp = 0;
if (next(ASSIGN)) { /* [vlh] 4.2 auto initialization */
indecl = 0; /* don't redeclare expr vars */
if (!SIMPLE_TYP(csp->s_type) && NOTPOINTER(csp->s_type)) {
synerr("illegal autoinitialization data type");
break;
}
peektok = ASSIGN;
commastop++; /* stop initializing at a comma */
expr_setup(); /* setup expr op stack */
p = get_symbol();
if (doopd(p))
synerr("auto initilization syntax");
else
if ((tp = (struct tnode *)expr(1)) != 0)
outexpr(tp);
else
synerr("auto initialization syntax");
commastop--; /* back to previous comma handling */
indecl = 1;
}
} while ( next(COMMA) );
if(!next(SEMI)) {
synerr("declaration syntax");
tdflag = 0; /* [vlh] 4.2.b reset on sighting a semicolon */
break;
}
tdflag = 0; /* [vlh] 4.2.b reset on sighting a semicolon */
} while( 1 );
ddsize += salign(INT,(int)ddsize);
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;
{
short type;
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 short type, i, sdp;
register struct symbol *sp, *tsp, *p;
register struct farg *fp;
long lvalue, value;
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;
scope_level = FUNC_SCOPE; /* [vlh] 4.2 */
for( fp = &fargtab[0]; pnext(); ) {
p = csp;
if( p->s_attrib & SDEFINED )
error("redeclaration: %.8s",p->s_symbol);
else if( fp >= &fargtab[NFARGS-1] ) {
synerr("too many parameters");
break;
}
else {
p->s_attrib |= SDEFINED;
p->s_scope = FUNC_SCOPE;
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;
if (!infunc && fp == &fargtab[0]) /* [vlh] 4.2 */
scope_level = GLOB_SCOPE;
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 */
if (dsp != tsp) /* [vlh] 4.2.... */
tsp->s_dp = cdp;
dsp = tsp; /* [vlh] 3.4 */
lvalue = value; /* [vlh] 3.4 */
for( i = sdp; i < cdp; i++)
dtab[i] *= lvalue;
dalloc(lvalue);
if( !next(RBRACK) )
break;
}
type = addsp(type,ARRAY);
continue;
}
if( castflg || dsp ) {
if (!infunc && castflg)
scope_level = GLOB_SCOPE; /* [vlh] 4.2 */
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 short ntype, t, i, tdf;
for( tdf = 0, t = tddp->s_type; SUPTYPE(t); t = delsp(t) )
if( ISARRAY(t) ) {
tdf++;
break;
}
ntype = 0;
for( t = type, i = dp; SUPTYPE(t); t = delsp(t) ) {
ntype = addsp(ntype,t);
if( tdf && ISARRAY(t) ) {
dtab[i] *= dtab[tddp->s_dp];
i++;
}
}
for( t = tddp->s_type, i = tddp->s_dp; SUPTYPE(t); t = delsp(t) )
if( ISARRAY(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);
}

78
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/def.h Normal file
View File

@@ -0,0 +1,78 @@
/**
* Copyright 1983
* Alcyon Corporation
* 8716 Production Ave.
* San Diego, CA 92121
**/
/* Parser External Definition File */
/*key word table*/
struct resword reswords[] = {
"asm", R_ASM, /* [vlh] 4.2 */
"auto", R_AUTO,
"break", R_BREAK,
"case", R_CASE,
"char", R_CHAR,
"continue", R_CONTINUE,
"default", R_DEFAULT,
"do", R_DO,
"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,
};
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 };
short nextlabel = 1;
short structlabel = 1;
char *exprp = &exprarea[0];
short swp = -1;
#ifdef VERSADOS
# ifdef FFLAG
int fflag = 1;
int eflag = 0;
# else
int eflag = 1;
int fflag = 0;
# endif
#endif

71
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/errors Normal file
View File

@@ -0,0 +1,71 @@
& operator illegal
=op assumed
address of register
assignable operand required
bad character constant
bad indirection
bad symbol table
can't copy (filename)
can't open (filename)
case not inside a switch block
character constant too long
constant required
default not inside a switch block
dimension table overflow
duplicate case value
expression too complex
field overflows byte
field overflows word
illegal call
illegal function declaration
illegal register specification
illegal structure operation
illegal type conversion
indirection on function invalid
initializer alignment
initializer list too long
invalid ?: operator syntax
invalid break statement
invalid character
invalid continue statement
invalid conversion
invalid data type
invalid expression
invalid field size
invalid field type description
invalid initializer
invalid long declaration
invalid operand type
invalid register specification
invalid short declaration
invalid storage class
invalid structure assignment
invalid structure declaration: (name)
invalid structure member name
invalid structure prototype: (name)
invalid type declaration
invalid typedef statement
invalid unsigned declaration
label redeclaration: (labelname)
missing colon
missing while
missing { in initialization
no */ before EOF
no structure name
not in parameter list: (name)
redeclaration: (name)
short assigned to pointer
string cannot cross line
string too long
structure table overflow
symbol table overflow
temp creation error
too many cases in switch
too many chars pushed back
too many initializers
too many tokens pushed back
undefined label: (name)
undefined symbol: (name)
unexpected EOF
usage: c068 source icode str [-e] [-f] [-w]
{ not matched by }

549
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/expr.c Normal file
View File

@@ -0,0 +1,549 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
#include "parser.h"
#define IS_ERROR 0
#define IS_TERMINAL 1
#define IS_OTHER 2
/**
* expr - expression evaluator
* This handles all the expression syntax in C. This is a
* straigt forward operator-stack/oppri scheme for translating
* infix into a binary expression tree.
**/
char *
expr(preset) /* returns 0 or ptr to node*/
int preset; /* [vlh] 4.2, stack setup ?? */
{
register char *p;
register short op, oppri;
short token;
if (!preset)
expr_setup();
while( (token=gettok(0)) != EOF ) {
switch( is_terminal(&token) ) {
case IS_ERROR: /* error condition */
exprerr:
if( token == SEMI || token == RCURBR )
pbtok(token);
error("invalid expression");
opdp = (char **)opdsave;
opp = (struct ops *)oprsave;
opdontop = opdotsave;
return(0);
case IS_TERMINAL: /* terminal node */
continue;
default: /* IS_OTHER operator node... */
break;
} /* switch is_terminal() */
/**
* 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)*/
(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--;
switch( op ) {
case STACKEND: /*we accept the expression...*/
pbtok(token);
if (!strassign)
if (!maketree(0)) {
#ifdef DEBUG
if (treedebug) printf("not maketree 0\n");
#endif
goto exprerr;
}
if (!(p=popopd())) {
#ifdef DEBUG
if (treedebug) printf("not popopd\n");
#endif
goto exprerr;
}
opdp = (char **)opdsave;
opp = (struct ops *)oprsave;
opdontop = opdotsave;
return(p);
case LPAREN: /*assure these have matching )*/
case CALL:
if( token != RPAREN )
goto exprerr;
break;
case MPARENS:
if( !maketree(NACALL) ) {
warning("Null expression encountered");
return(0);
/*goto exprerr;*/
}
continue;
case LBRACK:
if( token != RBRACK ) {
goto exprerr;
}
if(!maketree(ADD)) { /*array[index]->*(array+index)*/
#ifdef DEBUG
if (treedebug) printf("bad BINOP LBRACK ADD\n");
#endif
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)) {
#ifdef DEBUG
if (treedebug) printf("bad BINOP default\n");
#endif
goto exprerr;
}
continue; /*see if we can reduce some more...*/
} /* switch on op */
if( op != LPAREN && !maketree(op) ) {
#ifdef DEBUG
if (treedebug) printf("bad maketree not lparen\n");
#endif
goto exprerr;
}
break;
} /* while (1) */
}
error("unexpected EOF");
return(0);
}
/* expr_setup - setup op stack for expression evaluation */
expr_setup()
{
opdsave = (char *)opdp;
strassign = 0;
oprsave = (char *)opp;
opdotsave = opdontop;
if( !opp || !opdp ) {
opp = opstack;
opdp = opdstack;
}
else
opp++;
opp->o_op = STACKEND;
opp->o_pri = STKPRI;
opap = exprp;
opdontop = 0;
}
/**
* is_terminal - token switch for expr()
* the following are the terminal nodes of the expression 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.
**/
is_terminal(token) /* returns 0 for error, 1 for terminal, 2 for other */
short *token;
{
register struct tnode *p;
short type, sc;
long size;
switch( *token ) {
case CINT:
if( doopd(cnalloc(INT,cvalue)) )
return(IS_ERROR);
return(IS_TERMINAL);
case CFLOAT: /*[vlh] 3.4*/
if( doopd(fpcnalloc(FLOAT,clvalue)) )
return(IS_ERROR);
return(IS_TERMINAL);
case CLONG:
if( doopd(lcnalloc(LONG,clvalue)) )
return(IS_ERROR);
return(IS_TERMINAL);
case SYMBOL:
p = (struct tnode *)get_symbol();
if( doopd(p) )
return(IS_ERROR);
return(IS_TERMINAL);
case STRING:
outtstr(cvalue);
if( doopd(snalloc(ARRAY|CHAR,STATIC,cvalue,0,0)) )
return(IS_ERROR);
return(IS_TERMINAL);
/**
* 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)
*token = SIZEOF;
else if (cvalue == R_ASM)
*token = ASM;
else
return(IS_ERROR);
case COMPL:
case NOT:
if( opdontop ) /*can't have: operand unary-op*/
return(IS_ERROR);
break;
case LBRACK:
opdontop = 0;
break;
case RPAREN: /* [vlh] 4.2.f, was with RBRACK */
if (!opdontop) {
*token = MPARENS;
opdontop = 1; /* fake out expr for null expression... */
}
break;
case RBRACK:
if( !opdontop ) /*can't be: operator )*/
return(IS_ERROR);
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;
return(IS_TERMINAL);
}
if(PEEK(CLONG)) {
clvalue = -clvalue;
return(IS_TERMINAL);
}
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;
return(IS_TERMINAL);
}
*token = UMINUS;
}
break;
case AND:
if(!opdontop)
*token = ADDR;
break;
case MULT:
if( !opdontop )
*token = INDR;
break;
case LPAREN:
if( !opdontop ) { /*see if casting or abstract declarator*/
sc = type = 0;
if( gettype(&sc,&type,&size,0) ) {
sc = (type == STRUCT) ? dalloc(size) : cdp;
p = (struct tnode *)snalloc(type,STATIC,0,sc,sc);
p->t_type |= declarator(1);
if( !next(RPAREN) )
return(IS_ERROR);
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++;
return(IS_TERMINAL);
}
}
}
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*/
struc_parent[in_struct] = csp->s_par;
break;
} /* switch on token */
return(IS_OTHER);
}
/* get_symbol - handle symbol element for expr() */
char *
get_symbol()
{
register struct symnode *p;
p = (struct symnode *)csp;
if( !(p->s_attrib&SDEFINED) ) {
if( PEEK(LPAREN) ) { /*assume function call*/
p->s_sc = EXTERNAL;
p->s_type = FUNCTION|INT;
p->s_scope = GLOB_SCOPE; /* [vlh] 4.2 */
}
else if( commastop ) /*in initialization?*/
p->s_sc = EXTERNAL;
else {
error("undefined symbol: %.8s",p->s_symbol);
#ifdef DEBUG
if (symdebug)
printf("sym attrib %o type %o sc %d\n",p->s_type,p->s_sc,p->s_sc);
#endif
}
p->s_attrib |= SDEFINED;
}
if (p->s_sc==EXTERNAL || ISFUNCTION(p->t_type)) {
if (!reducep || p->s_sc==EXTERNAL || PEEK(LPAREN)) {
p = (struct symnode *)enalloc(p);
p->t_sc = EXTERNAL;
}
else /* [vlh] 3.4 if (main).... */
p = (struct symnode *)cnalloc(CINT,1); /* eval function name */
}
else
p = (struct symnode *)snalloc(p->s_type,p->s_sc,p->s_offset,
p->s_dp,p->s_ssp);
return((char *)p);
}
/* 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 lconode *ltp; /* pointer to left subtree*/
struct lconode *rtp; /* pointer to right subtree*/
{
register long lvalue, rvalue; /* [vlh] 4.1 short -> long */
short islong;
islong = 0;
if( ltp->t_op == CINT)
lvalue = ((struct conode *)ltp)->t_value;
else if (ltp->t_op == CLONG ) { /* [vlh] 4.1 added CLONG */
lvalue = ltp->t_lvalue;
islong++;
}
else
return(0);
if( rtp->t_op == CINT )
rvalue = ((struct conode *)rtp)->t_value;
else if (rtp->t_op == CLONG ) { /* [vlh] 4.1 added CLONG */
rvalue = rtp->t_lvalue;
islong++;
}
else
return(0);
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);
}
if (islong) {
ltp->t_op = CLONG;
ltp->t_lvalue = lvalue;
}
else
((struct conode *)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 lconode *tp; /* pointer to subexpression*/
{
register long value;
if( tp->t_op == CINT )
value = ((struct conode *)tp)->t_value;
else if( tp->t_op == CLONG) /* [vlh] 4.1 added clong.... */
value = tp->t_lvalue;
else
return(0);
switch( op ) {
case COMPL:
value = ~ value;
break;
case UMINUS:
value = - value;
break;
case NOT:
value = ! value;
break;
default:
return(0);
}
if( tp->t_op == CINT )
((struct conode *)tp)->t_value = value;
else /* [vlh] 4.1 added clong.... */
tp->t_lvalue = value;
pushopd(tp);
return(1);
}
/* cexpr - evaluate a constant integer expression*/
/* Used in evaluating array bounds, bit field numbers, etc.*/
long
cexpr() /* returns the constant value */
{
register struct lconode *tp;
register char *savep;
register short op;
savep = exprp;
exprp = opap;
commastop++;
tp = (struct lconode *)expr(0);
op = tp->t_op;
if (op != CINT && op != CLONG)
error("constant required"); /* [vlh] 4.1 added CLONG... */
commastop--;
exprp = savep;
return((op==CLONG) ? tp->t_lvalue : (long)((struct conode *)tp)->t_value);
}

391
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/icode.c Normal file
View File

@@ -0,0 +1,391 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
#include "parser.h"
#define LMIN(x,y) (x <= y) ? x : y
#define LMAX(x,y) (x >= y) ? x : y
/**
* This interfaces the Parser and the Code Generator, note that these
* allow you to link together the Parser and the Code Generator.
**/
#define SAVESTATE(sp,xbuf,sb) sp = obp; obp = &xbuf; sb = bol; bol = 1
#define RESTORSTATE(savep,sbol) obp = savep; bol = sbol
short inittype;
short bol = 1;
short begseq;
/* defbdata - set up for byte data, was outbdata */
defbdata() /* returns - none*/
{
inittype = CHAR;
printf("\t.dc.b ");
}
/* defwdata - set up for word data, was outwdata */
defwdata() /* returns - none*/
{
inittype = INT;
printf("\t.dc.w ");
}
/* defldata - set up for long data, [vlh] 4.2 */
defldata()
{
inittype = LONG;
printf("\t.dc.l ");
}
/* outc - output a constant*/
outc(type,value) /* returns - none*/
int type;
int value;
{
if( type == CHAR )
defbdata();
else
defwdata();
printf("$%x\n",value); /* [vlh] 4.2, changed to hex... */
}
/* 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 poshort data output*/
outfpdata() /*[vlh] 3.4 returns - none*/
{
inittype = FLOAT;
printf("\t.data\n");
}
/* outbexit - output function exit code*/
outbexit(nlocs,nds,nas) /* returns - none*/
int nlocs; /* [vlh] 4.2 */
int nds; /* number of D registers*/
int nas; /* number of A registers*/
{
struct iob *savep;
short sbol;
if (gflag) /* [vlh] 4.2 for symbolic debugger */
printf("\n\t~_lE%d:",lineno);
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);
printf("\n");
}
printf("\tunlk R14\n\trts\n");
SAVESTATE(savep,lbuf,sbol);
if( !nds && !nas ) /* adjust for 1 arg*/
nlocs += 4;
printf("link R14,#%d\n",-nlocs);
if (nds || nas) {
printf("movem.l R%d-R7",7-nds);
if (nas)
printf("/R%d-R13,-(sp)\n",14-nas);
else
printf(",-(sp)\n");
}
printf("%%");
RESTORSTATE(savep,sbol);
}
/* 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:
case PDECLIST:
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 short vdif, val, hval, i, tlab;
register struct swtch *s;
long lswvalue;
val = sp->sw_value;
hval = sp[ncases-1].sw_value;
vdif = hval - val;
if( ncases <= 4 ) {
/**
* simple switch, do compares and branches, 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++ ) {
lswvalue = s->sw_value;
OUTLCON(lswvalue);
}
OUTLCON(0L); /* mark for default label*/
for( s = sp, i = ncases; --i >= 0; s++ )
OUTCLAB(s->sw_label);
OUTCLAB(deflab);
OUTTEXT();
}
}
outeof()
{
v6flush(&lbuf);
v6flush(&sbuf);
v6flush(&obuf);
}
/* copysfile - copy string file to end of output file*/
copysfile(fname)
char *fname;
{
register short c;
close(sbuf.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("$%x",w); /* [vlh] 4.2, changed to hex... */
}
/* outlong - output a long data, [vlh] 4.2 changed for dc.l */
outlong(l) /* returns - none*/
long l; /* long data to output*/
{
/*defwdata(); outword((int)l.hiword); outword((int)l.loword);*/
defldata();
printf("$%lx",l);
outendseq();
}
/* outfp - output floating poshort data, [vlh] 4.2 changed for dc.l */
outfp(l) /*[vlh] 3.4 returns - none*/
long l; /* floating poshort data to output*/
{
/*defwdata(); outword((int)l.hiword); outword((int)l.loword);*/
defldata();
printf("$%lx",l);
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;
{
struct iob *savep;
short sbol;
SAVESTATE(savep,sbuf,sbol); /*save to restore later...*/
printf("\tL%d:",lab);
outstr((long)cstrsize,(long)cstrsize);
RESTORSTATE(savep,sbol);
}
/* outstr - output a string as a sequence of bytes*/
/* Outputs ".dc.b <byte1>,<byte2>,...,<0>*/
long
outstr(maxsize,strsize)
long maxsize, strsize;
{
register char *s;
register long i;
defbdata();
i = LMIN(strsize,maxsize);
for( s = cstr; i > 0; i-- ) {
outword((int)(*s++ & 0xff));
if (begseq==30 && i > 2) { /* [vlh] 4.1 */
outendseq(); /* limit line length to something */
defbdata(); /* reasonable, next .dc.b */
}
}
outendseq();
if (maxsize > strsize)
OUTRESMEM((long)(maxsize - strsize));
else if (maxsize && (strsize > maxsize))
warning("String initalizer truncated");
return(LMAX(strsize,maxsize));
}
/* cputc - put a character to a file descriptor (used by error) */
cputc(c, fn)
char c;
int fn;
{
#ifdef VERSADOS
versaputchar(c);
#else
if (fn == STDERR)
write(STDERR, &c, 1);
else
putchar(c);
#endif
}
/**
* putchar - 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.
* VERSADOS - handle outputting to intermediate or error files
**/
putchar(c)
char c;
{
if( c == '\t' ) {
if( bol ) /* not used && !onepass ) */
putc('(',obp); /*for code generator*/
}
else {
bol = (c == '\n');
putc(c,obp);
}
}
#ifdef VERSADOS
#define BSIZE 512
struct iob versfout { 1, BSIZE, &versfout.cbuf[0]};
versaputchar(c)
char c;
{
if (c == '\n') { /* end of line */
if (versaflush()) /* write one line */
return(-1);
return(c);
}
/* buffered output */
if (versfout.cc <= 0) {
versfout.cp = &(versfout.cbuf[0]);
if (write(versfout.fd,versfout.cp,BSIZE) != BSIZE)
return(-1);
versfout.cc = BSIZE;
}
*(versfout.cp)++ = c;
versfout.cc--;
return(c);
}
versaflush()
{
register short size, fildes;
if ((size = (BSIZE - versfout.cc)) == 0)
return(0);
versfout.cc = BSIZE;
versfout.cp = &(versfout.cbuf[0]);
fildes = (versfout.fd <= STDERR) ? 6 : versfout.fd;
if (write(fildes,versfout.cp,size) < 0)
return(-1);
return(0);
}
#endif

559
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/init.c Normal file
View File

@@ -0,0 +1,559 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
#include "parser.h"
#define NULL (char *)0
short inittype;
short bfield_ty; /* [vlh] 4.2 type of bit field currently initializing */
short bits_init; /* [vlh] 4.2 current bit field init value */
short in_bitinit; /* [vlh] 4.2 are we currently initializing a bit field ?? */
short lst_boffset; /* [vlh] 4.2 new bit field entity ?? */
char *opname[], *types[];
#define BCHK(plus) {plus = out_bfield(CHAR); nbout += plus; nbleft += plus;}
/*
* 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 short type;
long isize, datasize;
type = sp->s_type;
datasize = dsize(type,sp->s_dp,sp->s_ssp);
if( PEEK(COMMA) || PEEK(SEMI) ) { /*no initialization*/
isize = WALIGN(datasize);
#ifdef DEBUG
if(symdebug)
printf("%s sc %x attrib %x\n",sp->s_symbol,sp->s_sc,sp->s_attrib);
#endif
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 {
if (!(next(ASSIGN))) /*ignore '=' if there*/
warning("old fashion initialization");
if( type == LONG || ISPOINTER(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, 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( ISARRAY(sp->s_type) ) {
for( type = sp->s_type; ISARRAY(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(sp,type,dp,ssp) /* returns size of initializers in bytes*/
struct symbol *sp; /* [vlh] 4.2 for use in struct init */
int type, dp, ssp;
{
register short onetype, plus, atype;
long datasize, i, j, elsize, nbleft, nbout; /* [vlh] 3.4 int=>long */
i = (next(LCURBR));
for( onetype = type; ISARRAY(onetype); onetype = delsp(onetype) )
;
#ifdef DEBUG
if (symdebug) {
printf("type: %d BTYPE %d ISARRAY %d ",type,BTYPE(type),ISARRAY(type));
printf("POINTER %d\n",ISPOINTER(type));
printf("onetype: %d BTYPE %d ",onetype,BTYPE(onetype));
printf("ISARRAY %d POINTER %d\n",ISARRAY(onetype),ISPOINTER(onetype));
}
#endif
nbout = 0;
datasize = dsize(type,dp,ssp);
nbleft = 0; /*keep track of no. of bytes left*/
atype = (ISARRAY(type)) ? delsp(type) : type; /*[vlh]4.2 multi dimens */
if(type==(ARRAY|CHAR) || type==(ARRAY|INT) || type==(ARRAY|LONG))
nbout = str_init(datasize,type);
else if(atype==(ARRAY|CHAR) || atype==(ARRAY|INT) || atype==(ARRAY|LONG)) {
datasize = dsize(atype,dp,ssp);
elsize = dsize(atype,dp+1,ssp);
if( !i )
error("missing { in initialization");
do {
j = (next(LCURBR));
nbout += str_init(elsize,atype);
if (j && !(next(RCURBR)))
error("missing } in initialization");
next(COMMA); /* skip over comma... */
} while(!PEEK(RCURBR) && !PEEK(SEMI));
nbleft = datasize - nbout;
if ((elsize==INTSIZE && (onetype==INT) || (onetype==SHORT)) ||
(elsize==CHARSIZE && (onetype==CHAR)) ||
(elsize==LONGSIZE && (onetype==LONG)) ||
(datasize==elsize)) /*undimensioned array*/
nbleft = 0;
if (nbleft < 0) {
error("initializer list too long");
nbleft = 0;
}
} /* multi-dimensional array */
else if (BTYPE(type)==STRUCT && NOTPOINTER(type) && ISPOINTER(onetype)) {
elsize = PTRSIZE; /* [vlh] 4.2.f */
if( !i )
error("missing { in initialization");
do {
nbleft = s_or_a(POINTER|CHAR,elsize,&nbout,nbleft,NULL,NULL);
next(COMMA); /* skip over comma... */
} while(!PEEK(RCURBR) && !PEEK(SEMI));
}
else if (ISARRAY(type) || (BTYPE(type)==STRUCT && NOTPOINTER(type))) {
elsize = dsize(delsp(type),dp+1,ssp);
/* [vlh] 4.2, added proper handling of structure init... */
if( !i && BTYPE(type)==STRUCT )
error("missing { in initialization");
do {
nbleft = s_or_a(onetype,elsize,&nbout,nbleft,sp->s_par,NULL);
next(COMMA); /* skip over comma... */
} while(!PEEK(RCURBR) && !PEEK(SEMI));
}
else {
indecl = 0; /* [vlh] 4.2 */
nbout = oneinit(onetype,dp,(int)sp->s_sc); /* [vlh] 4.2.c add 2 args */
}
if (in_bitinit)
BCHK(plus) /* [vlh] 4.2 bit field initialization */
if( nbleft && (nbleft != elsize)) { /*pad current row*/
OUTRESMEM(nbleft);
nbout += nbleft;
}
if (i) {
next(COMMA); /* [vlh] 4.2 skip over extra comma */
if (!(next(RCURBR)))
error("missing } in initialization");
}
return(nbout);
}
/**
* s_or_a - initialize structure or array
* routine to deal with initializing structures and arrays and
* assure that structures are aligned properly. Checks initializers
* with the expected type.
* Attempts to match structure initializations against the
* elements of the structure.
* sp -- pointer to structure symbol table entry
**/
long
s_or_a(original,elsize,pnbout,bleft,sp,child) /* returns nbleft */
int original; /* [vlh] original type... */
long elsize, bleft, *pnbout;
struct symbol *sp; /* [vlh] 4.2 for use in struct init */
struct symbol *child; /* [vlh] 4.2 for use in struct init */
{
register long nbleft, nbout;
register short onetype, plus;
long i, temp, datasize;
short nest; /* [vlh] 4.2 nest <= number of LCURBR */
struct symbol *hold;
#ifdef DEBUG
if (symdebug) printf("s_or_a: elsize %ld\n",elsize);
#endif
nbleft = bleft; nbout = *pnbout; onetype = original; nest = i = 0;
do { /*in current row.*/
restart:
if (BTYPE(original)==STRUCT && !child) /* [vlh] 4.2 */
if ((child = sp->s_child) == 0)
break;
#ifdef DEBUG
if (symdebug && BTYPE(original)==STRUCT)
printf("s_or_a: child %s type %d\n",child->s_symbol,child->s_type);
#endif
if( PEEK(SEMI) || PEEK(EOF) || PEEK(RCURBR) )
break;
if( next(LCURBR) ) { /*recurse down one level?*/
nest++;
if (in_bitinit)
BCHK(plus) /* [vlh] 4.2 bit field initialization */
if( nbout && nbleft && (nbleft<elsize)) {
OUTRESMEM(nbleft); /*pad rest of current row*/
nbout += nbleft;
nbleft = 0;
}
if (!nbout && !nbleft)
goto restart;
if( i > elsize )
error("initializer list too long");
child = 0; /* force restart of structure match up */
goto restart;
}
else if( PEEK(RCURBR) ) {
if (nest) {
next(RCURBR);
nest--;
continue; /* goes to next comma... */
}
else
break;
}
else {
if (BTYPE(original) == STRUCT) { /* [vlh] 4.2 */
if ((onetype = child->s_type) == STRUCT) {
temp = nbout;
hold = child->s_child;
i = dsize(onetype,(hold->s_dp)+1,hold->s_ssp);
s_or_a(onetype,i,&temp,nbleft,hold,NULL);
if (!peektok)
peektok = COMMA; /* [vlh] 4.2 put it back.... */
goto past;
}
}
if(onetype==(ARRAY|CHAR) || onetype==(ARRAY|INT) ||
onetype==(ARRAY|LONG)) { /* [vlh]4.2 simple arrays */
datasize = dsize(onetype,child->s_dp,child->s_ssp);
i = str_init(datasize, onetype);
}
else if(original==(ARRAY|CHAR) || original==(ARRAY|INT) ||
original==(ARRAY|LONG)) { /* [vlh]4.2 simple arrays */
datasize = dsize(original,child->s_dp,child->s_ssp);
i = str_init(datasize, original);
}
else if (ISARRAY(onetype)) { /* [vlh] 4.2 */
temp = nbout;
#ifdef DEBUG
if (symdebug) printf("ISARRAY, recursing on s_or_a... type %d\n",onetype);
#endif
i = dsize(delsp(onetype),child->s_dp+1,child->s_ssp);
s_or_a(delsp(onetype),i,&temp,nbleft,hold,NULL);
goto past;
}
else {
if ((nbleft & 1) && onetype != CHAR) {
nbleft--;
nbout++;
OUTEVEN();
}
i = oneinit(onetype,child->s_dp,(int)child->s_sc);
}
past:
nbout += i;
if(!nbleft)
nbleft = elsize;
if( i > nbleft )
error("initializer alignment");
nbleft = (i >= nbleft) ? 0 : nbleft - i;
if (BTYPE(original)==STRUCT) { /* [vlh] 4.2, get next child */
if (!(child = child->s_sib)) { /* [vlh] 4.2 at end... */
plus = (in_bitinit) ? out_bfield(CHAR) : 0;
nbleft -= plus;
nbout += nbleft;
if (nbleft && (nbleft < elsize)) {
OUTRESMEM(nbleft);
nbleft = 0;
}
if (SUPTYPE(original) != ARRAY) {
break;
}
}
}
}
} while( next(COMMA) );
if (BTYPE(original)==STRUCT) { /* [vlh] 4.2, ensure padding... */
plus = (in_bitinit) ? out_bfield(CHAR) : 0;
nbout += nbleft;
if (nbleft && (nbleft < elsize)) {
OUTRESMEM(nbleft);
nbleft = 0;
}
}
*pnbout = nbout;
while(nest--) {
next(COMMA); /* comma's may separate.... */
if (!next(RCURBR)) /* force release of matched curbr */
error("mismatched curly braces");
}
next(COMMA); /* comma's may separate.... */
return(nbleft);
}
/**
* str_init - string (array) initialization [vlh] 4.2
* initialize a character array, truncating or padding as required
**/
long
str_init(datasize,type)
long datasize;
int type; /* should not get a bit field here..... */
{
register long maxsize, output;
#ifdef DEBUG
if (symdebug) printf("str_init: type %d, datasize %ld\n",type,datasize);
if (symdebug) printf("str_init: SUPTYPE %d, ",SUPTYPE(type));
if (symdebug) printf("BTYPE %d\n",BTYPE(type));
#endif
output = 0L;
if ((datasize==CHARSIZE && (BTYPE(type)==CHAR)) || /*undimensioned array*/
(datasize==INTSIZE && (BTYPE(type)==INT) || (BTYPE(type)==SHORT)) ||
(datasize==LONGSIZE && (BTYPE(type)==LONG))) {
datasize = 0;
maxsize = 0x7fff; /* max 32 bit positive value */
#ifdef DEBUG
if (symdebug) printf("undimensioned type %d datasize %ld\n",type,datasize);
#endif
}
else
maxsize = datasize;
do {
if (next(STRING)) {
output += (!datasize) ? outstr((long)cstrsize,(long)cstrsize) :
outstr(maxsize-output,(long)cstrsize);
return(output);
}
output += oneinit(BTYPE(type)|ARRAY,0,0);
#ifdef DEBUG
if (symdebug) printf("output %ld, ",output);
if (symdebug) printf("maxsize %ld, ",maxsize);
#endif
if (maxsize <= output) {
if (maxsize < output)
error("character array initializer alignment");
return(output);
}
} while (next(COMMA) && !PEEK(SEMI) && !PEEK(RCURBR));
if (datasize) {
OUTRESMEM(maxsize-output);
return(maxsize);
}
return(output);
}
/**
* oneinit - get one initializer expression or constant
* This checks the type of the data item expected against the
* type obtained from expr.
**/
oneinit(type,dp,sc) /* returns size of initializer*/
int type; /* type of initializer*/
int dp, sc; /* [vlh] 4.2.c add for bit field init */
{
register short op, plus, ivalue;
register struct tnode *tp;
register long value;
commastop++;
#ifdef DEBUG
if (symdebug) printf("oneinit: type = %d\n",type);
#endif
if ((tp = (struct tnode *)expr(0)) == 0) {
error("invalid initializer");
commastop--;
return(0);
}
commastop--;
if ((op = tp->t_op) == CINT)
clvalue = value = ((struct conode *)tp)->t_value;
else if (op == CLONG)
clvalue = value = ((struct lconode *)tp)->t_lvalue;
else
value = clvalue;
if (sc == BFIELDCL)
return(one_binit(type,dp,sc,value));
ivalue = value;
plus = (in_bitinit) ? out_bfield(type) : 0;
switch( ISALLTYPE(type) ) {
case UCHAR:
if( op == CINT || op == CLONG ) { /* [vlh] 4.2, added CLONG */
outc(CHAR,((int)(ivalue&0xff)));
if ((ivalue&0xff00) && ((ivalue&0xff00) != 0xff00))
warning("initializer truncated");
return(1+plus);
}
if( op == ADDR ) { /* [vlh] 4.2, STRING.... */
outc(CHAR,((int)(*cstr&0xff)));
warning("string used to initialize character value");
return(1+plus);
}
break;
case CHAR:
if( op == CINT || op == CLONG ) { /* [vlh] 4.2, added CLONG */
outc(CHAR,((int)ivalue)&0xff);
#ifdef DEBUG
if (symdebug) printf("ivalue %d\n",ivalue);
#endif
if ((ivalue>255) || (ivalue<-128))
warning("initializer truncated");
return(1+plus);
}
if( op == ADDR ) { /* [vlh] 4.2, STRING.... */
outc(CHAR,((int)*cstr)&0xff);
warning("string used to initialize character value");
return(1+plus);
}
break;
case ARRAY|CHAR:
if( op == CINT || op == CLONG ) { /* [vlh] 4.2, added CLONG */
if (ccbytes < 2) {
outc(CHAR,((int)ivalue)&0xff);
if ((ivalue>255) || (ivalue<-128))
warning("initializer truncated");
return(1+plus);
}
else { /* 2 character charconst eg. 'ab' */
outc(INT,ivalue);
return(2+plus);
}
}
break;
case INT:
case ARRAY|INT:
if (op == ADDR)
break;
if( op == CINT || op == CLONG ) { /* [vlh] 4.2, added CLONG */
outc(INT,(int)value);
if ((value&0xffff0000) && ((value&0xffff0000) != 0xffff0000))
warning("initializer truncated");
}
else
outinit(tp,inittype);
return(2+plus);
case UNSIGNED: /* [vlh] 4.0 split from INT... */
case USHORT: /* [vlh] 4.2 added... */
case ARRAY|UNSIGNED:
if (op == ADDR)
break;
if( op == CLONG || op == CINT ) { /* [vlh] 4.2, rewrote */
if ((value&0xffff0000) && ((value&0xffff0000) != 0xffff0000))
warning("initializer truncated");
ivalue = value & 0xffff;
outc(INT,ivalue);
}
else
outinit(tp,inittype);
return(2+plus);
case LONG:
case ULONG:
case ARRAY|LONG:
case POINTER|CHAR:
case POINTER|UCHAR:
case POINTER|INT:
case POINTER|LONG:
case POINTER|ULONG:
case POINTER|STRUCT:
case POINTER|UNSIGNED:
if( op==CINT || op==CLONG )
outlong(value);
else
outinit(tp,inittype);
return(4+plus);
case DOUBLE: /* [vlh] 3.4 */
case FLOAT:
outfp(value);
return(4+plus);
}
error("invalid initializer type=%d",ISALLTYPE(type));
return(plus);
}
/**
* one_binit - individula element bit field initialization. [vlh] 4.2
* returns the number of bytes actually initialize 1, 2 or 0
**/
one_binit(type,dp,sc,value)
int type,dp,sc;
long value;
{
register short plus, mask, op;
op = (BTYPE(type) == CHAR) ? BITSPCHAR : BITSPWORD;
op = (dp>>8)%op;
if (in_bitinit && ((bfield_ty != BTYPE(type)) || (op < lst_boffset)))
plus = out_bfield(type);
else
plus = 0;
lst_boffset = op;
bfield_ty = BTYPE(type);
mask = (1 << (dp & 0xff)) - 1;
bits_init |= ((value & mask) << op);
in_bitinit++;
return(plus);
}
/* out_bfield - last item was a bit field output it [vlh] 4.2 */
out_bfield(type) /* return number of bytes output */
int type;
{
in_bitinit = 0;
if (bfield_ty == CHAR) { /* char bit field type */
outc(CHAR,(int)bits_init);
bits_init = 0;
if (ISALLTYPE(type) != CHAR) /* returns 2 */
OUTEVEN();
else
return(1);
}
else { /* int/unsigned bit field type */
outc(INT,(int)bits_init);
bits_init = 0;
}
return(2);
}

112
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/interf.c Normal file
View File

@@ -0,0 +1,112 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
#include "parser.h"
short 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));
}
/* outasm - outputs asm literal. [vlh] 4.2 asm instruction */
outasm()
{
register char *p;
OUTLINE();
OUTNULL();
putchar('\t');
for (p = cstr; *p ; p++) {
putchar(*p);
if (*p == '\n')
putchar('\t');
}
putchar('\n');
}
outexpr(tp)
struct tnode *tp;
{
if (!tp)
return;
OUTLINE();
outtree(tp);
}
/* interprets and prints the parse tree */
outtree(tp)
struct tnode *tp;
{
short w1, w2;
if( !tp )
return;
printf("%x.%x",tp->t_op,tp->t_type);
switch( tp->t_op ) {
case CINT:
printf(".%x\n",((struct conode *)tp)->t_value);
break;
case CLONG:
w1 = ((struct lconode *)tp)->t_lvalue.hiword;
w2 = ((struct lconode *)tp)->t_lvalue.loword;
printf(".%x.%x\n",w1,w2);
break;
case CFLOAT: /*[vlh] 3.4*/
w1 = ((struct lconode *)tp)->t_lvalue.hiword;
w2 = ((struct lconode *)tp)->t_lvalue.loword;
printf(".%x.%x\n",w1,w2);
break;
case SYMBOL:
printf(".%x",((struct symnode *)tp)->t_sc);
if( ((struct symnode *)tp)->t_sc == EXTERNAL )
printf(".%.8s\n",((struct extnode *)tp)->t_symbol);
else
printf(".%x\n",((struct symnode *)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;
} /* end of case... */
}

579
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/lex.c Normal file
View File

@@ -0,0 +1,579 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
#ifdef PDP11
# define short int
#endif
#include "parser.h"
#include "lex.h"
/**
* 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);
}
/**
* 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,pseen)
long significant;
int pseen; /* period seen and couldn't be pushed back */
{
register char c;
register long places; /* decimal places */
short esign;
double exp, fraction, fp;
places = 0L; esign = 0; fraction = significant; exp = 0.0;
if (pseen || (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) );
}
double
power10(pwr) /* used by getfp, 10^pwr */
long pwr;
{
double 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 */
double f;
{
register long exp, l;
register short sign;
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 */
double f;
{
register long exp, l;
register short sign;
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);
}
/* 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 short 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(force) /* returns token type*/
int force; /* force nested decls */
{
register short c, nextc, i, islong;
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:
indecl = 0;
cvalue = 0; /* [vlh] not reserved word... */
default:
return( ctype[c] );
case PERIOD: /* [vlh] 4.2, floating point constant ?? */
c = ngetch();
putback(c);
if (ctype[c] == DIGIT) {
clvalue = getfp(0L,TRUE);
return(CFLOAT);
}
return(PERIOD);
case LCURBR: /* [vlh] 4.2, next level increase */
indecl = 0; /* [vlh] 4.2, functions which return values */
if (infunc) /* first curly brace will be missed */
scope_level++;
return(LCURBR);
case RCURBR: /* [vlh] 4.2, next level decrease */
if (scope_decls[scope_level]) {
if (scope_level != FUNC_SCOPE)
freesyms(scope_level);
scope_decls[scope_level] = 0;
}
if (scope_level != GLOB_SCOPE)
scope_level--;
return(RCURBR);
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;
}
ccbytes = cstrsize - 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*/
ccbytes = 0;
if( c != '0' ) {
putback(c);
dofp:
value = getdec();
islong = ((value > 32767) || (value < 0));
if ((c=ngetch())=='.' || c=='e' || c=='E') { /*[vlh] 3.4 */
putback(c);
clvalue = getfp(value,FALSE);
return(CFLOAT);
}
putback(c);
}
else if( peekis('x') || peekis('X') ) {
value = gethex();
islong = ((value > 65535) || (value < 0));
}
else {
if (peekis('.')) {
putback('.');
goto dofp;
}
value = getoct(0);
islong = ((value > 65535) || (value < 0));
}
if( peekis('l') || peekis('L') || islong ) {
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('<') ) {
warning("old fashion assignment \"=<<\"");
return(EQLSH);
}
}
else if( peekis('>') ) {
if( peekis('>') ) {
warning("old fashion assignment \"=>>\"");
return(EQRSH);
}
}
else if( (i=index("-*&=+/|^%",(c=ngetch()))) >= 0 ) {
if( i < 3 ) {
if( (nextc=ngetch()) != ' ' )
warning("=%c assumed",c);
putback(nextc);
}
i = asmap[i];
if (i != EQUALS)
warning("old fashion assignment statement");
return( i );
}
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,indecl|force);
if( csp->s_attrib & SRESWORD ) {
cvalue = csp->s_offset;
if (cvalue == R_SIZEOF) { /* [vlh] 4.2 */
#ifdef DEBUG
if (symdebug) printf("presizeof indecl %d\n",indecl);
#endif
predecl = indecl;
indecl = 0;
}
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 short 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 short c;
register char *ptr;
if( pbchar ) {
c = pbchar;
pbchar = 0;
return(c);
}
if( (c=getc(&ibuf)) == EOLC ) {
cr_last = 1;
lineno++;
}
else if( cr_last && c == '#') { /* [vlh] 4.2 handle: # 33 "file.h" */
getc(&ibuf); /* get space */
lineno = getdec() & 077777;
ptr = &source[0];
getc(&ibuf); /* get double quote */
while ((c=getc(&ibuf)) != '\"')
*ptr++ = c&0377;
c = getc(&ibuf); /* get carriage return*/
*ptr = 0;
cr_last = 1;
} /* exits with cr_last still set !!!! */
else if( c < 0 )
c = EOF;
else
cr_last = 0;
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 short 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 short i;
register short c;
register short 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("bnrtf",c)) >= 0 ) /* 4.1 added f... */
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';
}
/* 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 short token;
if( (token=gettok(0)) == tok )
return(1);
peektok = token;
return(0);
}
/* pnext - if next token is a symbol, skip and return success*/
/* This allows for clean parsing of declarations.*/
pnext() /* returns 1 if matched, 0 otherwise*/
{
register short token;
if( (token=gettok(1)) == SYMBOL ) /* next symbol a param ?? */
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;
}

83
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/lex.h Normal file
View File

@@ -0,0 +1,83 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
#define TOUPPER(c) ((c) & ~32)
#define BIAS 127L
#define EXPSIZ 4
#define FRACSIZ 20
/**
* 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, WHITSP, 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
};
#define SOI '\01'
/**
* 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[] = {
EQSUB, /*=- Self modify... */
EQMULT, /*=* Self modify... */
EQAND, /*=& Self modify... */
EQUALS, /*==*/
EQADD, /*=+*/
EQDIV, /*=/*/
EQOR, /*=|*/
EQXOR, /*=^*/
EQMOD, /*=%*/
};
short pbchar; /*pushed back character*/
char escmap[] = "\b\n\r\t\f"; /* 4.1 added \f */
long toieee();
long toffp();
double power10();

439
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/log Normal file
View File

@@ -0,0 +1,439 @@
.he "C68 Parser"Change Log"Page %"
.de bg
.sp
.in +5
..
.de eg
.sp
.ne 8
.in -5
..
1. 4/12/82 - Undefined symbols not being detected
.bg
This was caused by expr setting the defined flag for the symbol and
then setting its type to label. Solution was to check for undefined
symbol in expr and output error message there, since the only place
an undefined symbol can occur in a statement is after a goto.
This results in all undefined symbols in statements having one error
message output on the line the symbol is used, and all undefined
labels error messages being output once at the end of the function.
.eg
2. 4/12/82 - Operand stack underflow problem
.bg
Error recovery not very effective, skipped over closing right bracket,
which cascaded errors. Changed synerr to put back the syncronizing
token, no matter which it was. Also changed stmt to not call expr
when the first token on the line was right bracket. This resulted
in "operand stack underflow" errors when a label immediately preceded
a right bracket, e.g. at the end of a function or at the end of
a switch statement. Also added logic in expr and popopd so that
the "invalid expression" error would be output rather than
"operand stack underflow".
.eg
3. 4/13/82 - Error message cleanup
.bg
Changed "expression too complex" messages and "invalid
structure proto" message.
.eg
4. 4/13/82 - Missing =% operator
.bg
Lex did not check for =% operator, added it.
.eg
5. 4/16/82 - Bad function declarations
.bg
The functions lookup, tnalloc and sbrk were not declared as returning
pointers.
.eg
6. 4/19/82 - Added static declarations
.bg
Declaring functions and external variables as static did not work.
Added fixes to gettype, doextdef, dodecl and expr to correctly handle
static variable and function declartions.
.eg
7. 4/23/82 - Typedef stuff again....
.bg
Adding declarator info to typedef declaration in cast did not work
correctly. This required adding typedef info carefully into the
type info already obtained from gettype. The routine addtdtype
was added to do all this jazz correctly. Also, declarator was changed
so that it would return the super-type info in the correct (rather
than reverse) order. Both expr and dodecl were changed to reflect the
the addtdtype routine. Also, it turned out that expr was being
recursively called the declarator (via cexpr). This required the
careful setting of the pointers (opp, opdp, exprp, opap) to the
expression stacks and workspace. This resulted in changes to doreturn
and to copyargs, which require the expression area be set up.
.eg
8. 4/26/82 - structure pointer initialization
.bg
A pointer to a structure could not be initialized, problem in
initlist checking only for a structure being an aggregate type.
added (btype(type)==STRUCT) && notpointer(type) into aggregate
type test.
.eg
9. 4/26/82 - memory fault after invalid conversion error
.bg
cvopgen was not setting rtp pointer if invalid conversion, resulting
in invalid address in tree. Changed cvopgen so it would return
tp upon invalid conversion problem.
.eg
10. 5/4/82 - external definition syntax loop
.bg
The error "external definition syntax" would not necessarily skip
the offending token. Changed next(RCURBR) to gettok()!=RCURBR to
insure token was skipped.
.eg
11. 5/4/82 - Char pointer array string init error
.bg
The syntax: char *x[] {"xx"}; would not work because the type
given to oneinit was ARRAY of CHAR. Added code in initlist to
give oneinit the "basic" type of the data structure. Also added
routine revsp.
This routine
doesn't fix anything, but it's probably clearer what's going on...
.eg
12. 5/4/82 - Declarator syntax problem
.bg
The syntax: int (*x)(); would not work because the check for a
valid declarator in getdecl was to check sp, a local register,
rather than dsp, the declarator symbol pointer. The parenthesis
caused a recursive call, and the local sp was set in the recursive
instance, rather than the one that did the check.
.eg
13. 5/5/82 - Missing } error for non-aggregate inits
.bg
Got "missing }" for: char *p {"xx"}; had mistakenly changed
next(RCURBR)==0 to next(RCURBR) in initlist when fixing bug 10.
.eg
14. 5/10/82 - Braces around string init for char array
.bg
Got "invalid initializer" for: char x[] {"xx"}; was not checking for
this case in initlist. Added code in initlist to check for this.
.eg
15. 5/12/82 - Integer initialization in long or pointer data type
.bg
The case: char *x[] { 0 }; only resulted in an integer initialization.
Fixed oneinit to extend int to long and output as long constant.
.eg
16. 5/20/82 - Long -1 initialization
.bg
The syntax: long x -1; initialized x to 1, added check in cexpr to
add check after '-' for CINT as well as CLONG.
.eg
17. 5/27/82 - sizeof structure prototype
.bg
The syntax: sizeof( struct x ) where x is a structure prototype name
was not working (although this is not part of OFFICIAL C syntax anyway).
Added code in expr to do right thing with type STRUCT. Also saw and
fixed some STRPROTO bugs in gettype and dodecl.
.eg
18. 6/1/82 - int to pointer conversion not getting error
.bg
Test in maketree for integer to pointer conversion was not correct.
Changed test in maketree to flag any INT or UNSN assignment conversion if
the right hand side was not an constant.
.eg
19. 6/2/82 - int to pointer conversion again
.bg
Test in maketree fixing bug 18 was not quite correct, did not allow
*p =+ i; added check in maketree for only assignment operator.
.eg
20. 6/2/82 - line numbers on error messages
.bg
Line numbers on error messages sometimes off by one. This is because
expr or stmt can gobble up one or two tokens, thereby incrementing the
line number.
.eg
21. 6/17/82 - unsigned initialization
.bg
Couldn't do: unsigned x = 1; There were no entries in oneinit for a
base type of UNSIGNED...
.eg
22. 11/23/82 - nonunique structure names
.bg
Added the system III capability to handle structures which have
elements which have the same name, but different types and/or
structure offsets.
.eg
23. 12/06/82 - forward referenced structures
.bg
Forward referenced structures are now allowed, checking to be sure
that they are defined is left until end of file is reached.
.eg
24. 12/13/82 - structure assignments [vlh] 4.0
.bg
One structure may be assigned to another provided that the one on
the right is smaller than or equal to the left one in size.
.eg
25. 12/16/82 - Don't generate .globl's for external func's [vlh] 4.0
.bg
Don't automatically generate .globl's for external functions, avoids
automatically loading routines which may never be used (like stdio).
.eg
26. 1/5/83 - sizeof as array size specification [vlh] 4.0
.bg
Recursive call to 'getdecl' caused the size specified using sizeof
to be lost.
.eg
27. 1/12/83 - procedure/function name as identifier [vlh] 4.0
.bg
Generated "tst.l #_ident" for "if (ident) ;" where ident is a procedure
or function name. Changed this to generate as true instead.
.eg
28. 1/25/83 - outgoto macro [vlh] 4.0
.bg
Made the outgoto procedure a macro, requires it's single parameter to
be a constant.
.eg
29. 2/8/83 - typedef of forward referenced structures [vlh] 4.0
.bg
The dimension table pointer of a typedefed forward referenced structure
was being initialized incorrectly.
.eg
30. 2/12/83 - Pointer to structure comparisons to integers [vlh] 4.0
.bg
Previously the integer value was being multiplied by the size of the
structure in words.
.eg
31. 2/19/83 - Pointers assigned to structure array element [vlh] 4.1
.bg
struct {char d[10];} *p; char *q; q = &p->d;
.eg
32. 2/28/83 - For loop construction [vlh] 4.1
.bg
Altered the code that is generated so that only one branch is inside
the for loop. Better code is now generated.
.eg
33. 3/1/83 - While loop construction [vlh] 4.1
.bg
Altered the code that is generated so that only one branch is inside the
while loop. Better code is now generated.
.eg
34. 3/1/83 - Char and char * casting [vlh] 4.1
.bg
Added the docast unary operator to fix the char cast problem in the
parser, changed the char * cast to do a int to long conv in the case
of a char *.
.eg
35. 3/7/83 - Unsigned/int global initialization [vlh] 4.1
.bg
Initialization of integer to -32768 generated an error, as did unsigned
initializations > 32767.
.eg
36. 3/29/83 - string defines [vlh] 4.1
.bg
Initialization's of strings has been broken up into dc.b's of no greater
than 32 bytes at a time. This is to avoid building one which is too
long for the assembler and the editor.
.eg
37. 4/21/83 - structure alignment [vlh] 4.1
.bg
Fixed the structure alignment call to salign which caused character pointers
to not be aligned properly.
.eg
38. 4/22/83 - structure fields with same names [vlh] 4.1
.bg
Structure fields with the same names were only being inserted into the
symbol table once. Required a test to ensure that all declarations of
fields are inserted and just statement handling is allowed to short
circuit it.
.eg
39. 5/2/83 - added '\f' recognization [vlh] 4.1
.bg
Added recognizing and proper treatment of the form feed escaped
character '\f'.
.eg
40. 5/10/83 - multi-dimensional arrays [vlh] 4.1
.bg
The indices into multi-dimensional arrays were being computed incorrectly.
The arrayref routine was setting the proper dimension table pointer, and
then resetting it to it's parent's value.
.eg
41. 5/11/83 - int to long constant conversion [vlh] 4.1
.bg
Constants were not being converted until the code generation pass. For
this reason certain constants were not being calculated correctly.
The long constant 0x8000 was left as an integer constant value of -32768
and passed to the code generator. The codegenerator does not know what
the original value was. Constant conversions from integers to longs needed
to be done in the parser.
.eg
42. 6/6/83 - return with null expression [vlh] 4.1
.bg
A return call which included parenthesis but a null expression caused the
parser to generate an error and bus error. There was no test of expr's
return value in case of an error in which the expression tree would be
non-existent. Need to check for parens without expression.
.eg
43. 6/8/83 - sizeof array as a structure field [vlh] 4.1
.bg
The sizeof all types of values was being treated as a single node. If the
item in question was an array element ensconsed in a structure the value
was always determined to be the size of a pointer. This required the addition
of a new subroutine which in the case of an array inside a structure traversed
the tree and took into account the two nodes nearest to the tips of the tree.
.eg
44. 6/13/83 - added block declarations [vlh] 4.2
.bg
Reworked original link and movem to be done at the bottom of the routine
at which time the number of variables register and stack will be known.
This requires an extra branch at the top and bottom of each function.
.eg
45. 6/14/83 - added auto initilization [vlh] 4.2
.bg
Added the recognizing of the equal sign as a local variable initialization.
Faked out expression by handling the symbol internally. Turned on commastop
to ensure only one variable is parsed at a time.
.eg
46. 6/15/83 - local/global same name [vlh] 4.2
.bg
Added the facility to the parser to allow for local/global/block/nested block
variables with the same name. This required the addition of a scope level
to the symbol table node. Global scope is 0. Function parameters and
local variables are at level 1, etcetera. Each left curly brace signifies
and additional nesting level. This requires freeing symbols at every
right curly brace if there are any at that level. Added an array to keep
track of what levels have variables declared so that the symbol table did
not have to be searched for every curly brace.
.eg
47. 6/21/83 - link file [vlh] 4.2
.bg
Added the link file. Writes link information (link and movem instructions)
into this file for remerging by the codegenerator. This was added in order
to produce cleaner code with the addition of block variables and
local initializations.
.eg
48. 6/22/83 - structures [vlh] 4.2
.bg
Rewrote all the code to deal with structures and their elements and how
and where they are put into the symbol table. Necessitated the addition
of two more symbol table pointers: a child link (pointer from structure
to it's first element), and a sibling link (linking together all the
elements in a structure). Every unnamed structure is now being added to
the symbol table with a fake name.
.eg
49. 6/27/83 - asm [vlh] 4.2
.bg
Added the asm instruction to the parser in order to generate assembly
language code directly into the C source.
.eg
50. 6/28/83 - bit fields [vlh] 4.2
.bg
Bit fields where not being aligned on a word boundary when necessary.
Also the value of s_dp which was used to decided the bit offset of
the field was not being reset if an int bit field followed a character
bit field.
.eg
51. 6/28/83 - structure initialization and alignment [vlh] 4.2
.bg
Rewrote all code which deals with initializing structures. It now
compares the sizes and types of the structure fields against the
objects which are used to initialize the structures. It defines
space for padding properly. Arrays inside of structures are now
being initialized properly. They are truncated at the appropriate
space if required, otherwise they are terminated by a null byte
and padded to the appropriate size. If they are truncated then
the parser generates a warning message.
.eg
52. 7/7/83 - scope problem [vlh] 4.2
.bg
Variables which were declared on more than one scoping level were
not always being identified properly. In particular, if a variable
is accessed on a nesting level different from it's declaration
it would not always choose the right declaration.
.eg
53. 7/13/83 - long vs. short vs. int [vlh] 4.2
.bg
All references to int variables have been changed to shorts. This is
for the sake of portability between regulus and the vax.
.eg
54. 7/20/83 - bit field initialization [vlh] 4.2
.bg
Added a routine called bfield_init which outputs the word or character
once it is built. Added code to oneinit to build the bit fields as
they were evaluated.
.eg
55. 7/20/83 - symbolic debugger flag [vlh] 4.2
.bg
Added recognizing of the '-g' flag. Output the label required before
the link instruction.
.eg
56. 7/25/83 - fixed structure assignments again [vlh] 4.2
.bg
Move the structure assignment size test into the maketree routine.
Make a right side structure larger than a left only a warning.
Determine the size of the structures in the maketree routine before
the original tree nodes are altered beyond comprehension.
.eg
57. 7/25/83 - unsigned char/long [vlh] 4.2
.bg
Initial changes required to allow unsigned char and unsigned long
types.
.eg
58. 7/29/83 - long constant conversion to int [vlh] 4.2
.bg
Operations in which one operand is a long constant and the other is
an integer will cause the long constant to be converted at all times.
Caused an additional condition to be added to the conversion code in
the maketree routine.
.eg
59. 8/1/83 - frstruct pointer as struct element [vlh] 4.2
.bg
A pointer to a forward referenced structure was being incorrectly
linked into the structure declaration. Required several tests
and some additional code in the get_s_or_u and get_type routines.
.eg
60. 8/5/83 - function label test [vlh] 4.2
.bg
Bad code was being generated for a statement of the form "if(func_name)".
The immediate value of the function label was being tested. Fixed this
by adding a test in funcref() to not generate addresses if the operand is
a SYMBOL or NOT.
.eg
61. 8/8/83 - constant expression evaluation [vlh] 4.2
.bg
Added a test to tree() to avoid adding conversion ops to an expression
which involves only long/short constants. This ensures that they will
be evaluated by the parser in binopeval.
.eg
62. 8/9/83 - source file to cgen [vlh] 4.2
.bg
Altered the macro which outputs the line number to the intermediate file
to also output the file name, for use in generating errors in the
code generator pass.
.eg
63. 8/10/83 - constant test for long [vlh] 4.2
.bg
Changed the gettok() routines test of a constant as a long to check to
see if any of the high bits (0xffff0000) are set in the value. As all
numbers are positive at the time of this evaluation it is the most sure
fire way to decide.
.eg
64. 8/12/83 - array dimension using sizeof [vlh] 4.2
.bg
Fixed a rather obscure parser bug which involved specifying the dimensions
of an array of structures using the sizeof operator on a structure.
Required a reset in the getdecl routine of dp if cdp had been changed
because of a sizeof operation.
.eg
65. 8/24/83 - 16 bit hex and octal constants [vlh] 4.2
.bg
By definition of Kernighan and Ritchie all octal and hex constants which
fit as unsigned values into an integer size are defined to be integers.
.eg
66. 8/25/83 - 2 dimensional array initialization [vlh] 4.2
.bg
Two dimensional arrays were not being initialized properly in 4.2...
Requires multiple calls to str_init.
.eg
67. 9/2/83 - labels and function names [vlh] 4.2
.bg
Fixed the compiler to handle local-globals with local labels which have
the same name as functions. Fixes in stmt.c to force a new symbol table
entry for the label.
.eg
68. 9/6/83 - floating point constant, w/o preceding digit [vlh] 4.2
.bg
Added a gettok entry for PERIOD to check for a floating point constant
which does not contain a leading digit and thus process it as such.
.eg

322
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/main.c Normal file
View File

@@ -0,0 +1,322 @@
/**
* Copyright 1983
* Alcyon Corporation
* 8716 Production Ave.
* San Diego, Ca. 92121
**/
char *version = "@(#)c068 parser 4.2 - Sep 6, 1983";
#include "parser.h"
#include "def.h"
#include <signal.h>
/**
* ALCYON C Compiler for the Motorola 68000 - Parser
*
* Called from c68:
*
* c068 source icode link
*
* source: input source code, preprocessed with comments stripped
*
* icode: contains the intermediate code for the code generator,
* for a detailed explanaion see ../doc/icode.
*
* link: contains the procedure link and movem instructions.
*
* 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 strucs/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
*
**/
char strfile[] = "/tmp/pXXXXXX";
int cleanup();
/**
* 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, *p, *calledby;
calledby = *argv++;
if( argc < 4 )
usage(calledby);
signal(SIGINT,cleanup);
for(q = &source, p = *argv++; *q++ = *p++; );
if( fopen(source,&ibuf,0) < 0 ) /* 3rd arg for versados */
ferror("can't open %s",source);
source[strlen(source)-1] = 'c';
if( fcreat(*argv++,&obuf,0) < 0 || fcreat(*argv++,&lbuf,0) < 0 )
ferror("temp creation error");
mktemp(strfile);
if (fcreat(strfile,&sbuf,0) < 0)
ferror("string file temp creation error");
obp = &obuf;
lineno++;
frstp = -1; /* [vlh] 3.4 - initialize only once */
cr_last = 1; /* [vlh] 4.2 */
#ifndef VERSADOS
for( argc -= 4; argc; argv++, argc--) { /* get args.... */
q = *argv;
if( *q++ != '-' )
usage(calledby);
while( 1 ) {
switch( *q++ ) {
case 'e':
eflag++;
continue;
case 'f':
fflag++;
continue;
case 'g': /* symbolic debugger flag */
gflag++;
continue;
case 'w': /* [vlh] 4.1 warning messages, not fatal */
wflag++;
continue;
case 't': /* [vlh] 4.1, put strings into text segment */
tflag++;
continue;
#ifdef DEBUG
case 'D': /* [vlh] 4.1, turn debugging on */
debug++;
continue;
case 's': /* [vlh] 4.1, if debug on, debug symbols */
if (debug)
symdebug++;
continue;
case 'x': /* [vlh] 4.1, if debug on, debug expr tree */
if (debug)
treedebug++;
continue;
#endif
case '\0':
break;
default:
usage(calledby);
} /* end of case */
break;
} /* end of while loop */
} /* end of for loop to get flags */
#endif
syminit();
while( !PEEK(EOF) )
doextdef();
outeof();
if (!tflag) /* [vlh] 4.1 */
outdata();
else /* [vlh] 4.1, output strings into text segment */
OUTTEXT();
copysfile(strfile);
cleanup();
}
cleanup()
{
signal(SIGINT,SIG_IGN);
close(lbuf.fd);
unlink(strfile);
exit(errcnt!=0);
}
/* usage - output usage error message and die*/
usage(calledby)
char *calledby;
{
ferror("usage: %s source link icode [-e|-f] [-w] [-T]",calledby);
}
/**
* error - report an error message
* outputs current line number and error message
* [vlh] 4.2 generate filename and approp line number
**/
error(s,x1,x2,x3,x4,x5,x6) /* returns - none*/
char *s; /* error message*/
int x1, x2, x3, x4, x5, x6; /* args for printf*/
{
printf((char *)STDERR,"\"%s\", * %d: ",source,lineno);
printf((char *)STDERR,s,x1,x2,x3,x4,x5,x6);
cputc('\n',STDERR);
errcnt++;
}
/* 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);
errcnt = -1;
cleanup();
}
/**
* warning - Bad practices error message (non-portable code)
* Outputs error message
* [vlh] 4.2, generate filename and approp line number
**/
warning(s,x1,x2,x3,x4,x5,x6) /* returns - none*/
char *s; /* error message*/
int x1, x2, x3, x4, x5, x6; /* args for printf*/
{
if (wflag)
return;
printf((char *)STDERR,"\"%s\", * %d: (warning) ",source,lineno);
printf((char *)STDERR,s,x1,x2,x3,x4,x5,x6);
cputc('\n',STDERR);
}
/* 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 short token;
error(s,x1,x2,x3,x4,x5,x6);
while( (token=gettok(0)) != SEMI && token != EOF && token != LCURBR &&
token != RCURBR )
;
pbtok(token);
}
v6flush(v6buf)
struct iob *v6buf;
{
register short i;
i = BLEN - v6buf->cc;
v6buf->cc = BLEN;
v6buf->cp = &(v6buf->cbuf[0]);
if(write(v6buf->fd,v6buf->cp,i) != i)
return(-1);
return(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 short i;
for( s = str, i = 0; *s != '\0'; i++ )
if( *s++ == chr )
return(i);
return(-1);
}
/* genunique - generate a unique structure name */
genunique(ptr)
char *ptr;
{
register short num;
*ptr++ = ' '; /* symbols will never have names starting with a space */
for (num=structlabel; num != 0; ) {
*ptr++ = (num%10) + '0';
num /= 10;
}
*ptr = '\0';
structlabel++;
}
static char _uniqlet = 'A';
char *mktemp(ap)
char *ap;
{
register char *p;
register int i,j;
p = ap;
i = getpid(); /*process id*/
while( *p )
p++;
for(j = 5; --j != -1; ) {
*--p = ((i&7) + '0');
i >>= 3;
}
*--p = _uniqlet;
_uniqlet++;
if( _uniqlet > 'Z' )
_uniqlet = 'a';
if( _uniqlet == 'z' )
return(0);
return(ap);
}
/**
* strlen - compute string length.
* computes number of bytes in a string.
**/
strlen(s)
char *s;
{ register int n;
for (n=0; *s++ != '\0'; )
n++;
return(n);
}
#ifdef DRI
printf(string,a,b,c,d,e,f,g)
char *string;
int a,b,c,d,e,f,g;
{
char area[256];
register char *p;
sprintf(area,string,a,b,c,d,e,f,g);
for(p = &area[0]; *p ; p++)
putchar(*p);
}
#endif

127
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/makefile Normal file
View File

@@ -0,0 +1,127 @@
CC = cc
C68 = nc68
SOURCES = decl.c expr.c icode.c init.c interf.c lex.c main.c stmt.c tabl.c \
putexpr.c misc.c node.c symt.c tree.c
INCLUDES = parser.h ../icode.h
VAXOBJS = vaxobj/decl.o vaxobj/expr.o vaxobj/icode.o vaxobj/init.o \
vaxobj/interf.o vaxobj/lex.o vaxobj/main.o vaxobj/stmt.o \
vaxobj/tabl.o vaxobj/putexpr.o vaxobj/misc.o vaxobj/node.o \
vaxobj/symt.o vaxobj/tree.o
C68OBJS = 68obj/decl.o 68obj/expr.o 68obj/icode.o 68obj/init.o \
68obj/interf.o 68obj/lex.o 68obj/main.o 68obj/stmt.o \
68obj/tabl.o 68obj/putexpr.o 68obj/misc.o 68obj/node.o \
68obj/symt.o 68obj/tree.o
CFLAGS = -w -O -DVAX11 -DDEBUG
C68FLAGS = -L -r -f -DMC68000 -DDEBUG -t0 -t1
LIB = -lV6
C68LIB = -l6
vax: ${VAXOBJS}
@mkver -e "parser -"
${CC} ${CFLAGS} version.c ${VAXOBJS} -o c068.vax ${LIB}
c068: ${C68OBJS}
@mkver -e "parser -"
${C68} ${C68FLAGS} ${C68OBJS} version.c -o c068.68 ${C68LIB}
@setstack c068.68 8192 8192
2k: ${C68OBJS}
@mkver -e "parser -"
${C68} -n2 ${C68FLAGS} -r ${C68OBJS} version.c -o c068.2k ${C68LIB}
@setstack c068.2k 8192 8192
4k: ${C68OBJS}
@mkver -e "parser -"
${C68} -n ${C68FLAGS} -r ${C68OBJS} version.c -o c068.4k ${C68LIB}
@setstack c068.4k 8192 8192
all: vax 4k
tags:
ctags ${SOURCES} ${INCLUDES}
vaxobj/decl.o: decl.c
${CC} ${CFLAGS} -c decl.c;mv -f decl.o vaxobj/decl.o
vaxobj/expr.o: expr.c
${CC} ${CFLAGS} -c expr.c;mv -f expr.o vaxobj/expr.o
vaxobj/icode.o: icode.c
${CC} ${CFLAGS} -c icode.c;mv -f icode.o vaxobj/icode.o
vaxobj/init.o: init.c
${CC} ${CFLAGS} -c init.c;mv -f init.o vaxobj/init.o
vaxobj/interf.o: interf.c
${CC} ${CFLAGS} -c interf.c;mv -f interf.o vaxobj/interf.o
vaxobj/lex.o: lex.c
${CC} ${CFLAGS} -c lex.c;mv -f lex.o vaxobj/lex.o
vaxobj/main.o: main.c
${CC} ${CFLAGS} -c main.c;mv -f main.o vaxobj/main.o
vaxobj/stmt.o: stmt.c
${CC} ${CFLAGS} -c stmt.c;mv -f stmt.o vaxobj/stmt.o
vaxobj/tabl.o: tabl.c
${CC} ${CFLAGS} -c tabl.c;mv -f tabl.o vaxobj/tabl.o
vaxobj/putexpr.o: putexpr.c
${CC} ${CFLAGS} -c putexpr.c;mv -f putexpr.o vaxobj/putexpr.o
vaxobj/misc.o: misc.c
${CC} ${CFLAGS} -c misc.c;mv -f misc.o vaxobj/misc.o
vaxobj/node.o: node.c
${CC} ${CFLAGS} -c node.c;mv -f node.o vaxobj/node.o
vaxobj/symt.o: symt.c
${CC} ${CFLAGS} -c symt.c;mv -f symt.o vaxobj/symt.o
vaxobj/tree.o: tree.c
${CC} ${CFLAGS} -c tree.c;mv -f tree.o vaxobj/tree.o
68obj/decl.o: decl.c
${C68} ${C68FLAGS} -c decl.c;mv -f decl.o 68obj/decl.o
68obj/expr.o: expr.c
${C68} ${C68FLAGS} -c expr.c;mv -f expr.o 68obj/expr.o
68obj/icode.o: icode.c
${C68} ${C68FLAGS} -c icode.c;mv -f icode.o 68obj/icode.o
68obj/init.o: init.c
${C68} ${C68FLAGS} -c init.c;mv -f init.o 68obj/init.o
68obj/interf.o: interf.c
${C68} ${C68FLAGS} -c interf.c;mv -f interf.o 68obj/interf.o
68obj/lex.o: lex.c
${C68} ${C68FLAGS} -c lex.c;mv -f lex.o 68obj/lex.o
68obj/main.o: main.c
${C68} ${C68FLAGS} -c main.c;mv -f main.o 68obj/main.o
68obj/stmt.o: stmt.c
${C68} ${C68FLAGS} -c stmt.c;mv -f stmt.o 68obj/stmt.o
68obj/tabl.o: tabl.c
${C68} ${C68FLAGS} -c tabl.c;mv -f tabl.o 68obj/tabl.o
68obj/putexpr.o: putexpr.c
${C68} ${C68FLAGS} -c putexpr.c;mv -f putexpr.o 68obj/putexpr.o
68obj/misc.o: misc.c
${C68} ${C68FLAGS} -c misc.c;mv -f misc.o 68obj/misc.o
68obj/node.o: node.c
${C68} ${C68FLAGS} -c node.c;mv -f node.o 68obj/node.o
68obj/symt.o: symt.c
${C68} ${C68FLAGS} -c symt.c;mv -f symt.o 68obj/symt.o
68obj/tree.o: tree.c
${C68} ${C68FLAGS} -c tree.c;mv -f tree.o 68obj/tree.o

16
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/makefile.reg Normal file
View File

@@ -0,0 +1,16 @@
CC = c68
OBJS = decl.o expr.o icode.o init.o interf.o lex.o main.o
OBJ2 = stmt.o tabl.o putexpr.o misc.o node.o symt.o
CFLAGS = -L -e
LIB = -l6 -lE -l7
st: ${OBJS} ${OBJ2}
@mkver -e "parser - "
${CC} -n ${CFLAGS} -r ${OBJS} ${OBJ2} version.c -o c068.st ${LIB}
@setstack c068.st 8192 8192 ; size c068.st
C068: ${OBJS} ${OBJ2}
@mkver -e "parser - "
${CC} ${CFLAGS} -r ${OBJS} ${OBJ2} version.c -o c068.68 ${LIB}
@setstack c068.68 8192 8192 ; size c068.68

218
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/misc.c Normal file
View File

@@ -0,0 +1,218 @@
/*
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 short 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 short 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 short 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 short 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,offset) /* returns number of bytes padded*/
int type; /* data type*/
int flen; /* field length*/
int offset; /* current structure offset */
{
register short off;
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;
else
off = (offset & 1); /* 1 if odd, 0 if even */
break;
case CHAR:
case UCHAR:
if( flen > BITSPCHAR )
error("field overflows byte");
off = ((flen+boffset) > BITSPCHAR );
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 short off;
off = offset;
if( boffset ) { /*remaining bit fields, flush 'em*/
off += (boffset+(BITSPCHAR-1))/BITSPCHAR;
boffset = 0;
}
while( ISARRAY(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))) {
#ifdef DEBUG
if (treedebug) printf("bad indirection..................\n");
#endif
error("bad indirection");
}
return( delsp(type) );
}
/* dosizeof - return size of object ptd at by POINTER [vlh] 4.2 */
dosizeof(tp,bool) /* returns size of object in bytes*/
struct tnode *tp; /* POINTER to tree node*/
int bool; /* 1==>sizeof expr, 0==>other sizeof*/
{
short size;
struct tnode *lp, *rp;
PUTEXPR(treedebug,"dosizeof",tp);
if (NOTPOINTER(tp->t_type) || tp->t_op != ADD)
size = dsize(tp->t_type, tp->t_dp, tp->t_ssp);
else {
lp = tp->t_left; rp = tp->t_right;
while (lp->t_op == ADD) {
rp = lp->t_right;
lp = lp->t_left;
}
size = dtab[lp->t_dp - 1] * dsize(rp->t_type,rp->t_dp,rp->t_ssp);
}
if (bool) /* [vlh] 4.2 */
indecl = predecl; /* value previous to sizeof.... */
return(size);
}
/* psize - return size of object ptd at by POINTER*/
long /* [vlh] 3.4 short => 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;
if (ISARRAY(type)) {
do {
type = delsp(type);
} while (ISARRAY(type));
nel = dtab[dp];
}
if( ISFUNCTION(type) )
return(0);
size = (ISPOINTER(type)) ? PTRSIZE : (type == STRUCT) ?
dtab[sp] : dinfo[type]&DTSIZE;
if(!size)
error("invalid data type");
return( size * nel );
}
/* 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 short type;
type = tp->t_type;
if( type != INT && type != UNSIGNED && type != CHAR && type != UCHAR &&
!SUPTYPE(type) && type != atype ) /* [vlh]4.2 was error: */
warning("integral type expected"); /* "invalid operand type" */
}

201
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/node.c Normal file
View File

@@ -0,0 +1,201 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
/* node allocation, node stack manipulation routines */
#include "parser.h"
/**
* 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 = (struct extnode *)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((char *)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 = (struct conode *)talloc(sizeof(*cp));
cp->t_op = CINT;
cp->t_type = type;
cp->t_dp = 0;
cp->t_ssp = 0;
cp->t_value = value;
return((char *)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 = (struct lconode *)talloc(sizeof(*cp));
cp->t_op = CLONG;
cp->t_type = type;
cp->t_dp = 0;
cp->t_ssp = 0;
cp->t_lvalue = value;
return((char *)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 = (struct lconode *)talloc(sizeof(*cp));
cp->t_op = CFLOAT;
cp->t_type = type;
cp->t_dp = 0;
cp->t_ssp = 0;
cp->t_lvalue = value;
return((char *)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*/
struct tnode *left; /* left subtree*/
struct tnode *right; /* right subtree*/
{
register struct tnode *tp;
tp = (struct tnode *)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;
#ifdef DEBUG
if (treedebug)
printf("tnalloc: op %d type %d dp %d ssp %d\n",op,type,dp,ssp);
#endif
return((char *)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 = (struct symnode *)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((char *)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++ = (char *)tp;
}
/**
* popopd - pop operand stack
* Checks for stack underflow
**/
char *
popopd() /* returns ptr to top operand*/
{
register char *tp; /* struct tnode */
if( opdp <= &opdstack[0] )
return(0);
tp = *--opdp;
return(tp);
}
/* 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);
}

407
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/parser.h Normal file
View File

@@ -0,0 +1,407 @@
/*
Copyright 1983
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
/**
* C68 Parser - include file
**/
#ifdef DRI
# include <stdio.h>
# include <klib.h>
# undef putchar
# define putchar xputchar
# undef ferror
# define ferror xferror
# define printf xprintf
#endif
#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
#define R_ASM 28
/*
* 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 512 /*hash table size, 3.4 made prime */
#define BSIZE 512 /*io buffer size */
#define SYMSIZE 1024 /*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 DREG 0100 /*data loadable into D-register?*/
#define HICREG 2 /*highest reg # used for code gen*/
#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 128 /*max no. of forward ref struct proto*/
#define PATHSIZE 128
#define SCOPE_LEVLS 50 /* [vlh] 4.2, # of scope levels */
#define GLOB_SCOPE 0 /* [vlh] 4.2, global level is 0 */
#define FUNC_SCOPE 1 /* [vlh] 4.2, function level is 1 */
#define STDERR 2 /* [vlh] 4.2, error ==> STDERR... */
/*symbol table node*/
struct symbol {
char s_attrib; /* defined, resword, global, typedef */
char s_sc; /* auto, static, external, register */
short s_type; /* 4bits specified, 2 bit fields for ptr */
short s_dp; /* index into dimension table */
short s_ssp; /* dimension table/function arg table */
short s_offset; /* offset inside of structure */
short s_scope; /* [vlh] 4.2 scope of symbol */
char s_symbol[SSIZE]; /* symbol identifier, to SSIZE chars */
struct symbol *s_par; /* if struct, ptr to parent (sys III) */
struct symbol *s_child; /* if struct, ptr to 1st child (sys III) */
struct symbol *s_sib; /* if struct, ptr to sibling (sys III) */
struct symbol *s_next; /* next symbol table entry */
};
/*expression tree operator node*/
struct tnode {
short t_op;
short t_type;
short t_dp;
short t_ssp;
struct tnode *t_left;
struct tnode *t_right;
};
/*expression tree node for symbol - only keeps location*/
struct symnode {
short t_op;
short t_type; /*data type of symbol*/
short t_dp; /*dimension pointer of symbol*/
short t_ssp; /*structure size index to dtab*/
short t_sc; /*storage class of symbol*/
short t_offset; /*offset of symbol*/
short t_label;
};
/*expressioon tree node for external symbol - need to keep name*/
struct extnode {
short t_op;
short t_type;
short t_dp;
short t_ssp;
short t_sc;
short t_offset;
short t_reg;
short t_symbol[SSIZE]; /*symbol name*/
};
/*expression tree node for integer constant*/
struct conode {
short t_op;
short t_type;
short t_dp;
short t_ssp;
short t_value; /*constant value*/
};
/* long constant node structure */
struct lconode {
short t_op;
short t_type;
short t_dp;
short t_ssp;
long t_lvalue; /*constant value*/
};
/* key word table */
struct resword {
char *r_name;
int r_value;
} reswords[];
/* switch table structure */
struct swtch {
#ifndef VAX11
short sw_label;
short sw_value;
#else
short sw_label;
short sw_value;
#endif
} swtab[SWSIZE];
/*operator and operand stack used by expr*/
struct ops { /*operator stack*/
short o_op; /*operator*/
short o_pri; /*priority*/
} opstack[OPSSIZE], *opp;
/* Miscellaneous Variables for declarations */
short scope_decls[SCOPE_LEVLS]; /*[vlh] 4.2 decls at this scope ?? */
short scope_level; /*[vlh] 4.2, global=0, func=1 */
short indecl; /*[vlh] 4.2, are we in a decl ?? */
short predecl; /*[vlh] 4.2, value previous to sizeof */
short tdflag; /*declaration is a typedef proto*/
struct symbol *tdp; /*points to typedef prototype*/
short localsize; /*length of local variables*/
short naregs; /*keeps track of ptr registers alloc'd*/
short ndregs; /*keep track of data registers alloc'd*/
short boffset; /*current bit offset in structure*/
short in_struct; /*set when in structure declaration*/
/* Miscellaneous Variables for expression handling */
short opdotsave; /* vars used by the expression evaluator */
short opdontop; /*op on top of expr stack ?? */
short strassign;
char *opdsave, *oprsave;
char *opdstack[OPDSIZE]; /*operand stack*/
char **opdp; /*operand stack pointer*/
char *opap; /*ptr to next avail loc in exprarea*/
short opinfo[]; /*operator info table*/
short commastop; /*stop parse at comma*/
short colonstop; /*stop parse at colon*/
/* Miscellaneous Variables for statement generation */
short cswp; /*current low switch table index*/
short clabel; /*continue label*/
short blabel; /*break label*/
short rlabel; /*return label*/
short dlabel; /*default label*/
/* Miscellaneous Variables */
short lineno; /*current line number of input*/
short cr_last; /* determine if # is file specification */
short errcnt; /*count of errors*/
char source[PATHSIZE]; /*[vlh]source filename for err rpting*/
short strassign;
struct tnode *frp; /*pointer to function return info node*/
short smember; /*set when seen . or ->*/
short instmt; /*[vlh] 4.1 in a stmt*/
short infunc; /*set when in function body*/
short reducep; /*[vlh] if(procid); reduction*/
short peektok; /*peeked at token*/
/* Parser Variables which are initialized in parser.ext */
extern char *exprp; /*place to start building expression*/
extern short swp; /*current entry in switch table*/
extern short nextlabel; /*generates unique label numbers*/
extern short structlabel; /*generates unique label names*/
extern char dinfo[];
extern char aregtab[];
extern char dregtab[];
/* Parser flags */
short eflag; /*[vlh] 3.4 IEEE floats */
short fflag; /*[vlh] 3.4 FFP floats */
short gflag; /*[vlh] 4.2 symbolic debugger flag */
short xflag; /*translate int's to long's*/
short tflag; /*[vlh] 4.1, put strings into text seg*/
short wflag; /*[vlh] don't generate warning mesgs*/
short debug; /*[vlh] 4.1, debug flag */
short symdebug; /*[vlh] 4.2, sym debug flag */
short treedebug; /*[vlh] 4.2, expr tree debug flag */
/*dimension table*/
long dtab[DSIZE]; /* [vlh] 3.4 short => long */
short cdp; /*next entry in dtab to alloc*/
/*lexical analyzer values*/
short cvalue; /*current token if keyword or CINT*/
short ccbytes; /*number of bytes in char constant*/
short 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*/
/* 0 no structure */
struct symbol *struc_parent[10];/*[vlh] ptrs to struc symbols*/
struct symbol *struc_sib[10]; /*[vlh] ptrs to struc symbols*/
struct symbol *hold_sib; /*[vlh] wrap sib past struct decl*/
/*function argument table, used to collect function parameters*/
struct farg {
struct symbol *f_sp;
short f_offset;
} fargtab[NFARGS];
/*forward referenced structure prototype names*/
struct symbol *frstab[NFRSTR];
short frstp;
/*output buffers for intermediate code and strings*/
struct iob {
int fd;
int cc;
char *cp;
char cbuf[BSIZE];
} obuf, lbuf, sbuf, ibuf, *obp;
/* Macro's used by the Parser */
#define ISTYPEDEF(sp) (sp->s_attrib&STYPEDEF)
#define WALIGN(add) ((add+1)&(~1))
#define ISARRAY(type) ((type&SUPTYP)==ARRAY)
#define ISFUNCTION(type) ((type&SUPTYP)==FUNCTION)
#define ISPOINTER(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 ISALLTYPE(type) (type&(SUPTYP|TYPE))
#define ASGNOP(op) ((opinfo[op]&OPASSIGN)!=0)
#define RELOP(op) ((opinfo[op]&OPREL)!=0)
#define COMOP(op) ((opinfo[op]&OPCOM)!=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 SIMPLE_TYP(typ) ((typ>=CHAR) && (typ<=DOUBLE))
/* checks for symbol with structure element storage class */
#define ISSTEL(tp) (tp->t_op==SYMBOL && (SESC(tp)))
#define SESC(x) (x->t_sc==STELCL||x->t_sc==UNELCL||x->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(0)) == tok )
/* outbentry - output symbol '%', signifying routine entry, for link info */
#define OUTBENTRY() printf("%%\n")
#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")
/* get on a word boundary */
#define OUTEVEN() printf("\t.even\n")
/* output current line number into icode */
#define OUTLINE() if(!bol) putchar('\n'); printf(".%x.%s\n",lineno,source)
/* 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 %ld\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)
/* output a null tree */
#define OUTNULL() printf("0\n")
#ifdef DEBUG
# define PUTEXPR(dbg,id_str,node_ptr) if (dbg) putexpr(id_str,node_ptr)
#else
# define PUTEXPR(dbg,id_str,node_ptr)
#endif
/*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 *get_symbol(); /* [vlh] 4.2 split from expr() */
char *sbrk();
char *mktemp();
long initlist();
long dsize();
long psize();
long dodecl();
long dlist();
long getdec();
long gethex();
long getoct();
long getfp();
long toieee();
long toffp();
long cexpr();
long s_or_a();
long str_init();
long outstr();

261
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/putexpr.c Normal file
View File

@@ -0,0 +1,261 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
#include "parser.h"
#include <ctype.h>
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[] = {
"typeless", /*0=TYPELESS*/
"char", /*1=CHAR*/
"short", /*2=SHORT*/
"int", /*3=INT*/
"long", /*4=LONG*/
"uchar", /*5=UCHAR*/
"ushort", /*6=USHORT*/
"uint", /*7=UINT*/
"ulong", /*8=ULONG*/
"float", /*9=FLOAT*/
"double", /*10=DOUBLE*/
"struct", /*11=STRUCT*/
invalid, /*12=undefined*/
invalid, /*13=undefined*/
invalid, /*14=undefined*/
invalid, /*15=undefined*/
};
#ifdef DEBUG
char *suvals[] = {
"zero",
"one",
"quick",
"small",
"constant",
"Areg",
"Dreg",
"addressable",
"loadable",
"easy",
"hard",
"veryhard",
};
short level;
putexpr(name,tp)
char *name;
struct tnode *tp;
{
printf("%s\n",name);
if (tp != 0)
putsexpr(tp);
}
putsexpr(tp)
struct tnode *tp;
{
register struct tnode *ltp;
register short op;
char ch;
level++;
ltp = tp->t_left;
op = tp->t_op;
outlevel();
if (op < 0 || op > 78) {
printf("INVALID op\n");
return;
}
printf("%s ",opname[op]);
puttsu(tp);
switch( op ) {
case DCLONG:
case CLONG:
case CFLOAT: /*[vlh] 3.4 */
printf(" %x.%x\n",((struct lconode *)tp)->t_lvalue.hiword,
((struct lconode *)tp)->t_lvalue.loword);
break;
case CINT:
printf(" %d\n",((struct conode *)tp)->t_value);
break;
case AUTODEC:
case AUTOINC:
printf("Autodec or Autoinc");
break;
case SYMBOL:
switch( ((struct symnode *)tp)->t_sc ) {
case REGISTER:
printf(" Register");
break;
case CINDR:
printf(" %d\n",((struct symnode *)tp)->t_offset);
break;
case CLINDR:
case CFINDR: /* [vlh] 3.4 */
printf(" %x.%x\n",((struct symnode *)tp)->t_offset,tp->t_ssp);
break;
case REGOFF:
printf(" Regoffset");
break;
case EXTERNAL:
case EXTOFF:
printf(" %s+%d",((struct symnode *)tp)->t_symbol,
((struct symnode *)tp)->t_offset);
if( tp->t_sc == EXTOFF )
printf("Ext offset");
break;
case STATIC:
case STATOFF:
printf(" STATIC or STATOFF");
if( ((struct symnode *)tp)->t_sc == STATOFF )
printf("STATOFF");
break;
case INDEXED:
printf(" %d indexed",((struct symnode *)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 short i;
for( i = 0; i < level; i++ )
printf(" ");
}
puttsu(tp)
struct tnode *tp;
{
register short 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

12
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/readme Normal file
View File

@@ -0,0 +1,12 @@
This is a list of the files in this directory:
decl.c: C declarations
expr.c: C expressions
interf.c: Interface to code generator
iput.c: Intermediate code output
lex.c: Lexical analysis
main.c: Main routine and utilities
node.c: Node allocation routines
stmt.c: C statements
tabl.c: Expression operator info table
log: Log of bugs and their fixes
ERRORS: List of error messages parser produces

585
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/stmt.c Normal file
View File

@@ -0,0 +1,585 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
#include "parser.h"
#define LABGEN(l,sl) sl=l;l=nextlabel++
#define DOBODY(l) stmt();OUTLAB((l));clno=lineno;lineno=rinit
short bol;
/* stmt - process a single statement*/
stmt() /* returns - none*/
{
register short token, lab;
while( 1 ) {
switch(token=gettok(0)) {
case LCURBR: /*handle { ... }*/
scope_decls[scope_level] = 1; /* [vlh] 4.2, block decls */
dlist(TYPELESS);
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(0));
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;
case R_ASM:
doasm();
return;
case R_CHAR:
case R_INT:
case R_FLOAT:
case R_LONG:
case R_DOUBLE:
case R_STRUCT:
case R_UNION:
case R_REGISTER:
synerr("invalid declaration");
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 = (struct tnode *)expr(0);
reducep = 0;
if( next(RPAREN) )
return((char *)tp);
}
synerr("parenthesized expression syntax");
return(0);
}
/* 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;
sp->s_scope = FUNC_SCOPE;
if( !sp->s_offset )
sp->s_offset = nextlabel++;
}
else if (sp->s_scope != FUNC_SCOPE) { /* [vlh] 4.2 */
csp = lookup(sp->s_symbol,1); /* force individual entry */
sp = csp;
sp->s_type = LLABEL;
sp->s_scope = FUNC_SCOPE;
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 ) { /* [vlh] 4.2 */
if( sp->s_scope == FUNC_SCOPE ) { /* truly redefined !!!! */
error("label redeclaration: %.8s",sp->s_symbol);
return;
}
csp = lookup(sp->s_symbol,1); /* force individual entry */
sp = csp;
}
sp->s_attrib |= SDEFINED;
sp->s_sc = STATIC;
sp->s_type = LLABEL;
sp->s_scope = FUNC_SCOPE;
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 short lab;
long value;
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,(int)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 short lab, saveblab, saveclab;
LABGEN(blabel,saveblab);
LABGEN(clabel,saveclab);
lab = nextlabel++;
OUTLINE(); /*[vlh]4.2 output lineno for debugger*/
OUTNULL(); /*[vlh]4.2 null tree for line number */
OUTLAB(lab); /*branch back to here*/
stmt(); /*do statement*/
OUTLAB(clabel); /*continue label*/
if( !nextrw(R_WHILE) ) {
warning("missing while"); /*only advisory...*/
OUTGOTO(lab);
}
else
outifgoto(balpar(),TRUE,lab); /*while expression*/
OUTLAB(blabel); /*break label*/
blabel = saveblab; /*restore labels*/
clabel = saveclab;
}
/*
* 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 short testlab, stmtlab, saveblab, saveclab;
register struct tnode *rip, *cp;
register char *savep;
short rinit, clno, iscond;
LABGEN(blabel,saveblab);
LABGEN(clabel,saveclab);
if( !next(LPAREN) ) {
forerr:
#ifdef DEBUG
if (symdebug) printf("invalid for... commastop is %d",commastop);
#endif
synerr("invalid for statement");
return;
}
if( !next(SEMI) ) { /*do init expression*/
outexpr(expr(0));
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 = (struct tnode *)expr(0);
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 = (struct tnode *)expr(0); /*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 short elselab, exitlab;
tp = (struct tnode *)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;
short parens;
/*if( !peekc(';') ) { /*need to compute return?*/
/*parens = next(LPAREN); /*[vlh] 4.2 check for lparen*/
/*if (!next(RPAREN)) { /*a return expression exists*/
/*if ((tp = (struct tnode *)expr(0)) != 0) {
/*outforreg(FRETURN,frp,tp);
/*if (parens && !next(RPAREN)) /*[vlh]4.2 match paren*/
/*synerr("parenthesized expression syntax");
/*}
/*}
/*else
/*warning("null expression in return statement");
/*}*/
if (!peekc(';')) {
if ((tp=(struct tnode *)expr(0)) != 0)
outforreg(FRETURN,frp,tp);
else
putback(';');
}
else
putback(';');
OUTGOTO(rlabel); /*branch to the return label*/
}
/*
* doasm - handles: asm( "string" ) ; [vlh] 4.2
* Outputs the string as literal assembly language code
*/
doasm() /* returns - none*/
{
OUTLINE(); /* [vlh] 4.2 output line number */
OUTNULL(); /* [vlh]4.2 null tree for line number */
if( next(LPAREN) ) {
if (next(STRING))
if (next(RPAREN)) {
outasm();
return;
}
}
synerr("illegal asm syntax");
}
/*
* 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 short saveblab, swlab, savedlab, saveswp, i;
register struct tnode *tp;
LABGEN(blabel,saveblab);
tp = (struct tnode *)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 short saveclab, saveblab, lab;
register char *savep;
register struct tnode *tp;
LABGEN(blabel,saveblab);
LABGEN(clabel,saveclab);
LABGEN(clabel,lab);
savep = exprp;
if((tp = (struct tnode *)balpar()) != 0) /*get condition clause*/
OUTGOTO(clabel); /*condition label*/
exprp = opap;
OUTLINE(); /* [vlh] 4.2 output start label.... */
OUTNULL(); /*[vlh]4.2 null tree for line number */
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 short token;
if( (token=gettok(0)) != 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 short temp;
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 = (struct tnode *)popopd() )
outcforreg(tp->t_right);
opp = 0; opdp = (char **)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 = 0; opdp = (char **)0;
}

260
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/symt.c Normal file
View File

@@ -0,0 +1,260 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
/**
* symbol table entry allocation and lookup routines
**/
#include "parser.h"
#define STEL HSIZE/2
struct symbol *symtab[HSIZE]; /*hash table*/
struct symbol *symbols; /*pointer to next avail symbol buf*/
/* 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 short i;
while( (sp=symbols) <= 0 ) {
if( (sp = (struct symbol *)sbrk(SYMSIZE)) == -1 )
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 = sp->s_type = sp->s_dp = sp->s_ssp = 0;
sp->s_offset = offset;
if (in_struct) {
sp->s_par = struc_parent[in_struct];
hold_sib = struc_sib[in_struct];
sp->s_scope = (infunc) ? FUNC_SCOPE : GLOB_SCOPE; /* [vlh] 4.2 */
#ifdef DEBUG
if (symdebug)
printf(" struct element parent is %.8s\n", sp->s_par->s_symbol);
#endif
if (struc_sib[in_struct]) {
struc_sib[in_struct]->s_sib = sp;
#ifdef DEBUG
if (symdebug)
printf(" sparent sib is %.8s\n",struc_sib[in_struct]->s_symbol);
#endif
}
else {
struc_parent[in_struct]->s_child = sp;
#ifdef DEBUG
if (symdebug)
printf(" child of %.8s\n",struc_parent[in_struct]->s_symbol);
#endif
}
struc_sib[in_struct] = sp;
sp->s_child = sp->s_sib = 0;
}
else {
sp->s_sib = sp->s_child = sp->s_par = 0;
sp->s_scope = scope_level; /* [vlh] 4.2 */
}
symcopy(sym,sp->s_symbol); /*copy symbol to symbol struct*/
i = symhash(sym,in_struct|smember); /*link into chain list*/
sp->s_next = symtab[i];
symtab[i] = sp;
return((char *)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,force) /* returns pointer to symbol buffer*/
char *sym; /* pointer to symbol*/
int force; /* [vlh] 4.2 force entry in symbol table */
{
register struct symbol *sp, *hold;
register char *p;
short exact, prev_level; /* same name, diff type or offset */
p = sym; prev_level = 0;
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|in_struct)) { /*[vlh]*/
hold = 0;
for( sp=symtab[symhash(p,0)]; sp!=0; sp=sp->s_next )
if(symequal(p,sp->s_symbol))
if (scope_level == sp->s_scope) /* [vlh] 4.2 added scope... */
return(sp); /* perfect scope match */
else
if (prev_level <= sp->s_scope) { /* only closer scope */
hold = sp;
prev_level = sp->s_scope;
}
if (!force && hold) /* [vlh] 4.2 added scope... */
return(hold);
}
else { /* doing a declaration or an expression */
hold = 0; exact = 0;
for( sp=symtab[symhash(p,in_struct|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 && (instmt || in_struct==0 || smember!=0)) /*4.1*/
return(hold);
}
#ifdef DEBUG
if (symdebug) printf("installing [%.8s] %d\n",p,indecl);
#endif
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(level) /* returns - none*/
int level; /* [vlh] 4.2 scope levels... */
{
register short i;
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 (level == FUNC_SCOPE)
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 ( !(sp->s_attrib & SGLOBAL) && sp->s_scope < level)
tp = sp;
else {
#ifdef DEBUG
if (symdebug)
printf("freeing %s, level %d\n",sp->s_symbol,level);
#endif
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(ok) /* returns - none*/
int ok;
{
register struct symbol **htp, *sp;
register short 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;
sp->s_par = frstab[sp->s_ssp]->s_par;
}
if( sc == PDECLIST ) {
error("not in parameter list: %.8s",sp->s_symbol);
sp->s_sc = AUTO;
if (ok)
outlocal(sp->s_type,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 short 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 short 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;
short *exact;
{
if (struc_parent[in_struct]==sp->s_par) /* all structures have parents */
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 short i;
for( p = sym1, q = sym2, i = SSIZE; --i >= 0; )
*q++ = ( *p ? *p++ : '\0');
}

119
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/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 - short required on left*/
/*004000-- OPRWORD - short required on right*/
/*010000-- OPCOM commutative*/
/*020000-- OPRAS - right associative*/
/*040000-- OPTERM - termination node*/
/*100000 - OPCONVS - conversion operator*/
short 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*/
};

482
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/tree.c Normal file
View File

@@ -0,0 +1,482 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
#include "parser.h"
short strassign, strsize; /* [vlh] 4.2 save structure size for assignment */
/**
* 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 short type, ltype, rtype, lconv, conv, pconv, docast, left, right;
#ifdef DEBUG
if (treedebug)
printf("maketree op = %d\n",op);
#endif
if( BINOP(op) ) {
if(!(rtp=(struct tnode *)popopd()))
return(0);
rtype = (rtp=(struct tnode *)funcref(arrayref(rtp)))->t_type;
PUTEXPR(treedebug,"maketree r",rtp);
}
if(!(ltp=(struct tnode *)popopd()))
return(0);
PUTEXPR(treedebug,"maketree l",ltp);
if( op == ASM ) /* [vlh] 4.2 asm internal function */
return(1);
if( op == SIZEOF ) { /* [vlh] 4.2 dosizeof */
pushopd(cnalloc(INT,dosizeof(ltp,1)));
return(1);
}
if( op != ADDR ) {
ltp = (struct tnode *)arrayref(ltp);
if (op!=CALL && op!=NACALL)
ltp = (struct tnode *)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(1);
}
if( ltype == STRUCT || rtype == STRUCT ) {
if (ltype==STRUCT && rtype==STRUCT && op==ASSIGN) { /*[vlh]*/
left = dosizeof(ltp,0); /* [vlh] 4.2 */
strsize = right = dosizeof(rtp,0); /* [vlh] 4.2 */
if (left < right) { /* left side smaller than right */
warning("left side of structure assignment smaller than right");
strsize = left;
} /* [vlh] 4.2 */
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 (ASGNOP(op) || lconv >= conv || ((RELOP(op) || COMOP(op)) &&
ltype==INT && rtype==LONG && rtp->t_op==CLONG)) { /*[vlh] 4.2*/
conv = cvmap[lconv][conv];
lconv = 0;
}
else {
conv = cvmap[conv][lconv];
lconv = 1;
type = rtype;
}
}
if( ASGNOP(op) ) {
if( (op == ASSIGN || op == FRETURN) && rtp->t_op != CINT &&
(conv == INT_PTR || conv == UNSN_PTR) )
warning("short assigned to pointer");
else 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;
else if ( BINOP(op) && (ltp->t_op == CINT || ltp->t_op == CLONG) &&
(rtp->t_op == CINT || rtp->t_op == CLONG)) /* [vlh] 4.2 */
conv = 0;
pconv = 0;
if (RELOP(op) && ISALLTYPE(ltype) == (STRUCT | POINTER)
&& (conv == INT_PTR || conv == LONG_PTR)) /* [vlh] 3.4 */
conv = 0; /* short compare to struct pointer, no conversion */
if (op==FRETURN && conv == LONG_PTR)
conv = 0;
if( conv == PTR_PTR ) {
conv = 0;
if( op == SUB ) {
type = LONG;
pconv++;
}
else if(op != FRETURN && ( (ISALLTYPE(ltype) != ISALLTYPE(rtype) ||
ISALLTYPE(ltype) != (POINTER|CHAR)) ) )
warning("suspect conversion operation");
}
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 = (struct tnode *)cvopgen(ltp,type,conv,psize(rtp),op);
else
rtp = (struct tnode *)cvopgen(rtp,type,conv,psize(ltp),op);
}
if( op == CAST ) { /* [vlh] 4.0 */
if ( docast ) /* predefined to handle conv/cast ops */
rtp = (struct tnode *)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;
p = (struct tnode *)tnalloc(op,type,p->t_dp,p->t_ssp,ltp,rtp);
pushopd(p);
}
if(op==SUB && (ltype&POINTER) && (rtype&POINTER) && !lconv && !conv) {
warning("pointer subtraction yields a long result");
#ifdef DEBUG
if(symdebug) printf("pconv = %d\n",pconv);
#endif
}
if( pconv && ltype != (POINTER|CHAR) ) {
if(!(ltp=(struct tnode *)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 short type;
type = ltp->t_type;
#ifdef DEBUG
if (treedebug)
printf("specops: op = %d type = %d\n",op,type);
#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 = (struct tnode *)popopd(); /*ltp cannot be 0*/
case PERIOD: /*expr . name*/
if( !(ISSTEL(rtp)) )
error("invalid structure member name");
type = rtp->t_type;
if( ISARRAY(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 = (struct tnode *)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 = (struct tnode *)tnalloc(op,rtp->t_type,0,0,ltp,rtp);
break;
case LAND:
case LOR:
case COMMA: /*don't need conversions here*/
ltp = (struct tnode *)tnalloc(op,INT,0,0,ltp,rtp);
break;
case INDR:
if( ltp->t_op == ADDR ) /**& is null op*/
ltp = ltp->t_left;
else {
if( ISFUNCTION(type) )
error("indirection on function invalid");
ltp = (struct tnode *)tnalloc(INDR,delspchk(type),ltp->t_dp,
ltp->t_ssp,ltp,0L);
}
break;
case STASSIGN: /*[vlh]*/
ltp = (struct tnode *)tnalloc(STASSIGN,strsize,0,0,ltp,rtp);
break;
case NACALL:
case CALL:
if( NOTFUNCTION(type) ) {
error("illegal call");
#ifdef DEBUG
if (symdebug) printf("illegal call...................\n");
#endif
}
ltp = (struct tnode *)tnalloc(op,delspchk(type),ltp->t_dp,ltp->t_ssp,
ltp,rtp);
break;
case ADDR:
if( ltp->t_op == INDR ) /*&* is null op*/
ltp = ltp->t_left;
else if( ltp->t_op == SYMBOL ) {
if( ((struct symnode *)ltp)->t_sc == REGISTER )
error("address of register");
ltp = (struct tnode *)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 short cop;
#ifdef DEBUG
if (treedebug) {
printf("cvopgen: type=%d conv=%d op=%d ",type,conv,op);
printf("- type=%d op=%d\n",tp->t_type,tp->t_op);
}
#endif
switch(conv) {
case INT_PTR:
case UNSN_PTR:
if ((type == (POINTER|CHAR) || ISALLTYPE(type) == (POINTER|STRUCT)) &&
(op == CAST || op == FRETURN) ) {
cop = INT2L; /* [vlh] 4.0 */
break;
}
else
if( op == CAST || op == FRETURN ) {
cop = INT2L; /*of the ptd to objects length plus*/
if( len != 1L ) { /*an integer to long covnversion*/
rtp = (struct tnode *)cnalloc(INT,(int)len);
tp = (struct tnode *)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((char *)tp);
cop = (conv == PTR_LONG ? DIV : MULT);
rtp = (struct tnode *)cnalloc(INT,(int)len);
break;
case INT_LONG:
if (tp->t_op == CINT) /* [vlh] 4.1 constant conversion */
return(lcnalloc(type,(long)((struct conode *)tp)->t_value));
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:
case PTR_INT:
case PTR_UNSN:
cop = LONG2I;
break;
default:
error("invalid conversion");
return((char *)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 short 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 (ISFUNCTION(tp->t_type) )
tp = (struct tnode *)tnalloc(ADDR,addsp(tp->t_type,POINTER),tp->t_dp,
tp->t_ssp,tp,0L);
return((char *)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*/
{
register short dp;
if( ISARRAY(tp->t_type) && !(ISSTEL(tp)) ) {
tp->t_dp++;
dp = tp->t_dp;
pushopd(tp);
tadjust(tp,delspchk(tp->t_type),-1,0);
maketree(ADDR);
tp = (struct tnode *)popopd(); /*tp cannot be 0*/
tp->t_dp = dp; /* 4.1 [vlh] get proper dp !!!! */
}
return((char *)tp);
}
/* 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 UCHAR:
case USHORT:
case UNSIGNED:
return(1);
case ULONG:
case LONG:
return(2);
case FLOAT:
case DOUBLE:
return(3);
default:
return(4);
}
}

1
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/version.c Normal file
View File

@@ -0,0 +1 @@
char *compiled = "@(#) parser - Wed Sep 7 15:52 1983";

13
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v103/parser/warnings Normal file
View File

@@ -0,0 +1,13 @@
unsigned long unimplemented, signed long assumed
unsigned char unimplemented, signed char assumed
Null expression encountered
String initalizer truncated
string used to initialize character value
initializer truncated
integral type expected
missing while
null expression in return statement
left side of structure assignment smaller than right
short assigned to pointer
suspect conversion operation
pointer subtraction yields a long result