seppdroid/Digital-Research-Source-Code
1
0
Fork 0
mirror of https://github.com/SEPPDROID/Digital-Research-Source-Code.git synced 2025-10-24 17:04:19 +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

20
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/build.m68 Normal file
View File

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

18
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/build.pdp Normal file
View File

@@ -0,0 +1,18 @@
mkver "parser 4.3 -"
cc -w -O -DPDP11 -c decl.c
cc -w -O -DPDP11 -c expr.c
cc -w -O -DPDP11 -c icode.c
cc -w -O -DPDP11 -c init.c
cc -w -O -DPDP11 -c interf.c
cc -w -O -f -DPDP11 -c lex.c
cc -w -O -DPDP11 -c main.c
cc -w -O -DPDP11 -c stmt.c
cc -w -O -DPDP11 -c tabl.c
cc -w -O -DPDP11 -c putexpr.c
cc -w -O -DPDP11 -c misc.c
cc -w -O -DPDP11 -c node.c
cc -w -O -DPDP11 -c symt.c
cc -w -O -DPDP11 -c tree.c
cc -w -O -DPDP11 -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 -l6 -lC -o c068.pdp

18
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/build.vax Normal file
View File

@@ -0,0 +1,18 @@
mkver "parser 4.3 -"
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 -lV6 -o c068.vax
rm *.o

17
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/build.vdo Normal file
View File

@@ -0,0 +1,17 @@
mkver -e "C68 Parser 4.3 -"
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 init.c
c68 -f -L -S -DVERSADOS -DMC68000 lex.c
c68 -f -L -S -DVERSADOS -DMC68000 -DFFLAG main.c ; mv main.s mainf.s
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 symt.c
c68 -f -L -S -DVERSADOS -DMC68000 tree.c
c68 -f -L -S -DVERSADOS -DMC68000 tabl.c
c68 -f -L -S -DVERSADOS -DMC68000 version.c

967
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/decl.c Normal file
View File

@@ -0,0 +1,967 @@
/*
Copyright 1982, 1983
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
@(#)decl.c 1.13 1/3/84
*/
#include "parser.h"
/* PNEXT - if next token is a symbol, skip and return success, allows */
/* for clean parsing of declarations */
#define PNEXT() next(SYMBOL)
#ifdef SYM_TO_DSK
/* setup address saving, structure assignment, set pointer to structure */
# define ASSG(a,na,e,ne,p) a = na; e = ne; p = &e
#endif
/*
* 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;
#ifdef SYM_TO_DSK
long sp_addr;
struct symbol sp_entry;
#endif
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);
#ifdef DEBUG
if(symdebug)
printf("dflag %d sc %d type 0%o size %d\n",dflag,sc,type,size);
#endif
if(type==STRUCT) /* deal with forward ref structures */
chksyms(0);
while( dodecl(sc,type,0,size), (sp=dsp) != 0 ) {
#ifdef SYM_TO_DSK
ASSG(sp_addr,dsp_addr,sp_entry,dsp_entry,sp);
#endif
if (type==STRUCT) { /* [vlh] 4.2 */
sp->s_child = sp->s_par = struc_parent[0];
TO_DSK(sp,sp_addr);
READ_ST(dsp,dsp_addr);
}
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;
}
ZERO_DSP();
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;
#ifndef SYM_TO_DSK
struct symbol *parent;
#else
long parent;
#endif
if(declok || instmt)
tdp = 0;
uflag = decflag = lflag = sflag = 0; tsize = 0L; /* tdp=0 4.3 removed */
dtype = TYPELESS;
sc = *defsc;
indecl = 0; /* start off at 0 !!!! */
for( ; ; decflag++ ) {
if( (token=gettok(0)) == SYMBOL && ISTYPEDEF(csp) ) {
dtype = 0;
indecl = declok;
if (declok || instmt) /* tdp not used in initialization cast */
#ifdef SYM_TO_DSK
{ ASSG(tdp_addr,csp_addr,tdp_entry,csp_entry,tdp); }
#else
tdp = csp;
#endif
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 = (scope_level == GLOB_SCOPE) ? DEXTERN : EXTERNAL;
continue;
case R_REGISTER:
if( sc && sc != REGISTER && sc != PDECLIST && sc != PDECREG)
error("invalid register specification");
sc = (sc != PDECLIST) ? REGISTER : PDECREG;
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 && 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 if (dtype == INT)
dtype = UNSIGNED;
else /*[vlh] 4.2+*/
error("invalid unsigned declaration");
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;
#ifndef SYM_TO_DSK
struct symbol **parent;
#else
long *parent;
#endif
long *ptsize;
short *pdtype;
{
char sym[8];
register short token, stdflag, sbits, fake;
#ifdef SYM_TO_DSK
struct symbol sp_entry;
long sp_addr;
#endif
stdflag = tdflag;
tdflag = 0; sp = 0;
token = cvalue;
smember++;
if (!next(SYMBOL)) { /* force fake struct name into symbol table */
fake=1;
genunique(sym);
csp = (struct symbol *)lookup(sym,1); /* [vlh] 4.2 */
}
else
fake=0;
/*struct [symbol] { ... }*/
#ifdef SYM_TO_DSK
ASSG(sp_addr,csp_addr,sp_entry,csp_entry,sp);
*parent = sp_addr;
#else
*parent = sp = csp;
#endif
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);
TO_DSK(sp,sp_addr);
} /* sc <-- STRPROTO */
else if( sp->s_sc != STRPROTO ) {
#ifdef DEBUG
if (treedebug) {
printf("redec2 typ %d sc %d ",sp->s_type,sp->s_sc);
printf("scope %d %d\n",sp->s_scope,scope_level);
}
#endif
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... */
#ifndef SYM_TO_DSK
hold_sib->s_sib = 0; /* not null parent !! [vlh]4.3 */
#else
read_st(&volatile,hold_sib);
volatile.s_sib = 0;
write_st(&volatile,hold_sib);
#endif
}
in_struct++;
#ifndef SYM_TO_DSK
struc_parent[in_struct] = sp;
#else
struc_parent[in_struct] = sp_addr;
#endif
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] ) {
#ifdef DEBUG
if (treedebug) {
printf("redec3 typ %d sc %d ",sp->s_type,sp->s_sc);
printf("scope %d %d\n",sp->s_scope,scope_level);
}
#endif
error("redeclaration: %.8s",sp->s_symbol);
}
dtab[sp->s_ssp] = *ptsize;
}
struc_parent[in_struct] = 0;
struc_sib[in_struct] = 0;
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]) { /* 4.2+ don't access off of zero */
#ifndef SYM_TO_DSK
if (struc_sib[in_struct]->s_type == STRUCT) { /* [vlh] 4.2.e */
#else
read_st(&volatile,struc_sib[in_struct]);
if (volatile.s_type == STRUCT) { /* [vlh] 4.2.e */
#endif
struc_sib[in_struct] = hold_sib;
if (hold_sib) {
#ifndef SYM_TO_DSK
hold_sib->s_sib = hold_sib->s_par = 0;
#else
read_st(&volatile,hold_sib);
volatile.s_sib = volatile.s_par = 0;
write_st(&volatile,hold_sib);
#endif
}
}
}
token = FRSTRUCT;
if( ++frstp >= NFRSTR )
ferror("structure table overflow");
#ifndef SYM_TO_DSK
frstab[frstp] = sp;
#else
frstab[frstp] = sp_addr;
#endif
}
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;
#ifdef SYM_TO_DSK
struct symbol sp_entry;
long sp_addr;
#endif
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 && dsp != 0 ) {
#ifdef SYM_TO_DSK
read_st(dsp,dsp_addr); /* be sure we have latest !!! */
ASSG(sp_addr,dsp_addr,sp_entry,dsp_entry,sp);
#else
sp = dsp;
#endif
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;
TO_DSK(sp,sp_addr);
READ_ST(dsp,dsp_addr);
switch( sp->s_sc ) { /*check for redeclarations.*/
case STELCL:
case UNELCL:
case 0:
break;
case PARMLIST:
if (sc != PDECLIST && sc != PDECREG)
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 DEXTERN:
case EXTERNAL:
if (sp->s_type == type) {
if (sc == sp->s_sc || sc == EXTERNAL || sc == DEXTERN)
break;
if (ISFUNCTION(sp->s_type) && sc == STATIC) /* [vlh] 4.2 */
break;
if (sc == AUTO && SUPTYPE(type) == FUNCTION) {
sc = EXTERNAL;
break;
}
} /* fall through...... */
default:
redec:
#ifdef DEBUG
if (treedebug) {
printf("redec4 typ %d %d sc %d %d ",sp->s_type,type,sp->s_sc,sc);
printf("scope %d %d\n",sp->s_scope,scope_level);
}
#endif
if(scope_level==GLOB_SCOPE) /*[vlh] 4.3, extern signif to 7*/
error("redeclaration: %.7s",sp->s_symbol);
else
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;
#ifdef DEBUG
if(symdebug) printf("%s <= offset %d\n",sp->s_symbol,offset);
#endif
}
if( dtype == FUNCTION ) {
if( sc != AUTO && sc != EXTERNAL && sc != DEXTERN && sc != STATIC )
error("illegal function declaration");
if( sc != STATIC )
sc = EXTERNAL;
}
else if (sc == REGISTER || sc == PDECREG) { /*[vlh]4.3, add PDECREG*/
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;
TO_DSK(sp,sp_addr);
READ_ST(dsp,dsp_addr);
/* trying to output locals in the appropriate order.... */
if (infunc && scope_level==FUNC_SCOPE)
if (sc==STATIC || sc==PDECREG || 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;
#ifdef SYM_TO_DSK
struct symbol sp_str; /* hold fp... */
long sp_addr; /* addresses */
#endif
infunc++;
opap = exprp;
sp = fsp;
frp = (struct farg *)snalloc(delsp(sp->s_type),sp->s_sc,sp->s_type,
sp->s_dp, sp->s_ssp);
exprp = opap;
OUTTEXT();
OUTFLAB(fsp->s_symbol);
olddp = cdp;
dlist(PDECLIST);
rlabel = nextlabel++;
if(!next(LCURBR))
synerr("function body syntax");
else {
localsize = 0; /*end of first auto offset from l.e.p.*/
offset = 8; /*first arg offset from l.e.p.*/
scope_level = FUNC_SCOPE; /* [vlh] 4.2 */
scope_decls[FUNC_SCOPE] = 1; /* [vlh] 4.2, force at this level */
for( fp = &fargtab[0]; fp->f_sp; fp++ ) {
#ifndef SYM_TO_DSK
sp = fp->f_sp;
#else
sp_addr = fp->f_sp;
sp = &sp_str;
read_st(sp,sp_addr);
#endif
#ifdef DEBUG
if(symdebug)
printf("farg: %s type 0%o sc %d\n",sp->s_symbol,sp->s_type,sp->s_sc);
#endif
toff = offset;
if( sp->s_type == CHAR ) /*char argument*/
toff++; /*offset of lower byte in word*/
if( sp->s_sc == PDECREG ) {
fp->f_offset = toff;
sp->s_sc = REGISTER;
}
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++;
}
TO_DSK(sp,sp_addr);
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);
}
if (gflag)
outlocal(CHAR,AUTO,"_EnD__",offset); /*[vlh] 4.2, for cdb */
offset += 2; /* [vlh] 4.2, for cdb, argument end argument */
OUTBENTRY(); /* [vlh] 4.2, must be before declarations */
dlist(TYPELESS); /* [vlh] 4.1 was just a zero... */
chksyms(0);
#ifndef NOPROFILE
if(profile)
OUTPCALL(fsp->s_symbol);
#endif
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;
#ifdef SYM_TO_DSK
struct symbol sp_str;
sp = &sp_str;
#endif
for( fp = &fargtab[0]; fp->f_sp; fp++ ) {
#ifndef SYM_TO_DSK
sp = fp->f_sp;
#else
read_st(sp,fp->f_sp);
#endif
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*/
ZERO_DSP();
if (next(ASSIGN)) { /* [vlh] 4.2 auto initialization */
indecl = 0; /* don't redeclare expr vars */
READ_ST(csp,csp_addr);
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;
ZERO_DSP();
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;
#ifdef SYM_TO_DSK
long tsp_addr;
long sp_addr;
struct symbol sp_entry;
struct symbol tsp_entry;
#endif
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) ) {
#ifdef SYM_TO_DSK
ASSG(dsp_addr,csp_addr,dsp_entry,csp_entry,dsp);
ASSG(sp_addr,dsp_addr,sp_entry,dsp_entry,sp);
#else
sp = dsp = csp;
#endif
type = 0;
sp->s_dp = sdp;
TO_DSK(sp,sp_addr);
}
while( 1 ) {
if( next(LPAREN) ) { /*declarator ( ... )*/
if(!infunc) {
ndregs = naregs = 0;
scope_level = FUNC_SCOPE; /* [vlh] 4.2 */
indecl++; /* [vlh] 4.3 */
for( fp = &fargtab[0]; PNEXT(); ) {
p = csp;
if( p->s_attrib & SDEFINED ) {
#ifdef DEBUG
if (treedebug) {
printf("redec1 typ %d %d sc %d",p->s_type,type,p->s_sc);
printf("scope %d %d\n",p->s_scope,scope_level);
}
#endif
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*/
#ifndef SYM_TO_DSK
fp->f_sp = p;
#else
fp->f_sp = csp_addr;
#endif
fp++;
TO_DSK(p,csp_addr);
}
if(!next(COMMA))
break;
}
indecl--; /* [vlh] 4.3, must not confuse, we are in decls */
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 {
#ifdef SYM_TO_DSK
ASSG(tsp_addr,dsp_addr,tsp_entry,dsp_entry,tsp);
value = cexpr(); /* recurses on sizeof.... resets dsp */
if (dsp_addr != tsp_addr) { /* [vlh] 4.2.... */
tsp->s_dp = cdp;
write_st(&tsp_entry,tsp_addr);
ASSG(dsp_addr,tsp_addr,dsp_entry,tsp_entry,dsp);
}
#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 */
}
#endif
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);
}

80
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/def.h Normal file
View File

@@ -0,0 +1,80 @@
/**
* Copyright 1983
* Alcyon Corporation
* 8716 Production Ave.
* San Diego, CA 92121
*
* @(#)def.h 1.3 11/4/83
**/
/* 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

341
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/disk.c Normal file
View File

@@ -0,0 +1,341 @@
/**
* Copyright 1983
* Alcyon Corporation
* 8716 Production Ave.
* San Diego, Ca. 92121
*
* @(#)disk.c 1.2 11/3/83
**/
/**
* These routines replace the symbol handling routines in symt.c in
* the case that the machine which this compiler is running on does
* not have enough memory to store the symbol table. These routines
* build and manage an on disk symbol table
*
* Symbol Table entry allocation and lookup routines
**/
#ifdef SYM_TO_DSK
#include "parser.h"
#ifndef MC68000
# include <c68/order.h>
#else
# include <order.h>
#endif
#define SYM_SIZ 36 /*sizeof(struct symbol)*/
#define DBUFSIZ 28 * SYM_SIZ /* max # of symbols storable in under 1K */
#define STEL HSIZE/2
char dbuf[DBUFSIZ];
long data_addr = 0; /*location dbuf[0] represents*/
long symtab[HSIZE]; /*hash table*/
short dirty_buf; /*dirty buffer??, buffer altered??*/
/**
* 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 address of csp_entry */
char *sym; /* symbol to install*/
int attrib; /* attribues of symbol*/
int offset; /* symbol offset (resword value)*/
{
register struct symbol *sp;
register short i;
register long item_offset; /* location for new item */
#ifdef DEBUG
struct symbol par_entry;
#endif
item_offset = dsk_offset;
dsk_offset += SYM_SIZ;
sp = &csp_entry;
sp->s_sc = sp->s_type = sp->s_dp = sp->s_ssp = 0;
sp->s_offset = offset;
sp->s_attrib = attrib;
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
read_st(&par_entry,sp->s_par);
if (symdebug)
printf(" struct element parent is %.8s\n", par_entry.s_symbol);
#endif
if (struc_sib[in_struct]) {
read_st(&volatile,struc_sib[in_struct]);
volatile.s_sib = item_offset;
write_st(&volatile,struc_sib[in_struct]);
#ifdef DEBUG
if (symdebug) {
printf(" sparent sib is %.8s\n",volatile.s_symbol);
printf(" sparent addr %ld ",struc_sib[in_struct]);
printf("child addr %ld\n",item_offset);
}
#endif
}
else {
read_st(&volatile,struc_parent[in_struct]);
volatile.s_child = item_offset;
write_st(&volatile,struc_parent[in_struct]);
#ifdef DEBUG
if (symdebug)
printf(" child of %.8s\n",volatile.s_symbol);
#endif
}
struc_sib[in_struct] = item_offset;
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] = item_offset;
write_st(sp,item_offset);
csp_addr = item_offset;
return(sp);
}
/**
* lookup - looks up a symbol in symbol table
* Hashes symbol, then goes thru chain, if not found, then
* installs the symbol.
**/
char *
lookup(sym,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;
register char *p;
short exact, prev_level; /* same name, diff type or offset */
long next_sym, hold;
p = sym; prev_level = 0; sp = &csp_entry;
if ((next_sym = symtab[symhash(p,0)]) != 0) {
while (next_sym != 0) {
read_st(&csp_entry,next_sym);
if((sp->s_attrib&(SRESWORD|STYPEDEF)) && symequal(p,sp->s_symbol)) {
csp_addr = next_sym;
return(&csp_entry);
}
next_sym = sp->s_next;
}
}
hold = 0;
if (!(smember|in_struct)) { /*[vlh]*/
if ((next_sym = symtab[symhash(p,0)]) != 0) {
while (next_sym != 0) {
read_st(&csp_entry,next_sym);
if(symequal(p,sp->s_symbol)) {
if (scope_level == sp->s_scope) {
csp_addr = next_sym;
return(&csp_entry); /* perfect scope match */
}
else if (!force && prev_level <= sp->s_scope) {
hold = next_sym;
prev_level = sp->s_scope;
}
}
next_sym = sp->s_next;
}
if ( hold ) { /* [vlh] 4.2 added scope... */
csp_addr = hold;
read_st(&csp_entry,csp_addr);
return(&csp_entry);
}
}
}
else { /* doing a declaration or an expression */
exact = 0;
if ((next_sym = symtab[symhash(p,in_struct|smember)]) != 0) {;
while (next_sym != 0) {
read_st(&csp_entry,next_sym);
if( symequal(p,sp->s_symbol) ) {
if (symsame(sp,hold,&exact)) {
csp_addr = next_sym;
return(&csp_entry);
}
else if (!hold && !exact)
hold = next_sym;
}
next_sym = sp->s_next;
}
if (hold && (instmt || in_struct==0 || smember!=0)) { /*4.1*/
csp_addr = hold;
read_st(&csp_entry,csp_addr);
return(&csp_entry);
}
}
}
#ifdef DEBUG
if (symdebug) printf("installing [%.8s]\n",p);
#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;
register long *lp;
register long hold, current, next_sym;
struct symbol sp_entry;
sp = &sp_entry;
for(lp = &symtab[0], i = 0; i != HSIZE; lp++, i++) {
current = *lp;
for (hold = 0; current != 0; current = next_sym) {
read_st(sp,current);
next_sym = 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)) || (sp->s_scope < level))
hold = current; /* should do a break !!! ??? */
else {
#ifdef DEBUG
if (symdebug) {
printf("freeing %s, level %d, next %ld ",sp->s_symbol,level,sp->s_next);
printf("location %ld\n",current);
}
#endif
if( hold ) { /* should never get this case !!! ??? */
read_st(&volatile,hold);
volatile.s_next = sp->s_next;
write_st(&volatile,hold);
}
else
*lp = sp->s_next;
}
}
}
}
/**
* 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;
{
struct symbol item;
register struct symbol *sp;
register short sc;
register long next_sym;
next_sym = 0; sp = &item;
while(next_sym < dsk_offset) {
read_st(sp,next_sym);
sc = sp->s_sc;
if(sc!=0 && sp->s_ssp>=0 && (BTYPE(sp->s_type))==FRSTRUCT) {
read_st(&volatile,frstab[sp->s_ssp]);
sp->s_par = volatile.s_par;
sp->s_ssp = volatile.s_ssp; /* 3.4 ssp>0 */
sp->s_type = (sp->s_type&~TYPE) | STRUCT;
}
if( sc == PDECLIST ) {
error("not in parameter list: %.8s",sp->s_symbol);
sp->s_sc = AUTO;
if (ok)
outlocal(sp->s_type,sc,sp->s_symbol,sp->s_offset);
}
write_st(sp,next_sym);
next_sym += SYM_SIZ;
}
}
/* read symbol table item from disk into structure */
read_st(sp,d_offset)
register struct symbol *sp;
long d_offset;
{
register char *p, *s;
register short i;
if ((d_offset >= (data_addr+DBUFSIZ)) || (d_offset < data_addr))
reset_dbuf(d_offset);
p = &dbuf[d_offset - data_addr];
sp->s_attrib = *p++;
sp->s_sc = *p++;
sp->s_type.wb1 = *p++; sp->s_type.wb2 = *p++;
sp->s_dp.wb1 = *p++; sp->s_dp.wb2 = *p++;
sp->s_ssp.wb1 = *p++; sp->s_ssp.wb2 = *p++;
sp->s_offset.wb1 = *p++; sp->s_offset.wb2 = *p++;
sp->s_scope.wb1 = *p++; sp->s_scope.wb2 = *p++;
for(i=0, s = sp->s_symbol; i < SSIZE; i++)
*s++ = *p++;
sp->s_par.b1 = *p++; sp->s_par.b2 = *p++;
sp->s_par.b3 = *p++; sp->s_par.b4 = *p++;
sp->s_child.b1 = *p++; sp->s_child.b2 = *p++;
sp->s_child.b3 = *p++; sp->s_child.b4 = *p++;
sp->s_sib.b1 = *p++; sp->s_sib.b2 = *p++;
sp->s_sib.b3 = *p++; sp->s_sib.b4 = *p++;
sp->s_next.b1 = *p++; sp->s_next.b2 = *p++;
sp->s_next.b3 = *p++; sp->s_next.b4 = *p;
}
/* write symbol table item to disk */
write_st(sp,d_offset)
register struct symbol *sp;
long d_offset;
{
register char *p, *s;
register short i;
dirty_buf = 1;
if ((d_offset >= (data_addr+DBUFSIZ)) || (d_offset < data_addr))
reset_dbuf(d_offset);
p = &dbuf[d_offset - data_addr];
*p++ = sp->s_attrib;
*p++ = sp->s_sc;
*p++ = (sp->s_type).wb1; *p++ = (sp->s_type).wb2;
*p++ = (sp->s_dp).wb1; *p++ = (sp->s_dp).wb2;
*p++ = (sp->s_ssp).wb1; *p++ = (sp->s_ssp).wb2;
*p++ = (sp->s_offset).wb1; *p++ = (sp->s_offset).wb2;
*p++ = (sp->s_scope).wb1; *p++ = (sp->s_scope).wb2;
for(i=0, s = sp->s_symbol; i < SSIZE; i++)
*p++ = *s++;
*p++ = (sp->s_par).b1; *p++ = (sp->s_par).b2;
*p++ = (sp->s_par).b3; *p++ = (sp->s_par).b4;
*p++ = (sp->s_child).b1; *p++ = (sp->s_child).b2;
*p++ = (sp->s_child).b3; *p++ = (sp->s_child).b4;
*p++ = (sp->s_sib).b1; *p++ = (sp->s_sib).b2;
*p++ = (sp->s_sib).b3; *p++ = (sp->s_sib).b4;
*p++ = (sp->s_next).b1; *p++ = (sp->s_next).b2;
*p++ = (sp->s_next).b3; *p = (sp->s_next).b4;
}
reset_dbuf(dsk_addr)
long dsk_addr; /* addr of next symbol to read or write */
{
if(dirty_buf) { /* dirty buffer...... */
dirty_buf = 1;
lseek(dsk_fd,data_addr,0);
write(dsk_fd,&dbuf,DBUFSIZ);
close(dsk_fd);
dsk_fd = open(dskfile,2);
}
lseek(dsk_fd,dsk_addr,0);
read(dsk_fd,&dbuf,DBUFSIZ);
data_addr = dsk_addr;
}
#endif

19
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/down12.sub Normal file
View File

@@ -0,0 +1,19 @@
VAX B:DECL.C $$FA
VAX B:DISK.C $$FA
VAX B:EXPR.C $$FA
VAX B:ICODE.C $$FA
VAX B:INIT.C $$FA
VAX B:INTERF.C $$FA
VAX B:LEX.C $$FA
VAX B:MAIN.C $$FA
VAX B:MISC.C $$FA
VAX B:NODE.C $$FA
VAX B:PUTEXPR.C $$FA
VAX B:STMT.C $$FA
VAX B:SYMT.C $$FA
VAX B:TABL.C $$FA
VAX B:TREE.C $$FA
VAX B:VERSION.C $$FA
VAX B:DEF.H $$FA
VAX B:LEX.H $$FA
VAX B:PARSER.H $$FA

19
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/down12.sub.2 Normal file
View File

@@ -0,0 +1,19 @@
e:vax DECL.C r
e:vax DISK.C r
e:vax EXPR.C r
e:vax ICODE.C r
e:vax INIT.C r
e:vax INTERF.C r
e:vax LEX.C r
e:vax MAIN.C r
e:vax MISC.C r
e:vax NODE.C r
e:vax PUTEXPR.C r
e:vax STMT.C r
e:vax SYMT.C r
e:vax TABL.C r
e:vax TREE.C r
e:vax VERSION.C r
e:vax DEF.H r
e:vax LEX.H r
e:vax PARSER.H r

551
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/expr.c Normal file
View File

@@ -0,0 +1,551 @@
/*
Copyright 1982, 1983
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
@(#)expr.c 1.8 12/15/83
*/
#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 && !maketree(0))
goto exprerr;
if (!(p=popopd()))
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)*/
goto exprerr;
op = INDR;
break;
case PREINC: /*turn these into binary operators*/
case POSTINC: /*which in reality they are...*/
case PREDEC:
case POSTDEC:
pushopd(cnalloc(INT,1));
default:
if(!maketree(op))
goto exprerr;
continue; /*see if we can reduce some more...*/
} /* switch on op */
if( op != LPAREN && !maketree(op) )
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;
#ifdef SYM_TO_DSK
long p_addr;
struct symbol p_entry;
p_entry = csp_entry;
p_addr = csp_addr;
p = &p_entry;
#else
p = (struct symnode *)csp;
#endif
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);
}
p->s_attrib |= SDEFINED;
TO_DSK(p,p_addr);
}
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);
READ_ST(csp,csp_addr);
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, size;
PUTEXPR(treedebug,"binopeval l",ltp);
PUTEXPR(treedebug,"binopeval r",rtp);
islong = 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);
if( ltp->t_op == CINT)
lvalue = ((struct conode *)ltp)->t_value;
else if (ltp->t_op == CLONG ) { /* [vlh] 4.1 added CLONG */
if ((ltp->t_type & POINTER) && op==ADD) { /* [vlh]4.3 array coercion */
if(ltp->t_ssp) { /* if not structure pointer coercion */
size = dsize(delsp(ltp->t_type),ltp->t_dp,ltp->t_ssp);
rvalue *= size;
}
#ifdef DEBUG
warning("constant coerced");
#endif
}
lvalue = ltp->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 || ( (lvalue>0) && (rvalue>0) && (lvalue>0x7fff) ) ) {
ltp->t_op = CLONG;
ltp->t_lvalue = lvalue;
if(ltp->t_type==INT)
ltp->t_type = LONG; /* 4.2+ */
} /* [vlh] 4.3, turn int into long if necessary */
else
((struct conode *)ltp)->t_value = lvalue;
pushopd(ltp);
PUTEXPR(treedebug,"result binop",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);
}

403
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/icode.c Normal file
View File

@@ -0,0 +1,403 @@
/*
Copyright 1982, 1983
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
@(#)icode.c 1.5 12/30/83
*/
#include "parser.h"
#ifdef VERSADOS
int inerr;
#endif
#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;
/* output current line number into icode */
outline()
{
if(!bol)
putchar('\n');
printf(".%x.%s\n",lineno,source);
lst_ln_id = lineno;
}
/* 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);
putchar('\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");
}
putchar('%');
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:
case PDECREG:
printf("\t~%.8s=R%d\n",sym,val);
break;
case AUTO:
case PDECLIST:
printf("\t~%.8s=%d\n",sym,val);
break;
}
}
#define DSW "\tcmp.l (R8)+,R0\n\tdbeq R1,L%d\n\tmove.l %d(R8),R8\n\tjmp (R8)\n"
/* 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(DSW,i,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 */
/* outfp - output floating poshort data, [vlh] 4.2 changed for dc.l */
outfp_or_l(l) /*[vlh] 3.4 returns - none*/
long l; /* long data (float or fixed point) to output*/
{
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;
{
#ifdef VERSADOS
if (inerr) {
versaputchar(c);
return;
}
#endif
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

245
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/icode.h Normal file
View File

@@ -0,0 +1,245 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
/*
* intermediate code operators
* 0=>EOF, special operator
*/
#define EOF 0
/*1-59=>operators that generate code (entries in code gen optab)*/
#define ADD 1
#define SUB 2
#define MULT 3
#define DIV 4
#define MOD 5
#define RSH 6
#define LSH 7
#define AND 8
#define OR 9
#define XOR 10
#define NOT 11
#define UMINUS 12
#define COMPL 13
#define PREDEC 14
#define PREINC 15
#define POSTDEC 16
#define POSTINC 17
#define ASSIGN 18
#define EQADD 19
#define EQSUB 20
#define EQMULT 21
#define EQDIV 22
#define EQMOD 23
#define EQRSH 24
#define EQLSH 25
#define EQAND 26
#define EQOR 27
#define EQXOR 28
#define FJSR 29
#define EQUALS 30
#define NEQUALS 31
#define GREAT 32
#define GREATEQ 33
#define LESS 34
#define LESSEQ 35
#define INT2L 36
#define LONG2I 37
/*machine dependent operators that generate code*/
#define BTST 38
#define LOAD 39
#define LMULT 40
#define LDIV 41
#define LMOD 42
#define LEQMULT 43
#define LEQDIV 44
#define LEQMOD 45
#define EQADDR 46
#define EQNOT 47
#define EQNEG 48
#define DOCAST 49
#define STASSIGN 50 /*[vlh]*/
#define LONG2F 51 /*[vlh] 3.4*/
#define FLOAT2L 52 /*[vlh] 3.4*/
#define INT2F 53 /*[vlh] 3.4*/
#define FLOAT2I 54 /*[vlh] 3.4*/
#define TOCHAR 55 /*[vlh] 4.1*/
#define LCGENOP 56 /*change if adding more operators...*/
/*intermediate code operators that do not generate code*/
#define ADDR 60
#define INDR 61
#define LAND 62
#define LOR 63
#define QMARK 64
#define COLON 65
#define COMMA 66
#define CINT 67
#define CLONG 68
#define SYMBOL 69
#define AUTOINC 70
#define AUTODEC 71
#define CALL 72
#define NACALL 73
#define BFIELD 74
#define IFGOTO 75
#define INIT 76
#define CFORREG 77
#define DCLONG 78
#define CFLOAT 79 /*[vlh] 3.4*/
/*operators local to parser*/
#define CAST 80
#define SEMI 81
#define LCURBR 82
#define RCURBR 83
#define LBRACK 84
#define RBRACK 85
#define LPAREN 86
#define RPAREN 87
#define STRING 88
#define RESWORD 89
#define APTR 90
#define PERIOD 91
#define SIZEOF 92
#define MPARENS 93
#define FRETURN 94
#define ASM 95 /* [vlh] 4.2 */
#define STACKEND 100
/*data types*/
#define TYPELESS 0
#define CHAR 01
#define SHORT 02
#define INT 03
#define LONG 04
#define UCHAR 05
#define USHORT 06
#define UNSIGNED 07
#define ULONG 010
#define FLOAT 011
#define DOUBLE 012
/*data types local to parser*/
#define STRUCT 013
#define FRSTRUCT 014
#define LLABEL 015
/*type flags and definitions*/
#define TYPE 017
#define SUPTYP 060
#define ALLTYPE 077
#define POINTER 020
#define FUNCTION 040
#define ARRAY 060
#define SUTYPLEN 2
/*data registers*/
#define DREG0 0
#define DREG2 2
#define DREG3 3
#define DREG4 4
#define DREG5 5
#define DREG6 6
#define DREG7 7
#define AREG3 11
#define AREG4 12
#define AREG5 13
/*storage classes*/
#define AUTO 1
#define REGISTER 2
#define EXTERNAL 3
#define STATIC 4
#define REGOFF 5
#define EXTOFF 6
#define STATOFF 7
#define INDEXED 8
/*exclusively code generator storage classes*/
#define CINDR 9
#define CLINDR 10
#define CFINDR 11 /* [vlh] 3.4 */
/*exclusively parser storage classes*/
#define STRPROTO 9
#define PDECLIST 10
#define PARMLIST 11
#define BFIELDCL 12
#define UNELCL 13
#define STELCL 14
#define PDECREG 15 /* [vlh] 4.3, PDECLIST register variable */
#define DEXTERN 16 /* [vlh] 4.3, explicitly defined extern */
/*opinfo table bits*/
#define OPPRI 077
#define OPBIN 0100
#define OPLVAL 0200
#define OPREL 0400
#define OPASSIGN 01000
#define OPLWORD 02000
#define OPRWORD 04000
#define OPCOM 010000
#define OPRAS 020000
#define OPTERM 040000
#define OPCONVS 0100000
/*68000 definitions*/
#define PTRSIZE 4
#define LONGSIZE 4
#define INTSIZE 2
#define CHARSIZE 1
#define SSIZE 8 /* chars per symbol */
#define TRUE 1
#define FALSE 0
#define TABC '\t' /* tab character */
#define EOLC '\n' /* end of line character */
#define BITSPBYTE 8
/*operator class priorities*/
#define TRMPRI 0 /* terminal nodes */
#define RPNPRI 1 /* ) and ] */
#define CALPRI 2 /* in-stack call, ( or [ */
#define COLPRI 3 /* init or case priority for : or , */
#define STKPRI 4 /* priority of end of stack */
#define COMPRI 5 /* normal priority for , */
#define ASGPRI 6 /* =, +=, -=, *=, /=, %=, ... */
#define QMKPRI 7 /* ?: */
#define LORPRI 8 /* || */
#define LNDPRI 9 /* && */
#define ORPRI 10 /* |, ^ */
#define ANDPRI 11 /* & */
#define EQLPRI 12 /* ==, != */
#define RELPRI 13 /* >, <, >=, <= */
#define SHFPRI 14 /* <<, >> */
#define ADDPRI 15 /* +, - */
#define MULPRI 16 /* *, /, % */
#define UNOPRI 17 /* !, ++, --, &, *, -, ~, sizeof */
#define LPNPRI 18 /* ., ->, [, (, function call */
#define PSTPRI 19 /* in-stack post--, post++ */
#ifndef VAX11
struct { short hiword; short loword; };
#else
# ifndef VMS
# define UNIX 1
# endif
struct { short loword; short hiword; };
#endif
#ifdef PDP11
# define UNIX 1
#endif
#define EXPSIZE 4096 /* EXPSIZE enlarged [vlh] 4.1 */
char exprarea[EXPSIZE]; /* made char [vlh] 4.2 */
/* v6io buffer declaration */
#define BLEN 512

642
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/init.c Normal file
View File

@@ -0,0 +1,642 @@
/*
Copyright 1982, 1983
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
@(#)init.c 1.13 1/3/84
*/
#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 ?? */
#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(initdebug)
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 if (sp->s_sc == DEXTERN) /* explicitly EXTERN */
sp->s_sc = EXTERNAL;
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 */
#ifdef SYM_TO_DSK
struct symbol par_str; /* parent structure.... */
#endif
i = (next(LCURBR));
for( onetype = type; ISARRAY(onetype); onetype = delsp(onetype) )
;
#ifdef DEBUG
if (initdebug) {
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)) {
nbleft = 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))) {
nbleft = elsize = dsize(delsp(type),dp,ssp); /* was dp+1 */
/* [vlh] 4.2, added proper handling of structure init... */
if( !i && BTYPE(type)==STRUCT )
error("missing { in initialization");
do {
#ifndef SYM_TO_DSK
nbleft = s_or_a(onetype,elsize,&nbout,nbleft,sp->s_par,NULL);
#else
read_st(&par_str,sp->s_par);
nbleft = s_or_a(onetype,elsize,&nbout,nbleft,&par_str,NULL);
#endif
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);
}
#ifndef SYM_TO_DSK
# define COPY(c,s) c = s
# define HCOPY(c,s) c = s
#else
# define COPY(c,s) c_addr = s; c = &child_str; read_st(c,c_addr)
# define HCOPY(c,s) c_addr = s; c = &hold_str; read_st(c,c_addr)
#endif
#define BASIC_AR(x) (x==(ARRAY|CHAR)||x==(ARRAY|INT)||x==(ARRAY|LONG))
/**
* 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, addup, x;
short nest, snest; /* [vlh] 4.2 nest <= number of LCURBR */
struct symbol *hold;
#ifdef SYM_TO_DSK
long c_addr;
struct symbol child_str; /* child structure */
struct symbol hold_str; /* hold structure */
#endif
nbleft = bleft; nbout = *pnbout; onetype = original; nest = i = 0;
#ifdef DEBUG
if (initdebug)
printf("s_or_a: [%s] elsize %ld\n",(sp) ? sp->s_symbol : "",elsize);
#endif
do { /*in current row.*/
restart:
if (BTYPE(original) == STRUCT) { /* [vlh] 4.3 */
if(!child) {
if (!sp->s_child)
break;
else {
COPY(child,sp->s_child);
}
}
onetype = child->s_type;
#ifdef DEBUG
if (initdebug)
printf("s_or_a: child %s type %d\n",child->s_symbol,onetype);
#endif
}
if( PEEK(SEMI) || PEEK(EOF) || PEEK(RCURBR) )
break;
if(child && onetype == STRUCT) { /* [vlh] 4.3 */
#ifdef DEBUG
if(initdebug) printf("s_or_a recurse onetype STRUCT\n");
#endif
snest = (next(LCURBR));
temp = nbout;
HCOPY(hold,child->s_par); /* was s_child */
i = dsize(onetype,(hold->s_dp)+1,hold->s_ssp);
s_or_a(onetype,i,&temp,i,hold,NULL);
if(snest) {
if (!next(RCURBR)) /* force release of matched curbr */
error("mismatched curly braces");
}
else if (!peektok)
peektok = COMMA; /* [vlh] 4.2 put it back.... */
goto past;
}
else 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 ( BASIC_AR(onetype) ) { /* [vlh]4.2 simple arrays */
#ifdef DEBUG
if(initdebug) printf("BASIC_AR onetype 0%o\n",onetype);
#endif
datasize = dsize(onetype,child->s_dp,child->s_ssp);
i = str_init(datasize, onetype);
}
else if ( BASIC_AR(original) ) { /* [vlh]4.2 simple arrays */
#ifdef DEBUG
if(initdebug) printf("BASIC_AR original 0%o\n",original);
#endif
datasize = dsize(original,child->s_dp,child->s_ssp);
i = str_init(datasize, original);
}
else if (ISARRAY(onetype)) { /* [vlh] 4.2 */
#ifdef DEBUG
if(initdebug) printf("ISARRAY onetype 0%o\n",onetype);
#endif
addup = 0; /* array of structures or arrays */
temp = nbout;
i = dsize(onetype,child->s_dp,child->s_ssp);
onetype = delsp(onetype);
datasize = dsize(onetype,child->s_dp+1,child->s_ssp);
HCOPY(hold,child->s_par); /* was s_child */
x = onetype & ~POINTER; /* [vlh] 4.3, simple pointer */
if( SIMPLE_TYP(x) ) {
#ifdef DEBUG
if(initdebug) printf("simple type 0%o 0%o\n",onetype,x);
#endif
for(addup=0; addup != i; addup += datasize) {
if (PEEK(RCURBR) || PEEK(SEMI)) {
OUTRESMEM(i);
break;
} /*[vlh] 4.3, no more initializers */
oneinit(onetype,hold->s_dp,(int)hold->s_sc);
next(COMMA);
}
if (!peektok)
peektok = COMMA; /* [vlh] 4.2 put it back.... */
#ifdef DEBUG
if(initdebug) printf("peektok %d addup %ld\n",peektok,addup);
#endif
}
else
for(addup=0; addup != i; addup += datasize) {
x = s_or_a(onetype,datasize,&temp,datasize,hold,NULL);
if(x) { /*[vlh] 4.3, no initializer for current item*/
OUTRESMEM(i - (addup + datasize - x));
break;
}
}
}
else { /* simple type....... */
if ((nbleft & 1) && onetype != CHAR) {
nbleft--;
nbout++;
OUTEVEN();
}
if (!child) /* mra/vlh4.2+ don't access off of zero !!! */
i = oneinit(onetype,0,0);
else
i = oneinit(onetype,child->s_dp,(int)child->s_sc);
}
past:
nbout += i;
if ( !nbleft && !SIMPLE_TYP(original) )
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->s_sib) { /* [vlh] 4.2 at end... */
plus = (in_bitinit) ? out_bfield(CHAR) : 0;
nbleft -= plus;
nbout += nbleft;
if ( nbleft ) { /* was checking against elsize */
OUTRESMEM(nbleft);
nbleft = 0;
}
if (SUPTYPE(original) != ARRAY)
break;
#ifdef DEBUG
if(initdebug) printf("last child out...\n");
#endif
}
else {
COPY(child,child->s_sib);
}
}
}
#ifdef DEBUG
if(initdebug && child)
printf("child [%s] PEEKTOK comma %d\n",child->s_symbol,PEEK(COMMA));
#endif
} while( next(COMMA) );
#ifdef DEBUG
if(initdebug) printf("exiting s_or_a: nbleft %ld\n",nbleft);
#endif
if (BTYPE(original)==STRUCT) { /* [vlh] 4.2, ensure padding... */
plus = (in_bitinit) ? out_bfield(CHAR) : 0;
nbout += nbleft;
if ( nbleft ) { /* was checking against 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 (initdebug) printf("str_init: type %d, datasize %ld\n",type,datasize);
if (initdebug) printf("str_init: SUPTYPE %d, ",SUPTYPE(type));
if (initdebug) 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 (initdebug) 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 (initdebug) printf("output %ld, ",output);
if (initdebug) 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 (initdebug) 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 = ((struct conode *)tp)->t_value;
else if (op == CLONG)
clvalue = ((struct lconode *)tp)->t_lvalue;
ivalue = value = clvalue;
if (sc == BFIELDCL)
return(one_binit(type,dp,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 (initdebug) 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:
case POINTER|DOUBLE: /* [vlh] 4.2 */
case POINTER|FLOAT: /* [vlh] 4.2 */
if( op!=CINT && op!=CLONG ) {
outinit(tp,inittype);
return(4+plus);
}
case DOUBLE: /* [vlh] 3.4 */
case FLOAT:
outfp_or_l(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,value)
int type,dp;
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);
}

114
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/interf.c Normal file
View File

@@ -0,0 +1,114 @@
/*
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;
if (lineno != lst_ln_id) {
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... */
}

580
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/lex.c Normal file
View File

@@ -0,0 +1,580 @@
/*
Copyright 1982, 1983
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
@(#)lex.c 1.6 11/21/83
*/
#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 */
{
#ifndef NOFP
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) );
#else
return(0L);
#endif
}
#ifndef NOFP
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);
}
#endif
/* 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);
}
error("illegal operator '=<'");
return(EQUALS);
}
else if( peekis('>') ) {
if( peekis('>') ) {
warning("old fashion assignment \"=>>\"");
return(EQRSH);
}
error("illegal operator '=>'");
return(EQUALS);
}
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 ) {
if(lst_ln_id != lineno && instmt) { /* [vlh] 4.2 */
outline();
OUTNULL();
}
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];
if ((c = getc(&ibuf)) != '\"') /* get past double quote */
*ptr++ = c & 0377;
while ((c=getc(&ibuf)) != '\"' && c != '\n')
*ptr++ = c&0377;
if (c != '\n')
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, c, 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);
}
/* 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;
}

87
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/lex.h Normal file
View File

@@ -0,0 +1,87 @@
/*
Copyright 1982, 1983
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
@(#)lex.h 1.4 11/7/83
*/
#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 */
#ifndef NOFP
long toieee();
long toffp();
double power10();
#endif

57
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/list.com Normal file
View File

@@ -0,0 +1,57 @@
$ num
DECL.C
DECL.lis
$ num
DISK.C
DISK.lis
$ num
EXPR.C
EXPR.lis
$ num
ICODE.C
ICODE.lis
$ num
INIT.C
INIT.lis
$ num
INTERF.C
INTERF.lis
$ num
LEX.C
LEX.lis
$ num
MAIN.C
MAIN.lis
$ num
MISC.C
MISC.lis
$ num
NODE.C
NODE.lis
$ num
PUTEXPR.C
PUTEXPR.lis
$ num
STMT.C
STMT.lis
$ num
SYMT.C
SYMT.lis
$ num
TABL.C
TABL.lis
$ num
TREE.C
TREE.lis
$ num
VERSION.C
VERSION.lis
$ num
DEF.H
DEF.lst
$ num
LEX.H
LEX.lst
$ num
PARSER.H
PARSER.lst

24
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/list.com.1 Normal file
View File

@@ -0,0 +1,24 @@
Directory DRB0:[STEVE.CPM68K.V102A.PARSER]
DECL.C;2
DISK.C;2
EXPR.C;2
ICODE.C;2
INIT.C;2
INTERF.C;2
LEX.C;2
MAIN.C;2
MISC.C;2
NODE.C;2
PUTEXPR.C;2
STMT.C;2
SYMT.C;2
TABL.C;2
TREE.C;2
VERSION.C;2
DEF.H;2
LEX.H;2
PARSER.H;2
Total of 19 files.

388
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/main.c Normal file
View File

@@ -0,0 +1,388 @@
/**
* Copyright 1983
* Alcyon Corporation
* 8716 Production Ave.
* San Diego, Ca. 92121
**/
char *version = "@(#)main.c 1.8 12/28/83";
#include "parser.h"
#include "def.h"
#ifndef VERSADOS
# include <signal.h>
#else
int inerr;
#endif
/**
* 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
*
**/
#ifndef VERSADOS
# ifndef VMS
char strfile[] = "/tmp/PsXXXXXX";
# else
char strfile[] = "wk:pXXXXXX";
# endif
#else
char *strfile;
#endif
#ifdef SYM_TO_DSK
char dskfile[] = "/tmp/PdXXXXXX";
#endif
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);
#ifndef VERSADOS
if( signal(SIGINT,SIG_IGN) != SIG_IGN ) /*[mac] 4.2a*/
signal(SIGINT,cleanup);
if( signal(SIGQUIT,SIG_IGN) != SIG_IGN )
signal(SIGQUIT,cleanup);
if( signal(SIGHUP,SIG_IGN) != SIG_IGN )
signal(SIGHUP,cleanup);
signal(SIGTERM,cleanup);
#endif
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");
#ifndef VERSADOS
mktemp(strfile);
#else
strfile = *argv++;
#endif
if (fcreat(strfile,&sbuf,0) < 0)
ferror("string file temp creation error");
obp = &obuf;
#ifdef SYM_TO_DSK
mktemp(dskfile);
dsk_fd = creat(dskfile,0644);
#endif
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 't': /* [vlh] 4.1, put strings into text segment */
tflag++;
continue;
#ifndef NOPROFILE
case 'p': /* [vlh] 4.3 profiler output file */
profile++;
continue;
#endif
case 'w': /* [vlh] 4.1 warning messages, not fatal */
wflag++;
continue;
#ifdef DEBUG
case 'D': /* [vlh] 4.1, turn debugging on */
debug++;
continue;
case 'i': /* [vlh] 4.2, if debug on, debug initialization */
if (debug)
initdebug++;
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()
{
#ifndef VERSADOS
signal(SIGINT,SIG_IGN);
unlink(strfile);
#endif
#ifdef SYM_TO_DSK
unlink(dskfile);
#endif
close(lbuf.fd);
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*/
{
#ifndef VERSADOS
printf((char *)STDERR,"\"%s\", * %d: ",source,lineno);
printf((char *)STDERR,s,x1,x2,x3,x4,x5,x6);
cputc('\n',STDERR);
#else
inerr=1;
printf("\"%s\", * %d: ",source,lineno);
printf(s,x1,x2,x3,x4,x5,x6);
printf("\n");
inerr=0;
#endif
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;
#ifndef VERSADOS
printf((char *)STDERR,"\"%s\", * %d: (warning) ",source,lineno);
printf((char *)STDERR,s,x1,x2,x3,x4,x5,x6);
cputc('\n',STDERR);
#else
inerr=1;
printf("\"%s\", * %d: (warning) ",source,lineno);
printf(s,x1,x2,x3,x4,x5,x6);
printf("\n");
inerr=0;
#endif
}
/* 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++;
}
#ifndef VERSADOS
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);
}
#endif
/**
* 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 WHITE
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

126
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/makefile Normal file
View File

@@ -0,0 +1,126 @@
CC = cc
C68 = c68
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 vaxobj/disk.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
XCFLAGS = -w -O -DVAX11 -DDEBUG -DSYM_TO_DSK
C68FLAGS = -L -r -f -DMC68000 -DDEBUG
LIB = -lV6
C68LIB = -l6
vax: ${VAXOBJS}
@mkver -e "parser 4.3 -"
${CC} ${CFLAGS} version.c ${VAXOBJS} -o c068.vax ${LIB}
c068: ${C68OBJS}
@mkver -e "parser 4.3 -"
${C68} ${C68FLAGS} ${C68OBJS} version.c -o c068.68 ${C68LIB}
@setstack c068.68 8192 8192
4k: ${C68OBJS}
@mkver -e "parser 4.3 -"
${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
vaxobj/disk.o: disk.c
${CC} ${CFLAGS} -c disk.c;mv -f disk.o vaxobj/disk.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

239
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/misc.c Normal file
View File

@@ -0,0 +1,239 @@
/*
Copyright 1982, 1983
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);
if(type & (0xc000 >> SUTYPLEN)) /* [vlh] 4.3, top type field full */
error("arrays limited to five dimensions");
else
type <<= SUTYPLEN;
return( type | 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)))
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, type;
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;
}
type = lp->t_type;
if ((type&STRUCT)==STRUCT || (type&FRSTRUCT)==FRSTRUCT)
size = dtab[lp->t_dp - 1] * dsize(rp->t_type,rp->t_dp,rp->t_ssp);
else
size = dtab[lp->t_dp - 1] * (dinfo[type&TYPE]&DTSIZE);
#ifdef DEBUG
if(treedebug) {
printf("second case: rtype 0%o ltype 0%o ",rp->t_type,lp->t_type);
printf("dtab %ld\n",dtab[lp->t_dp-1]);
}
#endif
}
if (bool) /* [vlh] 4.2 */
indecl = predecl; /* value previous to sizeof.... */
#ifdef DEBUG
if(treedebug) {
printf("rtype 0%o ltype 0%o ",rp->t_type,lp->t_type);
printf("size %d, dtab %ld\n",size,dtab[lp->t_dp-1]);
}
#endif
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;
#ifdef DEBUG
if(treedebug) {
printf("size %ld ",size); printf("nel %ld ",nel);
printf("dinfo[type=0%o] ==> %d\n",type,dinfo[type]&DTSIZE);
}
#endif
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/v102a/orgc068/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);
}

483
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/parser.h Normal file
View File

@@ -0,0 +1,483 @@
/*
Copyright 1983
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
/**
* C68 Parser - include file
**/
#ifdef WHITE
# define NOPROFILE
# define VAX11
# include <stdio.h>
# include <klib.h>
# undef putchar
# define putchar xputchar
# undef ferror
# define ferror xferror
# define printf xprintf
#endif
#ifndef DECC
# include "../icode.h"
#else
# define NOPROFILE
# define VAX11
/* ICODE functionally equivilent to icode.h, vprintf equivilent to printf */
# include "ICODE"
# define printf vprintf
#endif
#ifdef VERSADOS
# define NOPROFILE
#endif
/*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 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... */
#ifndef PDP11
# define SYMSIZE 1024 /*size to alloc for symbol structures*/
#else
# define SYMSIZE 128
#endif
/*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 */
#ifndef SYM_TO_DSK
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 */
#else
long s_par; /* if struct, ptr to parent (sys III) */
long s_child; /* if struct, ptr to 1st child (sys III) */
long s_sib; /* if struct, ptr to sibling (sys III) */
long s_next; /* next symbol table entry */
#endif
};
/*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;
/*output buffers for intermediate code and strings*/
struct iob {
int fd;
int cc;
char *cp;
char cbuf[BSIZE];
} obuf, lbuf, sbuf, ibuf, *obp;
/* Symbols Used by the on disk symbol table handler */
#ifdef SYM_TO_DSK
long dsk_offset; /* location for next symbol entry */
struct symbol volatile; /* very temporary structure */
struct symbol csp_entry; /* symbol storage space */
struct symbol dsp_entry; /* symbol storage space */
struct symbol tdp_entry; /* symbol storage space */
long csp_addr, dsp_addr; /* location....... */
long tdp_addr;
int dsk_fd;
char dskfile[];
#endif
/* 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 lst_ln_id; /*[vlh] 4.2 last line an id was output on...*/
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*/
#ifndef NOPROFILE
short profile; /*[vlh] 4.3, profiler output */
#endif
#ifdef DEBUG
short debug; /*[vlh] 4.1, debug flag */
short initdebug; /*[vlh] 4.2, init debug flag */
short symdebug; /*[vlh] 4.2, sym debug flag */
short treedebug; /*[vlh] 4.2, expr tree debug flag */
#endif
/*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 */
#ifndef SYM_TO_DSK
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*/
#else
long struc_parent[10]; /*[vlh] address of struc symbols*/
long struc_sib[10]; /*[vlh] address of struc symbols*/
long hold_sib; /*[vlh] wrap sib past struct decl*/
#endif
/*function argument table, used to collect function parameters*/
struct farg {
#ifndef SYM_TO_DSK
struct symbol *f_sp;
#else
long f_sp;
#endif
short f_offset;
} fargtab[NFARGS];
/*forward referenced structure prototype names*/
#ifndef SYM_TO_DSK
struct symbol *frstab[NFRSTR];
#else
long *frstab[NFRSTR];
#endif
short frstp;
/* 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 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)
#ifndef NOPROFILE
/* output function label */
#define OUTPCALL(sym) printf("\tmove.l _%.8s,(sp)\n\tjsr ___popen\n",sym)
#endif
/* output data label */
#define OUTDLAB(sym) printf("\t_%.8s:\n",sym)
/* output a null tree */
#define OUTNULL() printf("0\n")
/* Debugging Macros */
#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
/* On Disk Symbol Table macro */
#ifdef SYM_TO_DSK
# define TO_DSK(symp,addr) write_st(symp,addr)
# define READ_ST(symp,addr) read_st(symp,addr)
# define ZERO_DSP() dsp_addr = dsp = 0;
#else
# define TO_DSK(symp,addr)
# define READ_ST(symp,addr)
# define ZERO_DSP() dsp = 0
#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/v102a/orgc068/putexpr.c Normal file
View File

@@ -0,0 +1,261 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
#ifdef DEBUG
#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*/
};
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 [0x%x]\n",tp->t_value,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

584
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/stmt.c Normal file
View File

@@ -0,0 +1,584 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
@(#)stmt.c 1.4 12/27/83
*/
#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++;
TO_DSK(sp,csp_addr);
}
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++;
TO_DSK(sp,csp_addr);
}
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++;
TO_DSK(sp,csp_addr);
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 {
if(addswitch(&swtab[cswp],swp-cswp,(int)value,lab=nextlabel)) {
nextlabel++;
OUTLAB(lab);
swp++;
} /* [vlh] 4.3, only if not duplicate case !!! */
}
}
/* 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;
outline();
OUTNULL();
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;
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;
outline(); /*[vlh]4.2 output line number on cond*/
OUTNULL(); /*[vlh]4.2 null tree for line number*/
if((tp = (struct tnode *)balpar()) != 0) /*get condition clause*/
OUTGOTO(clabel); /*condition label*/
exprp = opap;
OUTLAB(lab);
stmt(); /*statement*/
OUTLAB(clabel); /*condition test*/
outifgoto(tp,TRUE,lab); /* branch back to top of loop */
OUTLAB(blabel); /*break to here*/
exprp = savep;
blabel = saveblab;
clabel = saveclab; /*restore labels*/
}
/* nextrw - is next token the specified reserved word?*/
nextrw(rw) /* returns 1 if match, 0 otherwise*/
int rw; /* reserved word to match*/
{
register 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");
return(0); /* [vlh] 4.3, don't add it in !!!! */
}
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;
}
}
return(1);
}
/* 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;
}

304
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/symt.c Normal file
View File

@@ -0,0 +1,304 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
@(#)symt.c 1.8 12/30/83
*/
/**
* symbol table entry allocation and lookup routines
**/
#include "parser.h"
#define STEL HSIZE/2
#ifndef SYM_TO_DSK
struct symbol *symtab[HSIZE]; /*hash table*/
struct symbol *symbols; /*pointer to next avail symbol buf*/
#endif
/**
* 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;
#ifdef SYM_TO_DSK
install("",0,0); /* null entry at zero */
#endif
for( rp = &reswords[0]; rp->r_name != 0; rp++ )
install(rp->r_name,SRESWORD|SDEFINED,rp->r_value);
}
#ifndef SYM_TO_DSK
/**
* 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, is;
#ifndef DECC
while( (sp=symbols) <= 0 ) {
#else
/**
* Peculiar bug on the vax required changing <= to ==. DEC
* people are checking into why the relational <, >, <=, >=
* don't work properly when a global pointer to a structure
* is compared with 0.
**/
while( (sp=symbols) == 0 ) {
#endif
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++;
}
}
is = in_struct;
symbols = sp->s_next;
sp->s_attrib = attrib;
sp->s_offset = offset;
sp->s_sc = sp->s_type = sp->s_dp = sp->s_ssp = 0;
sp->s_sib = sp->s_child = sp->s_par = 0;
if (is) {
sp->s_par = struc_parent[is];
hold_sib = struc_sib[is];
sp->s_scope = (infunc) ? FUNC_SCOPE : GLOB_SCOPE; /* [vlh] 4.2 */
if (struc_sib[is])
struc_sib[is]->s_sib = sp;
else
struc_parent[is]->s_child = sp;
struc_sib[is] = sp;
}
else
sp->s_scope = scope_level; /* [vlh] 4.2 */
symcopy(sym,sp->s_symbol); /*copy symbol to symbol struct*/
i = symhash(sym,is|smember); /*link into chain list*/
sp->s_next = symtab[i];
symtab[i] = sp;
#ifdef DEBUG
if (symdebug && attrib != (SRESWORD|SDEFINED)) {
printf(" scope %d\n",sp->s_scope);
/*
if(sp->s_par) printf(" struct element parent [%.8s] %d %ld\n",
sp->s_par->s_symbol,is,sp->s_par);
else printf(" NO parent\n");
if(struc_sib[is]) printf(" struct sib [%.8s]\n",
struc_sib[is]->s_symbol);
else printf(" struct sib NULL\n");
if(struc_parent[is]) {
printf(" struct par [%.8s] ",struc_parent[is]->s_symbol);
if(struc_parent[is]->s_child) printf("child [%.8s]\n",
struc_parent[is]->s_child->s_symbol);
else printf("no child\n");
}
else printf(" struct parent NULL\n");
*/
}
#endif
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);
hold = 0;
if (!(smember|in_struct)) { /*[vlh]*/
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 (!force && prev_level <= sp->s_scope) {
hold = sp;
prev_level = sp->s_scope;
}
}
if ( hold ) /* [vlh] 4.2 added scope... */
return(hold);
}
else { /* doing a declaration or an expression */
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_par = frstab[sp->s_ssp]->s_par;
#ifdef DEBUG
if(symdebug) printf("[%s] <= par [%s]\n",sp->s_symbol,sp->s_par->s_symbol);
#endif
sp->s_ssp = frstab[sp->s_ssp]->s_ssp; /* 3.4 ssp>0 */
sp->s_type = (sp->s_type&~TYPE) | STRUCT; /* 4.2+ moved */
}
if( sc == PDECLIST || sc == PDECREG ) {
error("not in parameter list: %.8s",sp->s_symbol);
sp->s_sc = (sc == PDECLIST) ? AUTO : REGISTER;
if (ok)
outlocal(sp->s_type,sp->s_sc,sp->s_symbol,sp->s_offset);
}
}
}
#endif
/**
* symhash - compute hash value for symbol
* Sums the symbols characters and takes that modulus the hash table
* size.
* [vlh] 4.3, symhash must be on minimum number of chars which is a max
* eg. Maximum number for external variable is SSIZE-1...
**/
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-1; *p != '\0' && i > 0; i-- )
hashval += *p++;
return( hashval % HSIZE );
}
/**
* symequal - check for symbol equality
* Does comparison between two symbols.
* [vlh] 4.3, global (external symbols) match at SSIZE-1!!!
**/
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;
i = (scope_level == GLOB_SCOPE && !smember && !in_struct) ? SSIZE-1 : SSIZE;
for( p = sym1, q = sym2; *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/v102a/orgc068/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*/
};

506
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/orgc068/tree.c Normal file
View File

@@ -0,0 +1,506 @@
/*
Copyright 1982
Alcyon Corporation
8716 Production Ave.
San Diego, Ca. 92121
*/
#include "parser.h"
#define QCAST(l,r) (l->t_type==CHAR && ((r->t_op==SYMBOL && r->t_sc!=REGISTER \
&& r->t_sc<=STATIC) || r->t_type!=CHAR))
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 ( op==ASSIGN ) { /*[vlh]*/
if(ltype != STRUCT) {
ltp->t_type = rtp->t_type;
ltp->t_ssp = rtp->t_ssp;
ltp->t_dp = rtp->t_dp;
ltype = STRUCT;
}
else if (rtype != STRUCT) {
rtp->t_type = ltp->t_type;
rtp->t_ssp = ltp->t_ssp;
rtp->t_dp = ltp->t_dp;
rtype = STRUCT;
}
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 || (COMOP(op) && /* 4.3 not RELOP */
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) ) {
conv = INT_LONG; /* [vlh] 4.3 */
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==LONG_PTR || conv==PTR_LONG))
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= QCAST(ltp,rtp);
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 ((ltype&POINTER) && rtype==INT) /* [vlh] 4.3 */
rtp = (struct tnode *)cvopgen(rtp,type,INT_LONG,psize(ltp),op);
else if ( rtp->t_type != CHAR && !conv ) {
rtp->t_type = ltp->t_type;
rtp->t_ssp = ltp->t_ssp; /* [vlh] 3.4 */
if(rtp->t_op != BFIELD) /* [vlh] 4.3, bitfield condition */
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);
if(binopeval(MULT,tp,rtp)) /* [vlh] 4.3 */
tp = popopd();
else
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);
if (binopeval(cop,tp,rtp)) /* [vlh] 4.3 */
return( popopd() );
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/v102a/orgc068/version.c Normal file
View File

@@ -0,0 +1 @@
char *compiled = "@(#) parser 4.3 - Tue Jan 3 14:59 1984";