mirror of
https://github.com/PDP-10/PCC20.git
synced 2026-01-13 15:17:51 +00:00
478 lines
9.5 KiB
C
478 lines
9.5 KiB
C
# include "cc.h"
|
||
|
||
/*
|
||
|
||
C Compiler
|
||
Routines common to phases P and C
|
||
|
||
Copyright (c) 1977 by Alan Snyder
|
||
|
||
ctype
|
||
remarr
|
||
mprint
|
||
mprd
|
||
align
|
||
|
||
*/
|
||
|
||
/**********************************************************************
|
||
|
||
CTYPE - convert type to CTYPE
|
||
|
||
**********************************************************************/
|
||
|
||
int ctype (t) type t;
|
||
|
||
{extern int tpoint[], talign[], ntype;
|
||
extern type TINT;
|
||
extern type remarr();
|
||
int ac, tag;
|
||
|
||
if (t->tag == TTFUNC) t = t->val;
|
||
switch (t->tag) {
|
||
|
||
case TTCHAR: return (ct_char);
|
||
case TTINT: return (ct_int);
|
||
case TTFLOAT: return (ct_float);
|
||
case TTDOUBLE: return (ct_double);
|
||
case TTSTRUCT: return (ct_struct);
|
||
case TTPTR: t = remarr (t->val);
|
||
switch (t->tag) {
|
||
case TTCHAR:
|
||
case TTFLOAT:
|
||
case TTDOUBLE: break;
|
||
case TTSTRUCT: ac = t->align;
|
||
for (tag=0;tag<ntype;++tag)
|
||
if (talign[tag]==ac)
|
||
return (ct_p0 + tpoint[tag]);
|
||
default: t = TINT;
|
||
}
|
||
return (ct_p0 + tpoint[t->tag]);
|
||
}
|
||
return (ct_bad);
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
REMARR - remove "array of ..." modifiers from type
|
||
|
||
**********************************************************************/
|
||
|
||
type remarr (t) type t;
|
||
|
||
{while (t->tag == TTARRAY) t = t->val;
|
||
return (t);
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
MPRINT - Macro Printing Routine
|
||
|
||
**********************************************************************/
|
||
|
||
mprint (s,x1,x2,x3,x4,x5,x6,x7) char *s;
|
||
|
||
{int *p; /* argument pointer */
|
||
int c; /* current character */
|
||
extern int f_mac;
|
||
|
||
p = &x1;
|
||
while (c = *s++)
|
||
{if (c == '*') mprd (*p++);
|
||
else cputc (c, f_mac);
|
||
}
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
MPRD - Print Decimal Integer
|
||
|
||
**********************************************************************/
|
||
|
||
mprd (i)
|
||
|
||
{extern int f_mac;
|
||
int b[30], *p, a;
|
||
|
||
if (i < 0)
|
||
{i = -i;
|
||
if (i < 0)
|
||
{mprint (SMALLEST);
|
||
return;
|
||
}
|
||
cputc ('-', f_mac);
|
||
}
|
||
|
||
p = b;
|
||
while (a = i/10)
|
||
{*p++ = i%10 + '0';
|
||
i = a;
|
||
}
|
||
|
||
cputc (i + '0', f_mac);
|
||
while (p > b) cputc (*--p, f_mac);
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
ALIGN - align integer according to alignment class
|
||
|
||
**********************************************************************/
|
||
|
||
int align (i, ac)
|
||
|
||
{int r, a;
|
||
extern int calign[];
|
||
|
||
a = calign[ac];
|
||
if (r = (i % a)) return (i + (a - r));
|
||
return (i);
|
||
}
|
||
|
||
/**********************************************************************
|
||
|
||
TYPES
|
||
|
||
Representation:
|
||
|
||
A type is represented by a pointer to a descriptor,
|
||
stored in TYPTAB. There are a fixed number
|
||
of classes of types, distinguished by a tag value.
|
||
The descriptor also contains the size and the alignment
|
||
class of objects of the type. The format of the remainder
|
||
of the descriptor is dependent upon the tag:
|
||
|
||
fields: the size in bits
|
||
pointers: the pointed-to type
|
||
functions: the returned type
|
||
arrays: the element type, the number of elements
|
||
structs: a pointer to a sequence of field definitions,
|
||
terminated by an UNDEF name
|
||
dummy structs: the name of the structure type
|
||
others: nothing
|
||
|
||
Types not involving structures are uniquely represented.
|
||
The notion of equality of types is complex where recursive
|
||
structure definitions are involved; luckily, the concept
|
||
is unnecessary in C. The structure field lists are
|
||
allocated from the end of TYPTAB.
|
||
|
||
Operations:
|
||
|
||
typinit () initialize type data base
|
||
typcinit () initialize type constants
|
||
mkptr (T) => T make pointer type
|
||
mkfunc (T) => T make function type
|
||
mkarray (T, N) => T make array type
|
||
mkcfield (N) => T make char field type
|
||
mkifield (N) => T make int field type
|
||
typrint (T, f) print description of type
|
||
|
||
In c22:
|
||
|
||
mkstruct (n, F[n]) => T make structure type
|
||
mkdummy (name) => T make dummy structure type
|
||
fixdummy (T, n, F[n]) complete structure definition
|
||
wtyptab (f) write type table
|
||
tp2o (T) => I cvt type to integer offset
|
||
|
||
In c34:
|
||
|
||
rtyptab (f) read type table
|
||
to2p (I) => T cvt offset to type pointer
|
||
|
||
Internal Operations:
|
||
|
||
mktype (tag, V[]) => T make type from tag and
|
||
extra values
|
||
typequal (tag, V[], T) => B compare type descriptors
|
||
typscan (T) => T return "next" type descriptor
|
||
typadd (tag, V[]) => T add non-struct type to table
|
||
typxh (w) => T append word to type table
|
||
recxl (w) => *I append word to field list
|
||
fixtype (T) => T compute size and alignment
|
||
fixbtype (T, tag) compute for basic type
|
||
fixstr (T) compute for structure type
|
||
prstruct (T, f) print structure type
|
||
|
||
**********************************************************************/
|
||
|
||
extern int tsize[], talign[];
|
||
|
||
/**********************************************************************
|
||
|
||
Format tables:
|
||
|
||
NVAL - number of extra descriptor values for each tag
|
||
FORM - format number describing format of extra values:
|
||
0 - no extra values
|
||
1 - integer
|
||
2 - type
|
||
3 - type, integer
|
||
4 - fieldlist
|
||
|
||
**********************************************************************/
|
||
|
||
int typnval[] {0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 1, 1};
|
||
int typform[] {0, 0, 0, 0, 0, 0, 0, 1, 1, 2, 2, 3, 4, 1};
|
||
|
||
/* special type values */
|
||
|
||
type TCHAR;
|
||
type TINT;
|
||
type TFLOAT;
|
||
type TDOUBLE;
|
||
type TLONG;
|
||
type TUNSIGNED;
|
||
type TUNDEF;
|
||
type TPCHAR;
|
||
type TACHAR;
|
||
type TFINT;
|
||
|
||
/* type table */
|
||
|
||
int typtab[TTSIZE];
|
||
int *ctypp, *crecp, *etypp;
|
||
|
||
/**********************************************************************
|
||
|
||
OPERATIONS
|
||
|
||
**********************************************************************/
|
||
|
||
type mkptr();
|
||
type mkfunc();
|
||
type mkarray();
|
||
type mktype();
|
||
type typscan();
|
||
type typadd();
|
||
type typxh();
|
||
type fixtype();
|
||
|
||
typinit ()
|
||
|
||
{ctypp = typtab;
|
||
crecp = etypp = typtab+TTSIZE;
|
||
typcinit ();
|
||
}
|
||
|
||
typcinit ()
|
||
|
||
{TCHAR = mktype (TTCHAR);
|
||
TINT = mktype (TTINT);
|
||
TFLOAT = mktype (TTFLOAT);
|
||
TDOUBLE = mktype (TTDOUBLE);
|
||
TLONG = mktype (TTLONG);
|
||
TUNSIGNED = mktype (TTUNSIGNED);
|
||
TUNDEF = mktype (TTUNDEF);
|
||
TPCHAR = mkptr (TCHAR);
|
||
TACHAR = mkarray (TCHAR, 1);
|
||
TFINT = mkfunc (TINT);
|
||
}
|
||
|
||
type mkptr (t) type t;
|
||
{return (mktype (TTPTR, &t));}
|
||
|
||
type mkfunc (t) type t;
|
||
|
||
{switch (t->tag) {
|
||
case TTCHAR: t = TINT; break;
|
||
case TTFLOAT: t = TDOUBLE; break;
|
||
case TTFUNC:
|
||
case TTARRAY:
|
||
case TTSTRUCT:
|
||
case TTDUMMY: errcidn (1004);
|
||
t = mkptr (t);
|
||
break;
|
||
}
|
||
return (mktype (TTFUNC, &t));
|
||
}
|
||
|
||
type mkarray (t, n) type t;
|
||
{return (mktype (TTARRAY, &t));}
|
||
|
||
type mkcfield (n)
|
||
{return (mktype (TTCFIELD, &n));}
|
||
|
||
type mkifield (n)
|
||
{return (mktype (TTIFIELD, &n));}
|
||
|
||
type mktype (tag, v)
|
||
int v[];
|
||
|
||
{register typedesc *p; /* pointer to current type in table */
|
||
|
||
p = typtab;
|
||
while (p < ctypp)
|
||
{if (typequal (tag, v, p)) return (p);
|
||
p = typscan (p);
|
||
}
|
||
return (typadd (tag, v));
|
||
}
|
||
|
||
int typequal (tag, v, p)
|
||
int tag, v[];
|
||
typedesc *p;
|
||
|
||
{register int *pv;
|
||
|
||
if (tag != p->tag) return (FALSE);
|
||
pv = &(p->val);
|
||
switch (typnval[tag]) {
|
||
case 2: if (v[1] != pv[1]) return (FALSE);
|
||
case 1: if (v[0] != pv[0]) return (FALSE);
|
||
default: return (TRUE);
|
||
}
|
||
}
|
||
|
||
typedesc *typscan (p)
|
||
typedesc *p;
|
||
|
||
{return (&(p->val) + typnval[p->tag]);}
|
||
|
||
type typadd (tag, v)
|
||
int v[];
|
||
|
||
{register type t; /* the new type created */
|
||
register int n; /* number of extra values */
|
||
|
||
t = typxh (tag);
|
||
typxh (-1); /* size not known yet */
|
||
typxh (0); /* "default" alignment class */
|
||
n = typnval[tag];
|
||
while (--n>=0) typxh (*v++);
|
||
if (tag == TTFUNC) t->size = 0; /* avoid spurious errmsg */
|
||
t = fixtype (t);
|
||
if (tag == TTFUNC) t->size = -1;
|
||
return (t);
|
||
}
|
||
|
||
typedesc *typxh (w)
|
||
int w;
|
||
|
||
{if (ctypp < crecp)
|
||
{*ctypp = w;
|
||
return (ctypp++);
|
||
}
|
||
errx (4006);
|
||
}
|
||
|
||
int *recxl (w)
|
||
int w;
|
||
|
||
{if (crecp > ctypp)
|
||
{*--crecp = w;
|
||
return (crecp);
|
||
}
|
||
errx (4006);
|
||
}
|
||
|
||
type fixtype (t) type t;
|
||
|
||
{register int tag;
|
||
register type et;
|
||
|
||
if (t->size < 0) switch (tag = t->tag) {
|
||
|
||
case TTCFIELD: fixbtype (t, TTCHAR);
|
||
break;
|
||
|
||
case TTLONG:
|
||
case TTUNSIGNED:
|
||
case TTIFIELD:
|
||
case TTPTR: fixbtype (t, TTINT);
|
||
break;
|
||
|
||
case TTCHAR:
|
||
case TTINT:
|
||
case TTFLOAT:
|
||
case TTDOUBLE: fixbtype (t, tag);
|
||
break;
|
||
|
||
case TTUNDEF: t->size = 0;
|
||
t->align = 0;
|
||
break;
|
||
|
||
case TTFUNC: errcidn (1005);
|
||
return (mkptr (t));
|
||
|
||
case TTARRAY: t->val = et = fixtype (t->val);
|
||
t->size = t->nelem*et->size;
|
||
t->align = et->align;
|
||
break;
|
||
|
||
case TTDUMMY: errx (2040, TIDN, t->val);
|
||
return (mkptr (t));
|
||
|
||
case TTSTRUCT: if (t->size == -2)
|
||
{errcidn (2019);
|
||
return (mkptr (t));
|
||
}
|
||
fixstr (t);
|
||
break;
|
||
|
||
default: errx (6014);
|
||
}
|
||
return (t);
|
||
}
|
||
|
||
fixbtype (t, tag)
|
||
type t;
|
||
|
||
{t->size = tsize[tag];
|
||
t->align = talign[tag];
|
||
}
|
||
|
||
# ifndef SCRIMP
|
||
|
||
typrint (t, f)
|
||
type t;
|
||
|
||
{switch (t->tag) {
|
||
case TTCHAR: cprint (f, "char"); return;
|
||
case TTINT: cprint (f, "int"); return;
|
||
case TTFLOAT: cprint (f, "float"); return;
|
||
case TTDOUBLE: cprint (f, "double"); return;
|
||
case TTLONG: cprint (f, "long"); return;
|
||
case TTUNSIGNED: cprint (f, "unsigned"); return;
|
||
case TTCFIELD: cprint (f, "char[%d]", t->val); return;
|
||
case TTIFIELD: cprint (f, "int[%d]", t->val); return;
|
||
case TTUNDEF: cprint (f, "undefined"); return;
|
||
case TTPTR: cprint (f, "*"); typrint (t->val, f);
|
||
return;
|
||
case TTFUNC: cprint (f, "()"); typrint (t->val, f);
|
||
return;
|
||
case TTARRAY: cprint (f, "[%d]", t->nelem);
|
||
typrint (t->val, f); return;
|
||
case TTSTRUCT: prstruct (t, f); break;
|
||
default: cprint (f, "?");
|
||
}
|
||
}
|
||
|
||
prstruct (t, f)
|
||
type t;
|
||
|
||
{register field *fp;
|
||
static int level;
|
||
|
||
++level;
|
||
if (level > 1) cprint (f, "struct#%d", t);
|
||
else
|
||
{fp = t->val;
|
||
cprint (f, "{");
|
||
while (fp->name != UNDEF)
|
||
{pridn (fp->name, f);
|
||
cprint (f, ":");
|
||
typrint (fp->dtype, f);
|
||
if ((++fp)->name != UNDEF) cprint (f, ",");
|
||
}
|
||
cprint (f, "}");
|
||
}
|
||
--level;
|
||
}
|
||
|
||
pridn (i, f) {;}
|
||
|
||
# endif
|
||
|
||
|