mirror of
https://github.com/PDP-10/its.git
synced 2026-01-17 00:33:22 +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
|
|
|