* Copyright (c) 1983 Regents of the University of California.
* All rights reserved. The Berkeley software License Agreement
* specifies the terms and conditions for redistribution.
static char sccsid
[] = "@(#)c.c 5.5 (Berkeley) %G%";
static char rcsid
[] = "$Header: c.c,v 1.5 84/12/26 10:38:23 linton Exp $";
* C-dependent symbol routines.
#define isdouble(range) ( \
range->symvalue.rangev.upper == 0 and range->symvalue.rangev.lower > 0 \
#define isrange(t, name) (t->class == RANGE and istypename(t->type, name))
* Initialize C language information.
langC
= language_define("c", ".c");
language_setop(langC
, L_PRINTDECL
, c_printdecl
);
language_setop(langC
, L_PRINTVAL
, c_printval
);
language_setop(langC
, L_TYPEMATCH
, c_typematch
);
language_setop(langC
, L_BUILDAREF
, c_buildaref
);
language_setop(langC
, L_EVALAREF
, c_evalaref
);
language_setop(langC
, L_MODINIT
, c_modinit
);
language_setop(langC
, L_HASMODULES
, c_hasmodules
);
language_setop(langC
, L_PASSADDR
, c_passaddr
);
* Test if two types are compatible.
public Boolean
c_typematch(type1
, type2
)
register Symbol t1
, t2
, tmp
;
if (t1
== t_char
->type
or t1
== t_int
->type
or t1
== t_real
->type
) {
(t2
== t_int
->type
or t2
== t_char
->type
)
(t2
== t_char
->type
or t2
== t_int
->type
)
t1
->class == RANGE
and isdouble(t1
) and t2
== t_real
->type
t1
->class == RANGE
and t2
->class == RANGE
and
t1
->symvalue
.rangev
.lower
== t2
->symvalue
.rangev
.lower
and
t1
->symvalue
.rangev
.upper
== t2
->symvalue
.rangev
.upper
t1
->type
== t2
->type
and (
(t1
->class == t2
->class) or
(t1
->class == SCAL
and t2
->class == CONST
) or
(t1
->class == CONST
and t2
->class == SCAL
)
t1
->class == PTR
and c_typematch(t1
->type
, t_char
) and
t2
->class == ARRAY
and c_typematch(t2
->type
, t_char
) and
* Print out the declaration of a C variable.
private printdecl(s
, indent
)
Boolean semicolon
, newline
;
printf("%*c", indent
, ' ');
if (s
->type
->class == SCAL
) {
printf("enumeration constant with value ");
eval(s
->symvalue
.constval
);
printf("const %s = ", symname(s
));
if (s
->class != TYPE
and s
->level
< 0) {
if (s
->type
->class == ARRAY
) {
printtype(s
->type
, s
->type
->type
, indent
);
t
= rtype(s
->type
->chain
);
assert(t
->class == RANGE
);
printf(" %s[%d]", symname(s
), t
->symvalue
.rangev
.upper
+ 1);
printtype(s
, s
->type
, indent
);
if (s
->type
->class != PTR
) {
printf("%s", symname(s
));
if (s
->type
->class == ARRAY
) {
printtype(s
->type
, s
->type
->type
, indent
);
t
= rtype(s
->type
->chain
);
assert(t
->class == RANGE
);
printf(" %s[%d]", symname(s
), t
->symvalue
.rangev
.upper
+ 1);
printtype(s
, s
->type
, indent
);
if (s
->type
->class != PTR
) {
printf("%s", symname(s
));
printf(" : %d", s
->symvalue
.field
.length
);
error("unexpected missing type information");
printtype(s
, s
->type
, indent
);
printf("(enumeration constant, value %d)", s
->symvalue
.iconval
);
printf("%s", symname(s
));
if (not istypename(s
->type
, "void")) {
printtype(s
, s
->type
, indent
);
printf("%s", symname(s
));
printf("source file \"%s.c\"", symname(s
));
printf("executable file \"%s\"", symname(s
));
printf("[%s]", classname(s
));
* Recursive whiz-bang procedure to print the type portion
* The symbol associated with the type is passed to allow
* searching for type names without getting "type blah = blah".
private printtype(s
, t
, indent
)
panic("printtype: class %s", classname(t
));
printtype(t
, t
->type
, indent
);
printf("%s ", c_classname(t
));
if (s
->name
!= nil
and s
->class == TAG
) {
if (p
[0] == '$' and p
[1] == '$') {
printf("%s {\n", t
->class == RECORD
? "struct" : "union");
for (i
= t
->chain
; i
!= nil
; i
= i
->chain
) {
assert(i
->class == FIELD
);
printf("%*c", indent
, ' ');
r0
= t
->symvalue
.rangev
.lower
;
r1
= t
->symvalue
.rangev
.upper
;
if (istypename(t
->type
, "char")) {
if (r0
< 0x20 or r0
> 0x7e) {
printf("'%c'..", (char) r0
);
if (r1
< 0x20 or r1
> 0x7e) {
printf("'%c'", (char) r1
);
} else if (r0
> 0 and r1
== 0) {
printf("%ld byte real", r0
);
printf("%lu..%lu", r0
, r1
);
printf("%ld..%ld", r0
, r1
);
printtype(t
, t
->type
, indent
);
if (t
->type
->class != PTR
) {
printtype(t
, t
->type
, indent
);
printtype(t
, t
->type
, indent
);
printf("@%s", symname(t
));
if (s
->name
!= nil
and s
->class == TAG
) {
printf("%s ", symname(s
));
printf("%s", symname(i
));
printf("unresolved tag %s", symname(t
));
printf("%s %s", c_classname(i
), symname(t
));
printf("(class %d)", t
->class);
* List the parameters of a procedure or function.
* No attempt is made to combine like types.
for (t
= s
->chain
; t
!= nil
; t
= t
->chain
) {
printf("%s", symname(t
));
for (t
= s
->chain
; t
!= nil
; t
= t
->chain
) {
panic("unexpected class %d for parameter", t
->class);
* Print out the value on the top of the expression stack
* in the format for the type of the given symbol.
if ((t
->class == RANGE
and istypename(t
->type
, "char")) or
str
= (String
) (sp
-= len
);
if (s
->language
!= primlang
) {
while (--len
> 0 and *str
!= '\0') {
if (*str
!= '\0') { /* XXX - pitch trailing null */
if (s
->language
!= primlang
) {
if (s
== t_boolean
->type
or istypename(s
->type
, "boolean")) {
printRangeVal(popsmall(s
), s
);
} else if (s
== t_char
->type
or istypename(s
->type
, "char")) {
printRangeVal(pop(char), s
);
} else if (s
== t_real
->type
or isdouble(s
)) {
switch (s
->symvalue
.rangev
.lower
) {
panic("bad real size %d", t
->symvalue
.rangev
.lower
);
printRangeVal(popsmall(s
), s
);
} else if (t
->class == RANGE
and istypename(t
->type
, "char")) {
printString(a
, (boolean
) (s
->language
!= primlang
));
* Unresolved structure pointers?
if (ord(s
->class) > ord(TYPEREF
)) {
panic("printval: bad class %d", ord(s
->class));
printf("[%s]", c_classname(s
));
* Print out a C structure.
private c_printstruct (s
)
off
= f
->symvalue
.field
.offset
;
len
= f
->symvalue
.field
.length
;
n
= (off
+ len
+ BITSPERBYTE
- 1) div BITSPERBYTE
;
printf("%s = ", symname(f
));
* Return the C name for the particular class of a symbol.
public String
c_classname(s
)
public Node
c_buildaref(a
, slist
)
Symbol etype
, atype
, eltype
;
if (not compatible(p
->nodetype
, t_int
)) {
fprintf(stderr
, "subscript must be integer-compatible");
r
= build(O_MUL
, p
, build(O_LCON
, (long) size(eltype
)));
r
= build(O_ADD
, build(O_RVAL
, a
), r
);
} else if (t
->class != ARRAY
) {
fprintf(stderr
, "\" is not an array");
for (; p
!= nil
and t
!= nil
; p
= p
->value
.arg
[1], t
= t
->chain
) {
etype
= rtype(esub
->nodetype
);
if (not compatible(atype
, etype
)) {
fprintf(stderr
, "subscript \"");
fprintf(stderr
, "\" is the wrong type");
r
= build(O_INDEX
, r
, esub
);
if (p
!= nil
or t
!= nil
) {
fprintf(stderr
, "too many subscripts for \"");
fprintf(stderr
, "not enough subscripts for \"");
* Evaluate a subscript index.
public c_evalaref(s
, base
, i
)
lb
= s
->symvalue
.rangev
.lower
;
ub
= s
->symvalue
.rangev
.upper
;
warning("subscript out of range");
push(long, base
+ (i
- lb
) * size(t
->type
));
* Initialize typetable information.
public c_modinit (typetable
)
public boolean
c_hasmodules ()
public boolean
c_passaddr (param
, exprtype
)
b
= (boolean
) (t
->class == ARRAY
);