1: %{
2: #ifndef lint
3: static char RCSid[] = "$Header: courier.y,v 2.0 85/11/21 07:21:35 jqj Exp $";
4: #endif
5:
6: /* $Log: courier.y,v $
7: * Revision 2.0 85/11/21 07:21:35 jqj
8: * 4.3BSD standard release
9: *
10: * Revision 1.1 85/11/20 12:58:22 jqj
11: * Initial revision
12: *
13: * Revision 1.6 85/05/23 06:19:42 jqj
14: * Public Beta-test version, released 24 May 1985
15: *
16: * Revision 1.5 85/05/06 08:13:14 jqj
17: * Almost Beta-test version.
18: *
19: * Revision 1.4 85/03/26 06:09:49 jqj
20: * Revised public alpha-test version, released 26 March 1985
21: *
22: * Revision 1.3 85/03/11 16:39:15 jqj
23: * Public alpha-test version, released 11 March 1985
24: *
25: * Revision 1.2 85/02/21 11:05:07 jqj
26: * alpha test version
27: *
28: * Revision 1.1 85/02/15 13:53:01 jqj
29: * Initial revision
30: *
31: */
32:
33: #include "compiler.h"
34:
35: static char *currentdecl;
36: static char streamdecl;
37: %}
38:
39: %token
40: identifier number string
41:
42: %token
43: ARRAY _BEGIN BOOLEAN CARDINAL
44: CHOICE DEPENDS END ERROR
45: INTEGER LONG OF PROCEDURE
46: PROGRAM RECORD REPORTS RETURNS
47: SEQUENCE STRING TYPE UNSPECIFIED
48: UPON VERSION TRUE FALSE
49: _CHOOSES
50:
51: %union {
52: struct type *type;
53: struct constant *constant;
54: list list;
55: char *stringvalue;
56: }
57:
58: %type <type>
59: ConstructedType
60: DesignatorType
61: PredefinedType
62: ReferencedType
63: Type
64:
65: %type <constant>
66: ReferencedConstant
67: Constant
68: PredefinedConstant
69: ConstructedConstant
70:
71: %type <list>
72: ArgumentList Candidate CandidateList
73: Correspondence CorrespondenceList Designator
74: DesignatorList ErrorList Field
75: FieldList NameList ResultList
76: Component ReferencedProgramList ElementList
77: ComponentList TypedCandidate TypedCandidateList
78: TypedDesignator TypedDesignatorList CNameList
79:
80: %type <stringvalue>
81: NumericValue MaximumNumber
82: ReferencedProgram
83: identifier number string
84:
85: %start Program
86: %%
87:
88: Program :
89: ProgramHeader ProgramBody
90: {
91: wrapup_program($1);
92: }
93: ;
94:
95: ProgramHeader :
96: identifier ':' PROGRAM number VERSION number '='
97: {
98: program_header($1,$4,$6);
99: $$ = $1;
100: }
101: ;
102:
103: ProgramBody :
104: _BEGIN DependencyList DeclarationList END '.'
105: ;
106:
107: DependencyList :
108: /* empty */
109: {
110: program_body();
111: }
112: | DEPENDS UPON ReferencedProgramList ';'
113: {
114: program_body();
115: }
116: ;
117:
118: ReferencedProgramList :
119: ReferencedProgram
120: {
121: }
122: | ReferencedProgramList ',' ReferencedProgram
123: {
124: }
125: ;
126:
127: ReferencedProgram :
128: identifier '(' number ')' VERSION number
129: {
130: /* as a side effect, the program is entered into the */
131: /* list of dependencies */
132: ref_program($1,$3,$6);
133: $$ = $1;
134: }
135: ;
136:
137: DeclarationList :
138: /* empty */
139: | DeclarationList Declaration
140: ;
141:
142: Declaration :
143: Target TypeDeclaration
144: | Target ConstantDeclaration
145: | error ';'
146: {
147: fprintf(stderr,"\t\t\tDeclaration skipped\n");
148: }
149: ;
150:
151: Target :
152: identifier ':'
153: {
154: struct object *symbol;
155:
156: currentdecl = $1;
157: streamdecl = 0; /* not parsing a StreamOf yet */
158: if (symbol = check_def(currentdecl, CurrentProgram)) {
159: error(ERROR,
160: "Attempt to redefine ``%s''",
161: name_of(symbol));
162: YYERROR;
163: }
164: }
165: ;
166:
167: TypeDeclaration :
168: TYPE '=' Type ';'
169: {
170: struct object *symbol;
171:
172: symbol = make_symbol(currentdecl, CurrentProgram);
173: define_type(symbol, $3);
174: }
175: ;
176:
177: ConstantDeclaration :
178: Type '=' Constant ';'
179: {
180: struct object *symbol;
181:
182: symbol = make_symbol(currentdecl, CurrentProgram);
183: if (type_check($1, $3)) {
184: define_constant(symbol, $1, $3);
185: } else
186: error(ERROR,
187: "Type clash in declaration of ``%s''",
188: name_of(symbol));
189: }
190: ;
191:
192: Type :
193: PredefinedType
194: {
195: $$ = $1;
196: }
197: | ConstructedType
198: {
199: $$ = $1;
200: }
201: | ReferencedType
202: {
203: $$ = $1;
204: }
205: ;
206:
207: Constant :
208: PredefinedConstant
209: {
210: $$ = $1;
211: }
212: |
213: ConstructedConstant
214: {
215: $$ = $1;
216: }
217: |
218: ReferencedConstant
219: {
220: $$ = $1;
221: }
222: ;
223:
224:
225: PredefinedType :
226: BOOLEAN
227: {
228: $$ = Boolean_type;
229: }
230: | CARDINAL
231: {
232: $$ = Cardinal_type;
233: }
234: | LONG CARDINAL
235: {
236: $$ = LongCardinal_type;
237: }
238: | INTEGER
239: {
240: $$ = Integer_type;
241: }
242: | LONG INTEGER
243: {
244: $$ = LongInteger_type;
245: }
246: | STRING
247: {
248: $$ = String_type;
249: }
250: | UNSPECIFIED
251: {
252: $$ = Unspecified_type;
253: }
254: | LONG UNSPECIFIED
255: {
256: $$ = LongUnspecified_type;
257: }
258: ;
259:
260: PredefinedConstant :
261: TRUE
262: {
263: $$ = Boolean_constant("1");
264: }
265: |
266: FALSE
267: {
268: $$ = Boolean_constant("0");
269: }
270: |
271: number
272: {
273: $$ = Numeric_constant($1);
274: }
275: |
276: string
277: {
278: $$ = String_constant($1);
279: }
280: ;
281:
282: ConstructedConstant :
283: /* simple ReferencedConstant */
284: identifier
285: {
286: struct object *sym;
287:
288: if (sym = check_def($1,(char *)NULL)) {
289: if (class_of(sym) == O_ENUMTAG)
290: $$ = enumeration_constant(sym->o_enum->en_name);
291: else if (class_of(sym) == O_CONSTANT &&
292: sym->o_constant->cn_constr == C_ENUMERATION)
293: $$ = sym->o_constant;
294: else {
295: error(ERROR,
296: "``%s'' is not of appropriate type",
297: name_of(sym));
298: YYERROR;
299: }
300: } else if (sym = check_def($1, CurrentProgram)) {
301: if (class_of(sym) == O_CONSTANT)
302: $$ = sym->o_constant;
303: else {
304: error(ERROR,
305: "``%s'' is not of appropriate type",
306: name_of(sym));
307: YYERROR;
308: }
309: } else {
310: error(ERROR,"``%s'' is not defined",
311: $1);
312: YYERROR;
313: }
314: }
315: |
316: /* SequenceConstant */
317: /* ArrayConstant */
318: '[' ElementList ']'
319: {
320: $$ = array_constant($2);
321: }
322: |
323: /* RecordConstant */
324: '[' ComponentList ']'
325: {
326: $$ = record_constant($2);
327: }
328: |
329: /* RecordConstant */
330: /* SequenceConstant */
331: /* ArrayConstant */
332: '[' ']'
333: {
334: $$ = record_constant(NIL);
335: }
336: |
337: /* ChoiceConstant */
338: identifier Constant
339: {
340: struct object* symbol;
341:
342: if ((symbol = check_def($1,(char *)NULL)) ||
343: (symbol = check_def($1,CurrentProgram))) {
344: if (class_of(symbol) == O_CONSTANT &&
345: symbol->o_constant->cn_constr == C_ENUMERATION) {
346: $$ = choice_constant(
347: cons((list) symbol->o_constant->cn_value,
348: (list) $2) );
349: }
350: else if (class_of(symbol) == O_ENUMTAG) {
351: $$ = choice_constant(
352: cons((list) symbol->o_enum->en_name,
353: (list) $2) );
354: }
355: else {
356: error(ERROR, "Expected enumeration constant but got ``%s''\n",
357: name_of(symbol));
358: YYERROR;
359: }
360: }
361: else {
362: error(ERROR, "Designator ``%s'' undefined\n",
363: $1);
364: YYERROR;
365: }
366: }
367: ;
368:
369:
370: ElementList :
371: Constant
372: {
373: $$ = cons((list) $1, NIL);
374:
375: }
376: |
377: Constant ',' ElementList
378: {
379: $$ = cons((list)$1, $3);
380: }
381: ;
382:
383: ComponentList :
384: Component
385: {
386: $$ = $1;
387: }
388: |
389: Component ',' ComponentList
390: {
391: /* flatten */
392: cdr($1) = $3;
393: $$ = $1;
394: }
395: ;
396:
397: Component :
398: CNameList ':' Constant
399: {
400: list p;
401:
402: /* flatten this for simplicity of representation */
403: for (p = $1; p != NIL; p = cdr(p))
404: car(p) = cons(car(p),(list)$3);
405: $$ = $1;
406: }
407: ;
408:
409: CNameList :
410: identifier
411: {
412: /* note that CNameList now is a list of strings */
413: $$ = cons((list) $1, NIL);
414: }
415: | identifier ',' CNameList
416: {
417: /* note that NameList now is a list of strings */
418: $$ = cons(cons((list)$1, NIL), $3);
419: }
420: ;
421:
422: ConstructedType :
423: '{' CorrespondenceList '}'
424: {
425: $$ = enumeration_type($2);
426: }
427: | ARRAY NumericValue OF Type
428: {
429: $$ = array_type($2, $4);
430: }
431: | SEQUENCE MaximumNumber OF Type
432: {
433: $$ = sequence_type($2, $4);
434: }
435: | RECORD ArgumentList
436: {
437: $$ = record_type($2);
438: }
439: | CHOICE DesignatorType OF '{' TypedCandidateList '}'
440: {
441: $$ = choice_type($2, $5);
442: }
443: | CHOICE OF '{' CandidateList '}'
444: {
445: if (streamdecl > 0) {
446: $$ = choice_type(StreamEnum_type, $4);
447: }
448: /* as side effect build an anonymous enumerated type */
449: else
450: $$ = choice_type((struct type *) NIL, $4);
451: }
452: | PROCEDURE ArgumentList ResultList ErrorList
453: {
454: $$ = procedure_type($2, $3, $4);
455: }
456: | ERROR ArgumentList
457: {
458: $$ = error_type( $2);
459: }
460: ;
461:
462: ReferencedType :
463: identifier
464: {
465: struct object *symbol;
466:
467: if (symbol = check_def($1,CurrentProgram)) {
468: if (class_of(symbol) == O_TYPE)
469: $$ = symbol->o_type;
470: else {
471: error(ERROR,"``%s'' is not a type",
472: name_of(symbol));
473: YYERROR;
474: }
475: }
476: else if (streq($1,currentdecl)) {
477: if (strncmp(currentdecl,"StreamOf",8) == 0) {
478: streamdecl++;
479: error(WARNING,
480: "Stream definition of ``%s'';\n\
481: \t\t\trecursion treated as Nil record",
482: $1);
483: $$ = record_type(NIL);
484: } else {
485: /* fake it */
486: $$ = enumeration_type(NIL);
487: $$->type_name = make_full_name(
488: CurrentProgram, CurrentVersion,
489: currentdecl);
490: }
491: }
492: else {
493: error(ERROR,"``%s'' is unrecognized", $1);
494: YYERROR;
495: }
496: }
497: | identifier '.' identifier
498: {
499: struct object *symbol;
500:
501: if (check_dependency($1) &&
502: (symbol = check_def($3,$1))) {
503: if (class_of(symbol) == O_TYPE)
504: $$ = symbol->o_type;
505: else {
506: error(ERROR,"``%s'' is not a type",
507: name_of(symbol));
508: YYERROR;
509: }
510: }
511: else {
512: error(ERROR,"``%s.%s'' is unrecognized",$1,$3);
513: YYERROR;
514: }
515: }
516: ;
517:
518: CorrespondenceList :
519: Correspondence
520: {
521: $$ = cons($1, NIL);
522: }
523: | CorrespondenceList ',' Correspondence
524: {
525: $$ = nconc($1, cons($3, NIL));
526: }
527: ;
528:
529: Correspondence :
530: identifier '(' NumericValue ')'
531: {
532: struct object *symbol;
533: char *newid;
534:
535: if (!(symbol = check_def($1,(char *)NULL))) {
536: symbol = make_symbol($1,(char *)NULL);
537: define_enumeration_symbol(symbol,$3);
538: }
539: else if (class_of(symbol) != O_ENUMTAG) {
540: error(ERROR,"``%s'' already defined",
541: name_of(symbol));
542: YYERROR;
543: }
544: else if ((streq($1,"nextSegment") &&
545: stringtocard($3) == 0) ||
546: (streq($1,"lastSegment") &&
547: stringtocard($3) == 1)) {
548: /* do nothing */
549: streamdecl++;
550: }
551: else /*
552: * if (symbol->o_enum->en_value!=stringtocard($3))
553: */ {
554: newid = gensym($1);
555: error(WARNING,
556: "Enumerator ``%s'' already declared;\n\
557: \t\t\tusing name ``%s'' instead",
558: $1,newid);
559: symbol = make_symbol(newid,(char *)NULL);
560: define_enumeration_symbol(symbol,$3);
561: }
562: $$ = cons((list) symbol, (list) $3);
563: }
564: ;
565:
566: MaximumNumber :
567: NumericValue
568: {
569: $$ = $1;
570: }
571: | /* empty */
572: {
573: $$ = "65535"; /* maximum Cardinal */
574: }
575: ;
576:
577: NumericValue :
578: number
579: {
580: $$ = $1;
581: }
582: | ReferencedConstant
583: {
584: if (($1)->cn_constr != C_NUMERIC) {
585: error(ERROR,"Expected numeric constant");
586: YYERROR;
587: }
588: $$ = ($1)->cn_value;
589: }
590: ;
591:
592: DesignatorType :
593: ReferencedType
594: {
595: $$ = $1;
596: }
597: ;
598:
599: TypedCandidateList :
600: TypedCandidate
601: {
602: $$ = cons($1, NIL);
603: }
604: | TypedCandidateList ',' TypedCandidate
605: {
606: $$ = nconc($1, cons($3, NIL));
607: }
608: ;
609:
610: TypedCandidate :
611: TypedDesignatorList _CHOOSES Type
612: {
613: $$ = cons($1, (list) $3);
614: }
615: ;
616:
617: TypedDesignatorList :
618: TypedDesignator
619: {
620: $$ = cons($1, NIL);
621: }
622: | TypedDesignatorList ',' TypedDesignator
623: {
624: $$ = nconc($1, cons($3, NIL));
625: }
626: ;
627:
628: TypedDesignator :
629: identifier
630: {
631: struct object *symbol;
632:
633: if ((symbol = check_def($1,CurrentProgram)) &&
634: symbol->o_constant->cn_constr == C_ENUMERATION) {
635: $1 = symbol->o_constant->cn_value;
636: }
637: if ((symbol = check_def($1,(char *)NULL)) &&
638: class_of(symbol) == O_ENUMTAG)
639: $$ = cons((list) symbol, NIL);
640: else {
641: error(ERROR,"Designator ``%s'' is not of appropriate type",
642: $1);
643: YYERROR;
644: }
645: }
646: ;
647:
648: CandidateList :
649: Candidate
650: {
651: $$ = cons($1, NIL);
652: }
653: | CandidateList ',' Candidate
654: {
655: $$ = nconc($1, cons($3, NIL));
656: }
657: ;
658:
659: Candidate :
660: DesignatorList _CHOOSES Type
661: {
662: $$ = cons($1, (list) $3);
663: }
664: ;
665:
666: DesignatorList :
667: Designator
668: {
669: $$ = cons($1, NIL);
670: }
671: | DesignatorList ',' Designator
672: {
673: $$ = nconc($1, cons($3, NIL));
674: }
675: ;
676:
677: Designator :
678: Correspondence
679: {
680: $$ = $1;
681: }
682: ;
683:
684: ResultList :
685: /* empty */
686: {
687: $$ = NIL;
688: }
689: | RETURNS '[' FieldList ']'
690: {
691: $$ = $3;
692: }
693: ;
694:
695: ArgumentList :
696: /* empty */
697: {
698: $$ = NIL;
699: }
700: | '[' ']'
701: {
702: $$ = NIL;
703: }
704: | '[' FieldList ']'
705: {
706: $$ = $2;
707: }
708: ;
709:
710: ErrorList :
711: /* empty */
712: {
713: $$ = NIL;
714: }
715: | REPORTS '[' NameList ']'
716: {
717: $$ = $3;
718: }
719: ;
720:
721: FieldList :
722: Field
723: {
724: $$ = $1;
725: }
726: | FieldList ',' Field
727: {
728: $$ = nconc($1, $3);
729: }
730: ;
731:
732: Field :
733: NameList ':' Type
734: {
735: /* flatten representation for simplicity */
736: /* note that this could be even simpler, but I */
737: /* don't have the patience to change code everywhere */
738: list p;
739:
740: for (p = $1; p != NIL; p = cdr(p))
741: car(p) = cons(cons(car(p),NIL),(list)$3);
742: $$ = $1;
743: }
744: ;
745:
746: ReferencedConstant :
747: /* see ConstructedConstant for simple referenced constants */
748: identifier '.' identifier
749: {
750: struct object *symbol;
751:
752: if (check_dependency($1) && (symbol=check_def($3,$1))) {
753: if (class_of(symbol) != O_CONSTANT) {
754: error(ERROR,"Constant expected, but got ``%s''",
755: name_of(symbol));
756: YYERROR;
757: }
758: $$ = symbol->o_constant;
759: } else {
760: error(ERROR,"Unrecognized symbol ``%s.%s''",
761: $1,$3);
762: }
763: }
764: ;
765:
766: NameList :
767: identifier
768: {
769: /* note that NameList now is a list of strings */
770: $$ = cons((list) $1, NIL);
771: }
772: | NameList ',' identifier
773: {
774: /* note that NameList now is a list of strings */
775: $$ = nconc($1, cons((list) $3, NIL));
776: }
777: ;
778:
779:
780: %%
781:
782: YYSTYPE yyv[];
783: int yynerrs;
784: extern int yylineno;
785:
786: struct parser_state {
787: YYSTYPE yyv[YYMAXDEPTH];
788: YYSTYPE yylval;
789: YYSTYPE yyval;
790: int yychar;
791: int yynerrs;
792: short yyerrflag;
793: int yylineno;
794: int recursive_flag;
795: char *CurrentProgram;
796: int CurrentVersion;
797: int CurrentNumber;
798: char yysbuf[200]; /*YYLMAX*/
799: char *yysptr;
800: };
801: extern char yysbuf[], *yysptr;
802:
803: int *
804: save_parser_state()
805: {
806: struct parser_state *p;
807:
808: p = New(struct parser_state);
809: bcopy(yyv, p->yyv, YYMAXDEPTH*sizeof(YYSTYPE));
810: p->yylval = yylval;
811: p->yyval = yyval;
812: p->yychar = yychar;
813: p->yynerrs = yynerrs;
814: p->yyerrflag = yyerrflag;
815: p->yylineno = yylineno;
816: p->recursive_flag = recursive_flag;
817: p->CurrentProgram = CurrentProgram;
818: p->CurrentVersion = CurrentVersion;
819: p->CurrentNumber = CurrentNumber;
820: p->yysptr = yysptr;
821: bcopy(yysbuf, p->yysbuf, 200);
822: yysptr = yysbuf;
823: recursive_flag = 1;
824: return ((int*) p);
825: }
826:
827: restore_parser_state(p)
828: struct parser_state *p;
829: {
830: yysptr = p->yysptr;
831: bcopy(p->yysbuf, yysbuf, 200);
832: CurrentProgram = p->CurrentProgram;
833: CurrentVersion = p->CurrentVersion;
834: CurrentNumber = p->CurrentNumber;
835: recursive_flag = p->recursive_flag;
836: yylineno = p->yylineno;
837: yyerrflag = p->yyerrflag;
838: yynerrs = p->yynerrs;
839: yychar = p->yychar;
840: yyval = p->yyval;
841: yylval = p->yylval;
842: bcopy(p->yyv, yyv, YYMAXDEPTH*sizeof(YYSTYPE));
843: free((char *) p);
844: }