xref: /csrg-svn/old/dbx/modula-2.c (revision 42683)
121613Sdist /*
238105Sbostic  * Copyright (c) 1983 The Regents of the University of California.
338105Sbostic  * All rights reserved.
438105Sbostic  *
5*42683Sbostic  * %sccs.include.redist.c%
621613Sdist  */
718261Slinton 
816622Ssam #ifndef lint
9*42683Sbostic static char sccsid[] = "@(#)modula-2.c	5.4 (Berkeley) 06/01/90";
1038105Sbostic #endif /* not lint */
1116622Ssam 
1216622Ssam /*
1316622Ssam  * Modula-2 specific symbol routines.
1416622Ssam  */
1516622Ssam 
1616622Ssam #include "defs.h"
1716622Ssam #include "symbols.h"
1816622Ssam #include "modula-2.h"
1916622Ssam #include "languages.h"
2016622Ssam #include "tree.h"
2116622Ssam #include "eval.h"
2216622Ssam #include "mappings.h"
2316622Ssam #include "process.h"
2416622Ssam #include "runtime.h"
2516622Ssam #include "machine.h"
2616622Ssam 
2716622Ssam #ifndef public
2816622Ssam #endif
2916622Ssam 
3016622Ssam private Language mod2;
3116622Ssam private boolean initialized;
3216622Ssam 
3318261Slinton 
3418261Slinton #define ischar(t) ( \
3518261Slinton     (t) == t_char->type or \
3618261Slinton     ((t)->class == RANGE and istypename((t)->type, "char")) \
3718261Slinton )
3818261Slinton 
3916622Ssam /*
4016622Ssam  * Initialize Modula-2 information.
4116622Ssam  */
4216622Ssam 
modula2_init()4316622Ssam public modula2_init ()
4416622Ssam {
4516622Ssam     mod2 = language_define("modula-2", ".mod");
4616622Ssam     language_setop(mod2, L_PRINTDECL, modula2_printdecl);
4716622Ssam     language_setop(mod2, L_PRINTVAL, modula2_printval);
4816622Ssam     language_setop(mod2, L_TYPEMATCH, modula2_typematch);
4916622Ssam     language_setop(mod2, L_BUILDAREF, modula2_buildaref);
5016622Ssam     language_setop(mod2, L_EVALAREF, modula2_evalaref);
5116622Ssam     language_setop(mod2, L_MODINIT, modula2_modinit);
5216622Ssam     language_setop(mod2, L_HASMODULES, modula2_hasmodules);
5316622Ssam     language_setop(mod2, L_PASSADDR, modula2_passaddr);
5416622Ssam     initialized = false;
5516622Ssam }
5616622Ssam 
5716622Ssam /*
5816622Ssam  * Typematch tests if two types are compatible.  The issue
5916622Ssam  * is a bit complicated, so several subfunctions are used for
6016622Ssam  * various kinds of compatibility.
6116622Ssam  */
6216622Ssam 
builtinmatch(t1,t2)6318261Slinton private boolean builtinmatch (t1, t2)
6418261Slinton register Symbol t1, t2;
6518261Slinton {
6618261Slinton     boolean b;
6718261Slinton 
6818261Slinton     b = (boolean) (
6918261Slinton 	(
7018261Slinton 	    t2 == t_int->type and t1->class == RANGE and
7118261Slinton 	    (
7218261Slinton 		istypename(t1->type, "integer") or
7318261Slinton 		istypename(t1->type, "cardinal")
7418261Slinton 	    )
7518261Slinton 	) or (
7618261Slinton 	    t2 == t_char->type and
7718261Slinton 	    t1->class == RANGE and istypename(t1->type, "char")
7818261Slinton 	) or (
7918261Slinton 	    t2 == t_real->type and
8018261Slinton 	    t1->class == RANGE and (
8118261Slinton 		istypename(t1->type, "real") or
8218261Slinton 		istypename(t1->type, "longreal")
8318261Slinton 	    )
8418261Slinton 	) or (
8518261Slinton 	    t2 == t_boolean->type and
8618261Slinton 	    t1->class == RANGE and istypename(t1->type, "boolean")
8718261Slinton 	)
8818261Slinton     );
8918261Slinton     return b;
9018261Slinton }
9118261Slinton 
nilMatch(t1,t2)9216622Ssam private boolean nilMatch (t1, t2)
9316622Ssam register Symbol t1, t2;
9416622Ssam {
9516622Ssam     boolean b;
9616622Ssam 
9716622Ssam     b = (boolean) (
9816622Ssam 	(t1 == t_nil and t2->class == PTR) or
9916622Ssam 	(t1->class == PTR and t2 == t_nil)
10016622Ssam     );
10116622Ssam     return b;
10216622Ssam }
10316622Ssam 
enumMatch(t1,t2)10416622Ssam private boolean enumMatch (t1, t2)
10516622Ssam register Symbol t1, t2;
10616622Ssam {
10716622Ssam     boolean b;
10816622Ssam 
10916622Ssam     b = (boolean) (
11018261Slinton 	(t1->class == SCAL and t2->class == CONST and t2->type == t1) or
11118261Slinton 	(t1->class == CONST and t2->class == SCAL and t1->type == t2)
11216622Ssam     );
11316622Ssam     return b;
11416622Ssam }
11516622Ssam 
openArrayMatch(t1,t2)11616622Ssam private boolean openArrayMatch (t1, t2)
11716622Ssam register Symbol t1, t2;
11816622Ssam {
11916622Ssam     boolean b;
12016622Ssam 
12116622Ssam     b = (boolean) (
12216622Ssam 	(
12333326Sdonn 	    t1->class == OPENARRAY and t1->symvalue.ndims == 1 and
12416622Ssam 	    t2->class == ARRAY and
12516622Ssam 	    compatible(rtype(t2->chain)->type, t_int) and
12616622Ssam 	    compatible(t1->type, t2->type)
12716622Ssam 	) or (
12833326Sdonn 	    t2->class == OPENARRAY and t2->symvalue.ndims == 1 and
12916622Ssam 	    t1->class == ARRAY and
13016622Ssam 	    compatible(rtype(t1->chain)->type, t_int) and
13116622Ssam 	    compatible(t1->type, t2->type)
13216622Ssam 	)
13316622Ssam     );
13416622Ssam     return b;
13516622Ssam }
13616622Ssam 
isConstString(t)13716622Ssam private boolean isConstString (t)
13816622Ssam register Symbol t;
13916622Ssam {
14016622Ssam     boolean b;
14116622Ssam 
14216622Ssam     b = (boolean) (
14316622Ssam 	t->language == primlang and t->class == ARRAY and t->type == t_char
14416622Ssam     );
14516622Ssam     return b;
14616622Ssam }
14716622Ssam 
stringArrayMatch(t1,t2)14816622Ssam private boolean stringArrayMatch (t1, t2)
14916622Ssam register Symbol t1, t2;
15016622Ssam {
15116622Ssam     boolean b;
15216622Ssam 
15316622Ssam     b = (boolean) (
15416622Ssam 	(
15516622Ssam 	    isConstString(t1) and
15616622Ssam 	    t2->class == ARRAY and compatible(t2->type, t_char->type)
15716622Ssam 	) or (
15816622Ssam 	    isConstString(t2) and
15916622Ssam 	    t1->class == ARRAY and compatible(t1->type, t_char->type)
16016622Ssam 	)
16116622Ssam     );
16216622Ssam     return b;
16316622Ssam }
16416622Ssam 
modula2_typematch(type1,type2)16516622Ssam public boolean modula2_typematch (type1, type2)
16616622Ssam Symbol type1, type2;
16716622Ssam {
16818261Slinton     boolean b;
16916622Ssam     Symbol t1, t2, tmp;
17016622Ssam 
17116622Ssam     t1 = rtype(type1);
17216622Ssam     t2 = rtype(type2);
17316622Ssam     if (t1 == t2) {
17416622Ssam 	b = true;
17516622Ssam     } else {
17618261Slinton 	if (t1 == t_char->type or t1 == t_int->type or
17718261Slinton 	    t1 == t_real->type or t1 == t_boolean->type
17818261Slinton 	) {
17916622Ssam 	    tmp = t1;
18016622Ssam 	    t1 = t2;
18116622Ssam 	    t2 = tmp;
18216622Ssam 	}
18316622Ssam 	b = (Boolean) (
18433326Sdonn 	    builtinmatch(t1, t2) or
18518261Slinton 	    nilMatch(t1, t2) or enumMatch(t1, t2) or
18618261Slinton 	    openArrayMatch(t1, t2) or stringArrayMatch(t1, t2)
18716622Ssam 	);
18816622Ssam     }
18916622Ssam     return b;
19016622Ssam }
19116622Ssam 
19216622Ssam /*
19316622Ssam  * Indent n spaces.
19416622Ssam  */
19516622Ssam 
indent(n)19616622Ssam private indent (n)
19716622Ssam int n;
19816622Ssam {
19916622Ssam     if (n > 0) {
20016622Ssam 	printf("%*c", n, ' ');
20116622Ssam     }
20216622Ssam }
20316622Ssam 
modula2_printdecl(s)20416622Ssam public modula2_printdecl (s)
20516622Ssam Symbol s;
20616622Ssam {
20716622Ssam     register Symbol t;
20816622Ssam     Boolean semicolon;
20916622Ssam 
21016622Ssam     semicolon = true;
21116622Ssam     if (s->class == TYPEREF) {
21216622Ssam 	resolveRef(t);
21316622Ssam     }
21416622Ssam     switch (s->class) {
21516622Ssam 	case CONST:
21616622Ssam 	    if (s->type->class == SCAL) {
21718261Slinton 		semicolon = false;
21818261Slinton 		printf("enumeration constant with value ");
21918261Slinton 		eval(s->symvalue.constval);
22018261Slinton 		modula2_printval(s);
22116622Ssam 	    } else {
22216622Ssam 		printf("const %s = ", symname(s));
22318261Slinton 		eval(s->symvalue.constval);
22416622Ssam 		modula2_printval(s);
22516622Ssam 	    }
22616622Ssam 	    break;
22716622Ssam 
22816622Ssam 	case TYPE:
22916622Ssam 	    printf("type %s = ", symname(s));
23016622Ssam 	    printtype(s, s->type, 0);
23116622Ssam 	    break;
23216622Ssam 
23316622Ssam 	case TYPEREF:
23416622Ssam 	    printf("type %s", symname(s));
23516622Ssam 	    break;
23616622Ssam 
23716622Ssam 	case VAR:
23816622Ssam 	    if (isparam(s)) {
23916622Ssam 		printf("(parameter) %s : ", symname(s));
24016622Ssam 	    } else {
24116622Ssam 		printf("var %s : ", symname(s));
24216622Ssam 	    }
24316622Ssam 	    printtype(s, s->type, 0);
24416622Ssam 	    break;
24516622Ssam 
24616622Ssam 	case REF:
24716622Ssam 	    printf("(var parameter) %s : ", symname(s));
24816622Ssam 	    printtype(s, s->type, 0);
24916622Ssam 	    break;
25016622Ssam 
25116622Ssam 	case RANGE:
25216622Ssam 	case ARRAY:
25333326Sdonn 	case OPENARRAY:
25418261Slinton 	case DYNARRAY:
25518261Slinton 	case SUBARRAY:
25616622Ssam 	case RECORD:
25716622Ssam 	case VARNT:
25816622Ssam 	case PTR:
25916622Ssam 	    printtype(s, s, 0);
26016622Ssam 	    semicolon = false;
26116622Ssam 	    break;
26216622Ssam 
26316622Ssam 	case FVAR:
26416622Ssam 	    printf("(function variable) %s : ", symname(s));
26516622Ssam 	    printtype(s, s->type, 0);
26616622Ssam 	    break;
26716622Ssam 
26816622Ssam 	case FIELD:
26916622Ssam 	    printf("(field) %s : ", symname(s));
27016622Ssam 	    printtype(s, s->type, 0);
27116622Ssam 	    break;
27216622Ssam 
27316622Ssam 	case PROC:
27416622Ssam 	    printf("procedure %s", symname(s));
27516622Ssam 	    listparams(s);
27616622Ssam 	    break;
27716622Ssam 
27816622Ssam 	case PROG:
27916622Ssam 	    printf("program %s", symname(s));
28016622Ssam 	    listparams(s);
28116622Ssam 	    break;
28216622Ssam 
28316622Ssam 	case FUNC:
28418261Slinton 	    printf("procedure %s", symname(s));
28516622Ssam 	    listparams(s);
28616622Ssam 	    printf(" : ");
28716622Ssam 	    printtype(s, s->type, 0);
28816622Ssam 	    break;
28916622Ssam 
29016622Ssam 	case MODULE:
29116622Ssam 	    printf("module %s", symname(s));
29216622Ssam 	    break;
29316622Ssam 
29416622Ssam 	default:
29518261Slinton 	    printf("[%s]", classname(s));
29616622Ssam 	    break;
29716622Ssam     }
29816622Ssam     if (semicolon) {
29916622Ssam 	putchar(';');
30016622Ssam     }
30116622Ssam     putchar('\n');
30216622Ssam }
30316622Ssam 
30416622Ssam /*
30516622Ssam  * Recursive whiz-bang procedure to print the type portion
30616622Ssam  * of a declaration.
30716622Ssam  *
30816622Ssam  * The symbol associated with the type is passed to allow
30916622Ssam  * searching for type names without getting "type blah = blah".
31016622Ssam  */
31116622Ssam 
printtype(s,t,n)31216622Ssam private printtype (s, t, n)
31316622Ssam Symbol s;
31416622Ssam Symbol t;
31516622Ssam int n;
31616622Ssam {
31718261Slinton     Symbol tmp;
31818261Slinton     int i;
31916622Ssam 
32016622Ssam     if (t->class == TYPEREF) {
32116622Ssam 	resolveRef(t);
32216622Ssam     }
32316622Ssam     switch (t->class) {
32416622Ssam 	case VAR:
32516622Ssam 	case CONST:
32616622Ssam 	case FUNC:
32716622Ssam 	case PROC:
32816622Ssam 	    panic("printtype: class %s", classname(t));
32916622Ssam 	    break;
33016622Ssam 
33116622Ssam 	case ARRAY:
33216622Ssam 	    printf("array[");
33316622Ssam 	    tmp = t->chain;
33416622Ssam 	    if (tmp != nil) {
33516622Ssam 		for (;;) {
33616622Ssam 		    printtype(tmp, tmp, n);
33716622Ssam 		    tmp = tmp->chain;
33816622Ssam 		    if (tmp == nil) {
33916622Ssam 			break;
34016622Ssam 		    }
34116622Ssam 		    printf(", ");
34216622Ssam 		}
34316622Ssam 	    }
34416622Ssam 	    printf("] of ");
34516622Ssam 	    printtype(t, t->type, n);
34616622Ssam 	    break;
34716622Ssam 
34833326Sdonn 	case OPENARRAY:
34933326Sdonn 	    printf("array of ");
35033326Sdonn 	    for (i = 1; i < t->symvalue.ndims; i++) {
35133326Sdonn 		printf("array of ");
35233326Sdonn 	    }
35333326Sdonn 	    printtype(t, t->type, n);
35433326Sdonn 	    break;
35533326Sdonn 
35618261Slinton 	case DYNARRAY:
35718261Slinton 	    printf("dynarray of ");
35818261Slinton 	    for (i = 1; i < t->symvalue.ndims; i++) {
35918261Slinton 		printf("array of ");
36018261Slinton 	    }
36118261Slinton 	    printtype(t, t->type, n);
36218261Slinton 	    break;
36318261Slinton 
36418261Slinton 	case SUBARRAY:
36518261Slinton 	    printf("subarray of ");
36618261Slinton 	    for (i = 1; i < t->symvalue.ndims; i++) {
36718261Slinton 		printf("array of ");
36818261Slinton 	    }
36918261Slinton 	    printtype(t, t->type, n);
37018261Slinton 	    break;
37118261Slinton 
37216622Ssam 	case RECORD:
37316622Ssam 	    printRecordDecl(t, n);
37416622Ssam 	    break;
37516622Ssam 
37616622Ssam 	case FIELD:
37716622Ssam 	    if (t->chain != nil) {
37816622Ssam 		printtype(t->chain, t->chain, n);
37916622Ssam 	    }
38016622Ssam 	    printf("\t%s : ", symname(t));
38116622Ssam 	    printtype(t, t->type, n);
38216622Ssam 	    printf(";\n");
38316622Ssam 	    break;
38416622Ssam 
38516622Ssam 	case RANGE:
38616622Ssam 	    printRangeDecl(t);
38716622Ssam 	    break;
38816622Ssam 
38916622Ssam 	case PTR:
39016622Ssam 	    printf("pointer to ");
39116622Ssam 	    printtype(t, t->type, n);
39216622Ssam 	    break;
39316622Ssam 
39416622Ssam 	case TYPE:
39516622Ssam 	    if (t->name != nil and ident(t->name)[0] != '\0') {
39616622Ssam 		printname(stdout, t);
39716622Ssam 	    } else {
39816622Ssam 		printtype(t, t->type, n);
39916622Ssam 	    }
40016622Ssam 	    break;
40116622Ssam 
40216622Ssam 	case SCAL:
40316622Ssam 	    printEnumDecl(t, n);
40416622Ssam 	    break;
40516622Ssam 
40616622Ssam 	case SET:
40716622Ssam 	    printf("set of ");
40816622Ssam 	    printtype(t, t->type, n);
40916622Ssam 	    break;
41016622Ssam 
41116622Ssam 	case TYPEREF:
41216622Ssam 	    break;
41316622Ssam 
41418261Slinton 	case FPROC:
41518261Slinton 	case FFUNC:
41618261Slinton 	    printf("procedure");
41718261Slinton 	    break;
41818261Slinton 
41916622Ssam 	default:
42018261Slinton 	    printf("[%s]", classname(t));
42116622Ssam 	    break;
42216622Ssam     }
42316622Ssam }
42416622Ssam 
42516622Ssam /*
42616622Ssam  * Print out a record declaration.
42716622Ssam  */
42816622Ssam 
printRecordDecl(t,n)42916622Ssam private printRecordDecl (t, n)
43016622Ssam Symbol t;
43116622Ssam int n;
43216622Ssam {
43316622Ssam     register Symbol f;
43416622Ssam 
43516622Ssam     if (t->chain == nil) {
43616622Ssam 	printf("record end");
43716622Ssam     } else {
43816622Ssam 	printf("record\n");
43916622Ssam 	for (f = t->chain; f != nil; f = f->chain) {
44016622Ssam 	    indent(n+4);
44116622Ssam 	    printf("%s : ", symname(f));
44216622Ssam 	    printtype(f->type, f->type, n+4);
44316622Ssam 	    printf(";\n");
44416622Ssam 	}
44516622Ssam 	indent(n);
44616622Ssam 	printf("end");
44716622Ssam     }
44816622Ssam }
44916622Ssam 
45016622Ssam /*
45116622Ssam  * Print out the declaration of a range type.
45216622Ssam  */
45316622Ssam 
printRangeDecl(t)45416622Ssam private printRangeDecl (t)
45516622Ssam Symbol t;
45616622Ssam {
45716622Ssam     long r0, r1;
45816622Ssam 
45916622Ssam     r0 = t->symvalue.rangev.lower;
46016622Ssam     r1 = t->symvalue.rangev.upper;
46118261Slinton     if (ischar(t)) {
46216622Ssam 	if (r0 < 0x20 or r0 > 0x7e) {
46316622Ssam 	    printf("%ld..", r0);
46416622Ssam 	} else {
46516622Ssam 	    printf("'%c'..", (char) r0);
46616622Ssam 	}
46716622Ssam 	if (r1 < 0x20 or r1 > 0x7e) {
46816622Ssam 	    printf("\\%lo", r1);
46916622Ssam 	} else {
47016622Ssam 	    printf("'%c'", (char) r1);
47116622Ssam 	}
47216622Ssam     } else if (r0 > 0 and r1 == 0) {
47316622Ssam 	printf("%ld byte real", r0);
47416622Ssam     } else if (r0 >= 0) {
47516622Ssam 	printf("%lu..%lu", r0, r1);
47616622Ssam     } else {
47716622Ssam 	printf("%ld..%ld", r0, r1);
47816622Ssam     }
47916622Ssam }
48016622Ssam 
48116622Ssam /*
48216622Ssam  * Print out an enumeration declaration.
48316622Ssam  */
48416622Ssam 
printEnumDecl(e,n)48516622Ssam private printEnumDecl (e, n)
48616622Ssam Symbol e;
48716622Ssam int n;
48816622Ssam {
48916622Ssam     Symbol t;
49016622Ssam 
49116622Ssam     printf("(");
49216622Ssam     t = e->chain;
49316622Ssam     if (t != nil) {
49416622Ssam 	printf("%s", symname(t));
49516622Ssam 	t = t->chain;
49616622Ssam 	while (t != nil) {
49716622Ssam 	    printf(", %s", symname(t));
49816622Ssam 	    t = t->chain;
49916622Ssam 	}
50016622Ssam     }
50116622Ssam     printf(")");
50216622Ssam }
50316622Ssam 
50416622Ssam /*
50516622Ssam  * List the parameters of a procedure or function.
50616622Ssam  * No attempt is made to combine like types.
50716622Ssam  */
50816622Ssam 
listparams(s)50916622Ssam private listparams (s)
51016622Ssam Symbol s;
51116622Ssam {
51216622Ssam     Symbol t;
51316622Ssam 
51416622Ssam     if (s->chain != nil) {
51516622Ssam 	putchar('(');
51616622Ssam 	for (t = s->chain; t != nil; t = t->chain) {
51716622Ssam 	    switch (t->class) {
51816622Ssam 		case REF:
51916622Ssam 		    printf("var ");
52016622Ssam 		    break;
52116622Ssam 
52216622Ssam 		case FPROC:
52316622Ssam 		case FFUNC:
52416622Ssam 		    printf("procedure ");
52516622Ssam 		    break;
52616622Ssam 
52716622Ssam 		case VAR:
52816622Ssam 		    break;
52916622Ssam 
53016622Ssam 		default:
53116622Ssam 		    panic("unexpected class %d for parameter", t->class);
53216622Ssam 	    }
53316622Ssam 	    printf("%s", symname(t));
53416622Ssam 	    if (s->class == PROG) {
53516622Ssam 		printf(", ");
53616622Ssam 	    } else {
53716622Ssam 		printf(" : ");
53816622Ssam 		printtype(t, t->type, 0);
53916622Ssam 		if (t->chain != nil) {
54016622Ssam 		    printf("; ");
54116622Ssam 		}
54216622Ssam 	    }
54316622Ssam 	}
54416622Ssam 	putchar(')');
54516622Ssam     }
54616622Ssam }
54716622Ssam 
54816622Ssam /*
54918261Slinton  * Test if a pointer type should be treated as a null-terminated string.
55018261Slinton  * The type given is the type that is pointed to.
55118261Slinton  */
55218261Slinton 
isCstring(type)55318261Slinton private boolean isCstring (type)
55418261Slinton Symbol type;
55518261Slinton {
55618261Slinton     boolean b;
55718261Slinton     register Symbol a, t;
55818261Slinton 
55918261Slinton     a = rtype(type);
56018261Slinton     if (a->class == ARRAY) {
56118261Slinton 	t = rtype(a->chain);
56218261Slinton 	b = (boolean) (
56318261Slinton 	    t->class == RANGE and istypename(a->type, "char") and
56418261Slinton 	    (t->symvalue.rangev.upper - t->symvalue.rangev.lower + 1) <= 0
56518261Slinton 	);
56618261Slinton     } else {
56718261Slinton 	b = false;
56818261Slinton     }
56918261Slinton     return b;
57018261Slinton }
57118261Slinton 
57218261Slinton /*
57316622Ssam  * Modula 2 interface to printval.
57416622Ssam  */
57516622Ssam 
modula2_printval(s)57616622Ssam public modula2_printval (s)
57716622Ssam Symbol s;
57816622Ssam {
57916622Ssam     prval(s, size(s));
58016622Ssam }
58116622Ssam 
58216622Ssam /*
58316622Ssam  * Print out the value on the top of the expression stack
58416622Ssam  * in the format for the type of the given symbol, assuming
58516622Ssam  * the size of the object is n bytes.
58616622Ssam  */
58716622Ssam 
prval(s,n)58816622Ssam private prval (s, n)
58916622Ssam Symbol s;
59016622Ssam integer n;
59116622Ssam {
59216622Ssam     Symbol t;
59316622Ssam     Address a;
59416622Ssam     integer len;
59516622Ssam     double r;
59618261Slinton     integer i;
59716622Ssam 
59816622Ssam     if (s->class == TYPEREF) {
59916622Ssam 	resolveRef(s);
60016622Ssam     }
60116622Ssam     switch (s->class) {
60216622Ssam 	case CONST:
60316622Ssam 	case TYPE:
60418261Slinton 	case REF:
60516622Ssam 	case VAR:
60616622Ssam 	case FVAR:
60716622Ssam 	case TAG:
60816622Ssam 	    prval(s->type, n);
60916622Ssam 	    break;
61016622Ssam 
61118261Slinton 	case FIELD:
61218261Slinton 	    if (isbitfield(s)) {
61333326Sdonn 		i = extractField(s);
61418261Slinton 		t = rtype(s->type);
61518261Slinton 		if (t->class == SCAL) {
61618261Slinton 		    printEnum(i, t);
61718261Slinton 		} else {
61818261Slinton 		    printRangeVal(i, t);
61918261Slinton 		}
62018261Slinton 	    } else {
62118261Slinton 		prval(s->type, n);
62218261Slinton 	    }
62318261Slinton 	    break;
62418261Slinton 
62516622Ssam 	case ARRAY:
62616622Ssam 	    t = rtype(s->type);
62718261Slinton 	    if (ischar(t)) {
62816622Ssam 		len = size(s);
62916622Ssam 		sp -= len;
63018261Slinton 		printf("\"%.*s\"", len, sp);
63116622Ssam 		break;
63216622Ssam 	    } else {
63316622Ssam 		printarray(s);
63416622Ssam 	    }
63516622Ssam 	    break;
63616622Ssam 
63733326Sdonn 	case OPENARRAY:
63818261Slinton 	case DYNARRAY:
63918261Slinton 	    printDynarray(s);
64018261Slinton 	    break;
64118261Slinton 
64218261Slinton 	case SUBARRAY:
64318261Slinton 	    printSubarray(s);
64418261Slinton 	    break;
64518261Slinton 
64616622Ssam 	case RECORD:
64716622Ssam 	    printrecord(s);
64816622Ssam 	    break;
64916622Ssam 
65016622Ssam 	case VARNT:
65118261Slinton 	    printf("[variant]");
65216622Ssam 	    break;
65316622Ssam 
65416622Ssam 	case RANGE:
65516622Ssam 	    printrange(s, n);
65616622Ssam 	    break;
65716622Ssam 
65818261Slinton 	/*
65918261Slinton 	 * Unresolved opaque type.
66018261Slinton 	 * Probably a pointer.
66118261Slinton 	 */
66218261Slinton 	case TYPEREF:
66318261Slinton 	    a = pop(Address);
66418261Slinton 	    printf("@%x", a);
66518261Slinton 	    break;
66618261Slinton 
66716622Ssam 	case FILET:
66818261Slinton 	    a = pop(Address);
66918261Slinton 	    if (a == 0) {
67018261Slinton 		printf("nil");
67118261Slinton 	    } else {
67218261Slinton 		printf("0x%x", a);
67318261Slinton 	    }
67418261Slinton 	    break;
67518261Slinton 
67616622Ssam 	case PTR:
67716622Ssam 	    a = pop(Address);
67816622Ssam 	    if (a == 0) {
67916622Ssam 		printf("nil");
68018261Slinton 	    } else if (isCstring(s->type)) {
68118261Slinton 		printString(a, true);
68216622Ssam 	    } else {
68316622Ssam 		printf("0x%x", a);
68416622Ssam 	    }
68516622Ssam 	    break;
68616622Ssam 
68716622Ssam 	case SCAL:
68818261Slinton 	    i = 0;
68918261Slinton 	    popn(n, &i);
69018261Slinton 	    printEnum(i, s);
69116622Ssam 	    break;
69216622Ssam 
69316622Ssam 	case FPROC:
69416622Ssam 	case FFUNC:
69516622Ssam 	    a = pop(long);
69616622Ssam 	    t = whatblock(a);
69716622Ssam 	    if (t == nil) {
69818261Slinton 		printf("0x%x", a);
69916622Ssam 	    } else {
70018261Slinton 		printname(stdout, t);
70116622Ssam 	    }
70216622Ssam 	    break;
70316622Ssam 
70416622Ssam 	case SET:
70516622Ssam 	    printSet(s);
70616622Ssam 	    break;
70716622Ssam 
70816622Ssam 	default:
70916622Ssam 	    if (ord(s->class) < ord(BADUSE) or ord(s->class) > ord(TYPEREF)) {
71016622Ssam 		panic("printval: bad class %d", ord(s->class));
71116622Ssam 	    }
71216622Ssam 	    printf("[%s]", classname(s));
71316622Ssam 	    break;
71416622Ssam     }
71516622Ssam }
71616622Ssam 
71716622Ssam /*
71818261Slinton  * Print out a dynamic array.
71918261Slinton  */
72018261Slinton 
72118261Slinton private Address printDynSlice();
72218261Slinton 
printDynarray(t)72318261Slinton private printDynarray (t)
72418261Slinton Symbol t;
72518261Slinton {
72618261Slinton     Address base;
72718261Slinton     integer n;
72818261Slinton     Stack *savesp, *newsp;
72918261Slinton     Symbol eltype;
73018261Slinton 
73118261Slinton     savesp = sp;
73218261Slinton     sp -= (t->symvalue.ndims * sizeof(Word));
73318261Slinton     base = pop(Address);
73418261Slinton     newsp = sp;
73518261Slinton     sp = savesp;
73618261Slinton     eltype = rtype(t->type);
73718261Slinton     if (t->symvalue.ndims == 0) {
73818261Slinton 	if (ischar(eltype)) {
73918261Slinton 	    printString(base, true);
74018261Slinton 	} else {
74118261Slinton 	    printf("[dynarray @nocount]");
74218261Slinton 	}
74318261Slinton     } else {
74418261Slinton 	n = ((long *) sp)[-(t->symvalue.ndims)];
74518261Slinton 	base = printDynSlice(base, n, t->symvalue.ndims, eltype, size(eltype));
74618261Slinton     }
74718261Slinton     sp = newsp;
74818261Slinton }
74918261Slinton 
75018261Slinton /*
75118261Slinton  * Print out one dimension of a multi-dimension dynamic array.
75218261Slinton  *
75318261Slinton  * Return the address of the element that follows the printed elements.
75418261Slinton  */
75518261Slinton 
printDynSlice(base,count,ndims,eltype,elsize)75618261Slinton private Address printDynSlice (base, count, ndims, eltype, elsize)
75718261Slinton Address base;
75818261Slinton integer count, ndims;
75918261Slinton Symbol eltype;
76018261Slinton integer elsize;
76118261Slinton {
76218261Slinton     Address b;
76318261Slinton     integer i, n;
76418261Slinton     char *slice;
76518261Slinton     Stack *savesp;
76618261Slinton 
76718261Slinton     b = base;
76818261Slinton     if (ndims > 1) {
76918261Slinton 	n = ((long *) sp)[-ndims + 1];
77018261Slinton     }
77118261Slinton     if (ndims == 1 and ischar(eltype)) {
77218261Slinton 	slice = newarr(char, count);
77318261Slinton 	dread(slice, b, count);
77418261Slinton 	printf("\"%.*s\"", count, slice);
77518261Slinton 	dispose(slice);
77618261Slinton 	b += count;
77718261Slinton     } else {
77818261Slinton 	printf("(");
77918261Slinton 	for (i = 0; i < count; i++) {
78018261Slinton 	    if (i != 0) {
78118261Slinton 		printf(", ");
78218261Slinton 	    }
78318261Slinton 	    if (ndims == 1) {
78418261Slinton 		slice = newarr(char, elsize);
78518261Slinton 		dread(slice, b, elsize);
78618261Slinton 		savesp = sp;
78718261Slinton 		sp = slice + elsize;
78818261Slinton 		printval(eltype);
78918261Slinton 		sp = savesp;
79018261Slinton 		dispose(slice);
79118261Slinton 		b += elsize;
79218261Slinton 	    } else {
79318261Slinton 		b = printDynSlice(b, n, ndims - 1, eltype, elsize);
79418261Slinton 	    }
79518261Slinton 	}
79618261Slinton 	printf(")");
79718261Slinton     }
79818261Slinton     return b;
79918261Slinton }
80018261Slinton 
printSubarray(t)80118261Slinton private printSubarray (t)
80218261Slinton Symbol t;
80318261Slinton {
80418261Slinton     printf("[subarray]");
80518261Slinton }
80618261Slinton 
80718261Slinton /*
80816622Ssam  * Print out the value of a scalar (non-enumeration) type.
80916622Ssam  */
81016622Ssam 
printrange(s,n)81116622Ssam private printrange (s, n)
81216622Ssam Symbol s;
81316622Ssam integer n;
81416622Ssam {
81516622Ssam     double d;
81616622Ssam     float f;
81716622Ssam     integer i;
81816622Ssam 
81916622Ssam     if (s->symvalue.rangev.upper == 0 and s->symvalue.rangev.lower > 0) {
82016622Ssam 	if (n == sizeof(float)) {
82116622Ssam 	    popn(n, &f);
82216622Ssam 	    d = f;
82316622Ssam 	} else {
82416622Ssam 	    popn(n, &d);
82516622Ssam 	}
82616622Ssam 	prtreal(d);
82716622Ssam     } else {
82816622Ssam 	i = 0;
82916622Ssam 	popn(n, &i);
83018261Slinton 	printRangeVal(i, s);
83116622Ssam     }
83216622Ssam }
83316622Ssam 
83416622Ssam /*
83516622Ssam  * Print out a set.
83616622Ssam  */
83716622Ssam 
printSet(s)83816622Ssam private printSet (s)
83916622Ssam Symbol s;
84016622Ssam {
84116622Ssam     Symbol t;
84216622Ssam     integer nbytes;
84316622Ssam 
84416622Ssam     nbytes = size(s);
84516622Ssam     t = rtype(s->type);
84616622Ssam     printf("{");
84716622Ssam     sp -= nbytes;
84816622Ssam     if (t->class == SCAL) {
84916622Ssam 	printSetOfEnum(t);
85016622Ssam     } else if (t->class == RANGE) {
85116622Ssam 	printSetOfRange(t);
85216622Ssam     } else {
85316622Ssam 	panic("expected range or enumerated base type for set");
85416622Ssam     }
85516622Ssam     printf("}");
85616622Ssam }
85716622Ssam 
85816622Ssam /*
85916622Ssam  * Print out a set of an enumeration.
86016622Ssam  */
86116622Ssam 
printSetOfEnum(t)86216622Ssam private printSetOfEnum (t)
86316622Ssam Symbol t;
86416622Ssam {
86516622Ssam     register Symbol e;
86616622Ssam     register integer i, j, *p;
86716622Ssam     boolean first;
86816622Ssam 
86916622Ssam     p = (int *) sp;
87016622Ssam     i = *p;
87116622Ssam     j = 0;
87216622Ssam     e = t->chain;
87316622Ssam     first = true;
87416622Ssam     while (e != nil) {
87516622Ssam 	if ((i&1) == 1) {
87616622Ssam 	    if (first) {
87716622Ssam 		first = false;
87816622Ssam 		printf("%s", symname(e));
87916622Ssam 	    } else {
88016622Ssam 		printf(", %s", symname(e));
88116622Ssam 	    }
88216622Ssam 	}
88316622Ssam 	i >>= 1;
88416622Ssam 	++j;
88516622Ssam 	if (j >= sizeof(integer)*BITSPERBYTE) {
88616622Ssam 	    j = 0;
88716622Ssam 	    ++p;
88816622Ssam 	    i = *p;
88916622Ssam 	}
89016622Ssam 	e = e->chain;
89116622Ssam     }
89216622Ssam }
89316622Ssam 
89416622Ssam /*
89516622Ssam  * Print out a set of a subrange type.
89616622Ssam  */
89716622Ssam 
printSetOfRange(t)89816622Ssam private printSetOfRange (t)
89916622Ssam Symbol t;
90016622Ssam {
90116622Ssam     register integer i, j, *p;
90216622Ssam     long v;
90316622Ssam     boolean first;
90416622Ssam 
90516622Ssam     p = (int *) sp;
90616622Ssam     i = *p;
90716622Ssam     j = 0;
90816622Ssam     v = t->symvalue.rangev.lower;
90916622Ssam     first = true;
91016622Ssam     while (v <= t->symvalue.rangev.upper) {
91116622Ssam 	if ((i&1) == 1) {
91216622Ssam 	    if (first) {
91316622Ssam 		first = false;
91416622Ssam 		printf("%ld", v);
91516622Ssam 	    } else {
91616622Ssam 		printf(", %ld", v);
91716622Ssam 	    }
91816622Ssam 	}
91916622Ssam 	i >>= 1;
92016622Ssam 	++j;
92116622Ssam 	if (j >= sizeof(integer)*BITSPERBYTE) {
92216622Ssam 	    j = 0;
92316622Ssam 	    ++p;
92416622Ssam 	    i = *p;
92516622Ssam 	}
92616622Ssam 	++v;
92716622Ssam     }
92816622Ssam }
92916622Ssam 
93016622Ssam /*
93118261Slinton  * Construct a node for subscripting a dynamic or subarray.
93218261Slinton  * The list of indices is left for processing in evalaref,
93318261Slinton  * unlike normal subscripting in which the list is expanded
93418261Slinton  * across individual INDEX nodes.
93518261Slinton  */
93618261Slinton 
dynref(a,t,slist)93718261Slinton private Node dynref (a, t, slist)
93818261Slinton Node a;
93918261Slinton Symbol t;
94018261Slinton Node slist;
94118261Slinton {
94218261Slinton     Node p, r;
94318261Slinton     integer n;
94418261Slinton 
94518261Slinton     p = slist;
94618261Slinton     n = 0;
94718261Slinton     while (p != nil) {
94818261Slinton 	if (not compatible(p->value.arg[0]->nodetype, t_int)) {
94918261Slinton 	    suberror("subscript \"", p->value.arg[0], "\" is the wrong type");
95018261Slinton 	}
95118261Slinton 	++n;
95218261Slinton 	p = p->value.arg[1];
95318261Slinton     }
95418261Slinton     if (n > t->symvalue.ndims and (t->symvalue.ndims != 0 or n != 1)) {
95518261Slinton 	suberror("too many subscripts for ", a, nil);
95618261Slinton     } else if (n < t->symvalue.ndims) {
95718261Slinton 	suberror("not enough subscripts for ", a, nil);
95818261Slinton     }
95918261Slinton     r = build(O_INDEX, a, slist);
96018261Slinton     r->nodetype = rtype(t->type);
96118261Slinton     return r;
96218261Slinton }
96318261Slinton 
96418261Slinton /*
96516622Ssam  * Construct a node for subscripting.
96616622Ssam  */
96716622Ssam 
modula2_buildaref(a,slist)96816622Ssam public Node modula2_buildaref (a, slist)
96916622Ssam Node a, slist;
97016622Ssam {
97116622Ssam     register Symbol t;
97216622Ssam     register Node p;
97318261Slinton     Symbol eltype;
97416622Ssam     Node esub, r;
97518261Slinton     integer n;
97616622Ssam 
97716622Ssam     t = rtype(a->nodetype);
97833326Sdonn     switch (t->class) {
97933326Sdonn 	case OPENARRAY:
98033326Sdonn 	case DYNARRAY:
98133326Sdonn 	case SUBARRAY:
98233326Sdonn 	    r = dynref(a, t, slist);
98333326Sdonn 	    break;
98433326Sdonn 
98533326Sdonn 	case ARRAY:
98633326Sdonn 	    r = a;
98733326Sdonn 	    eltype = rtype(t->type);
98833326Sdonn 	    p = slist;
98933326Sdonn 	    t = t->chain;
99033326Sdonn 	    while (p != nil and t != nil) {
99133326Sdonn 		esub = p->value.arg[0];
99233326Sdonn 		if (not compatible(rtype(t), rtype(esub->nodetype))) {
99333326Sdonn 		    suberror("subscript \"", esub, "\" is the wrong type");
99433326Sdonn 		}
99533326Sdonn 		r = build(O_INDEX, r, esub);
99633326Sdonn 		r->nodetype = eltype;
99733326Sdonn 		p = p->value.arg[1];
99833326Sdonn 		t = t->chain;
99916622Ssam 	    }
100033326Sdonn 	    if (p != nil) {
100133326Sdonn 		suberror("too many subscripts for ", a, nil);
100233326Sdonn 	    } else if (t != nil) {
100333326Sdonn 		suberror("not enough subscripts for ", a, nil);
100433326Sdonn 	    }
100533326Sdonn 	    break;
100633326Sdonn 
100733326Sdonn 	default:
100833326Sdonn 	    suberror("\"", a, "\" is not an array");
100933326Sdonn 	    break;
101016622Ssam     }
101116622Ssam     return r;
101216622Ssam }
101316622Ssam 
101416622Ssam /*
101518261Slinton  * Subscript usage error reporting.
101618261Slinton  */
101718261Slinton 
suberror(s1,e1,s2)101818261Slinton private suberror (s1, e1, s2)
101918261Slinton String s1, s2;
102018261Slinton Node e1;
102118261Slinton {
102218261Slinton     beginerrmsg();
102318261Slinton     if (s1 != nil) {
102418261Slinton 	fprintf(stderr, s1);
102518261Slinton     }
102618261Slinton     if (e1 != nil) {
102718261Slinton 	prtree(stderr, e1);
102818261Slinton     }
102918261Slinton     if (s2 != nil) {
103018261Slinton 	fprintf(stderr, s2);
103118261Slinton     }
103218261Slinton     enderrmsg();
103318261Slinton }
103418261Slinton 
103518261Slinton /*
103618261Slinton  * Check that a subscript value is in the appropriate range.
103718261Slinton  */
103818261Slinton 
subchk(value,lower,upper)103918261Slinton private subchk (value, lower, upper)
104018261Slinton long value, lower, upper;
104118261Slinton {
104218261Slinton     if (value < lower or value > upper) {
104318261Slinton 	error("subscript value %d out of range [%d..%d]", value, lower, upper);
104418261Slinton     }
104518261Slinton }
104618261Slinton 
104718261Slinton /*
104818261Slinton  * Compute the offset for subscripting a dynamic array.
104918261Slinton  */
105018261Slinton 
getdynoff(ndims,sub)105118261Slinton private getdynoff (ndims, sub)
105218261Slinton integer ndims;
105318261Slinton long *sub;
105418261Slinton {
105518261Slinton     long k, off, *count;
105618261Slinton 
105718261Slinton     count = (long *) sp;
105818261Slinton     off = 0;
105918261Slinton     for (k = 0; k < ndims - 1; k++) {
106018261Slinton 	subchk(sub[k], 0, count[k] - 1);
106118261Slinton 	off += (sub[k] * count[k+1]);
106218261Slinton     }
106318261Slinton     subchk(sub[ndims - 1], 0, count[ndims - 1] - 1);
106418261Slinton     return off + sub[ndims - 1];
106518261Slinton }
106618261Slinton 
106718261Slinton /*
106818261Slinton  * Compute the offset associated with a subarray.
106918261Slinton  */
107018261Slinton 
getsuboff(ndims,sub)107118261Slinton private getsuboff (ndims, sub)
107218261Slinton integer ndims;
107318261Slinton long *sub;
107418261Slinton {
107518261Slinton     long k, off;
107618261Slinton     struct subarrayinfo {
107718261Slinton 	long count;
107818261Slinton 	long mult;
107918261Slinton     } *info;
108018261Slinton 
108118261Slinton     info = (struct subarrayinfo *) sp;
108218261Slinton     off = 0;
108318261Slinton     for (k = 0; k < ndims; k++) {
108418261Slinton 	subchk(sub[k], 0, info[k].count - 1);
108518261Slinton 	off += sub[k] * info[k].mult;
108618261Slinton     }
108718261Slinton     return off;
108818261Slinton }
108918261Slinton 
109018261Slinton /*
109116622Ssam  * Evaluate a subscript index.
109216622Ssam  */
109316622Ssam 
modula2_evalaref(s,base,i)109418261Slinton public modula2_evalaref (s, base, i)
109516622Ssam Symbol s;
109618261Slinton Address base;
109716622Ssam long i;
109816622Ssam {
109918261Slinton     Symbol t;
110018261Slinton     long lb, ub, off;
110118261Slinton     long *sub;
110218261Slinton     Address b;
110316622Ssam 
110418261Slinton     t = rtype(s);
110518261Slinton     if (t->class == ARRAY) {
110618261Slinton 	findbounds(rtype(t->chain), &lb, &ub);
110718261Slinton 	if (i < lb or i > ub) {
110818261Slinton 	    error("subscript %d out of range [%d..%d]", i, lb, ub);
110918261Slinton 	}
111018261Slinton 	push(long, base + (i - lb) * size(t->type));
111133326Sdonn     } else if ((t->class == OPENARRAY or t->class == DYNARRAY) and
111233326Sdonn 	t->symvalue.ndims == 0
111333326Sdonn     ) {
111418261Slinton 	push(long, base + i * size(t->type));
111533326Sdonn     } else if (t->class == OPENARRAY or t->class == DYNARRAY or
111633326Sdonn 	t->class == SUBARRAY
111733326Sdonn     ) {
111818261Slinton 	push(long, i);
111918261Slinton 	sub = (long *) (sp - (t->symvalue.ndims * sizeof(long)));
112018261Slinton 	rpush(base, size(t));
112118261Slinton 	sp -= (t->symvalue.ndims * sizeof(long));
112218261Slinton 	b = pop(Address);
112318261Slinton 	sp += sizeof(Address);
112418261Slinton 	if (t->class == SUBARRAY) {
112518261Slinton 	    off = getsuboff(t->symvalue.ndims, sub);
112618261Slinton 	} else {
112718261Slinton 	    off = getdynoff(t->symvalue.ndims, sub);
112818261Slinton 	}
112918261Slinton 	sp = (Stack *) sub;
113018261Slinton 	push(long, b + off * size(t->type));
113118261Slinton     } else {
113218261Slinton 	error("[internal error: expected array in evalaref]");
113316622Ssam     }
113416622Ssam }
113516622Ssam 
113616622Ssam /*
113716622Ssam  * Initial Modula-2 type information.
113816622Ssam  */
113916622Ssam 
114016622Ssam #define NTYPES 12
114116622Ssam 
114216622Ssam private Symbol inittype[NTYPES + 1];
114316622Ssam 
addType(n,s,lower,upper)114416622Ssam private addType (n, s, lower, upper)
114516622Ssam integer n;
114616622Ssam String s;
114716622Ssam long lower, upper;
114816622Ssam {
114916622Ssam     register Symbol t;
115016622Ssam 
115116622Ssam     if (n > NTYPES) {
115216622Ssam 	panic("initial Modula-2 type number too large for '%s'", s);
115316622Ssam     }
115416622Ssam     t = insert(identname(s, true));
115516622Ssam     t->language = mod2;
115616622Ssam     t->class = TYPE;
115716622Ssam     t->type = newSymbol(nil, 0, RANGE, t, nil);
115816622Ssam     t->type->symvalue.rangev.lower = lower;
115916622Ssam     t->type->symvalue.rangev.upper = upper;
116016622Ssam     t->type->language = mod2;
116116622Ssam     inittype[n] = t;
116216622Ssam }
116316622Ssam 
initModTypes()116416622Ssam private initModTypes ()
116516622Ssam {
116616622Ssam     addType(1, "integer", 0x80000000L, 0x7fffffffL);
116716622Ssam     addType(2, "char", 0L, 255L);
116816622Ssam     addType(3, "boolean", 0L, 1L);
116916622Ssam     addType(4, "unsigned", 0L, 0xffffffffL);
117016622Ssam     addType(5, "real", 4L, 0L);
117116622Ssam     addType(6, "longreal", 8L, 0L);
117216622Ssam     addType(7, "word", 0L, 0xffffffffL);
117316622Ssam     addType(8, "byte", 0L, 255L);
117416622Ssam     addType(9, "address", 0L, 0xffffffffL);
117516622Ssam     addType(10, "file", 0L, 0xffffffffL);
117616622Ssam     addType(11, "process", 0L, 0xffffffffL);
117716622Ssam     addType(12, "cardinal", 0L, 0x7fffffffL);
117816622Ssam }
117916622Ssam 
118016622Ssam /*
118116622Ssam  * Initialize typetable.
118216622Ssam  */
118316622Ssam 
modula2_modinit(typetable)118416622Ssam public modula2_modinit (typetable)
118516622Ssam Symbol typetable[];
118616622Ssam {
118716622Ssam     register integer i;
118816622Ssam 
118916622Ssam     if (not initialized) {
119016622Ssam 	initModTypes();
119118261Slinton 	initialized = true;
119216622Ssam     }
119316622Ssam     for (i = 1; i <= NTYPES; i++) {
119416622Ssam 	typetable[i] = inittype[i];
119516622Ssam     }
119616622Ssam }
119716622Ssam 
modula2_hasmodules()119816622Ssam public boolean modula2_hasmodules ()
119916622Ssam {
120016622Ssam     return true;
120116622Ssam }
120216622Ssam 
modula2_passaddr(param,exprtype)120316622Ssam public boolean modula2_passaddr (param, exprtype)
120416622Ssam Symbol param, exprtype;
120516622Ssam {
120616622Ssam     return false;
120716622Ssam }
1208