1 /* voc 2.1.0 [2019/11/01]. Bootstrapping compiler for address size 8, alignment 8. xrtspaSF */
2
3 #define SHORTINT INT8
4 #define INTEGER INT16
5 #define LONGINT INT32
6 #define SET UINT32
7
8 #include "SYSTEM.h"
9 #include "OPB.h"
10 #include "OPM.h"
11 #include "OPS.h"
12 #include "OPT.h"
13
14 struct OPP__1 {
15 INT32 low, high;
16 };
17
18 typedef
19 struct OPP__1 OPP_CaseTable[128];
20
21
22 static INT8 OPP_sym, OPP_level;
23 static INT16 OPP_LoopLevel;
24 static OPT_Node OPP_TDinit, OPP_lastTDinit;
25 static INT16 OPP_nofFwdPtr;
26 static OPT_Struct OPP_FwdPtr[64];
27
28 export ADDRESS *OPP__1__typ;
29
30 static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar);
31 static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned);
32 static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq);
33 static void OPP_CaseLabelList (OPT_Node *lab, OPT_Struct LabelTyp, INT16 *n, OPP_CaseTable tab);
34 static void OPP_CheckMark (INT8 *vis);
35 static void OPP_CheckSym (INT16 s);
36 static void OPP_CheckSysFlag (INT16 *sysflag, INT16 default_);
37 static void OPP_ConstExpression (OPT_Node *x);
38 static void OPP_Element (OPT_Node *x);
39 static void OPP_Expression (OPT_Node *x);
40 static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b);
41 static void OPP_Factor (OPT_Node *x);
42 static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp);
43 export void OPP_Module (OPT_Node *prog, UINT32 opt);
44 static void OPP_PointerType (OPT_Struct *typ);
45 static void OPP_ProcedureDeclaration (OPT_Node *x);
46 static void OPP_Receiver (INT8 *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec);
47 static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned);
48 static void OPP_Sets (OPT_Node *x);
49 static void OPP_SimpleExpression (OPT_Node *x);
50 static void OPP_StandProcCall (OPT_Node *x);
51 static void OPP_StatSeq (OPT_Node *stat);
52 static void OPP_Term (OPT_Node *x);
53 static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned);
54 static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned);
55 static void OPP_err (INT16 n);
56 static void OPP_qualident (OPT_Object *id);
57 static void OPP_selector (OPT_Node *x);
58
59
OPP_err(INT16 n)60 static void OPP_err (INT16 n)
61 {
62 OPM_err(n);
63 }
64
OPP_CheckSym(INT16 s)65 static void OPP_CheckSym (INT16 s)
66 {
67 if ((INT16)OPP_sym == s) {
68 OPS_Get(&OPP_sym);
69 } else {
70 OPM_err(s);
71 }
72 }
73
OPP_qualident(OPT_Object * id)74 static void OPP_qualident (OPT_Object *id)
75 {
76 OPT_Object obj = NIL;
77 INT8 lev;
78 OPT_Find(&obj);
79 OPS_Get(&OPP_sym);
80 if ((((OPP_sym == 18 && obj != NIL)) && obj->mode == 11)) {
81 OPS_Get(&OPP_sym);
82 if (OPP_sym == 38) {
83 OPT_FindImport(obj, &obj);
84 OPS_Get(&OPP_sym);
85 } else {
86 OPP_err(38);
87 obj = NIL;
88 }
89 }
90 if (obj == NIL) {
91 OPP_err(0);
92 obj = OPT_NewObj();
93 obj->mode = 1;
94 obj->typ = OPT_undftyp;
95 obj->adr = 0;
96 } else {
97 lev = obj->mnolev;
98 if ((__IN(obj->mode, 0x06, 32) && lev != OPP_level)) {
99 obj->leaf = 0;
100 if (lev > 0) {
101 OPB_StaticLink(OPP_level - lev);
102 }
103 }
104 }
105 *id = obj;
106 }
107
OPP_ConstExpression(OPT_Node * x)108 static void OPP_ConstExpression (OPT_Node *x)
109 {
110 OPP_Expression(&*x);
111 if ((*x)->class != 7) {
112 OPP_err(50);
113 *x = OPB_NewIntConst(1);
114 }
115 }
116
OPP_CheckMark(INT8 * vis)117 static void OPP_CheckMark (INT8 *vis)
118 {
119 OPS_Get(&OPP_sym);
120 if (OPP_sym == 1 || OPP_sym == 7) {
121 if (OPP_level > 0) {
122 OPP_err(47);
123 }
124 if (OPP_sym == 1) {
125 *vis = 1;
126 } else {
127 *vis = 2;
128 }
129 OPS_Get(&OPP_sym);
130 } else {
131 *vis = 0;
132 }
133 }
134
OPP_CheckSysFlag(INT16 * sysflag,INT16 default_)135 static void OPP_CheckSysFlag (INT16 *sysflag, INT16 default_)
136 {
137 OPT_Node x = NIL;
138 INT64 sf;
139 if (OPP_sym == 31) {
140 OPS_Get(&OPP_sym);
141 if (!OPT_SYSimported) {
142 OPP_err(135);
143 }
144 OPP_ConstExpression(&x);
145 if (x->typ->form == 4) {
146 sf = x->conval->intval;
147 if (sf < 0 || sf > 1) {
148 OPP_err(220);
149 sf = 0;
150 }
151 } else {
152 OPP_err(51);
153 sf = 0;
154 }
155 *sysflag = OPM_Integer(sf);
156 OPP_CheckSym(23);
157 } else {
158 *sysflag = default_;
159 }
160 }
161
OPP_RecordType(OPT_Struct * typ,OPT_Struct * banned)162 static void OPP_RecordType (OPT_Struct *typ, OPT_Struct *banned)
163 {
164 OPT_Object fld = NIL, first = NIL, last = NIL, base = NIL;
165 OPT_Struct ftyp = NIL;
166 INT16 sysflag;
167 *typ = OPT_NewStr(13, 4);
168 (*typ)->BaseTyp = NIL;
169 OPP_CheckSysFlag(&sysflag, -1);
170 if (OPP_sym == 30) {
171 OPS_Get(&OPP_sym);
172 if (OPP_sym == 38) {
173 OPP_qualident(&base);
174 if ((base->mode == 5 && base->typ->comp == 4)) {
175 if (base->typ == *banned) {
176 OPP_err(58);
177 } else {
178 base->typ->pvused = 1;
179 (*typ)->BaseTyp = base->typ;
180 (*typ)->extlev = base->typ->extlev + 1;
181 (*typ)->sysflag = base->typ->sysflag;
182 }
183 } else {
184 OPP_err(52);
185 }
186 } else {
187 OPP_err(38);
188 }
189 OPP_CheckSym(22);
190 }
191 if (sysflag >= 0) {
192 (*typ)->sysflag = sysflag;
193 }
194 OPT_OpenScope(0, NIL);
195 first = NIL;
196 last = NIL;
197 for (;;) {
198 if (OPP_sym == 38) {
199 for (;;) {
200 if (OPP_sym == 38) {
201 if ((*typ)->BaseTyp != NIL) {
202 OPT_FindField(OPS_name, (*typ)->BaseTyp, &fld);
203 if (fld != NIL) {
204 OPP_err(1);
205 }
206 }
207 OPT_Insert(OPS_name, &fld);
208 OPP_CheckMark(&fld->vis);
209 fld->mode = 4;
210 fld->link = NIL;
211 fld->typ = OPT_undftyp;
212 if (first == NIL) {
213 first = fld;
214 }
215 if (last == NIL) {
216 (*typ)->link = fld;
217 } else {
218 last->link = fld;
219 }
220 last = fld;
221 } else {
222 OPP_err(38);
223 }
224 if (OPP_sym == 19) {
225 OPS_Get(&OPP_sym);
226 } else if (OPP_sym == 38) {
227 OPP_err(19);
228 } else {
229 break;
230 }
231 }
232 OPP_CheckSym(20);
233 OPP_Type(&ftyp, &*banned);
234 ftyp->pvused = 1;
235 if (ftyp->comp == 3) {
236 ftyp = OPT_undftyp;
237 OPP_err(88);
238 }
239 while (first != NIL) {
240 first->typ = ftyp;
241 first = first->link;
242 }
243 }
244 if (OPP_sym == 39) {
245 OPS_Get(&OPP_sym);
246 } else if (OPP_sym == 38) {
247 OPP_err(39);
248 } else {
249 break;
250 }
251 }
252 OPT_CloseScope();
253 }
254
OPP_ArrayType(OPT_Struct * typ,OPT_Struct * banned)255 static void OPP_ArrayType (OPT_Struct *typ, OPT_Struct *banned)
256 {
257 OPT_Node x = NIL;
258 INT64 n;
259 INT16 sysflag;
260 OPP_CheckSysFlag(&sysflag, 0);
261 if (OPP_sym == 25) {
262 *typ = OPT_NewStr(13, 3);
263 (*typ)->mno = 0;
264 (*typ)->sysflag = sysflag;
265 OPS_Get(&OPP_sym);
266 OPP_Type(&(*typ)->BaseTyp, &*banned);
267 (*typ)->BaseTyp->pvused = 1;
268 if ((*typ)->BaseTyp->comp == 3) {
269 (*typ)->n = (*typ)->BaseTyp->n + 1;
270 } else {
271 (*typ)->n = 0;
272 }
273 } else {
274 *typ = OPT_NewStr(13, 2);
275 (*typ)->sysflag = sysflag;
276 OPP_ConstExpression(&x);
277 if (x->typ->form == 4) {
278 n = x->conval->intval;
279 if (n <= 0 || n > OPM_MaxIndex) {
280 OPP_err(63);
281 n = 1;
282 }
283 } else {
284 OPP_err(51);
285 n = 1;
286 }
287 (*typ)->n = OPM_Longint(n);
288 if (OPP_sym == 25) {
289 OPS_Get(&OPP_sym);
290 OPP_Type(&(*typ)->BaseTyp, &*banned);
291 (*typ)->BaseTyp->pvused = 1;
292 } else if (OPP_sym == 19) {
293 OPS_Get(&OPP_sym);
294 if (OPP_sym != 25) {
295 OPP_ArrayType(&(*typ)->BaseTyp, &*banned);
296 }
297 } else {
298 OPP_err(35);
299 }
300 if ((*typ)->BaseTyp->comp == 3) {
301 (*typ)->BaseTyp = OPT_undftyp;
302 OPP_err(88);
303 }
304 }
305 }
306
OPP_PointerType(OPT_Struct * typ)307 static void OPP_PointerType (OPT_Struct *typ)
308 {
309 OPT_Object id = NIL;
310 *typ = OPT_NewStr(11, 1);
311 OPP_CheckSysFlag(&(*typ)->sysflag, 0);
312 OPP_CheckSym(28);
313 if (OPP_sym == 38) {
314 OPT_Find(&id);
315 if (id == NIL) {
316 if (OPP_nofFwdPtr < 64) {
317 OPP_FwdPtr[__X(OPP_nofFwdPtr, 64)] = *typ;
318 OPP_nofFwdPtr += 1;
319 } else {
320 OPP_err(224);
321 }
322 (*typ)->link = OPT_NewObj();
323 __COPY(OPS_name, (*typ)->link->name, 256);
324 (*typ)->BaseTyp = OPT_undftyp;
325 OPS_Get(&OPP_sym);
326 } else {
327 OPP_qualident(&id);
328 if (id->mode == 5) {
329 if (__IN(id->typ->comp, 0x1c, 32)) {
330 (*typ)->BaseTyp = id->typ;
331 } else {
332 (*typ)->BaseTyp = OPT_undftyp;
333 OPP_err(57);
334 }
335 } else {
336 (*typ)->BaseTyp = OPT_undftyp;
337 OPP_err(52);
338 }
339 }
340 } else {
341 OPP_Type(&(*typ)->BaseTyp, &OPT_notyp);
342 if (!__IN((*typ)->BaseTyp->comp, 0x1c, 32)) {
343 (*typ)->BaseTyp = OPT_undftyp;
344 OPP_err(57);
345 }
346 }
347 }
348
OPP_FormalParameters(OPT_Object * firstPar,OPT_Struct * resTyp)349 static void OPP_FormalParameters (OPT_Object *firstPar, OPT_Struct *resTyp)
350 {
351 INT8 mode;
352 OPT_Object par = NIL, first = NIL, last = NIL, res = NIL;
353 OPT_Struct typ = NIL;
354 first = NIL;
355 last = *firstPar;
356 if (OPP_sym == 38 || OPP_sym == 60) {
357 for (;;) {
358 if (OPP_sym == 60) {
359 OPS_Get(&OPP_sym);
360 mode = 2;
361 } else {
362 mode = 1;
363 }
364 for (;;) {
365 if (OPP_sym == 38) {
366 OPT_Insert(OPS_name, &par);
367 OPS_Get(&OPP_sym);
368 par->mode = mode;
369 par->link = NIL;
370 if (first == NIL) {
371 first = par;
372 }
373 if (*firstPar == NIL) {
374 *firstPar = par;
375 } else {
376 last->link = par;
377 }
378 last = par;
379 } else {
380 OPP_err(38);
381 }
382 if (OPP_sym == 19) {
383 OPS_Get(&OPP_sym);
384 } else if (OPP_sym == 38) {
385 OPP_err(19);
386 } else if (OPP_sym == 60) {
387 OPP_err(19);
388 OPS_Get(&OPP_sym);
389 } else {
390 break;
391 }
392 }
393 OPP_CheckSym(20);
394 OPP_Type(&typ, &OPT_notyp);
395 if (((typ->comp == 2 || typ->comp == 4) && typ->strobj == NIL)) {
396 OPP_err(-309);
397 }
398 if (mode == 1) {
399 typ->pvused = 1;
400 }
401 while (first != NIL) {
402 first->typ = typ;
403 first = first->link;
404 }
405 if (OPP_sym == 39) {
406 OPS_Get(&OPP_sym);
407 } else if (OPP_sym == 38) {
408 OPP_err(39);
409 } else {
410 break;
411 }
412 }
413 }
414 OPP_CheckSym(22);
415 if (OPP_sym == 20) {
416 OPS_Get(&OPP_sym);
417 *resTyp = OPT_undftyp;
418 if (OPP_sym == 38) {
419 OPP_qualident(&res);
420 if (res->mode == 5) {
421 if (res->typ->form < 13) {
422 *resTyp = res->typ;
423 } else {
424 OPP_err(54);
425 }
426 } else {
427 OPP_err(52);
428 }
429 } else {
430 OPP_err(38);
431 }
432 } else {
433 *resTyp = OPT_notyp;
434 }
435 }
436
OPP_TypeDecl(OPT_Struct * typ,OPT_Struct * banned)437 static void OPP_TypeDecl (OPT_Struct *typ, OPT_Struct *banned)
438 {
439 OPT_Object id = NIL;
440 *typ = OPT_undftyp;
441 if (OPP_sym < 30) {
442 OPP_err(12);
443 do {
444 OPS_Get(&OPP_sym);
445 } while (!(OPP_sym >= 30));
446 }
447 if (OPP_sym == 38) {
448 OPP_qualident(&id);
449 if (id->mode == 5) {
450 if (id->typ == *banned) {
451 OPP_err(58);
452 } else {
453 *typ = id->typ;
454 }
455 } else {
456 OPP_err(52);
457 }
458 } else if (OPP_sym == 54) {
459 OPS_Get(&OPP_sym);
460 OPP_ArrayType(&*typ, &*banned);
461 } else if (OPP_sym == 55) {
462 OPS_Get(&OPP_sym);
463 OPP_RecordType(&*typ, &*banned);
464 OPB_Inittd(&OPP_TDinit, &OPP_lastTDinit, *typ);
465 OPP_CheckSym(41);
466 } else if (OPP_sym == 56) {
467 OPS_Get(&OPP_sym);
468 OPP_PointerType(&*typ);
469 } else if (OPP_sym == 61) {
470 OPS_Get(&OPP_sym);
471 *typ = OPT_NewStr(12, 1);
472 OPP_CheckSysFlag(&(*typ)->sysflag, 0);
473 if (OPP_sym == 30) {
474 OPS_Get(&OPP_sym);
475 OPT_OpenScope(OPP_level, NIL);
476 OPP_FormalParameters(&(*typ)->link, &(*typ)->BaseTyp);
477 OPT_CloseScope();
478 } else {
479 (*typ)->BaseTyp = OPT_notyp;
480 (*typ)->link = NIL;
481 }
482 } else {
483 OPP_err(12);
484 }
485 for (;;) {
486 if (((OPP_sym >= 39 && OPP_sym <= 42) || OPP_sym == 22) || OPP_sym == 64) {
487 break;
488 }
489 OPP_err(15);
490 if (OPP_sym == 38) {
491 break;
492 }
493 OPS_Get(&OPP_sym);
494 }
495 }
496
OPP_Type(OPT_Struct * typ,OPT_Struct * banned)497 static void OPP_Type (OPT_Struct *typ, OPT_Struct *banned)
498 {
499 OPP_TypeDecl(&*typ, &*banned);
500 if (((((*typ)->form == 11 && (*typ)->BaseTyp == OPT_undftyp)) && (*typ)->strobj == NIL)) {
501 OPP_err(0);
502 }
503 }
504
OPP_selector(OPT_Node * x)505 static void OPP_selector (OPT_Node *x)
506 {
507 OPT_Object obj = NIL, proc = NIL;
508 OPT_Node y = NIL;
509 OPT_Struct typ = NIL;
510 OPS_Name name;
511 for (;;) {
512 if (OPP_sym == 31) {
513 OPS_Get(&OPP_sym);
514 for (;;) {
515 if (((*x)->typ != NIL && (*x)->typ->form == 11)) {
516 OPB_DeRef(&*x);
517 }
518 OPP_Expression(&y);
519 OPB_Index(&*x, y);
520 if (OPP_sym == 19) {
521 OPS_Get(&OPP_sym);
522 } else {
523 break;
524 }
525 }
526 OPP_CheckSym(23);
527 } else if (OPP_sym == 18) {
528 OPS_Get(&OPP_sym);
529 if (OPP_sym == 38) {
530 __MOVE(OPS_name, name, 256);
531 OPS_Get(&OPP_sym);
532 if ((*x)->typ != NIL) {
533 if ((*x)->typ->form == 11) {
534 OPB_DeRef(&*x);
535 }
536 if ((*x)->typ->comp == 4) {
537 OPT_FindField(name, (*x)->typ, &obj);
538 OPB_Field(&*x, obj);
539 if ((obj != NIL && obj->mode == 13)) {
540 if (OPP_sym == 17) {
541 OPS_Get(&OPP_sym);
542 y = (*x)->left;
543 if (y->class == 3) {
544 y = y->left;
545 }
546 if (y->obj != NIL) {
547 proc = OPT_topScope;
548 while ((proc->link != NIL && proc->link->mode != 13)) {
549 proc = proc->left;
550 }
551 if (proc->link == NIL || proc->link->link != y->obj) {
552 OPP_err(75);
553 }
554 typ = y->obj->typ;
555 if (typ->form == 11) {
556 typ = typ->BaseTyp;
557 }
558 OPT_FindField((*x)->obj->name, typ->BaseTyp, &proc);
559 if (proc != NIL) {
560 (*x)->subcl = 1;
561 } else {
562 OPP_err(74);
563 }
564 } else {
565 OPP_err(75);
566 }
567 }
568 if ((obj->typ != OPT_notyp && OPP_sym != 30)) {
569 OPP_err(30);
570 }
571 }
572 } else {
573 OPP_err(53);
574 }
575 } else {
576 OPP_err(52);
577 }
578 } else {
579 OPP_err(38);
580 }
581 } else if (OPP_sym == 17) {
582 OPS_Get(&OPP_sym);
583 OPB_DeRef(&*x);
584 } else if ((((((OPP_sym == 30 && (*x)->class < 7)) && (*x)->typ->form != 12)) && ((*x)->obj == NIL || (*x)->obj->mode != 13))) {
585 OPS_Get(&OPP_sym);
586 if (OPP_sym == 38) {
587 OPP_qualident(&obj);
588 if (obj->mode == 5) {
589 OPB_TypTest(&*x, obj, 1);
590 } else {
591 OPP_err(52);
592 }
593 } else {
594 OPP_err(38);
595 }
596 OPP_CheckSym(22);
597 } else {
598 break;
599 }
600 }
601 }
602
OPP_ActualParameters(OPT_Node * aparlist,OPT_Object fpar)603 static void OPP_ActualParameters (OPT_Node *aparlist, OPT_Object fpar)
604 {
605 OPT_Node apar = NIL, last = NIL;
606 *aparlist = NIL;
607 last = NIL;
608 if (OPP_sym != 22) {
609 for (;;) {
610 OPP_Expression(&apar);
611 if (fpar != NIL) {
612 OPB_Param(apar, fpar);
613 OPB_Link(&*aparlist, &last, apar);
614 fpar = fpar->link;
615 } else {
616 OPP_err(64);
617 }
618 if (OPP_sym == 19) {
619 OPS_Get(&OPP_sym);
620 } else if ((30 <= OPP_sym && OPP_sym <= 38)) {
621 OPP_err(19);
622 } else {
623 break;
624 }
625 }
626 }
627 if (fpar != NIL) {
628 OPP_err(65);
629 }
630 }
631
OPP_StandProcCall(OPT_Node * x)632 static void OPP_StandProcCall (OPT_Node *x)
633 {
634 OPT_Node y = NIL;
635 INT8 m;
636 INT16 n;
637 m = __SHORT(__SHORT((*x)->obj->adr, 32768), 128);
638 n = 0;
639 if (OPP_sym == 30) {
640 OPS_Get(&OPP_sym);
641 if (OPP_sym != 22) {
642 for (;;) {
643 if (n == 0) {
644 OPP_Expression(&*x);
645 OPB_StPar0(&*x, m);
646 n = 1;
647 } else if (n == 1) {
648 OPP_Expression(&y);
649 OPB_StPar1(&*x, y, m);
650 n = 2;
651 } else {
652 OPP_Expression(&y);
653 OPB_StParN(&*x, y, m, n);
654 n += 1;
655 }
656 if (OPP_sym == 19) {
657 OPS_Get(&OPP_sym);
658 } else if ((30 <= OPP_sym && OPP_sym <= 38)) {
659 OPP_err(19);
660 } else {
661 break;
662 }
663 }
664 OPP_CheckSym(22);
665 } else {
666 OPS_Get(&OPP_sym);
667 }
668 OPB_StFct(&*x, m, n);
669 } else {
670 OPP_err(30);
671 }
672 if ((OPP_level > 0 && (m == 1 || m == 30))) {
673 OPT_topScope->link->leaf = 0;
674 }
675 }
676
OPP_Element(OPT_Node * x)677 static void OPP_Element (OPT_Node *x)
678 {
679 OPT_Node y = NIL;
680 OPP_Expression(&*x);
681 if (OPP_sym == 21) {
682 OPS_Get(&OPP_sym);
683 OPP_Expression(&y);
684 OPB_SetRange(&*x, y);
685 } else {
686 OPB_SetElem(&*x);
687 }
688 }
689
OPP_Sets(OPT_Node * x)690 static void OPP_Sets (OPT_Node *x)
691 {
692 OPT_Node y = NIL;
693 if (OPP_sym != 24) {
694 OPP_Element(&*x);
695 for (;;) {
696 if (OPP_sym == 19) {
697 OPS_Get(&OPP_sym);
698 } else if ((30 <= OPP_sym && OPP_sym <= 38)) {
699 OPP_err(19);
700 } else {
701 break;
702 }
703 OPP_Element(&y);
704 OPB_Op(6, &*x, y);
705 }
706 } else {
707 *x = OPB_EmptySet();
708 }
709 OPP_CheckSym(24);
710 }
711
OPP_Factor(OPT_Node * x)712 static void OPP_Factor (OPT_Node *x)
713 {
714 OPT_Object fpar = NIL, id = NIL;
715 OPT_Node apar = NIL;
716 if (OPP_sym < 30) {
717 OPP_err(13);
718 do {
719 OPS_Get(&OPP_sym);
720 } while (!(OPP_sym >= 30));
721 }
722 if (OPP_sym == 38) {
723 OPP_qualident(&id);
724 *x = OPB_NewLeaf(id);
725 OPP_selector(&*x);
726 if (((*x)->class == 9 && (*x)->obj->mode == 8)) {
727 OPP_StandProcCall(&*x);
728 } else if (OPP_sym == 30) {
729 OPS_Get(&OPP_sym);
730 OPB_PrepCall(&*x, &fpar);
731 OPP_ActualParameters(&apar, fpar);
732 OPB_Call(&*x, apar, fpar);
733 OPP_CheckSym(22);
734 if (OPP_level > 0) {
735 OPT_topScope->link->leaf = 0;
736 }
737 }
738 } else if (OPP_sym == 35) {
739 switch (OPS_numtyp) {
740 case 1:
741 *x = OPB_NewIntConst(OPS_intval);
742 (*x)->typ = OPT_chartyp;
743 break;
744 case 2:
745 *x = OPB_NewIntConst(OPS_intval);
746 break;
747 case 3:
748 *x = OPB_NewRealConst(OPS_realval, OPT_realtyp);
749 break;
750 case 4:
751 *x = OPB_NewRealConst(OPS_lrlval, OPT_lrltyp);
752 break;
753 default:
754 OPM_LogWStr((CHAR*)"unhandled case in OPP.Factor, OPS.numtyp = ", 44);
755 OPM_LogWNum(OPS_numtyp, 0);
756 OPM_LogWLn();
757 break;
758 }
759 OPS_Get(&OPP_sym);
760 } else if (OPP_sym == 37) {
761 *x = OPB_NewString(OPS_str, OPS_intval);
762 OPS_Get(&OPP_sym);
763 } else if (OPP_sym == 36) {
764 *x = OPB_Nil();
765 OPS_Get(&OPP_sym);
766 } else if (OPP_sym == 30) {
767 OPS_Get(&OPP_sym);
768 OPP_Expression(&*x);
769 OPP_CheckSym(22);
770 } else if (OPP_sym == 31) {
771 OPS_Get(&OPP_sym);
772 OPP_err(30);
773 OPP_Expression(&*x);
774 OPP_CheckSym(22);
775 } else if (OPP_sym == 32) {
776 OPS_Get(&OPP_sym);
777 OPP_Sets(&*x);
778 } else if (OPP_sym == 33) {
779 OPS_Get(&OPP_sym);
780 OPP_Factor(&*x);
781 OPB_MOp(33, &*x);
782 } else {
783 OPP_err(13);
784 OPS_Get(&OPP_sym);
785 *x = NIL;
786 }
787 if (*x == NIL) {
788 *x = OPB_NewIntConst(1);
789 (*x)->typ = OPT_undftyp;
790 }
791 }
792
OPP_Term(OPT_Node * x)793 static void OPP_Term (OPT_Node *x)
794 {
795 OPT_Node y = NIL;
796 INT8 mulop;
797 OPP_Factor(&*x);
798 while ((1 <= OPP_sym && OPP_sym <= 5)) {
799 mulop = OPP_sym;
800 OPS_Get(&OPP_sym);
801 OPP_Factor(&y);
802 OPB_Op(mulop, &*x, y);
803 }
804 }
805
OPP_SimpleExpression(OPT_Node * x)806 static void OPP_SimpleExpression (OPT_Node *x)
807 {
808 OPT_Node y = NIL;
809 INT8 addop;
810 if (OPP_sym == 7) {
811 OPS_Get(&OPP_sym);
812 OPP_Term(&*x);
813 OPB_MOp(7, &*x);
814 } else if (OPP_sym == 6) {
815 OPS_Get(&OPP_sym);
816 OPP_Term(&*x);
817 OPB_MOp(6, &*x);
818 } else {
819 OPP_Term(&*x);
820 }
821 while ((6 <= OPP_sym && OPP_sym <= 8)) {
822 addop = OPP_sym;
823 OPS_Get(&OPP_sym);
824 OPP_Term(&y);
825 OPB_Op(addop, &*x, y);
826 }
827 }
828
OPP_Expression(OPT_Node * x)829 static void OPP_Expression (OPT_Node *x)
830 {
831 OPT_Node y = NIL;
832 OPT_Object obj = NIL;
833 INT8 relation;
834 OPP_SimpleExpression(&*x);
835 if ((9 <= OPP_sym && OPP_sym <= 14)) {
836 relation = OPP_sym;
837 OPS_Get(&OPP_sym);
838 OPP_SimpleExpression(&y);
839 OPB_Op(relation, &*x, y);
840 } else if (OPP_sym == 15) {
841 OPS_Get(&OPP_sym);
842 OPP_SimpleExpression(&y);
843 OPB_In(&*x, y);
844 } else if (OPP_sym == 16) {
845 OPS_Get(&OPP_sym);
846 if (OPP_sym == 38) {
847 OPP_qualident(&obj);
848 if (obj->mode == 5) {
849 OPB_TypTest(&*x, obj, 0);
850 } else {
851 OPP_err(52);
852 }
853 } else {
854 OPP_err(38);
855 }
856 }
857 }
858
OPP_Receiver(INT8 * mode,OPS_Name name,OPT_Struct * typ,OPT_Struct * rec)859 static void OPP_Receiver (INT8 *mode, OPS_Name name, OPT_Struct *typ, OPT_Struct *rec)
860 {
861 OPT_Object obj = NIL;
862 *typ = OPT_undftyp;
863 *rec = NIL;
864 if (OPP_sym == 60) {
865 OPS_Get(&OPP_sym);
866 *mode = 2;
867 } else {
868 *mode = 1;
869 }
870 __MOVE(OPS_name, name, 256);
871 OPP_CheckSym(38);
872 OPP_CheckSym(20);
873 if (OPP_sym == 38) {
874 OPT_Find(&obj);
875 OPS_Get(&OPP_sym);
876 if (obj == NIL) {
877 OPP_err(0);
878 } else if (obj->mode != 5) {
879 OPP_err(72);
880 } else {
881 *typ = obj->typ;
882 *rec = *typ;
883 if ((*rec)->form == 11) {
884 *rec = (*rec)->BaseTyp;
885 }
886 if (!((((*mode == 1 && (*typ)->form == 11)) && (*rec)->comp == 4) || (*mode == 2 && (*typ)->comp == 4))) {
887 OPP_err(70);
888 *rec = NIL;
889 }
890 if ((*rec != NIL && (*rec)->mno != OPP_level)) {
891 OPP_err(72);
892 *rec = NIL;
893 }
894 }
895 } else {
896 OPP_err(38);
897 }
898 OPP_CheckSym(22);
899 if (*rec == NIL) {
900 *rec = OPT_NewStr(13, 4);
901 (*rec)->BaseTyp = NIL;
902 }
903 }
904
OPP_Extends(OPT_Struct x,OPT_Struct b)905 static BOOLEAN OPP_Extends (OPT_Struct x, OPT_Struct b)
906 {
907 if ((b->form == 11 && x->form == 11)) {
908 b = b->BaseTyp;
909 x = x->BaseTyp;
910 }
911 if ((b->comp == 4 && x->comp == 4)) {
912 do {
913 x = x->BaseTyp;
914 } while (!(x == NIL || x == b));
915 }
916 return x == b;
917 }
918
919 static struct ProcedureDeclaration__16 {
920 OPT_Node *x;
921 OPT_Object *proc, *fwd;
922 OPS_Name *name;
923 INT8 *mode, *vis;
924 BOOLEAN *forward;
925 struct ProcedureDeclaration__16 *lnk;
926 } *ProcedureDeclaration__16_s;
927
928 static void Body__17 (void);
929 static void GetCode__19 (void);
930 static void GetParams__21 (void);
931 static void TProcDecl__23 (void);
932
GetCode__19(void)933 static void GetCode__19 (void)
934 {
935 OPT_ConstExt ext = NIL;
936 INT16 n;
937 INT64 c;
938 ext = OPT_NewExt();
939 (*ProcedureDeclaration__16_s->proc)->conval->ext = ext;
940 n = 0;
941 if (OPP_sym == 37) {
942 while (OPS_str[__X(n, 256)] != 0x00) {
943 (*ext)[__X(n + 1, 256)] = OPS_str[__X(n, 256)];
944 n += 1;
945 }
946 (*ext)[0] = __CHR(n);
947 OPS_Get(&OPP_sym);
948 } else {
949 for (;;) {
950 if (OPP_sym == 35) {
951 c = OPS_intval;
952 n += 1;
953 if ((c < 0 || c > 255) || n == 256) {
954 OPP_err(64);
955 c = 1;
956 n = 1;
957 }
958 OPS_Get(&OPP_sym);
959 (*ext)[__X(n, 256)] = __CHR(c);
960 }
961 if (OPP_sym == 19) {
962 OPS_Get(&OPP_sym);
963 } else if (OPP_sym == 35) {
964 OPP_err(19);
965 } else {
966 (*ext)[0] = __CHR(n);
967 break;
968 }
969 }
970 }
971 (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1,64);
972 }
973
GetParams__21(void)974 static void GetParams__21 (void)
975 {
976 (*ProcedureDeclaration__16_s->proc)->vis = *ProcedureDeclaration__16_s->vis;
977 (*ProcedureDeclaration__16_s->proc)->mode = *ProcedureDeclaration__16_s->mode;
978 (*ProcedureDeclaration__16_s->proc)->typ = OPT_notyp;
979 (*ProcedureDeclaration__16_s->proc)->conval = OPT_NewConst();
980 (*ProcedureDeclaration__16_s->proc)->conval->setval = 0x0;
981 if (OPP_sym == 30) {
982 OPS_Get(&OPP_sym);
983 OPP_FormalParameters(&(*ProcedureDeclaration__16_s->proc)->link, &(*ProcedureDeclaration__16_s->proc)->typ);
984 }
985 if (*ProcedureDeclaration__16_s->fwd != NIL) {
986 OPB_CheckParameters((*ProcedureDeclaration__16_s->proc)->link, (*ProcedureDeclaration__16_s->fwd)->link, 1);
987 if ((*ProcedureDeclaration__16_s->proc)->typ != (*ProcedureDeclaration__16_s->fwd)->typ) {
988 OPP_err(117);
989 }
990 *ProcedureDeclaration__16_s->proc = *ProcedureDeclaration__16_s->fwd;
991 OPT_topScope = (*ProcedureDeclaration__16_s->proc)->scope;
992 if (*ProcedureDeclaration__16_s->mode == 10) {
993 (*ProcedureDeclaration__16_s->proc)->mode = 10;
994 }
995 }
996 }
997
Body__17(void)998 static void Body__17 (void)
999 {
1000 OPT_Node procdec = NIL, statseq = NIL;
1001 INT32 c;
1002 c = OPM_errpos;
1003 (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(1,64);
1004 OPP_CheckSym(39);
1005 OPP_Block(&procdec, &statseq);
1006 OPB_Enter(&procdec, statseq, *ProcedureDeclaration__16_s->proc);
1007 *ProcedureDeclaration__16_s->x = procdec;
1008 (*ProcedureDeclaration__16_s->x)->conval = OPT_NewConst();
1009 (*ProcedureDeclaration__16_s->x)->conval->intval = c;
1010 if (OPP_sym == 38) {
1011 if (__STRCMP(OPS_name, (*ProcedureDeclaration__16_s->proc)->name) != 0) {
1012 OPP_err(4);
1013 }
1014 OPS_Get(&OPP_sym);
1015 } else {
1016 OPP_err(38);
1017 }
1018 }
1019
TProcDecl__23(void)1020 static void TProcDecl__23 (void)
1021 {
1022 OPT_Object baseProc = NIL;
1023 OPT_Struct objTyp = NIL, recTyp = NIL;
1024 INT8 objMode;
1025 OPS_Name objName;
1026 OPS_Get(&OPP_sym);
1027 *ProcedureDeclaration__16_s->mode = 13;
1028 if (OPP_level > 0) {
1029 OPP_err(73);
1030 }
1031 OPP_Receiver(&objMode, objName, &objTyp, &recTyp);
1032 if (OPP_sym == 38) {
1033 __MOVE(OPS_name, *ProcedureDeclaration__16_s->name, 256);
1034 OPP_CheckMark(&*ProcedureDeclaration__16_s->vis);
1035 OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp, &*ProcedureDeclaration__16_s->fwd);
1036 OPT_FindField(*ProcedureDeclaration__16_s->name, recTyp->BaseTyp, &baseProc);
1037 if ((baseProc != NIL && baseProc->mode != 13)) {
1038 baseProc = NIL;
1039 }
1040 if (*ProcedureDeclaration__16_s->fwd == baseProc) {
1041 *ProcedureDeclaration__16_s->fwd = NIL;
1042 }
1043 if ((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mnolev != OPP_level)) {
1044 *ProcedureDeclaration__16_s->fwd = NIL;
1045 }
1046 if ((((*ProcedureDeclaration__16_s->fwd != NIL && (*ProcedureDeclaration__16_s->fwd)->mode == 13)) && !__IN(1, (*ProcedureDeclaration__16_s->fwd)->conval->setval, 64))) {
1047 *ProcedureDeclaration__16_s->proc = OPT_NewObj();
1048 (*ProcedureDeclaration__16_s->proc)->leaf = 1;
1049 if ((*ProcedureDeclaration__16_s->fwd)->vis != *ProcedureDeclaration__16_s->vis) {
1050 OPP_err(118);
1051 }
1052 } else {
1053 if (*ProcedureDeclaration__16_s->fwd != NIL) {
1054 OPP_err(1);
1055 *ProcedureDeclaration__16_s->fwd = NIL;
1056 }
1057 OPT_OpenScope(0, NIL);
1058 OPT_topScope->right = recTyp->link;
1059 OPT_Insert(*ProcedureDeclaration__16_s->name, &*ProcedureDeclaration__16_s->proc);
1060 recTyp->link = OPT_topScope->right;
1061 OPT_CloseScope();
1062 }
1063 OPP_level += 1;
1064 OPT_OpenScope(OPP_level, *ProcedureDeclaration__16_s->proc);
1065 OPT_Insert(objName, &(*ProcedureDeclaration__16_s->proc)->link);
1066 (*ProcedureDeclaration__16_s->proc)->link->mode = objMode;
1067 (*ProcedureDeclaration__16_s->proc)->link->typ = objTyp;
1068 GetParams__21();
1069 if (baseProc != NIL) {
1070 if (objMode != baseProc->link->mode || !OPP_Extends(objTyp, baseProc->link->typ)) {
1071 OPP_err(115);
1072 }
1073 OPB_CheckParameters((*ProcedureDeclaration__16_s->proc)->link->link, baseProc->link->link, 0);
1074 if ((*ProcedureDeclaration__16_s->proc)->typ != baseProc->typ) {
1075 OPP_err(117);
1076 }
1077 if ((((((baseProc->vis == 1 && (*ProcedureDeclaration__16_s->proc)->vis == 0)) && recTyp->strobj != NIL)) && recTyp->strobj->vis == 1)) {
1078 OPP_err(109);
1079 }
1080 (*ProcedureDeclaration__16_s->proc)->conval->setval |= __SETOF(2,64);
1081 }
1082 if (!*ProcedureDeclaration__16_s->forward) {
1083 Body__17();
1084 }
1085 OPP_level -= 1;
1086 OPT_CloseScope();
1087 } else {
1088 OPP_err(38);
1089 }
1090 }
1091
OPP_ProcedureDeclaration(OPT_Node * x)1092 static void OPP_ProcedureDeclaration (OPT_Node *x)
1093 {
1094 OPT_Object proc = NIL, fwd = NIL;
1095 OPS_Name name;
1096 INT8 mode, vis;
1097 BOOLEAN forward;
1098 struct ProcedureDeclaration__16 _s;
1099 _s.x = x;
1100 _s.proc = &proc;
1101 _s.fwd = &fwd;
1102 _s.name = (void*)name;
1103 _s.mode = &mode;
1104 _s.vis = &vis;
1105 _s.forward = &forward;
1106 _s.lnk = ProcedureDeclaration__16_s;
1107 ProcedureDeclaration__16_s = &_s;
1108 proc = NIL;
1109 forward = 0;
1110 *x = NIL;
1111 mode = 6;
1112 if ((OPP_sym != 38 && OPP_sym != 30)) {
1113 if (OPP_sym == 1) {
1114 } else if (OPP_sym == 17) {
1115 forward = 1;
1116 } else if (OPP_sym == 6) {
1117 mode = 10;
1118 } else if (OPP_sym == 7) {
1119 mode = 9;
1120 } else {
1121 OPP_err(38);
1122 }
1123 if ((__IN(mode, 0x0600, 32) && !OPT_SYSimported)) {
1124 OPP_err(135);
1125 }
1126 OPS_Get(&OPP_sym);
1127 }
1128 if (OPP_sym == 30) {
1129 TProcDecl__23();
1130 } else if (OPP_sym == 38) {
1131 OPT_Find(&fwd);
1132 __MOVE(OPS_name, name, 256);
1133 OPP_CheckMark(&vis);
1134 if ((vis != 0 && mode == 6)) {
1135 mode = 7;
1136 }
1137 if ((fwd != NIL && (fwd->mnolev != OPP_level || fwd->mode == 8))) {
1138 fwd = NIL;
1139 }
1140 if ((((fwd != NIL && __IN(fwd->mode, 0xc0, 32))) && !__IN(1, fwd->conval->setval, 64))) {
1141 proc = OPT_NewObj();
1142 proc->leaf = 1;
1143 if (fwd->vis != vis) {
1144 OPP_err(118);
1145 }
1146 } else {
1147 if (fwd != NIL) {
1148 OPP_err(1);
1149 fwd = NIL;
1150 }
1151 OPT_Insert(name, &proc);
1152 }
1153 if ((mode != 6 && OPP_level > 0)) {
1154 OPP_err(73);
1155 }
1156 OPP_level += 1;
1157 OPT_OpenScope(OPP_level, proc);
1158 proc->link = NIL;
1159 GetParams__21();
1160 if (mode == 9) {
1161 GetCode__19();
1162 } else if (!forward) {
1163 Body__17();
1164 }
1165 OPP_level -= 1;
1166 OPT_CloseScope();
1167 } else {
1168 OPP_err(38);
1169 }
1170 ProcedureDeclaration__16_s = _s.lnk;
1171 }
1172
OPP_CaseLabelList(OPT_Node * lab,OPT_Struct LabelTyp,INT16 * n,OPP_CaseTable tab)1173 static void OPP_CaseLabelList (OPT_Node *lab, OPT_Struct LabelTyp, INT16 *n, OPP_CaseTable tab)
1174 {
1175 OPT_Node x = NIL, y = NIL, lastlab = NIL;
1176 INT16 i, f;
1177 INT32 xval, yval;
1178 *lab = NIL;
1179 lastlab = NIL;
1180 for (;;) {
1181 OPP_ConstExpression(&x);
1182 f = x->typ->form;
1183 if (__IN(f, 0x18, 32)) {
1184 xval = OPM_Longint(x->conval->intval);
1185 } else {
1186 OPP_err(61);
1187 xval = 1;
1188 }
1189 if (f == 4) {
1190 if (!(LabelTyp->form == 4) || LabelTyp->size < x->typ->size) {
1191 OPP_err(60);
1192 }
1193 } else if ((INT16)LabelTyp->form != f) {
1194 OPP_err(60);
1195 }
1196 if (OPP_sym == 21) {
1197 OPS_Get(&OPP_sym);
1198 OPP_ConstExpression(&y);
1199 yval = OPM_Longint(y->conval->intval);
1200 if (((INT16)y->typ->form != f && !((f == 4 && y->typ->form == 4)))) {
1201 OPP_err(60);
1202 }
1203 if (yval < xval) {
1204 OPP_err(63);
1205 yval = xval;
1206 }
1207 } else {
1208 yval = xval;
1209 }
1210 x->conval->intval2 = yval;
1211 i = *n;
1212 if (i < 128) {
1213 for (;;) {
1214 if (i == 0) {
1215 break;
1216 }
1217 if (tab[__X(i - 1, 128)].low <= yval) {
1218 if (tab[__X(i - 1, 128)].high >= xval) {
1219 OPP_err(62);
1220 }
1221 break;
1222 }
1223 tab[__X(i, 128)] = tab[__X(i - 1, 128)];
1224 i -= 1;
1225 }
1226 tab[__X(i, 128)].low = xval;
1227 tab[__X(i, 128)].high = yval;
1228 *n += 1;
1229 } else {
1230 OPP_err(213);
1231 }
1232 OPB_Link(&*lab, &lastlab, x);
1233 if (OPP_sym == 19) {
1234 OPS_Get(&OPP_sym);
1235 } else if (OPP_sym == 35 || OPP_sym == 38) {
1236 OPP_err(19);
1237 } else {
1238 break;
1239 }
1240 }
1241 }
1242
1243 static struct StatSeq__30 {
1244 INT32 *pos;
1245 struct StatSeq__30 *lnk;
1246 } *StatSeq__30_s;
1247
1248 static void CasePart__31 (OPT_Node *x);
1249 static void CheckBool__33 (OPT_Node *x);
1250 static void SetPos__35 (OPT_Node x);
1251
CasePart__31(OPT_Node * x)1252 static void CasePart__31 (OPT_Node *x)
1253 {
1254 INT16 n;
1255 INT32 low, high;
1256 BOOLEAN e;
1257 OPP_CaseTable tab;
1258 OPT_Node cases = NIL, lab = NIL, y = NIL, lastcase = NIL;
1259 OPP_Expression(&*x);
1260 *StatSeq__30_s->pos = OPM_errpos;
1261 if ((*x)->class == 8 || (*x)->class == 9) {
1262 OPP_err(126);
1263 } else if (!__IN((*x)->typ->form, 0x18, 32)) {
1264 OPP_err(125);
1265 }
1266 OPP_CheckSym(25);
1267 cases = NIL;
1268 lastcase = NIL;
1269 n = 0;
1270 for (;;) {
1271 if (OPP_sym < 40) {
1272 OPP_CaseLabelList(&lab, (*x)->typ, &n, tab);
1273 OPP_CheckSym(20);
1274 OPP_StatSeq(&y);
1275 OPB_Construct(17, &lab, y);
1276 OPB_Link(&cases, &lastcase, lab);
1277 }
1278 if (OPP_sym == 40) {
1279 OPS_Get(&OPP_sym);
1280 } else {
1281 break;
1282 }
1283 }
1284 if (n > 0) {
1285 low = tab[0].low;
1286 high = tab[__X(n - 1, 128)].high;
1287 if (high - low > 512) {
1288 OPP_err(209);
1289 }
1290 } else {
1291 low = 1;
1292 high = 0;
1293 }
1294 e = OPP_sym == 42;
1295 if (e) {
1296 OPS_Get(&OPP_sym);
1297 OPP_StatSeq(&y);
1298 } else {
1299 y = NIL;
1300 OPM_Mark(-307, OPM_curpos);
1301 }
1302 OPB_Construct(16, &cases, y);
1303 OPB_Construct(21, &*x, cases);
1304 cases->conval = OPT_NewConst();
1305 cases->conval->intval = low;
1306 cases->conval->intval2 = high;
1307 if (e) {
1308 cases->conval->setval = 0x02;
1309 } else {
1310 cases->conval->setval = 0x0;
1311 }
1312 }
1313
SetPos__35(OPT_Node x)1314 static void SetPos__35 (OPT_Node x)
1315 {
1316 x->conval = OPT_NewConst();
1317 x->conval->intval = *StatSeq__30_s->pos;
1318 }
1319
CheckBool__33(OPT_Node * x)1320 static void CheckBool__33 (OPT_Node *x)
1321 {
1322 if ((*x)->class == 8 || (*x)->class == 9) {
1323 OPP_err(126);
1324 *x = OPB_NewBoolConst(0);
1325 } else if ((*x)->typ->form != 2) {
1326 OPP_err(120);
1327 *x = OPB_NewBoolConst(0);
1328 }
1329 *StatSeq__30_s->pos = OPM_errpos;
1330 }
1331
OPP_StatSeq(OPT_Node * stat)1332 static void OPP_StatSeq (OPT_Node *stat)
1333 {
1334 OPT_Object fpar = NIL, id = NIL, t = NIL, obj = NIL;
1335 OPT_Struct idtyp = NIL;
1336 BOOLEAN e;
1337 OPT_Node s = NIL, x = NIL, y = NIL, z = NIL, apar = NIL, last = NIL, lastif = NIL;
1338 INT32 pos;
1339 OPS_Name name;
1340 struct StatSeq__30 _s;
1341 _s.pos = &pos;
1342 _s.lnk = StatSeq__30_s;
1343 StatSeq__30_s = &_s;
1344 *stat = NIL;
1345 last = NIL;
1346 for (;;) {
1347 x = NIL;
1348 if (OPP_sym < 38) {
1349 OPP_err(14);
1350 do {
1351 OPS_Get(&OPP_sym);
1352 } while (!(OPP_sym >= 38));
1353 }
1354 if (OPP_sym == 38) {
1355 OPP_qualident(&id);
1356 x = OPB_NewLeaf(id);
1357 OPP_selector(&x);
1358 if (OPP_sym == 34) {
1359 OPS_Get(&OPP_sym);
1360 OPP_Expression(&y);
1361 OPB_Assign(&x, y);
1362 } else if (OPP_sym == 9) {
1363 OPP_err(34);
1364 OPS_Get(&OPP_sym);
1365 OPP_Expression(&y);
1366 OPB_Assign(&x, y);
1367 } else if ((x->class == 9 && x->obj->mode == 8)) {
1368 OPP_StandProcCall(&x);
1369 if ((x != NIL && x->typ != OPT_notyp)) {
1370 OPP_err(55);
1371 }
1372 } else {
1373 OPB_PrepCall(&x, &fpar);
1374 if (OPP_sym == 30) {
1375 OPS_Get(&OPP_sym);
1376 OPP_ActualParameters(&apar, fpar);
1377 OPP_CheckSym(22);
1378 } else {
1379 apar = NIL;
1380 if (fpar != NIL) {
1381 OPP_err(65);
1382 }
1383 }
1384 OPB_Call(&x, apar, fpar);
1385 if (x->typ != OPT_notyp) {
1386 OPP_err(55);
1387 }
1388 if (OPP_level > 0) {
1389 OPT_topScope->link->leaf = 0;
1390 }
1391 }
1392 pos = OPM_errpos;
1393 } else if (OPP_sym == 45) {
1394 OPS_Get(&OPP_sym);
1395 OPP_Expression(&x);
1396 CheckBool__33(&x);
1397 OPP_CheckSym(26);
1398 OPP_StatSeq(&y);
1399 OPB_Construct(15, &x, y);
1400 SetPos__35(x);
1401 lastif = x;
1402 while (OPP_sym == 43) {
1403 OPS_Get(&OPP_sym);
1404 OPP_Expression(&y);
1405 CheckBool__33(&y);
1406 OPP_CheckSym(26);
1407 OPP_StatSeq(&z);
1408 OPB_Construct(15, &y, z);
1409 SetPos__35(y);
1410 OPB_Link(&x, &lastif, y);
1411 }
1412 if (OPP_sym == 42) {
1413 OPS_Get(&OPP_sym);
1414 OPP_StatSeq(&y);
1415 } else {
1416 y = NIL;
1417 }
1418 OPB_Construct(20, &x, y);
1419 OPP_CheckSym(41);
1420 OPB_OptIf(&x);
1421 pos = OPM_errpos;
1422 } else if (OPP_sym == 46) {
1423 OPS_Get(&OPP_sym);
1424 CasePart__31(&x);
1425 OPP_CheckSym(41);
1426 } else if (OPP_sym == 47) {
1427 OPS_Get(&OPP_sym);
1428 OPP_Expression(&x);
1429 CheckBool__33(&x);
1430 OPP_CheckSym(27);
1431 OPP_StatSeq(&y);
1432 OPB_Construct(22, &x, y);
1433 OPP_CheckSym(41);
1434 } else if (OPP_sym == 48) {
1435 OPS_Get(&OPP_sym);
1436 OPP_StatSeq(&x);
1437 if (OPP_sym == 44) {
1438 OPS_Get(&OPP_sym);
1439 OPP_Expression(&y);
1440 CheckBool__33(&y);
1441 } else {
1442 OPP_err(44);
1443 }
1444 OPB_Construct(23, &x, y);
1445 } else if (OPP_sym == 49) {
1446 OPS_Get(&OPP_sym);
1447 if (OPP_sym == 38) {
1448 OPP_qualident(&id);
1449 if (!(id->typ->form == 4)) {
1450 OPP_err(68);
1451 }
1452 OPP_CheckSym(34);
1453 OPP_Expression(&y);
1454 pos = OPM_errpos;
1455 x = OPB_NewLeaf(id);
1456 OPB_Assign(&x, y);
1457 SetPos__35(x);
1458 OPP_CheckSym(28);
1459 OPP_Expression(&y);
1460 pos = OPM_errpos;
1461 if (y->class != 7) {
1462 __MOVE("@@", name, 3);
1463 OPT_Insert(name, &t);
1464 __MOVE("@for", t->name, 5);
1465 t->mode = 1;
1466 t->typ = x->left->typ;
1467 obj = OPT_topScope->scope;
1468 if (obj == NIL) {
1469 OPT_topScope->scope = t;
1470 } else {
1471 while (obj->link != NIL) {
1472 obj = obj->link;
1473 }
1474 obj->link = t;
1475 }
1476 z = OPB_NewLeaf(t);
1477 OPB_Assign(&z, y);
1478 SetPos__35(z);
1479 OPB_Link(&*stat, &last, z);
1480 y = OPB_NewLeaf(t);
1481 } else if (!(y->typ->form == 4) || y->typ->size > x->left->typ->size) {
1482 OPP_err(113);
1483 }
1484 OPB_Link(&*stat, &last, x);
1485 if (OPP_sym == 29) {
1486 OPS_Get(&OPP_sym);
1487 OPP_ConstExpression(&z);
1488 } else {
1489 z = OPB_NewIntConst(1);
1490 }
1491 pos = OPM_errpos;
1492 x = OPB_NewLeaf(id);
1493 if (z->conval->intval > 0) {
1494 OPB_Op(12, &x, y);
1495 } else if (z->conval->intval < 0) {
1496 OPB_Op(14, &x, y);
1497 } else {
1498 OPP_err(63);
1499 OPB_Op(14, &x, y);
1500 }
1501 OPP_CheckSym(27);
1502 OPP_StatSeq(&s);
1503 y = OPB_NewLeaf(id);
1504 OPB_StPar1(&y, z, 13);
1505 SetPos__35(y);
1506 if (s == NIL) {
1507 s = y;
1508 } else {
1509 z = s;
1510 while (z->link != NIL) {
1511 z = z->link;
1512 }
1513 z->link = y;
1514 }
1515 OPP_CheckSym(41);
1516 OPB_Construct(22, &x, s);
1517 } else {
1518 OPP_err(38);
1519 }
1520 } else if (OPP_sym == 50) {
1521 OPS_Get(&OPP_sym);
1522 OPP_LoopLevel += 1;
1523 OPP_StatSeq(&x);
1524 OPP_LoopLevel -= 1;
1525 OPB_Construct(24, &x, NIL);
1526 OPP_CheckSym(41);
1527 pos = OPM_errpos;
1528 } else if (OPP_sym == 51) {
1529 OPS_Get(&OPP_sym);
1530 idtyp = NIL;
1531 x = NIL;
1532 for (;;) {
1533 if (OPP_sym == 38) {
1534 OPP_qualident(&id);
1535 y = OPB_NewLeaf(id);
1536 if ((((id != NIL && id->typ->form == 11)) && (id->mode == 2 || !id->leaf))) {
1537 OPP_err(245);
1538 }
1539 OPP_CheckSym(20);
1540 if (OPP_sym == 38) {
1541 OPP_qualident(&t);
1542 if (t->mode == 5) {
1543 if (id != NIL) {
1544 idtyp = id->typ;
1545 OPB_TypTest(&y, t, 0);
1546 id->typ = t->typ;
1547 } else {
1548 OPP_err(130);
1549 }
1550 } else {
1551 OPP_err(52);
1552 }
1553 } else {
1554 OPP_err(38);
1555 }
1556 } else {
1557 OPP_err(38);
1558 }
1559 pos = OPM_errpos;
1560 OPP_CheckSym(27);
1561 OPP_StatSeq(&s);
1562 OPB_Construct(15, &y, s);
1563 SetPos__35(y);
1564 if (idtyp != NIL) {
1565 id->typ = idtyp;
1566 idtyp = NIL;
1567 }
1568 if (x == NIL) {
1569 x = y;
1570 lastif = x;
1571 } else {
1572 OPB_Link(&x, &lastif, y);
1573 }
1574 if (OPP_sym == 40) {
1575 OPS_Get(&OPP_sym);
1576 } else {
1577 break;
1578 }
1579 }
1580 e = OPP_sym == 42;
1581 if (e) {
1582 OPS_Get(&OPP_sym);
1583 OPP_StatSeq(&s);
1584 } else {
1585 s = NIL;
1586 }
1587 OPB_Construct(27, &x, s);
1588 OPP_CheckSym(41);
1589 if (e) {
1590 x->subcl = 1;
1591 }
1592 } else if (OPP_sym == 52) {
1593 OPS_Get(&OPP_sym);
1594 if (OPP_LoopLevel == 0) {
1595 OPP_err(46);
1596 }
1597 OPB_Construct(25, &x, NIL);
1598 pos = OPM_errpos;
1599 } else if (OPP_sym == 53) {
1600 OPS_Get(&OPP_sym);
1601 if (OPP_sym < 39) {
1602 OPP_Expression(&x);
1603 }
1604 if (OPP_level > 0) {
1605 OPB_Return(&x, OPT_topScope->link);
1606 } else {
1607 OPB_Return(&x, NIL);
1608 }
1609 pos = OPM_errpos;
1610 }
1611 if (x != NIL) {
1612 SetPos__35(x);
1613 OPB_Link(&*stat, &last, x);
1614 }
1615 if (OPP_sym == 39) {
1616 OPS_Get(&OPP_sym);
1617 } else if (OPP_sym <= 38 || (45 <= OPP_sym && OPP_sym <= 53)) {
1618 OPP_err(39);
1619 } else {
1620 break;
1621 }
1622 }
1623 StatSeq__30_s = _s.lnk;
1624 }
1625
OPP_Block(OPT_Node * procdec,OPT_Node * statseq)1626 static void OPP_Block (OPT_Node *procdec, OPT_Node *statseq)
1627 {
1628 OPT_Struct typ = NIL;
1629 OPT_Object obj = NIL, first = NIL, last = NIL;
1630 OPT_Node x = NIL, lastdec = NIL;
1631 INT16 i;
1632 first = NIL;
1633 last = NIL;
1634 OPP_nofFwdPtr = 0;
1635 for (;;) {
1636 if (OPP_sym == 58) {
1637 OPS_Get(&OPP_sym);
1638 while (OPP_sym == 38) {
1639 OPT_Insert(OPS_name, &obj);
1640 OPP_CheckMark(&obj->vis);
1641 obj->typ = OPT_sinttyp;
1642 obj->mode = 1;
1643 if (OPP_sym == 9) {
1644 OPS_Get(&OPP_sym);
1645 OPP_ConstExpression(&x);
1646 } else if (OPP_sym == 34) {
1647 OPP_err(9);
1648 OPS_Get(&OPP_sym);
1649 OPP_ConstExpression(&x);
1650 } else {
1651 OPP_err(9);
1652 x = OPB_NewIntConst(1);
1653 }
1654 obj->mode = 3;
1655 obj->typ = x->typ;
1656 obj->conval = x->conval;
1657 OPP_CheckSym(39);
1658 }
1659 }
1660 if (OPP_sym == 59) {
1661 OPS_Get(&OPP_sym);
1662 while (OPP_sym == 38) {
1663 OPT_Insert(OPS_name, &obj);
1664 obj->mode = 5;
1665 obj->typ = OPT_undftyp;
1666 OPP_CheckMark(&obj->vis);
1667 if (OPP_sym == 9) {
1668 if (((((((((__STRCMP(obj->name, "SHORTINT") == 0 || __STRCMP(obj->name, "INTEGER") == 0) || __STRCMP(obj->name, "LONGINT") == 0) || __STRCMP(obj->name, "HUGEINT") == 0) || __STRCMP(obj->name, "REAL") == 0) || __STRCMP(obj->name, "LONGREAL") == 0) || __STRCMP(obj->name, "SET") == 0) || __STRCMP(obj->name, "CHAR") == 0) || __STRCMP(obj->name, "TRUE") == 0) || __STRCMP(obj->name, "FALSE") == 0) {
1669 OPM_Mark(-310, OPM_curpos);
1670 }
1671 OPS_Get(&OPP_sym);
1672 OPP_TypeDecl(&obj->typ, &obj->typ);
1673 } else if (OPP_sym == 34 || OPP_sym == 20) {
1674 OPP_err(9);
1675 OPS_Get(&OPP_sym);
1676 OPP_TypeDecl(&obj->typ, &obj->typ);
1677 } else {
1678 OPP_err(9);
1679 }
1680 if (obj->typ->strobj == NIL) {
1681 obj->typ->strobj = obj;
1682 }
1683 if (__IN(obj->typ->comp, 0x1c, 32)) {
1684 i = 0;
1685 while (i < OPP_nofFwdPtr) {
1686 typ = OPP_FwdPtr[__X(i, 64)];
1687 i += 1;
1688 if (__STRCMP(typ->link->name, obj->name) == 0) {
1689 typ->BaseTyp = obj->typ;
1690 typ->link->name[0] = 0x00;
1691 }
1692 }
1693 }
1694 OPP_CheckSym(39);
1695 }
1696 }
1697 if (OPP_sym == 60) {
1698 OPS_Get(&OPP_sym);
1699 while (OPP_sym == 38) {
1700 for (;;) {
1701 if (OPP_sym == 38) {
1702 OPT_Insert(OPS_name, &obj);
1703 OPP_CheckMark(&obj->vis);
1704 obj->mode = 1;
1705 obj->link = NIL;
1706 obj->leaf = obj->vis == 0;
1707 obj->typ = OPT_undftyp;
1708 if (first == NIL) {
1709 first = obj;
1710 }
1711 if (last == NIL) {
1712 OPT_topScope->scope = obj;
1713 } else {
1714 last->link = obj;
1715 }
1716 last = obj;
1717 } else {
1718 OPP_err(38);
1719 }
1720 if (OPP_sym == 19) {
1721 OPS_Get(&OPP_sym);
1722 } else if (OPP_sym == 38) {
1723 OPP_err(19);
1724 } else {
1725 break;
1726 }
1727 }
1728 OPP_CheckSym(20);
1729 OPP_Type(&typ, &OPT_notyp);
1730 typ->pvused = 1;
1731 if (typ->comp == 3) {
1732 typ = OPT_undftyp;
1733 OPP_err(88);
1734 }
1735 while (first != NIL) {
1736 first->typ = typ;
1737 first = first->link;
1738 }
1739 OPP_CheckSym(39);
1740 }
1741 }
1742 if (OPP_sym < 58 || OPP_sym > 60) {
1743 break;
1744 }
1745 }
1746 i = 0;
1747 while (i < OPP_nofFwdPtr) {
1748 if (OPP_FwdPtr[__X(i, 64)]->link->name[0] != 0x00) {
1749 OPP_err(128);
1750 }
1751 OPP_FwdPtr[__X(i, 64)] = NIL;
1752 i += 1;
1753 }
1754 OPT_topScope->adr = OPM_errpos;
1755 *procdec = NIL;
1756 lastdec = NIL;
1757 while (OPP_sym == 61) {
1758 OPS_Get(&OPP_sym);
1759 OPP_ProcedureDeclaration(&x);
1760 if (x != NIL) {
1761 if (lastdec == NIL) {
1762 *procdec = x;
1763 } else {
1764 lastdec->link = x;
1765 }
1766 lastdec = x;
1767 }
1768 OPP_CheckSym(39);
1769 }
1770 if (OPP_sym == 57) {
1771 OPS_Get(&OPP_sym);
1772 OPP_StatSeq(&*statseq);
1773 } else {
1774 *statseq = NIL;
1775 }
1776 if ((OPP_level == 0 && OPP_TDinit != NIL)) {
1777 OPP_lastTDinit->link = *statseq;
1778 *statseq = OPP_TDinit;
1779 }
1780 OPP_CheckSym(41);
1781 }
1782
OPP_Module(OPT_Node * prog,UINT32 opt)1783 void OPP_Module (OPT_Node *prog, UINT32 opt)
1784 {
1785 OPS_Name impName, aliasName;
1786 OPT_Node procdec = NIL, statseq = NIL;
1787 INT32 c;
1788 BOOLEAN done;
1789 OPS_Init();
1790 OPP_LoopLevel = 0;
1791 OPP_level = 0;
1792 OPS_Get(&OPP_sym);
1793 if (OPP_sym == 63) {
1794 OPS_Get(&OPP_sym);
1795 } else {
1796 OPP_err(16);
1797 }
1798 if (OPP_sym == 38) {
1799 OPM_LogCompiling(OPS_name, 256);
1800 OPT_Init(OPS_name, opt);
1801 OPS_Get(&OPP_sym);
1802 OPP_CheckSym(39);
1803 if (OPP_sym == 62) {
1804 OPS_Get(&OPP_sym);
1805 for (;;) {
1806 if (OPP_sym == 38) {
1807 __COPY(OPS_name, aliasName, 256);
1808 __COPY(aliasName, impName, 256);
1809 OPS_Get(&OPP_sym);
1810 if (OPP_sym == 34) {
1811 OPS_Get(&OPP_sym);
1812 if (OPP_sym == 38) {
1813 __COPY(OPS_name, impName, 256);
1814 OPS_Get(&OPP_sym);
1815 } else {
1816 OPP_err(38);
1817 }
1818 }
1819 OPT_Import(aliasName, impName, &done);
1820 } else {
1821 OPP_err(38);
1822 }
1823 if (OPP_sym == 19) {
1824 OPS_Get(&OPP_sym);
1825 } else if (OPP_sym == 38) {
1826 OPP_err(19);
1827 } else {
1828 break;
1829 }
1830 }
1831 OPP_CheckSym(39);
1832 }
1833 if (OPM_noerr) {
1834 OPP_TDinit = NIL;
1835 OPP_lastTDinit = NIL;
1836 c = OPM_errpos;
1837 OPP_Block(&procdec, &statseq);
1838 OPB_Enter(&procdec, statseq, NIL);
1839 *prog = procdec;
1840 (*prog)->conval = OPT_NewConst();
1841 (*prog)->conval->intval = c;
1842 if (OPP_sym == 38) {
1843 if (__STRCMP(OPS_name, OPT_SelfName) != 0) {
1844 OPP_err(4);
1845 }
1846 OPS_Get(&OPP_sym);
1847 } else {
1848 OPP_err(38);
1849 }
1850 if (OPP_sym != 18) {
1851 OPP_err(18);
1852 }
1853 }
1854 } else {
1855 OPP_err(38);
1856 }
1857 OPP_TDinit = NIL;
1858 OPP_lastTDinit = NIL;
1859 }
1860
EnumPtrs(void (* P)(void *))1861 static void EnumPtrs(void (*P)(void*))
1862 {
1863 P(OPP_TDinit);
1864 P(OPP_lastTDinit);
1865 __ENUMP(OPP_FwdPtr, 64, P);
1866 }
1867
1868 __TDESC(OPP__1, 1, 0) = {__TDFLDS("", 8), {-8}};
1869
OPP__init(void)1870 export void *OPP__init(void)
1871 {
1872 __DEFMOD;
1873 __MODULE_IMPORT(OPB);
1874 __MODULE_IMPORT(OPM);
1875 __MODULE_IMPORT(OPS);
1876 __MODULE_IMPORT(OPT);
1877 __REGMOD("OPP", EnumPtrs);
1878 __INITYP(OPP__1, OPP__1, 0);
1879 /* BEGIN */
1880 __ENDMOD;
1881 }
1882