/* Copyright (c) 1982 Regents of the University of California */
static char sccsid
[] = "@(#)pascal.c 1.2 %G%";
* Pascal-dependent symbol routines.
* Initialize Pascal information.
lang
= language_define("pascal", ".p");
language_setop(lang
, L_PRINTDECL
, pascal_printdecl
);
language_setop(lang
, L_PRINTVAL
, pascal_printval
);
language_setop(lang
, L_TYPEMATCH
, pascal_typematch
);
* Compatible tests if two types are compatible. The issue
* is complicated a bit by ranges.
* Integers and reals are not compatible since they cannot always be mixed.
public Boolean
pascal_typematch(type1
, type2
)
(t1
->type
== t2
->type
and (
(t1
->class == RANGE
and t2
->class == RANGE
) or
(t1
->class == SCAL
and t2
->class == CONST
) or
(t1
->class == CONST
and t2
->class == SCAL
) or
(t1
->type
== t_char
and t1
->class == ARRAY
and t2
->class == ARRAY
)
(t1
== t_nil
and t2
->class == PTR
) or
(t1
->class == PTR
and t2
== t_nil
)
public pascal_printdecl(s
)
if (s
->type
->class == SCAL
) {
printf("(enumeration constant, ord %ld)",
printf("const %s = ", symname(s
));
printf("type %s = ", symname(s
));
printf("(parameter) %s : ", symname(s
));
printf("var %s : ", symname(s
));
printf("(var parameter) %s : ", symname(s
));
printf("(function variable) %s : ", symname(s
));
printf("(field) %s : ", symname(s
));
printf("procedure %s", symname(s
));
printf("program %s", symname(s
));
printf("(%s", symname(t
));
for (t
= t
->chain
; t
!= nil
; t
= t
->chain
) {
printf(", %s", symname(t
));
printf("function %s", symname(s
));
error("class %s in printdecl", classname(s
));
* Recursive whiz-bang procedure to print the type portion
* of a declaration. Doesn't work quite right for variant records.
* The symbol associated with the type is passed to allow
* searching for type names without getting "type blah = blah".
panic("printtype: class %s", classname(t
));
printtype(t
->chain
, t
->chain
);
printtype(t
->chain
, t
->chain
);
printf("\t%s : ", symname(t
));
r0
= t
->symvalue
.rangev
.lower
;
r1
= t
->symvalue
.rangev
.upper
;
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
);
printf("%s", symname(t
));
printf("%s", symname(t
));
printf(", %s", symname(t
));
panic("empty enumeration");
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
) {
panic("unexpected class %d for parameter", t
->class);
printf("%s : ", symname(t
));
* Print out the value on the top of the expression stack
* in the format for the type of the given symbol.
public pascal_printval(s
)
pascal_printval(s
->type
);
if (t
==t_char
or (t
->class==RANGE
and t
->type
==t_char
)) {
printf("'%.*s'", len
, sp
);
error("can't print out variant records");
printf(((Boolean
) popsmall(s
)) == true ? "true" : "false");
} else if (s
== t_char
) {
printf("'%c'", pop(char));
} else if (s
->symvalue
.rangev
.upper
== 0 and
s
->symvalue
.rangev
.lower
> 0) {
switch (s
->symvalue
.rangev
.lower
) {
panic("bad real size %d", s
->symvalue
.rangev
.lower
);
} else if (s
->symvalue
.rangev
.lower
>= 0) {
printf("%lu", popsmall(s
));
printf("%ld", popsmall(s
));
printf("0x%x, 0%o", addr
, addr
);
error("missing record specification");
for (t
= s
->chain
; t
!= nil
; t
= t
->chain
) {
if (t
->symvalue
.iconval
== scalar
) {
printf("%s", symname(t
));
printf("(scalar = %d)", scalar
);
a
= fparamaddr(pop(long));
printf("%s", symname(t
));
if (ord(s
->class) < ord(BADUSE
) or ord(s
->class) > ord(TYPEREF
)) {
panic("printval: bad class %d", ord(s
->class));
error("don't know how to print a %s", classname(s
));