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 "OPM.h"
10 #include "OPS.h"
11 #include "OPT.h"
12 
13 
14 static INT16 OPB_exp;
15 static INT64 OPB_maxExp;
16 
17 
18 export void OPB_Assign (OPT_Node *x, OPT_Node y);
19 static void OPB_BindNodes (INT8 class, OPT_Struct typ, OPT_Node *x, OPT_Node y);
20 static INT16 OPB_BoolToInt (BOOLEAN b);
21 export void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp);
22 static void OPB_CharToString (OPT_Node n);
23 static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode);
24 static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo);
25 export void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames);
26 static void OPB_CheckProc (OPT_Struct x, OPT_Object y);
27 static void OPB_CheckPtr (OPT_Node x, OPT_Node y);
28 static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x);
29 static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp);
30 static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y);
31 export void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y);
32 static void OPB_Convert (OPT_Node *x, OPT_Struct typ);
33 export void OPB_DeRef (OPT_Node *x);
34 static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar);
35 export OPT_Node OPB_EmptySet (void);
36 export void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc);
37 export void OPB_Field (OPT_Node *x, OPT_Object y);
38 export void OPB_In (OPT_Node *x, OPT_Node y);
39 export void OPB_Index (OPT_Node *x, OPT_Node y);
40 export void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ);
41 static BOOLEAN OPB_IntToBool (INT64 i);
42 export void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y);
43 export void OPB_MOp (INT8 op, OPT_Node *x);
44 export OPT_Node OPB_NewBoolConst (BOOLEAN boolval);
45 export OPT_Node OPB_NewIntConst (INT64 intval);
46 export OPT_Node OPB_NewLeaf (OPT_Object obj);
47 export OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ);
48 export OPT_Node OPB_NewString (OPS_String str, INT64 len);
49 export OPT_Node OPB_Nil (void);
50 static BOOLEAN OPB_NotVar (OPT_Node x);
51 export void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y);
52 export void OPB_OptIf (OPT_Node *x);
53 export void OPB_Param (OPT_Node ap, OPT_Object fp);
54 export void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar);
55 export void OPB_Return (OPT_Node *x, OPT_Object proc);
56 export void OPB_SetElem (OPT_Node *x);
57 static void OPB_SetIntType (OPT_Node node);
58 export void OPB_SetRange (OPT_Node *x, OPT_Node y);
59 static void OPB_SetSetType (OPT_Node node);
60 export void OPB_StFct (OPT_Node *par0, INT8 fctno, INT16 parno);
61 export void OPB_StPar0 (OPT_Node *par0, INT16 fctno);
62 export void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno);
63 export void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n);
64 export void OPB_StaticLink (INT8 dlev);
65 export void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard);
66 static void OPB_err (INT16 n);
67 static INT64 OPB_log (INT64 x);
68 
69 
OPB_err(INT16 n)70 static void OPB_err (INT16 n)
71 {
72 	OPM_err(n);
73 }
74 
OPB_NewLeaf(OPT_Object obj)75 OPT_Node OPB_NewLeaf (OPT_Object obj)
76 {
77 	OPT_Node node = NIL;
78 	switch (obj->mode) {
79 		case 1:
80 			node = OPT_NewNode(0);
81 			node->readonly = (obj->vis == 2 && obj->mnolev < 0);
82 			break;
83 		case 2:
84 			node = OPT_NewNode(1);
85 			break;
86 		case 3:
87 			node = OPT_NewNode(7);
88 			node->conval = OPT_NewConst();
89 			__GUARDEQP(node->conval, OPT_ConstDesc) = *obj->conval;
90 			break;
91 		case 5:
92 			node = OPT_NewNode(8);
93 			break;
94 		case 6: case 7: case 8: case 9: case 10:
95 			node = OPT_NewNode(9);
96 			break;
97 		default:
98 			node = OPT_NewNode(0);
99 			OPB_err(127);
100 			break;
101 	}
102 	node->obj = obj;
103 	node->typ = obj->typ;
104 	return node;
105 }
106 
OPB_Construct(INT8 class,OPT_Node * x,OPT_Node y)107 void OPB_Construct (INT8 class, OPT_Node *x, OPT_Node y)
108 {
109 	OPT_Node node = NIL;
110 	node = OPT_NewNode(class);
111 	node->typ = OPT_notyp;
112 	node->left = *x;
113 	node->right = y;
114 	*x = node;
115 }
116 
OPB_Link(OPT_Node * x,OPT_Node * last,OPT_Node y)117 void OPB_Link (OPT_Node *x, OPT_Node *last, OPT_Node y)
118 {
119 	if (*x == NIL) {
120 		*x = y;
121 	} else {
122 		(*last)->link = y;
123 	}
124 	while (y->link != NIL) {
125 		y = y->link;
126 	}
127 	*last = y;
128 }
129 
OPB_BoolToInt(BOOLEAN b)130 static INT16 OPB_BoolToInt (BOOLEAN b)
131 {
132 	if (b) {
133 		return 1;
134 	} else {
135 		return 0;
136 	}
137 	__RETCHK;
138 }
139 
OPB_IntToBool(INT64 i)140 static BOOLEAN OPB_IntToBool (INT64 i)
141 {
142 	return i != 0;
143 }
144 
OPB_NewBoolConst(BOOLEAN boolval)145 OPT_Node OPB_NewBoolConst (BOOLEAN boolval)
146 {
147 	OPT_Node x = NIL;
148 	x = OPT_NewNode(7);
149 	x->typ = OPT_booltyp;
150 	x->conval = OPT_NewConst();
151 	x->conval->intval = OPB_BoolToInt(boolval);
152 	return x;
153 }
154 
OPB_OptIf(OPT_Node * x)155 void OPB_OptIf (OPT_Node *x)
156 {
157 	OPT_Node if_ = NIL, pred = NIL;
158 	if_ = (*x)->left;
159 	while (if_->left->class == 7) {
160 		if (OPB_IntToBool(if_->left->conval->intval)) {
161 			*x = if_->right;
162 			return;
163 		} else if (if_->link == NIL) {
164 			*x = (*x)->right;
165 			return;
166 		} else {
167 			if_ = if_->link;
168 			(*x)->left = if_;
169 		}
170 	}
171 	pred = if_;
172 	if_ = if_->link;
173 	while (if_ != NIL) {
174 		if (if_->left->class == 7) {
175 			if (OPB_IntToBool(if_->left->conval->intval)) {
176 				pred->link = NIL;
177 				(*x)->right = if_->right;
178 				return;
179 			} else {
180 				if_ = if_->link;
181 				pred->link = if_;
182 			}
183 		} else {
184 			pred = if_;
185 			if_ = if_->link;
186 		}
187 	}
188 }
189 
OPB_Nil(void)190 OPT_Node OPB_Nil (void)
191 {
192 	OPT_Node x = NIL;
193 	x = OPT_NewNode(7);
194 	x->typ = OPT_niltyp;
195 	x->conval = OPT_NewConst();
196 	x->conval->intval = 0;
197 	return x;
198 }
199 
OPB_EmptySet(void)200 OPT_Node OPB_EmptySet (void)
201 {
202 	OPT_Node x = NIL;
203 	x = OPT_NewNode(7);
204 	x->typ = OPT_settyp;
205 	x->conval = OPT_NewConst();
206 	x->conval->setval = 0x0;
207 	return x;
208 }
209 
OPB_SetIntType(OPT_Node node)210 static void OPB_SetIntType (OPT_Node node)
211 {
212 	node->typ = OPT_IntType(OPT_IntSize(node->conval->intval));
213 }
214 
OPB_SetSetType(OPT_Node node)215 static void OPB_SetSetType (OPT_Node node)
216 {
217 	INT32 i32;
218 	__GET((ADDRESS)&node->conval->setval + 4, i32, INT32);
219 	if (i32 == 0) {
220 		node->typ = OPT_set32typ;
221 	} else {
222 		node->typ = OPT_set64typ;
223 	}
224 }
225 
OPB_NewIntConst(INT64 intval)226 OPT_Node OPB_NewIntConst (INT64 intval)
227 {
228 	OPT_Node x = NIL;
229 	x = OPT_NewNode(7);
230 	x->conval = OPT_NewConst();
231 	x->conval->intval = intval;
232 	OPB_SetIntType(x);
233 	return x;
234 }
235 
OPB_NewRealConst(LONGREAL realval,OPT_Struct typ)236 OPT_Node OPB_NewRealConst (LONGREAL realval, OPT_Struct typ)
237 {
238 	OPT_Node x = NIL;
239 	x = OPT_NewNode(7);
240 	x->conval = OPT_NewConst();
241 	x->conval->realval = realval;
242 	x->typ = typ;
243 	x->conval->intval = -1;
244 	return x;
245 }
246 
OPB_NewString(OPS_String str,INT64 len)247 OPT_Node OPB_NewString (OPS_String str, INT64 len)
248 {
249 	OPT_Node x = NIL;
250 	x = OPT_NewNode(7);
251 	x->conval = OPT_NewConst();
252 	x->typ = OPT_stringtyp;
253 	x->conval->intval = -1;
254 	x->conval->intval2 = OPM_Longint(len);
255 	x->conval->ext = OPT_NewExt();
256 	__MOVE(str, *x->conval->ext, 256);
257 	return x;
258 }
259 
OPB_CharToString(OPT_Node n)260 static void OPB_CharToString (OPT_Node n)
261 {
262 	CHAR ch;
263 	n->typ = OPT_stringtyp;
264 	ch = __CHR(n->conval->intval);
265 	n->conval->ext = OPT_NewExt();
266 	if (ch == 0x00) {
267 		n->conval->intval2 = 1;
268 	} else {
269 		n->conval->intval2 = 2;
270 		(*n->conval->ext)[1] = 0x00;
271 	}
272 	(*n->conval->ext)[0] = ch;
273 	n->conval->intval = -1;
274 	n->obj = NIL;
275 }
276 
OPB_BindNodes(INT8 class,OPT_Struct typ,OPT_Node * x,OPT_Node y)277 static void OPB_BindNodes (INT8 class, OPT_Struct typ, OPT_Node *x, OPT_Node y)
278 {
279 	OPT_Node node = NIL;
280 	node = OPT_NewNode(class);
281 	node->typ = typ;
282 	node->left = *x;
283 	node->right = y;
284 	*x = node;
285 }
286 
OPB_NotVar(OPT_Node x)287 static BOOLEAN OPB_NotVar (OPT_Node x)
288 {
289 	return (x->class >= 7 && ((x->class != 11 || x->subcl != 29) || x->left->class >= 7));
290 }
291 
OPB_DeRef(OPT_Node * x)292 void OPB_DeRef (OPT_Node *x)
293 {
294 	OPT_Object strobj = NIL, bstrobj = NIL;
295 	OPT_Struct typ = NIL, btyp = NIL;
296 	typ = (*x)->typ;
297 	if ((*x)->class >= 7) {
298 		OPB_err(78);
299 	} else if (typ->form == 11) {
300 		if (typ == OPT_sysptrtyp) {
301 			OPB_err(57);
302 		}
303 		btyp = typ->BaseTyp;
304 		strobj = typ->strobj;
305 		bstrobj = btyp->strobj;
306 		if ((((((strobj != NIL && strobj->name[0] != 0x00)) && bstrobj != NIL)) && bstrobj->name[0] != 0x00)) {
307 			btyp->pbused = 1;
308 		}
309 		OPB_BindNodes(3, btyp, &*x, NIL);
310 	} else {
311 		OPB_err(84);
312 	}
313 }
314 
OPB_Index(OPT_Node * x,OPT_Node y)315 void OPB_Index (OPT_Node *x, OPT_Node y)
316 {
317 	INT16 f;
318 	OPT_Struct typ = NIL;
319 	f = y->typ->form;
320 	if ((*x)->class >= 7) {
321 		OPB_err(79);
322 	} else if (f != 4 || __IN(y->class, 0x0300, 32)) {
323 		OPB_err(80);
324 		y->typ = OPT_inttyp;
325 	}
326 	if ((*x)->typ->comp == 2) {
327 		typ = (*x)->typ->BaseTyp;
328 		if ((y->class == 7 && (y->conval->intval < 0 || y->conval->intval >= (INT64)(*x)->typ->n))) {
329 			OPB_err(81);
330 		}
331 	} else if ((*x)->typ->comp == 3) {
332 		typ = (*x)->typ->BaseTyp;
333 		if ((y->class == 7 && y->conval->intval < 0)) {
334 			OPB_err(81);
335 		}
336 	} else {
337 		OPB_err(82);
338 		typ = OPT_undftyp;
339 	}
340 	OPB_BindNodes(4, typ, &*x, y);
341 	(*x)->readonly = (*x)->left->readonly;
342 }
343 
OPB_Field(OPT_Node * x,OPT_Object y)344 void OPB_Field (OPT_Node *x, OPT_Object y)
345 {
346 	if ((*x)->class >= 7) {
347 		OPB_err(77);
348 	}
349 	if ((y != NIL && __IN(y->mode, 0x2010, 32))) {
350 		OPB_BindNodes(2, y->typ, &*x, NIL);
351 		(*x)->obj = y;
352 		(*x)->readonly = (*x)->left->readonly || (y->vis == 2 && y->mnolev < 0);
353 	} else {
354 		OPB_err(83);
355 		(*x)->typ = OPT_undftyp;
356 	}
357 }
358 
359 static struct TypTest__58 {
360 	OPT_Node *x;
361 	OPT_Object *obj;
362 	BOOLEAN *guard;
363 	struct TypTest__58 *lnk;
364 } *TypTest__58_s;
365 
366 static void GTT__59 (OPT_Struct t0, OPT_Struct t1);
367 
GTT__59(OPT_Struct t0,OPT_Struct t1)368 static void GTT__59 (OPT_Struct t0, OPT_Struct t1)
369 {
370 	OPT_Node node = NIL;
371 	OPT_Struct t = NIL;
372 	t = t0;
373 	while ((((t != NIL && t != t1)) && t != OPT_undftyp)) {
374 		t = t->BaseTyp;
375 	}
376 	if (t != t1) {
377 		while ((((t1 != NIL && t1 != t0)) && t1 != OPT_undftyp)) {
378 			t1 = t1->BaseTyp;
379 		}
380 		if (t1 == t0 || t0->form == 0) {
381 			if (*TypTest__58_s->guard) {
382 				OPB_BindNodes(5, NIL, &*TypTest__58_s->x, NIL);
383 				(*TypTest__58_s->x)->readonly = (*TypTest__58_s->x)->left->readonly;
384 			} else {
385 				node = OPT_NewNode(11);
386 				node->subcl = 16;
387 				node->left = *TypTest__58_s->x;
388 				node->obj = *TypTest__58_s->obj;
389 				*TypTest__58_s->x = node;
390 			}
391 		} else {
392 			OPB_err(85);
393 		}
394 	} else if (t0 != t1) {
395 		OPB_err(85);
396 	} else if (!*TypTest__58_s->guard) {
397 		if ((*TypTest__58_s->x)->class == 5) {
398 			node = OPT_NewNode(11);
399 			node->subcl = 16;
400 			node->left = *TypTest__58_s->x;
401 			node->obj = *TypTest__58_s->obj;
402 			*TypTest__58_s->x = node;
403 		} else {
404 			*TypTest__58_s->x = OPB_NewBoolConst(1);
405 		}
406 	}
407 }
408 
OPB_TypTest(OPT_Node * x,OPT_Object obj,BOOLEAN guard)409 void OPB_TypTest (OPT_Node *x, OPT_Object obj, BOOLEAN guard)
410 {
411 	struct TypTest__58 _s;
412 	_s.x = x;
413 	_s.obj = &obj;
414 	_s.guard = &guard;
415 	_s.lnk = TypTest__58_s;
416 	TypTest__58_s = &_s;
417 	if (OPB_NotVar(*x)) {
418 		OPB_err(112);
419 	} else if ((*x)->typ->form == 11) {
420 		if (((*x)->typ->BaseTyp->comp != 4 && (*x)->typ != OPT_sysptrtyp)) {
421 			OPB_err(85);
422 		} else if (obj->typ->form == 11) {
423 			GTT__59((*x)->typ->BaseTyp, obj->typ->BaseTyp);
424 		} else {
425 			OPB_err(86);
426 		}
427 	} else if (((((*x)->typ->comp == 4 && (*x)->class == 1)) && obj->typ->comp == 4)) {
428 		GTT__59((*x)->typ, obj->typ);
429 	} else {
430 		OPB_err(87);
431 	}
432 	if (guard) {
433 		(*x)->typ = obj->typ;
434 	} else {
435 		(*x)->typ = OPT_booltyp;
436 	}
437 	TypTest__58_s = _s.lnk;
438 }
439 
OPB_In(OPT_Node * x,OPT_Node y)440 void OPB_In (OPT_Node *x, OPT_Node y)
441 {
442 	INT16 f;
443 	INT64 k;
444 	f = (*x)->typ->form;
445 	if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) {
446 		OPB_err(126);
447 	} else if ((f == 4 && y->typ->form == 7)) {
448 		if ((*x)->class == 7) {
449 			k = (*x)->conval->intval;
450 			if (k < 0 || k >= (INT64)__ASHL(y->typ->size, 3)) {
451 				OPB_err(202);
452 			} else if (y->class == 7) {
453 				(*x)->conval->intval = OPB_BoolToInt(__IN(k, y->conval->setval, 64));
454 				(*x)->obj = NIL;
455 			} else {
456 				OPB_BindNodes(12, OPT_booltyp, &*x, y);
457 				(*x)->subcl = 15;
458 			}
459 		} else {
460 			OPB_BindNodes(12, OPT_booltyp, &*x, y);
461 			(*x)->subcl = 15;
462 		}
463 	} else {
464 		OPB_err(92);
465 	}
466 	(*x)->typ = OPT_booltyp;
467 }
468 
OPB_log(INT64 x)469 static INT64 OPB_log (INT64 x)
470 {
471 	OPB_exp = 0;
472 	if (x > 0) {
473 		while (!__ODD(x)) {
474 			x = __ASHR(x, 1);
475 			OPB_exp += 1;
476 		}
477 	}
478 	return x;
479 }
480 
OPB_CheckRealType(INT16 f,INT16 nr,OPT_Const x)481 static void OPB_CheckRealType (INT16 f, INT16 nr, OPT_Const x)
482 {
483 	LONGREAL min, max, r;
484 	if (f == 5) {
485 		min = OPM_MinReal;
486 		max = OPM_MaxReal;
487 	} else {
488 		min = OPM_MinLReal;
489 		max = OPM_MaxLReal;
490 	}
491 	r = __ABS(x->realval);
492 	if (r > max || r < min) {
493 		OPB_err(nr);
494 		x->realval = (LONGREAL)1;
495 	} else if (f == 5) {
496 		x->realval = x->realval;
497 	}
498 	x->intval = -1;
499 }
500 
501 static struct MOp__28 {
502 	struct MOp__28 *lnk;
503 } *MOp__28_s;
504 
505 static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z);
506 
NewOp__29(INT8 op,OPT_Struct typ,OPT_Node z)507 static OPT_Node NewOp__29 (INT8 op, OPT_Struct typ, OPT_Node z)
508 {
509 	OPT_Node node = NIL;
510 	node = OPT_NewNode(11);
511 	node->subcl = op;
512 	node->typ = typ;
513 	node->left = z;
514 	return node;
515 }
516 
OPB_MOp(INT8 op,OPT_Node * x)517 void OPB_MOp (INT8 op, OPT_Node *x)
518 {
519 	INT16 f;
520 	OPT_Struct typ = NIL;
521 	OPT_Node z = NIL;
522 	struct MOp__28 _s;
523 	_s.lnk = MOp__28_s;
524 	MOp__28_s = &_s;
525 	z = *x;
526 	if (z->class == 8 || z->class == 9) {
527 		OPB_err(126);
528 	} else {
529 		typ = z->typ;
530 		f = typ->form;
531 		switch (op) {
532 			case 33:
533 				if (f == 2) {
534 					if (z->class == 7) {
535 						z->conval->intval = OPB_BoolToInt(!OPB_IntToBool(z->conval->intval));
536 						z->obj = NIL;
537 					} else {
538 						z = NewOp__29(op, typ, z);
539 					}
540 				} else {
541 					OPB_err(98);
542 				}
543 				break;
544 			case 6:
545 				if (!__IN(f, 0x70, 32)) {
546 					OPB_err(96);
547 				}
548 				break;
549 			case 7:
550 				if (__IN(f, 0xf0, 32)) {
551 					if (z->class == 7) {
552 						if (f == 4) {
553 							if (z->conval->intval == (-9223372036854775807LL-1)) {
554 								OPB_err(203);
555 							} else {
556 								z->conval->intval = -z->conval->intval;
557 								OPB_SetIntType(z);
558 							}
559 						} else if (__IN(f, 0x60, 32)) {
560 							z->conval->realval = -z->conval->realval;
561 						} else {
562 							if (z->typ->size == 8) {
563 								z->conval->setval = ~z->conval->setval;
564 							} else {
565 								z->conval->setval = z->conval->setval ^ 0xffffffff;
566 							}
567 						}
568 						z->obj = NIL;
569 					} else {
570 						z = NewOp__29(op, typ, z);
571 					}
572 				} else {
573 					OPB_err(97);
574 				}
575 				break;
576 			case 21:
577 				if (__IN(f, 0x70, 32)) {
578 					if (z->class == 7) {
579 						if (f == 4) {
580 							if (z->conval->intval == (-9223372036854775807LL-1)) {
581 								OPB_err(203);
582 							} else {
583 								z->conval->intval = __ABS(z->conval->intval);
584 								OPB_SetIntType(z);
585 							}
586 						} else {
587 							z->conval->realval = __ABS(z->conval->realval);
588 						}
589 						z->obj = NIL;
590 					} else {
591 						z = NewOp__29(op, typ, z);
592 					}
593 				} else {
594 					OPB_err(111);
595 				}
596 				break;
597 			case 22:
598 				if (f == 3) {
599 					if (z->class == 7) {
600 						z->conval->intval = (INT16)__CAP(__CHR(z->conval->intval));
601 						z->obj = NIL;
602 					} else {
603 						z = NewOp__29(op, typ, z);
604 					}
605 				} else {
606 					OPB_err(111);
607 					z->typ = OPT_chartyp;
608 				}
609 				break;
610 			case 23:
611 				if (f == 4) {
612 					if (z->class == 7) {
613 						z->conval->intval = OPB_BoolToInt(__ODD(z->conval->intval));
614 						z->obj = NIL;
615 					} else {
616 						z = NewOp__29(op, typ, z);
617 					}
618 				} else {
619 					OPB_err(111);
620 				}
621 				z->typ = OPT_booltyp;
622 				break;
623 			case 24:
624 				if ((((z->class == 7 && f == 3)) && z->conval->intval >= 32)) {
625 					OPB_CharToString(z);
626 					f = 8;
627 				}
628 				if (z->class < 7 || f == 8) {
629 					z = NewOp__29(op, typ, z);
630 				} else {
631 					OPB_err(127);
632 				}
633 				z->typ = OPT_adrtyp;
634 				break;
635 			case 25:
636 				if ((f == 4 && z->class == 7)) {
637 					if ((0 <= z->conval->intval && z->conval->intval <= -1)) {
638 						z = NewOp__29(op, typ, z);
639 					} else {
640 						OPB_err(219);
641 					}
642 				} else {
643 					OPB_err(69);
644 				}
645 				z->typ = OPT_booltyp;
646 				break;
647 			default:
648 				OPM_LogWStr((CHAR*)"unhandled case in OPB.MOp, op = ", 33);
649 				OPM_LogWNum(op, 0);
650 				OPM_LogWLn();
651 				break;
652 		}
653 	}
654 	*x = z;
655 	MOp__28_s = _s.lnk;
656 }
657 
OPB_CheckPtr(OPT_Node x,OPT_Node y)658 static void OPB_CheckPtr (OPT_Node x, OPT_Node y)
659 {
660 	INT16 g;
661 	OPT_Struct p = NIL, q = NIL, t = NIL;
662 	g = y->typ->form;
663 	if (g == 11) {
664 		p = x->typ->BaseTyp;
665 		q = y->typ->BaseTyp;
666 		if ((p->comp == 4 && q->comp == 4)) {
667 			if (p->extlev < q->extlev) {
668 				t = p;
669 				p = q;
670 				q = t;
671 			}
672 			while ((((p != q && p != NIL)) && p != OPT_undftyp)) {
673 				p = p->BaseTyp;
674 			}
675 			if (p == NIL) {
676 				OPB_err(100);
677 			}
678 		} else {
679 			OPB_err(100);
680 		}
681 	} else if (g != 9) {
682 		OPB_err(100);
683 	}
684 }
685 
OPB_CheckParameters(OPT_Object fp,OPT_Object ap,BOOLEAN checkNames)686 void OPB_CheckParameters (OPT_Object fp, OPT_Object ap, BOOLEAN checkNames)
687 {
688 	OPT_Struct ft = NIL, at = NIL;
689 	while (fp != NIL) {
690 		if (ap != NIL) {
691 			ft = fp->typ;
692 			at = ap->typ;
693 			while ((ft->comp == 3 && at->comp == 3)) {
694 				ft = ft->BaseTyp;
695 				at = at->BaseTyp;
696 			}
697 			if (ft != at) {
698 				if ((ft->form == 12 && at->form == 12)) {
699 					if (ft->BaseTyp == at->BaseTyp) {
700 						OPB_CheckParameters(ft->link, at->link, 0);
701 					} else {
702 						OPB_err(117);
703 					}
704 				} else {
705 					OPB_err(115);
706 				}
707 			}
708 			if (fp->mode != ap->mode || (checkNames && __STRCMP(fp->name, ap->name) != 0)) {
709 				OPB_err(115);
710 			}
711 			ap = ap->link;
712 		} else {
713 			OPB_err(116);
714 		}
715 		fp = fp->link;
716 	}
717 	if (ap != NIL) {
718 		OPB_err(116);
719 	}
720 }
721 
OPB_CheckProc(OPT_Struct x,OPT_Object y)722 static void OPB_CheckProc (OPT_Struct x, OPT_Object y)
723 {
724 	if (__IN(y->mode, 0x04c0, 32)) {
725 		if (y->mode == 6) {
726 			if (y->mnolev == 0) {
727 				y->mode = 7;
728 			} else {
729 				OPB_err(73);
730 			}
731 		}
732 		if (x->BaseTyp == y->typ) {
733 			OPB_CheckParameters(x->link, y->link, 0);
734 		} else {
735 			OPB_err(117);
736 		}
737 	} else {
738 		OPB_err(113);
739 	}
740 }
741 
742 static struct ConstOp__13 {
743 	OPT_Node *x;
744 	INT16 *f;
745 	OPT_Const *xval, *yval;
746 	struct ConstOp__13 *lnk;
747 } *ConstOp__13_s;
748 
749 static INT16 ConstCmp__14 (void);
750 
ConstCmp__14(void)751 static INT16 ConstCmp__14 (void)
752 {
753 	INT16 res;
754 	switch (*ConstOp__13_s->f) {
755 		case 0:
756 			res = 9;
757 			break;
758 		case 1: case 3: case 4:
759 			if ((*ConstOp__13_s->xval)->intval < (*ConstOp__13_s->yval)->intval) {
760 				res = 11;
761 			} else if ((*ConstOp__13_s->xval)->intval > (*ConstOp__13_s->yval)->intval) {
762 				res = 13;
763 			} else {
764 				res = 9;
765 			}
766 			break;
767 		case 5: case 6:
768 			if ((*ConstOp__13_s->xval)->realval < (*ConstOp__13_s->yval)->realval) {
769 				res = 11;
770 			} else if ((*ConstOp__13_s->xval)->realval > (*ConstOp__13_s->yval)->realval) {
771 				res = 13;
772 			} else {
773 				res = 9;
774 			}
775 			break;
776 		case 2:
777 			if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) {
778 				res = 10;
779 			} else {
780 				res = 9;
781 			}
782 			break;
783 		case 7:
784 			if ((*ConstOp__13_s->xval)->setval != (*ConstOp__13_s->yval)->setval) {
785 				res = 10;
786 			} else {
787 				res = 9;
788 			}
789 			break;
790 		case 8:
791 			if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) < 0) {
792 				res = 11;
793 			} else if (__STRCMP(*(*ConstOp__13_s->xval)->ext, *(*ConstOp__13_s->yval)->ext) > 0) {
794 				res = 13;
795 			} else {
796 				res = 9;
797 			}
798 			break;
799 		case 9: case 11: case 12:
800 			if ((*ConstOp__13_s->xval)->intval != (*ConstOp__13_s->yval)->intval) {
801 				res = 10;
802 			} else {
803 				res = 9;
804 			}
805 			break;
806 		default:
807 			OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstCmp, f = ", 37);
808 			OPM_LogWNum(*ConstOp__13_s->f, 0);
809 			OPM_LogWLn();
810 			break;
811 	}
812 	(*ConstOp__13_s->x)->typ = OPT_booltyp;
813 	return res;
814 }
815 
OPB_ConstOp(INT16 op,OPT_Node x,OPT_Node y)816 static void OPB_ConstOp (INT16 op, OPT_Node x, OPT_Node y)
817 {
818 	INT16 f, g;
819 	OPT_Const xval = NIL, yval = NIL;
820 	INT64 xv, yv;
821 	BOOLEAN temp;
822 	struct ConstOp__13 _s;
823 	_s.x = &x;
824 	_s.f = &f;
825 	_s.xval = &xval;
826 	_s.yval = &yval;
827 	_s.lnk = ConstOp__13_s;
828 	ConstOp__13_s = &_s;
829 	f = x->typ->form;
830 	g = y->typ->form;
831 	xval = x->conval;
832 	yval = y->conval;
833 	if (f != g) {
834 		switch (f) {
835 			case 3:
836 				if (g == 8) {
837 					OPB_CharToString(x);
838 				} else {
839 					OPB_err(100);
840 					y->typ = x->typ;
841 					__GUARDEQP(yval, OPT_ConstDesc) = *xval;
842 				}
843 				break;
844 			case 4:
845 				if (g == 4) {
846 					if (x->typ->size <= y->typ->size) {
847 						x->typ = y->typ;
848 					} else {
849 						x->typ = OPT_IntType(x->typ->size);
850 					}
851 				} else if (g == 5) {
852 					x->typ = OPT_realtyp;
853 					xval->realval = xval->intval;
854 				} else if (g == 6) {
855 					x->typ = OPT_lrltyp;
856 					xval->realval = xval->intval;
857 				} else {
858 					OPB_err(100);
859 					y->typ = x->typ;
860 					__GUARDEQP(yval, OPT_ConstDesc) = *xval;
861 				}
862 				break;
863 			case 5:
864 				if (g == 4) {
865 					y->typ = x->typ;
866 					yval->realval = yval->intval;
867 				} else if (g == 6) {
868 					x->typ = OPT_lrltyp;
869 				} else {
870 					OPB_err(100);
871 					y->typ = x->typ;
872 					__GUARDEQP(yval, OPT_ConstDesc) = *xval;
873 				}
874 				break;
875 			case 6:
876 				if (g == 4) {
877 					y->typ = x->typ;
878 					yval->realval = yval->intval;
879 				} else if (g == 5) {
880 					y->typ = OPT_lrltyp;
881 				} else {
882 					OPB_err(100);
883 					y->typ = x->typ;
884 					__GUARDEQP(yval, OPT_ConstDesc) = *xval;
885 				}
886 				break;
887 			case 8:
888 				if (g == 3) {
889 					OPB_CharToString(y);
890 					g = 8;
891 				} else {
892 					OPB_err(100);
893 					y->typ = x->typ;
894 					__GUARDEQP(yval, OPT_ConstDesc) = *xval;
895 				}
896 				break;
897 			case 9:
898 				if (!__IN(g, 0x1800, 32)) {
899 					OPB_err(100);
900 				}
901 				break;
902 			case 11:
903 				OPB_CheckPtr(x, y);
904 				break;
905 			case 12:
906 				if (g != 9) {
907 					OPB_err(100);
908 				}
909 				break;
910 			default:
911 				OPB_err(100);
912 				y->typ = x->typ;
913 				__GUARDEQP(yval, OPT_ConstDesc) = *xval;
914 				break;
915 		}
916 		f = x->typ->form;
917 	}
918 	switch (op) {
919 		case 1:
920 			if (f == 4) {
921 				xv = xval->intval;
922 				yv = yval->intval;
923 				if (((((xv == 0 || yv == 0) || (((xv > 0 && yv > 0)) && yv <= __DIV(9223372036854775807LL, xv))) || (((xv > 0 && yv < 0)) && yv >= __DIV((-9223372036854775807LL-1), xv))) || (((xv < 0 && yv > 0)) && xv >= __DIV((-9223372036854775807LL-1), yv))) || (((((((xv < 0 && yv < 0)) && xv != (-9223372036854775807LL-1))) && yv != (-9223372036854775807LL-1))) && -xv <= __DIV(9223372036854775807LL, -yv))) {
924 					xval->intval = xv * yv;
925 					OPB_SetIntType(x);
926 				} else {
927 					OPB_err(204);
928 				}
929 			} else if (__IN(f, 0x60, 32)) {
930 				temp = __ABS(yval->realval) <= (LONGREAL)1;
931 				if (temp || __ABS(xval->realval) <=   1.79769296342094e+308 / (LONGREAL)__ABS(yval->realval)) {
932 					xval->realval = xval->realval * yval->realval;
933 					OPB_CheckRealType(f, 204, xval);
934 				} else {
935 					OPB_err(204);
936 				}
937 			} else if (f == 7) {
938 				xval->setval = (xval->setval & yval->setval);
939 				OPB_SetSetType(x);
940 			} else if (f != 0) {
941 				OPB_err(101);
942 			}
943 			break;
944 		case 2:
945 			if (f == 4) {
946 				if (yval->intval != 0) {
947 					xval->realval = xval->intval / (REAL)yval->intval;
948 					OPB_CheckRealType(5, 205, xval);
949 				} else {
950 					OPB_err(205);
951 					xval->realval = (LONGREAL)1;
952 				}
953 				x->typ = OPT_realtyp;
954 			} else if (__IN(f, 0x60, 32)) {
955 				temp = __ABS(yval->realval) >= (LONGREAL)1;
956 				if (temp || __ABS(xval->realval) <=   1.79769296342094e+308 * __ABS(yval->realval)) {
957 					xval->realval = xval->realval / yval->realval;
958 					OPB_CheckRealType(f, 205, xval);
959 				} else {
960 					OPB_err(205);
961 				}
962 			} else if (f == 7) {
963 				xval->setval = xval->setval ^ yval->setval;
964 				OPB_SetSetType(x);
965 			} else if (f != 0) {
966 				OPB_err(102);
967 			}
968 			break;
969 		case 3:
970 			if (f == 4) {
971 				if (yval->intval != 0) {
972 					xval->intval = __DIV(xval->intval, yval->intval);
973 					OPB_SetIntType(x);
974 				} else {
975 					OPB_err(205);
976 				}
977 			} else if (f != 0) {
978 				OPB_err(103);
979 			}
980 			break;
981 		case 4:
982 			if (f == 4) {
983 				if (yval->intval != 0) {
984 					xval->intval = __MOD(xval->intval, yval->intval);
985 					OPB_SetIntType(x);
986 				} else {
987 					OPB_err(205);
988 				}
989 			} else if (f != 0) {
990 				OPB_err(104);
991 			}
992 			break;
993 		case 5:
994 			if (f == 2) {
995 				xval->intval = OPB_BoolToInt((OPB_IntToBool(xval->intval) && OPB_IntToBool(yval->intval)));
996 			} else {
997 				OPB_err(94);
998 			}
999 			break;
1000 		case 6:
1001 			if (f == 4) {
1002 				temp = (yval->intval >= 0 && xval->intval <= 9223372036854775807LL - yval->intval);
1003 				if (temp || (yval->intval < 0 && xval->intval >= (-9223372036854775807LL-1) - yval->intval)) {
1004 					xval->intval += yval->intval;
1005 					OPB_SetIntType(x);
1006 				} else {
1007 					OPB_err(206);
1008 				}
1009 			} else if (__IN(f, 0x60, 32)) {
1010 				temp = (yval->realval >= (LONGREAL)0 && xval->realval <=   1.79769296342094e+308 - yval->realval);
1011 				if (temp || (yval->realval < (LONGREAL)0 && xval->realval >=  -1.79769296342094e+308 - yval->realval)) {
1012 					xval->realval = xval->realval + yval->realval;
1013 					OPB_CheckRealType(f, 206, xval);
1014 				} else {
1015 					OPB_err(206);
1016 				}
1017 			} else if (f == 7) {
1018 				xval->setval = xval->setval | yval->setval;
1019 				OPB_SetSetType(x);
1020 			} else if (f != 0) {
1021 				OPB_err(105);
1022 			}
1023 			break;
1024 		case 7:
1025 			if (f == 4) {
1026 				if ((yval->intval >= 0 && xval->intval >= (-9223372036854775807LL-1) + yval->intval) || (yval->intval < 0 && xval->intval <= 9223372036854775807LL + yval->intval)) {
1027 					xval->intval -= yval->intval;
1028 					OPB_SetIntType(x);
1029 				} else {
1030 					OPB_err(207);
1031 				}
1032 			} else if (__IN(f, 0x60, 32)) {
1033 				temp = (yval->realval >= (LONGREAL)0 && xval->realval >=  -1.79769296342094e+308 + yval->realval);
1034 				if (temp || (yval->realval < (LONGREAL)0 && xval->realval <=   1.79769296342094e+308 + yval->realval)) {
1035 					xval->realval = xval->realval - yval->realval;
1036 					OPB_CheckRealType(f, 207, xval);
1037 				} else {
1038 					OPB_err(207);
1039 				}
1040 			} else if (f == 7) {
1041 				xval->setval = (xval->setval & ~yval->setval);
1042 				OPB_SetSetType(x);
1043 			} else if (f != 0) {
1044 				OPB_err(106);
1045 			}
1046 			break;
1047 		case 8:
1048 			if (f == 2) {
1049 				xval->intval = OPB_BoolToInt(OPB_IntToBool(xval->intval) || OPB_IntToBool(yval->intval));
1050 			} else {
1051 				OPB_err(95);
1052 			}
1053 			break;
1054 		case 9:
1055 			xval->intval = OPB_BoolToInt(ConstCmp__14() == 9);
1056 			break;
1057 		case 10:
1058 			xval->intval = OPB_BoolToInt(ConstCmp__14() != 9);
1059 			break;
1060 		case 11:
1061 			if (__IN(f, 0x0a84, 32)) {
1062 				OPB_err(108);
1063 			} else {
1064 				xval->intval = OPB_BoolToInt(ConstCmp__14() == 11);
1065 			}
1066 			break;
1067 		case 12:
1068 			if (__IN(f, 0x0a84, 32)) {
1069 				OPB_err(108);
1070 			} else {
1071 				xval->intval = OPB_BoolToInt(ConstCmp__14() != 13);
1072 			}
1073 			break;
1074 		case 13:
1075 			if (__IN(f, 0x0a84, 32)) {
1076 				OPB_err(108);
1077 			} else {
1078 				xval->intval = OPB_BoolToInt(ConstCmp__14() == 13);
1079 			}
1080 			break;
1081 		case 14:
1082 			if (__IN(f, 0x0a84, 32)) {
1083 				OPB_err(108);
1084 			} else {
1085 				xval->intval = OPB_BoolToInt(ConstCmp__14() != 11);
1086 			}
1087 			break;
1088 		default:
1089 			OPM_LogWStr((CHAR*)"unhandled case in OPB.ConstOp, op = ", 37);
1090 			OPM_LogWNum(op, 0);
1091 			OPM_LogWLn();
1092 			break;
1093 	}
1094 	ConstOp__13_s = _s.lnk;
1095 }
1096 
OPB_Convert(OPT_Node * x,OPT_Struct typ)1097 static void OPB_Convert (OPT_Node *x, OPT_Struct typ)
1098 {
1099 	OPT_Node node = NIL;
1100 	INT16 f, g;
1101 	INT64 k;
1102 	LONGREAL r;
1103 	f = (*x)->typ->form;
1104 	g = typ->form;
1105 	if ((*x)->class == 7) {
1106 		if ((((f == 7 && g == 7)) && (*x)->typ->size > typ->size)) {
1107 			OPB_SetSetType(*x);
1108 			if ((*x)->typ->size > typ->size) {
1109 				OPB_err(203);
1110 				(*x)->conval->setval = 0x0;
1111 			}
1112 		} else if (f == 4) {
1113 			if (g == 4) {
1114 				if ((*x)->typ->size > typ->size) {
1115 					OPB_SetIntType(*x);
1116 					if ((*x)->typ->size > typ->size) {
1117 						OPB_err(203);
1118 						(*x)->conval->intval = 1;
1119 					}
1120 				}
1121 			} else if (__IN(g, 0x60, 32)) {
1122 				(*x)->conval->realval = (*x)->conval->intval;
1123 				(*x)->conval->intval = -1;
1124 			} else {
1125 				k = (*x)->conval->intval;
1126 				if (0 > k || k > 255) {
1127 					OPB_err(220);
1128 				}
1129 			}
1130 		} else if (__IN(f, 0x60, 32)) {
1131 			if (__IN(g, 0x60, 32)) {
1132 				OPB_CheckRealType(g, 203, (*x)->conval);
1133 			} else {
1134 				r = (*x)->conval->realval;
1135 				if (r <  -9.22337203685478e+018 || r >   9.22337203685478e+018) {
1136 					OPB_err(203);
1137 					r = (LONGREAL)1;
1138 				}
1139 				(*x)->conval->intval = __SHORT(__ENTIER(r), 2147483648LL);
1140 				OPB_SetIntType(*x);
1141 			}
1142 		}
1143 		(*x)->obj = NIL;
1144 	} else if (((((*x)->class == 11 && (*x)->subcl == 20)) && ((INT16)(*x)->left->typ->form < f || f > g))) {
1145 		if ((*x)->left->typ == typ) {
1146 			*x = (*x)->left;
1147 		}
1148 	} else {
1149 		node = OPT_NewNode(11);
1150 		node->subcl = 20;
1151 		node->left = *x;
1152 		*x = node;
1153 	}
1154 	(*x)->typ = typ;
1155 }
1156 
1157 static struct Op__38 {
1158 	INT16 *f, *g;
1159 	struct Op__38 *lnk;
1160 } *Op__38_s;
1161 
1162 static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y);
1163 static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y);
1164 
NewOp__39(INT8 op,OPT_Struct typ,OPT_Node * x,OPT_Node y)1165 static void NewOp__39 (INT8 op, OPT_Struct typ, OPT_Node *x, OPT_Node y)
1166 {
1167 	OPT_Node node = NIL;
1168 	node = OPT_NewNode(12);
1169 	node->subcl = op;
1170 	node->typ = typ;
1171 	node->left = *x;
1172 	node->right = y;
1173 	*x = node;
1174 }
1175 
strings__41(OPT_Node * x,OPT_Node * y)1176 static BOOLEAN strings__41 (OPT_Node *x, OPT_Node *y)
1177 {
1178 	BOOLEAN ok, xCharArr, yCharArr;
1179 	xCharArr = (__IN((*x)->typ->comp, 0x0c, 32) && (*x)->typ->BaseTyp->form == 3) || *Op__38_s->f == 8;
1180 	yCharArr = (__IN((*y)->typ->comp, 0x0c, 32) && (*y)->typ->BaseTyp->form == 3) || *Op__38_s->g == 8;
1181 	if ((((xCharArr && *Op__38_s->g == 3)) && (*y)->class == 7)) {
1182 		OPB_CharToString(*y);
1183 		*Op__38_s->g = 8;
1184 		yCharArr = 1;
1185 	}
1186 	if ((((yCharArr && *Op__38_s->f == 3)) && (*x)->class == 7)) {
1187 		OPB_CharToString(*x);
1188 		*Op__38_s->f = 8;
1189 		xCharArr = 1;
1190 	}
1191 	ok = (xCharArr && yCharArr);
1192 	if (ok) {
1193 		if ((*Op__38_s->f == 8 && (*x)->conval->intval2 == 1)) {
1194 			(*x)->typ = OPT_chartyp;
1195 			(*x)->conval->intval = 0;
1196 			OPB_Index(&*y, OPB_NewIntConst(0));
1197 		} else if ((*Op__38_s->g == 8 && (*y)->conval->intval2 == 1)) {
1198 			(*y)->typ = OPT_chartyp;
1199 			(*y)->conval->intval = 0;
1200 			OPB_Index(&*x, OPB_NewIntConst(0));
1201 		}
1202 	}
1203 	return ok;
1204 }
1205 
OPB_Op(INT8 op,OPT_Node * x,OPT_Node y)1206 void OPB_Op (INT8 op, OPT_Node *x, OPT_Node y)
1207 {
1208 	INT16 f, g;
1209 	OPT_Node t = NIL, z = NIL;
1210 	OPT_Struct typ = NIL;
1211 	BOOLEAN do_;
1212 	INT64 val;
1213 	struct Op__38 _s;
1214 	_s.f = &f;
1215 	_s.g = &g;
1216 	_s.lnk = Op__38_s;
1217 	Op__38_s = &_s;
1218 	z = *x;
1219 	if (((z->class == 8 || z->class == 9) || y->class == 8) || y->class == 9) {
1220 		OPB_err(126);
1221 	} else if ((z->class == 7 && y->class == 7)) {
1222 		OPB_ConstOp(op, z, y);
1223 		z->obj = NIL;
1224 	} else {
1225 		if (z->typ != y->typ) {
1226 			g = y->typ->form;
1227 			switch (z->typ->form) {
1228 				case 3:
1229 					if (z->class == 7) {
1230 						OPB_CharToString(z);
1231 					} else {
1232 						OPB_err(100);
1233 					}
1234 					break;
1235 				case 4:
1236 					if ((g == 4 && y->typ->size < z->typ->size)) {
1237 						OPB_Convert(&y, z->typ);
1238 					} else if (__IN(g, 0x70, 32)) {
1239 						OPB_Convert(&z, y->typ);
1240 					} else {
1241 						OPB_err(100);
1242 					}
1243 					break;
1244 				case 7:
1245 					if ((g == 7 && y->typ->size < z->typ->size)) {
1246 						OPB_Convert(&y, z->typ);
1247 					} else if (g == 7) {
1248 						OPB_Convert(&z, y->typ);
1249 					} else {
1250 						OPB_err(100);
1251 					}
1252 					break;
1253 				case 5:
1254 					if (g == 4) {
1255 						OPB_Convert(&y, z->typ);
1256 					} else if (__IN(g, 0x60, 32)) {
1257 						OPB_Convert(&z, y->typ);
1258 					} else {
1259 						OPB_err(100);
1260 					}
1261 					break;
1262 				case 6:
1263 					if (__IN(g, 0x70, 32)) {
1264 						OPB_Convert(&y, z->typ);
1265 					} else if (__IN(g, 0x60, 32)) {
1266 						OPB_Convert(&y, z->typ);
1267 					} else {
1268 						OPB_err(100);
1269 					}
1270 					break;
1271 				case 9:
1272 					if (!__IN(g, 0x1800, 32)) {
1273 						OPB_err(100);
1274 					}
1275 					break;
1276 				case 11:
1277 					OPB_CheckPtr(z, y);
1278 					break;
1279 				case 12:
1280 					if (g != 9) {
1281 						OPB_err(100);
1282 					}
1283 					break;
1284 				case 8:
1285 					break;
1286 				case 13:
1287 					if (z->typ->comp == 4) {
1288 						OPB_err(100);
1289 					}
1290 					break;
1291 				default:
1292 					OPB_err(100);
1293 					break;
1294 			}
1295 		}
1296 		typ = z->typ;
1297 		f = typ->form;
1298 		g = y->typ->form;
1299 		switch (op) {
1300 			case 1:
1301 				do_ = 1;
1302 				if (f == 4) {
1303 					if (z->class == 7) {
1304 						val = z->conval->intval;
1305 						if (val == 1) {
1306 							do_ = 0;
1307 							z = y;
1308 						} else if (val == 0) {
1309 							do_ = 0;
1310 						} else if (OPB_log(val) == 1) {
1311 							t = y;
1312 							y = z;
1313 							z = t;
1314 							op = 17;
1315 							y->typ = OPT_sinttyp;
1316 							y->conval->intval = OPB_exp;
1317 							y->obj = NIL;
1318 						}
1319 					} else if (y->class == 7) {
1320 						val = y->conval->intval;
1321 						if (val == 1) {
1322 							do_ = 0;
1323 						} else if (val == 0) {
1324 							do_ = 0;
1325 							z = y;
1326 						} else if (OPB_log(val) == 1) {
1327 							op = 17;
1328 							y->typ = OPT_sinttyp;
1329 							y->conval->intval = OPB_exp;
1330 							y->obj = NIL;
1331 						}
1332 					}
1333 				} else if (!__IN(f, 0xe1, 32)) {
1334 					OPB_err(105);
1335 					typ = OPT_undftyp;
1336 				}
1337 				if (do_) {
1338 					NewOp__39(op, typ, &z, y);
1339 				}
1340 				break;
1341 			case 2:
1342 				if (f == 4) {
1343 					if ((y->class == 7 && y->conval->intval == 0)) {
1344 						OPB_err(205);
1345 					}
1346 					OPB_Convert(&z, OPT_realtyp);
1347 					OPB_Convert(&y, OPT_realtyp);
1348 					typ = OPT_realtyp;
1349 				} else if (__IN(f, 0x60, 32)) {
1350 					if ((y->class == 7 && y->conval->realval == (LONGREAL)0)) {
1351 						OPB_err(205);
1352 					}
1353 				} else if ((f != 7 && f != 0)) {
1354 					OPB_err(102);
1355 					typ = OPT_undftyp;
1356 				}
1357 				NewOp__39(op, typ, &z, y);
1358 				break;
1359 			case 3:
1360 				do_ = 1;
1361 				if (f == 4) {
1362 					if (y->class == 7) {
1363 						val = y->conval->intval;
1364 						if (val == 0) {
1365 							OPB_err(205);
1366 						} else if (val == 1) {
1367 							do_ = 0;
1368 						} else if (OPB_log(val) == 1) {
1369 							op = 17;
1370 							y->typ = OPT_sinttyp;
1371 							y->conval->intval = -OPB_exp;
1372 							y->obj = NIL;
1373 						}
1374 					}
1375 				} else if (f != 0) {
1376 					OPB_err(103);
1377 					typ = OPT_undftyp;
1378 				}
1379 				if (do_) {
1380 					NewOp__39(op, typ, &z, y);
1381 				}
1382 				break;
1383 			case 4:
1384 				if (f == 4) {
1385 					if (y->class == 7) {
1386 						if (y->conval->intval == 0) {
1387 							OPB_err(205);
1388 						} else if (OPB_log(y->conval->intval) == 1) {
1389 							op = 18;
1390 							y->conval->intval = __ASH(-1, OPB_exp);
1391 							y->obj = NIL;
1392 						}
1393 					}
1394 				} else if (f != 0) {
1395 					OPB_err(104);
1396 					typ = OPT_undftyp;
1397 				}
1398 				NewOp__39(op, typ, &z, y);
1399 				break;
1400 			case 5:
1401 				if (f == 2) {
1402 					if (z->class == 7) {
1403 						if (OPB_IntToBool(z->conval->intval)) {
1404 							z = y;
1405 						}
1406 					} else if ((y->class == 7 && OPB_IntToBool(y->conval->intval))) {
1407 					} else {
1408 						NewOp__39(op, typ, &z, y);
1409 					}
1410 				} else if (f != 0) {
1411 					OPB_err(94);
1412 					z->typ = OPT_undftyp;
1413 				}
1414 				break;
1415 			case 6:
1416 				if (!__IN(f, 0xf1, 32)) {
1417 					OPB_err(105);
1418 					typ = OPT_undftyp;
1419 				}
1420 				do_ = 1;
1421 				if (f == 4) {
1422 					if ((z->class == 7 && z->conval->intval == 0)) {
1423 						do_ = 0;
1424 						z = y;
1425 					}
1426 					if ((y->class == 7 && y->conval->intval == 0)) {
1427 						do_ = 0;
1428 					}
1429 				}
1430 				if (do_) {
1431 					NewOp__39(op, typ, &z, y);
1432 				}
1433 				break;
1434 			case 7:
1435 				if (!__IN(f, 0xf1, 32)) {
1436 					OPB_err(106);
1437 					typ = OPT_undftyp;
1438 				}
1439 				if ((f != 4 || y->class != 7) || y->conval->intval != 0) {
1440 					NewOp__39(op, typ, &z, y);
1441 				}
1442 				break;
1443 			case 8:
1444 				if (f == 2) {
1445 					if (z->class == 7) {
1446 						if (!OPB_IntToBool(z->conval->intval)) {
1447 							z = y;
1448 						}
1449 					} else if ((y->class == 7 && !OPB_IntToBool(y->conval->intval))) {
1450 					} else {
1451 						NewOp__39(op, typ, &z, y);
1452 					}
1453 				} else if (f != 0) {
1454 					OPB_err(95);
1455 					z->typ = OPT_undftyp;
1456 				}
1457 				break;
1458 			case 9: case 10:
1459 				if (__IN(f, 0x1aff, 32) || strings__41(&z, &y)) {
1460 					typ = OPT_booltyp;
1461 				} else {
1462 					OPB_err(107);
1463 					typ = OPT_undftyp;
1464 				}
1465 				NewOp__39(op, typ, &z, y);
1466 				break;
1467 			case 11: case 12: case 13: case 14:
1468 				if (__IN(f, 0x79, 32) || strings__41(&z, &y)) {
1469 					typ = OPT_booltyp;
1470 				} else {
1471 					OPM_LogWLn();
1472 					OPM_LogWStr((CHAR*)"ELSE in Op()", 13);
1473 					OPM_LogWLn();
1474 					OPB_err(108);
1475 					typ = OPT_undftyp;
1476 				}
1477 				NewOp__39(op, typ, &z, y);
1478 				break;
1479 			default:
1480 				OPM_LogWStr((CHAR*)"unhandled case in OPB.Op, op = ", 32);
1481 				OPM_LogWNum(op, 0);
1482 				OPM_LogWLn();
1483 				break;
1484 		}
1485 	}
1486 	*x = z;
1487 	Op__38_s = _s.lnk;
1488 }
1489 
OPB_SetRange(OPT_Node * x,OPT_Node y)1490 void OPB_SetRange (OPT_Node *x, OPT_Node y)
1491 {
1492 	INT64 k, l;
1493 	if ((((*x)->class == 8 || (*x)->class == 9) || y->class == 8) || y->class == 9) {
1494 		OPB_err(126);
1495 	} else if (((*x)->typ->form == 4 && y->typ->form == 4)) {
1496 		if ((*x)->class == 7) {
1497 			k = (*x)->conval->intval;
1498 			if (0 > k || k > 63) {
1499 				OPB_err(202);
1500 			}
1501 		}
1502 		if (y->class == 7) {
1503 			l = y->conval->intval;
1504 			if (0 > l || l > 63) {
1505 				OPB_err(202);
1506 			}
1507 		}
1508 		if (((*x)->class == 7 && y->class == 7)) {
1509 			if (k <= l) {
1510 				(*x)->conval->setval = __SETRNG(k, l, 32);
1511 				OPB_SetSetType(*x);
1512 			} else {
1513 				OPB_err(201);
1514 				(*x)->conval->setval = __SETRNG(l, k, 32);
1515 			}
1516 			(*x)->obj = NIL;
1517 		} else {
1518 			OPB_BindNodes(10, OPT_settyp, &*x, y);
1519 		}
1520 	} else {
1521 		OPB_err(93);
1522 	}
1523 	(*x)->typ = OPT_settyp;
1524 }
1525 
OPB_SetElem(OPT_Node * x)1526 void OPB_SetElem (OPT_Node *x)
1527 {
1528 	INT64 k;
1529 	if ((*x)->class == 8 || (*x)->class == 9) {
1530 		OPB_err(126);
1531 	} else if ((*x)->typ->form != 4) {
1532 		OPB_err(93);
1533 	} else if ((*x)->class == 7) {
1534 		k = (*x)->conval->intval;
1535 		if ((0 <= k && k <= 63)) {
1536 			(*x)->conval->setval = 0x0;
1537 			(*x)->conval->setval |= __SETOF(k,64);
1538 		} else {
1539 			OPB_err(202);
1540 		}
1541 		OPB_SetSetType(*x);
1542 		(*x)->obj = NIL;
1543 	} else {
1544 		OPB_Convert(&*x, OPT_settyp);
1545 		(*x)->typ = OPT_settyp;
1546 	}
1547 }
1548 
OPB_CheckAssign(OPT_Struct x,OPT_Node ynode)1549 static void OPB_CheckAssign (OPT_Struct x, OPT_Node ynode)
1550 {
1551 	OPT_Struct y = NIL;
1552 	INT16 f, g;
1553 	OPT_Struct p = NIL, q = NIL;
1554 	y = ynode->typ;
1555 	f = x->form;
1556 	g = y->form;
1557 	if (ynode->class == 8 || (ynode->class == 9 && f != 12)) {
1558 		OPB_err(126);
1559 	}
1560 	switch (f) {
1561 		case 0: case 8:
1562 			break;
1563 		case 1:
1564 			if (!((__IN(g, 0x1a, 32) && y->size == 1))) {
1565 				OPB_err(113);
1566 			}
1567 			break;
1568 		case 2: case 3:
1569 			if (g != f) {
1570 				OPB_err(113);
1571 			}
1572 			break;
1573 		case 4: case 7:
1574 			if (g != f || x->size < y->size) {
1575 				OPB_err(113);
1576 			}
1577 			break;
1578 		case 5:
1579 			if (!__IN(g, 0x30, 32)) {
1580 				OPB_err(113);
1581 			}
1582 			break;
1583 		case 6:
1584 			if (!__IN(g, 0x70, 32)) {
1585 				OPB_err(113);
1586 			}
1587 			break;
1588 		case 11:
1589 			if ((x == y || g == 9) || (x == OPT_sysptrtyp && g == 11)) {
1590 			} else if (g == 11) {
1591 				p = x->BaseTyp;
1592 				q = y->BaseTyp;
1593 				if ((p->comp == 4 && q->comp == 4)) {
1594 					while ((((q != p && q != NIL)) && q != OPT_undftyp)) {
1595 						q = q->BaseTyp;
1596 					}
1597 					if (q == NIL) {
1598 						OPB_err(113);
1599 					}
1600 				} else {
1601 					OPB_err(113);
1602 				}
1603 			} else {
1604 				OPB_err(113);
1605 			}
1606 			break;
1607 		case 12:
1608 			if (ynode->class == 9) {
1609 				OPB_CheckProc(x, ynode->obj);
1610 			} else if (x == y || g == 9) {
1611 			} else {
1612 				OPB_err(113);
1613 			}
1614 			break;
1615 		case 10: case 9:
1616 			OPB_err(113);
1617 			break;
1618 		case 13:
1619 			x->pvused = 1;
1620 			if (x->comp == 2) {
1621 				if ((ynode->class == 7 && g == 3)) {
1622 					OPB_CharToString(ynode);
1623 					y = ynode->typ;
1624 					g = 8;
1625 				}
1626 				if (x == y) {
1627 				} else if ((((y->comp == 2 && y->BaseTyp == x->BaseTyp)) && y->n <= x->n)) {
1628 				} else if ((y->comp == 3 && y->BaseTyp == x->BaseTyp)) {
1629 				} else if (x->BaseTyp == OPT_chartyp) {
1630 					if (g == 8) {
1631 						if (ynode->conval->intval2 > x->n) {
1632 							OPB_err(114);
1633 						}
1634 					} else {
1635 						OPB_err(113);
1636 					}
1637 				} else {
1638 					OPB_err(113);
1639 				}
1640 			} else if (x->comp == 4) {
1641 				if (x == y) {
1642 				} else if (y->comp == 4) {
1643 					q = y->BaseTyp;
1644 					while ((((q != NIL && q != x)) && q != OPT_undftyp)) {
1645 						q = q->BaseTyp;
1646 					}
1647 					if (q == NIL) {
1648 						OPB_err(113);
1649 					}
1650 				} else {
1651 					OPB_err(113);
1652 				}
1653 			} else {
1654 				OPB_err(113);
1655 			}
1656 			break;
1657 		default:
1658 			OPM_LogWStr((CHAR*)"unhandled case in OPB.CheckAssign, f = ", 40);
1659 			OPM_LogWNum(f, 0);
1660 			OPM_LogWLn();
1661 			break;
1662 	}
1663 	if ((((((ynode->class == 7 && g < f)) && __IN(g, 0x30, 32))) && __IN(f, 0x70, 32))) {
1664 		OPB_Convert(&ynode, x);
1665 	}
1666 }
1667 
OPB_CheckLeaf(OPT_Node x,BOOLEAN dynArrToo)1668 static void OPB_CheckLeaf (OPT_Node x, BOOLEAN dynArrToo)
1669 {
1670 }
1671 
OPB_StPar0(OPT_Node * par0,INT16 fctno)1672 void OPB_StPar0 (OPT_Node *par0, INT16 fctno)
1673 {
1674 	INT16 f;
1675 	OPT_Struct typ = NIL;
1676 	OPT_Node x = NIL;
1677 	x = *par0;
1678 	f = x->typ->form;
1679 	switch (fctno) {
1680 		case 0:
1681 			if ((f == 4 && x->class == 7)) {
1682 				if ((0 <= x->conval->intval && x->conval->intval <= 255)) {
1683 					OPB_BindNodes(28, OPT_notyp, &x, x);
1684 				} else {
1685 					OPB_err(218);
1686 				}
1687 			} else {
1688 				OPB_err(69);
1689 			}
1690 			x->typ = OPT_notyp;
1691 			break;
1692 		case 1:
1693 			typ = OPT_notyp;
1694 			if (OPB_NotVar(x)) {
1695 				OPB_err(112);
1696 			} else if (f == 11) {
1697 				if (x->readonly) {
1698 					OPB_err(76);
1699 				}
1700 				f = x->typ->BaseTyp->comp;
1701 				if (__IN(f, 0x1c, 32)) {
1702 					if (f == 3) {
1703 						typ = x->typ->BaseTyp;
1704 					}
1705 					OPB_BindNodes(19, OPT_notyp, &x, NIL);
1706 					x->subcl = 1;
1707 				} else {
1708 					OPB_err(111);
1709 				}
1710 			} else {
1711 				OPB_err(111);
1712 			}
1713 			x->typ = typ;
1714 			break;
1715 		case 2:
1716 			OPB_MOp(21, &x);
1717 			break;
1718 		case 3:
1719 			OPB_MOp(22, &x);
1720 			break;
1721 		case 4:
1722 			if (x->class == 8 || x->class == 9) {
1723 				OPB_err(126);
1724 			} else if (f == 3) {
1725 				OPB_Convert(&x, OPT_inttyp);
1726 			} else {
1727 				OPB_err(111);
1728 			}
1729 			x->typ = OPT_inttyp;
1730 			break;
1731 		case 5:
1732 			if (x->class == 8 || x->class == 9) {
1733 				OPB_err(126);
1734 			} else if (__IN(f, 0x60, 32)) {
1735 				OPB_Convert(&x, OPT_linttyp);
1736 			} else {
1737 				OPB_err(111);
1738 			}
1739 			x->typ = OPT_linttyp;
1740 			break;
1741 		case 6:
1742 			OPB_MOp(23, &x);
1743 			break;
1744 		case 7:
1745 			if (x->class == 8) {
1746 				switch (f) {
1747 					case 2:
1748 						x = OPB_NewBoolConst(0);
1749 						break;
1750 					case 3:
1751 						x = OPB_NewIntConst(0);
1752 						x->typ = OPT_chartyp;
1753 						break;
1754 					case 4:
1755 						x = OPB_NewIntConst(OPM_SignedMinimum(x->typ->size));
1756 						break;
1757 					case 7:
1758 						x = OPB_NewIntConst(0);
1759 						x->typ = OPT_inttyp;
1760 						break;
1761 					case 5:
1762 						x = OPB_NewRealConst(OPM_MinReal, OPT_realtyp);
1763 						break;
1764 					case 6:
1765 						x = OPB_NewRealConst(OPM_MinLReal, OPT_lrltyp);
1766 						break;
1767 					default:
1768 						OPB_err(111);
1769 						break;
1770 				}
1771 			} else {
1772 				OPB_err(110);
1773 			}
1774 			break;
1775 		case 8:
1776 			if (x->class == 8) {
1777 				switch (f) {
1778 					case 2:
1779 						x = OPB_NewBoolConst(1);
1780 						break;
1781 					case 3:
1782 						x = OPB_NewIntConst(255);
1783 						x->typ = OPT_chartyp;
1784 						break;
1785 					case 4:
1786 						x = OPB_NewIntConst(OPM_SignedMaximum(x->typ->size));
1787 						break;
1788 					case 7:
1789 						x = OPB_NewIntConst(__ASHL(x->typ->size, 3) - 1);
1790 						x->typ = OPT_inttyp;
1791 						break;
1792 					case 5:
1793 						x = OPB_NewRealConst(OPM_MaxReal, OPT_realtyp);
1794 						break;
1795 					case 6:
1796 						x = OPB_NewRealConst(OPM_MaxLReal, OPT_lrltyp);
1797 						break;
1798 					default:
1799 						OPB_err(111);
1800 						break;
1801 				}
1802 			} else {
1803 				OPB_err(110);
1804 			}
1805 			break;
1806 		case 9:
1807 			if (x->class == 8 || x->class == 9) {
1808 				OPB_err(126);
1809 			} else if (__IN(f, 0x11, 32)) {
1810 				OPB_Convert(&x, OPT_chartyp);
1811 			} else {
1812 				OPB_err(111);
1813 				x->typ = OPT_chartyp;
1814 			}
1815 			break;
1816 		case 10:
1817 			if (x->class == 8 || x->class == 9) {
1818 				OPB_err(126);
1819 			} else if (f == 4) {
1820 				typ = OPT_ShorterOrLongerType(x->typ, -1);
1821 				if (typ == NIL) {
1822 					OPB_err(111);
1823 				} else {
1824 					OPB_Convert(&x, typ);
1825 				}
1826 			} else if (f == 6) {
1827 				OPB_Convert(&x, OPT_realtyp);
1828 			} else {
1829 				OPB_err(111);
1830 			}
1831 			break;
1832 		case 11:
1833 			if (x->class == 8 || x->class == 9) {
1834 				OPB_err(126);
1835 			} else if (f == 4) {
1836 				typ = OPT_ShorterOrLongerType(x->typ, 1);
1837 				if (typ == NIL) {
1838 					OPB_err(111);
1839 				} else {
1840 					OPB_Convert(&x, typ);
1841 				}
1842 			} else if (f == 5) {
1843 				OPB_Convert(&x, OPT_lrltyp);
1844 			} else if (f == 3) {
1845 				OPB_Convert(&x, OPT_linttyp);
1846 			} else {
1847 				OPB_err(111);
1848 			}
1849 			break;
1850 		case 13: case 14:
1851 			if (OPB_NotVar(x)) {
1852 				OPB_err(112);
1853 			} else if (f != 4) {
1854 				OPB_err(111);
1855 			} else if (x->readonly) {
1856 				OPB_err(76);
1857 			}
1858 			break;
1859 		case 15: case 16:
1860 			if (OPB_NotVar(x)) {
1861 				OPB_err(112);
1862 			} else if (x->typ->form != 7) {
1863 				OPB_err(111);
1864 				x->typ = OPT_settyp;
1865 			} else if (x->readonly) {
1866 				OPB_err(76);
1867 			}
1868 			break;
1869 		case 17:
1870 			if (!__IN(x->typ->comp, 0x0c, 32)) {
1871 				OPB_err(131);
1872 			}
1873 			break;
1874 		case 18:
1875 			if ((x->class == 7 && f == 3)) {
1876 				OPB_CharToString(x);
1877 				f = 8;
1878 			}
1879 			if (x->class == 8 || x->class == 9) {
1880 				OPB_err(126);
1881 			} else if (((!__IN(x->typ->comp, 0x0c, 32) || x->typ->BaseTyp->form != 3) && f != 8)) {
1882 				OPB_err(111);
1883 			}
1884 			break;
1885 		case 19:
1886 			if (x->class == 8 || x->class == 9) {
1887 				OPB_err(126);
1888 			} else if (f == 4) {
1889 				if (x->typ->size < OPT_linttyp->size) {
1890 					OPB_Convert(&x, OPT_linttyp);
1891 				}
1892 			} else {
1893 				OPB_err(111);
1894 				x->typ = OPT_linttyp;
1895 			}
1896 			break;
1897 		case 20:
1898 			OPB_CheckLeaf(x, 0);
1899 			OPB_MOp(24, &x);
1900 			break;
1901 		case 12:
1902 			if (x->class != 8) {
1903 				OPB_err(110);
1904 				x = OPB_NewIntConst(1);
1905 			} else if (__IN(f, 0x18fe, 32) || __IN(x->typ->comp, 0x14, 32)) {
1906 				OPT_TypSize(x->typ);
1907 				x->typ->pvused = 1;
1908 				x = OPB_NewIntConst(x->typ->size);
1909 			} else {
1910 				OPB_err(111);
1911 				x = OPB_NewIntConst(1);
1912 			}
1913 			break;
1914 		case 21:
1915 			OPB_MOp(25, &x);
1916 			break;
1917 		case 22: case 23:
1918 			if (x->class == 8 || x->class == 9) {
1919 				OPB_err(126);
1920 			} else if (!__IN(f, 0x9a, 32)) {
1921 				OPB_err(111);
1922 			}
1923 			break;
1924 		case 24: case 25: case 28: case 31:
1925 			if (x->class == 8 || x->class == 9) {
1926 				OPB_err(126);
1927 			} else if ((((x->class == 7 && f == 4)) && x->typ->size < OPT_adrtyp->size)) {
1928 				OPB_Convert(&x, OPT_adrtyp);
1929 			} else if (!((__IN(x->typ->form, 0x0810, 32) && x->typ->size == OPM_AddressSize))) {
1930 				OPB_err(111);
1931 				x->typ = OPT_adrtyp;
1932 			}
1933 			break;
1934 		case 26: case 27:
1935 			if ((f == 4 && x->class == 7)) {
1936 				if (x->conval->intval < 0 || x->conval->intval > -1) {
1937 					OPB_err(220);
1938 				}
1939 			} else {
1940 				OPB_err(69);
1941 			}
1942 			break;
1943 		case 29:
1944 			if (x->class != 8) {
1945 				OPB_err(110);
1946 			} else if (__IN(f, 0x0501, 32) || x->typ->comp == 3) {
1947 				OPB_err(111);
1948 			}
1949 			break;
1950 		case 30:
1951 			if (OPB_NotVar(x)) {
1952 				OPB_err(112);
1953 			} else if (f == 11) {
1954 			} else {
1955 				OPB_err(111);
1956 			}
1957 			break;
1958 		case 32:
1959 			if (x->class == 8 || x->class == 9) {
1960 				OPB_err(126);
1961 				x = OPB_NewBoolConst(0);
1962 			} else if (f != 2) {
1963 				OPB_err(120);
1964 				x = OPB_NewBoolConst(0);
1965 			} else {
1966 				OPB_MOp(33, &x);
1967 			}
1968 			break;
1969 		default:
1970 			OPM_LogWStr((CHAR*)"unhandled case in OPB.StPar0, fctno = ", 39);
1971 			OPM_LogWNum(fctno, 0);
1972 			OPM_LogWLn();
1973 			break;
1974 	}
1975 	*par0 = x;
1976 }
1977 
1978 static struct StPar1__53 {
1979 	struct StPar1__53 *lnk;
1980 } *StPar1__53_s;
1981 
1982 static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right);
1983 
NewOp__54(INT8 class,INT8 subcl,OPT_Node left,OPT_Node right)1984 static OPT_Node NewOp__54 (INT8 class, INT8 subcl, OPT_Node left, OPT_Node right)
1985 {
1986 	OPT_Node node = NIL;
1987 	node = OPT_NewNode(class);
1988 	node->subcl = subcl;
1989 	node->left = left;
1990 	node->right = right;
1991 	return node;
1992 }
1993 
OPB_StPar1(OPT_Node * par0,OPT_Node x,INT8 fctno)1994 void OPB_StPar1 (OPT_Node *par0, OPT_Node x, INT8 fctno)
1995 {
1996 	INT16 f, L;
1997 	OPT_Struct typ = NIL;
1998 	OPT_Node p = NIL, t = NIL;
1999 	struct StPar1__53 _s;
2000 	_s.lnk = StPar1__53_s;
2001 	StPar1__53_s = &_s;
2002 	p = *par0;
2003 	f = x->typ->form;
2004 	switch (fctno) {
2005 		case 13: case 14:
2006 			if (x->class == 8 || x->class == 9) {
2007 				OPB_err(126);
2008 				p->typ = OPT_notyp;
2009 			} else {
2010 				if (x->typ != p->typ) {
2011 					if ((f == 4 && (x->class == 7 || (p->typ->form == 4 && x->typ->size <= p->typ->size)))) {
2012 						OPB_Convert(&x, p->typ);
2013 					} else {
2014 						OPB_err(111);
2015 					}
2016 				}
2017 				p = NewOp__54(19, fctno, p, x);
2018 				p->typ = OPT_notyp;
2019 			}
2020 			break;
2021 		case 15: case 16:
2022 			if (x->class == 8 || x->class == 9) {
2023 				OPB_err(126);
2024 			} else if (f == 4) {
2025 				if ((x->class == 7 && (0 > x->conval->intval || x->conval->intval >= (INT64)__ASHL(p->typ->size, 3)))) {
2026 					OPB_err(202);
2027 				}
2028 				p = NewOp__54(19, fctno, p, x);
2029 			} else {
2030 				OPB_err(111);
2031 			}
2032 			p->typ = OPT_notyp;
2033 			break;
2034 		case 17:
2035 			if (!(f == 4) || x->class != 7) {
2036 				OPB_err(69);
2037 			} else if (x->typ->size == 1) {
2038 				L = OPM_Integer(x->conval->intval);
2039 				typ = p->typ;
2040 				while ((L > 0 && __IN(typ->comp, 0x0c, 32))) {
2041 					typ = typ->BaseTyp;
2042 					L -= 1;
2043 				}
2044 				if (L != 0 || !__IN(typ->comp, 0x0c, 32)) {
2045 					OPB_err(132);
2046 				} else {
2047 					x->obj = NIL;
2048 					if (typ->comp == 3) {
2049 						while (p->class == 4) {
2050 							p = p->left;
2051 							x->conval->intval += 1;
2052 						}
2053 						p = NewOp__54(12, 19, p, x);
2054 						p->typ = OPT_linttyp;
2055 					} else {
2056 						p = x;
2057 						p->conval->intval = typ->n;
2058 						OPB_SetIntType(p);
2059 					}
2060 				}
2061 			} else {
2062 				OPB_err(132);
2063 			}
2064 			break;
2065 		case 18:
2066 			if (OPB_NotVar(x)) {
2067 				OPB_err(112);
2068 			} else if ((__IN(x->typ->comp, 0x0c, 32) && x->typ->BaseTyp->form == 3)) {
2069 				if (x->readonly) {
2070 					OPB_err(76);
2071 				}
2072 				t = x;
2073 				x = p;
2074 				p = t;
2075 				p = NewOp__54(19, 18, p, x);
2076 			} else {
2077 				OPB_err(111);
2078 			}
2079 			p->typ = OPT_notyp;
2080 			break;
2081 		case 19:
2082 			if (x->class == 8 || x->class == 9) {
2083 				OPB_err(126);
2084 			} else if (f == 4) {
2085 				if ((p->class == 7 && x->class == 7)) {
2086 					if (-OPB_maxExp > x->conval->intval || x->conval->intval > OPB_maxExp) {
2087 						OPB_err(208);
2088 						p->conval->intval = 1;
2089 					} else if (x->conval->intval >= 0) {
2090 						if (__ABS(p->conval->intval) <= __DIV(9223372036854775807LL, (INT64)__ASH(1, x->conval->intval))) {
2091 							p->conval->intval = p->conval->intval * (INT64)__ASH(1, x->conval->intval);
2092 						} else {
2093 							OPB_err(208);
2094 							p->conval->intval = 1;
2095 						}
2096 					} else {
2097 						p->conval->intval = __ASH(p->conval->intval, x->conval->intval);
2098 					}
2099 					p->obj = NIL;
2100 				} else {
2101 					p = NewOp__54(12, 17, p, x);
2102 					p->typ = p->left->typ;
2103 				}
2104 			} else {
2105 				OPB_err(111);
2106 			}
2107 			break;
2108 		case 1:
2109 			if (x->class == 8 || x->class == 9) {
2110 				OPB_err(126);
2111 			} else if (p->typ->comp == 3) {
2112 				if (f == 4) {
2113 					if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) {
2114 						OPB_err(63);
2115 					}
2116 				} else {
2117 					OPB_err(111);
2118 				}
2119 				p->right = x;
2120 				p->typ = p->typ->BaseTyp;
2121 			} else {
2122 				OPB_err(64);
2123 			}
2124 			break;
2125 		case 22: case 23:
2126 			if (x->class == 8 || x->class == 9) {
2127 				OPB_err(126);
2128 			} else if (f != 4) {
2129 				OPB_err(111);
2130 			} else {
2131 				if (fctno == 22) {
2132 					p = NewOp__54(12, 27, p, x);
2133 				} else {
2134 					p = NewOp__54(12, 28, p, x);
2135 				}
2136 				p->typ = p->left->typ;
2137 			}
2138 			break;
2139 		case 24: case 25: case 26: case 27:
2140 			if (x->class == 8 || x->class == 9) {
2141 				OPB_err(126);
2142 			} else if (__IN(f, 0x18ff, 32)) {
2143 				if (fctno == 24 || fctno == 26) {
2144 					if (OPB_NotVar(x)) {
2145 						OPB_err(112);
2146 					}
2147 					t = x;
2148 					x = p;
2149 					p = t;
2150 				}
2151 				p = NewOp__54(19, fctno, p, x);
2152 			} else {
2153 				OPB_err(111);
2154 			}
2155 			p->typ = OPT_notyp;
2156 			break;
2157 		case 28:
2158 			if (x->class == 8 || x->class == 9) {
2159 				OPB_err(126);
2160 			} else if (f == 4) {
2161 				p = NewOp__54(12, 26, p, x);
2162 			} else {
2163 				OPB_err(111);
2164 			}
2165 			p->typ = OPT_booltyp;
2166 			break;
2167 		case 29:
2168 			if (((x->class == 8 || x->class == 9) || __IN(f, 0x0501, 32)) || x->typ->comp == 3) {
2169 				OPB_err(126);
2170 			}
2171 			OPT_TypSize(x->typ);
2172 			OPT_TypSize(p->typ);
2173 			if ((x->class != 7 && x->typ->size < p->typ->size)) {
2174 				OPB_err(-308);
2175 			}
2176 			if ((((x->class == 7 && x->typ->form == 4)) && p->typ->form == 4)) {
2177 				OPB_Convert(&x, p->typ);
2178 			} else {
2179 				t = OPT_NewNode(11);
2180 				t->subcl = 29;
2181 				t->left = x;
2182 				x = t;
2183 				x->typ = p->typ;
2184 			}
2185 			p = x;
2186 			break;
2187 		case 30:
2188 			if (x->class == 8 || x->class == 9) {
2189 				OPB_err(126);
2190 			} else if (f == 4) {
2191 				p = NewOp__54(19, 30, p, x);
2192 			} else {
2193 				OPB_err(111);
2194 			}
2195 			p->typ = OPT_notyp;
2196 			break;
2197 		case 31:
2198 			if (x->class == 8 || x->class == 9) {
2199 				OPB_err(126);
2200 			} else if ((((x->class == 7 && f == 4)) && x->typ->size < OPT_adrtyp->size)) {
2201 				OPB_Convert(&x, OPT_adrtyp);
2202 			} else if (!((__IN(x->typ->form, 0x0810, 32) && x->typ->size == OPM_AddressSize))) {
2203 				OPB_err(111);
2204 				x->typ = OPT_adrtyp;
2205 			}
2206 			p->link = x;
2207 			break;
2208 		case 32:
2209 			if ((f == 4 && x->class == 7)) {
2210 				if ((0 <= x->conval->intval && x->conval->intval <= 255)) {
2211 					OPB_BindNodes(28, OPT_notyp, &x, x);
2212 					x->conval = OPT_NewConst();
2213 					x->conval->intval = OPM_errpos;
2214 					OPB_Construct(15, &p, x);
2215 					p->conval = OPT_NewConst();
2216 					p->conval->intval = OPM_errpos;
2217 					OPB_Construct(20, &p, NIL);
2218 					OPB_OptIf(&p);
2219 					if (p == NIL) {
2220 					} else if (p->class == 28) {
2221 						OPB_err(99);
2222 					} else {
2223 						p->subcl = 32;
2224 					}
2225 				} else {
2226 					OPB_err(218);
2227 				}
2228 			} else {
2229 				OPB_err(69);
2230 			}
2231 			break;
2232 		default:
2233 			OPB_err(64);
2234 			break;
2235 	}
2236 	*par0 = p;
2237 	StPar1__53_s = _s.lnk;
2238 }
2239 
OPB_StParN(OPT_Node * par0,OPT_Node x,INT16 fctno,INT16 n)2240 void OPB_StParN (OPT_Node *par0, OPT_Node x, INT16 fctno, INT16 n)
2241 {
2242 	OPT_Node node = NIL;
2243 	INT16 f;
2244 	OPT_Node p = NIL;
2245 	p = *par0;
2246 	f = x->typ->form;
2247 	if (fctno == 1) {
2248 		if (x->class == 8 || x->class == 9) {
2249 			OPB_err(126);
2250 		} else if (p->typ->comp != 3) {
2251 			OPB_err(64);
2252 		} else if (f == 4) {
2253 			if ((x->class == 7 && (x->conval->intval <= 0 || x->conval->intval > OPM_MaxIndex))) {
2254 				OPB_err(63);
2255 			}
2256 			node = p->right;
2257 			while (node->link != NIL) {
2258 				node = node->link;
2259 			}
2260 			node->link = x;
2261 			p->typ = p->typ->BaseTyp;
2262 		} else {
2263 			OPB_err(111);
2264 		}
2265 	} else if ((fctno == 31 && n == 2)) {
2266 		if (x->class == 8 || x->class == 9) {
2267 			OPB_err(126);
2268 		} else if (f == 4) {
2269 			node = OPT_NewNode(19);
2270 			node->subcl = 31;
2271 			node->right = p;
2272 			node->left = p->link;
2273 			p->link = x;
2274 			p = node;
2275 		} else {
2276 			OPB_err(111);
2277 		}
2278 		p->typ = OPT_notyp;
2279 	} else {
2280 		OPB_err(64);
2281 	}
2282 	*par0 = p;
2283 }
2284 
OPB_StFct(OPT_Node * par0,INT8 fctno,INT16 parno)2285 void OPB_StFct (OPT_Node *par0, INT8 fctno, INT16 parno)
2286 {
2287 	INT16 dim;
2288 	OPT_Node x = NIL, p = NIL;
2289 	p = *par0;
2290 	if (fctno <= 19) {
2291 		if ((fctno == 1 && p->typ != OPT_notyp)) {
2292 			if (p->typ->comp == 3) {
2293 				OPB_err(65);
2294 			}
2295 			p->typ = OPT_notyp;
2296 		} else if (fctno <= 12) {
2297 			if (parno < 1) {
2298 				OPB_err(65);
2299 			}
2300 		} else {
2301 			if (((fctno == 13 || fctno == 14) && parno == 1)) {
2302 				OPB_BindNodes(19, OPT_notyp, &p, OPB_NewIntConst(1));
2303 				p->subcl = fctno;
2304 				p->right->typ = p->left->typ;
2305 			} else if ((fctno == 17 && parno == 1)) {
2306 				if (p->typ->comp == 3) {
2307 					dim = 0;
2308 					while (p->class == 4) {
2309 						p = p->left;
2310 						dim += 1;
2311 					}
2312 					OPB_BindNodes(12, OPT_linttyp, &p, OPB_NewIntConst(dim));
2313 					p->subcl = 19;
2314 				} else {
2315 					p = OPB_NewIntConst(p->typ->n);
2316 				}
2317 			} else if (parno < 2) {
2318 				OPB_err(65);
2319 			}
2320 		}
2321 	} else if (fctno == 32) {
2322 		if (parno == 1) {
2323 			x = NIL;
2324 			OPB_BindNodes(28, OPT_notyp, &x, OPB_NewIntConst(0));
2325 			x->conval = OPT_NewConst();
2326 			x->conval->intval = OPM_errpos;
2327 			OPB_Construct(15, &p, x);
2328 			p->conval = OPT_NewConst();
2329 			p->conval->intval = OPM_errpos;
2330 			OPB_Construct(20, &p, NIL);
2331 			OPB_OptIf(&p);
2332 			if (p == NIL) {
2333 			} else if (p->class == 28) {
2334 				OPB_err(99);
2335 			} else {
2336 				p->subcl = 32;
2337 			}
2338 		} else if (parno < 1) {
2339 			OPB_err(65);
2340 		}
2341 	} else {
2342 		if ((parno < 1 || (fctno > 21 && parno < 2)) || (fctno == 31 && parno < 3)) {
2343 			OPB_err(65);
2344 		}
2345 	}
2346 	*par0 = p;
2347 }
2348 
OPB_DynArrParCheck(OPT_Struct ftyp,OPT_Struct atyp,BOOLEAN fvarpar)2349 static void OPB_DynArrParCheck (OPT_Struct ftyp, OPT_Struct atyp, BOOLEAN fvarpar)
2350 {
2351 	INT16 f;
2352 	f = atyp->comp;
2353 	ftyp = ftyp->BaseTyp;
2354 	atyp = atyp->BaseTyp;
2355 	if ((fvarpar && ftyp == OPT_bytetyp)) {
2356 		if (!__IN(f, 0x0c, 32) || !((__IN(atyp->form, 0x1e, 32) && atyp->size == 1))) {
2357 			if (__IN(18, OPM_Options, 32)) {
2358 				OPB_err(-301);
2359 			}
2360 		}
2361 	} else if (__IN(f, 0x0c, 32)) {
2362 		if (ftyp->comp == 3) {
2363 			OPB_DynArrParCheck(ftyp, atyp, fvarpar);
2364 		} else if (ftyp != atyp) {
2365 			if ((((!fvarpar && ftyp->form == 11)) && atyp->form == 11)) {
2366 				ftyp = ftyp->BaseTyp;
2367 				atyp = atyp->BaseTyp;
2368 				if ((ftyp->comp == 4 && atyp->comp == 4)) {
2369 					while ((((ftyp != atyp && atyp != NIL)) && atyp != OPT_undftyp)) {
2370 						atyp = atyp->BaseTyp;
2371 					}
2372 					if (atyp == NIL) {
2373 						OPB_err(113);
2374 					}
2375 				} else {
2376 					OPB_err(66);
2377 				}
2378 			} else {
2379 				OPB_err(66);
2380 			}
2381 		}
2382 	} else {
2383 		OPB_err(67);
2384 	}
2385 }
2386 
OPB_CheckReceiver(OPT_Node * x,OPT_Object fp)2387 static void OPB_CheckReceiver (OPT_Node *x, OPT_Object fp)
2388 {
2389 	if (fp->typ->form == 11) {
2390 		if ((*x)->class == 3) {
2391 			*x = (*x)->left;
2392 		} else {
2393 			OPB_err(71);
2394 		}
2395 	}
2396 }
2397 
OPB_PrepCall(OPT_Node * x,OPT_Object * fpar)2398 void OPB_PrepCall (OPT_Node *x, OPT_Object *fpar)
2399 {
2400 	if (((*x)->obj != NIL && __IN((*x)->obj->mode, 0x22c0, 32))) {
2401 		*fpar = (*x)->obj->link;
2402 		if ((*x)->obj->mode == 13) {
2403 			OPB_CheckReceiver(&(*x)->left, *fpar);
2404 			*fpar = (*fpar)->link;
2405 		}
2406 	} else if (((((*x)->class != 8 && (*x)->typ != NIL)) && (*x)->typ->form == 12)) {
2407 		*fpar = (*x)->typ->link;
2408 	} else {
2409 		OPB_err(121);
2410 		*fpar = NIL;
2411 		(*x)->typ = OPT_undftyp;
2412 	}
2413 }
2414 
OPB_Param(OPT_Node ap,OPT_Object fp)2415 void OPB_Param (OPT_Node ap, OPT_Object fp)
2416 {
2417 	OPT_Struct q = NIL;
2418 	if (fp->typ->form != 0) {
2419 		if (fp->mode == 2) {
2420 			if (OPB_NotVar(ap)) {
2421 				OPB_err(122);
2422 			} else {
2423 				OPB_CheckLeaf(ap, 0);
2424 			}
2425 			if (ap->readonly) {
2426 				OPB_err(76);
2427 			}
2428 			if (fp->typ->comp == 3) {
2429 				OPB_DynArrParCheck(fp->typ, ap->typ, 1);
2430 			} else if ((fp->typ->comp == 4 && ap->typ->comp == 4)) {
2431 				q = ap->typ;
2432 				while ((((q != fp->typ && q != NIL)) && q != OPT_undftyp)) {
2433 					q = q->BaseTyp;
2434 				}
2435 				if (q == NIL) {
2436 					OPB_err(111);
2437 				}
2438 			} else if ((fp->typ == OPT_sysptrtyp && ap->typ->form == 11)) {
2439 			} else if ((ap->typ != fp->typ && !((((fp->typ->form == 1 && __IN(ap->typ->form, 0x1e, 32))) && ap->typ->size == 1)))) {
2440 				OPB_err(123);
2441 			} else if ((fp->typ->form == 11 && ap->class == 5)) {
2442 				OPB_err(123);
2443 			}
2444 		} else if (fp->typ->comp == 3) {
2445 			if ((ap->class == 7 && ap->typ->form == 3)) {
2446 				OPB_CharToString(ap);
2447 			}
2448 			if ((ap->typ->form == 8 && fp->typ->BaseTyp->form == 3)) {
2449 			} else if (ap->class >= 7) {
2450 				OPB_err(59);
2451 			} else {
2452 				OPB_DynArrParCheck(fp->typ, ap->typ, 0);
2453 			}
2454 		} else {
2455 			OPB_CheckAssign(fp->typ, ap);
2456 		}
2457 	}
2458 }
2459 
OPB_StaticLink(INT8 dlev)2460 void OPB_StaticLink (INT8 dlev)
2461 {
2462 	OPT_Object scope = NIL;
2463 	scope = OPT_topScope;
2464 	while (dlev > 0) {
2465 		dlev -= 1;
2466 		scope->link->conval->setval |= __SETOF(3,64);
2467 		scope = scope->left;
2468 	}
2469 }
2470 
OPB_Call(OPT_Node * x,OPT_Node apar,OPT_Object fp)2471 void OPB_Call (OPT_Node *x, OPT_Node apar, OPT_Object fp)
2472 {
2473 	OPT_Struct typ = NIL;
2474 	OPT_Node p = NIL;
2475 	INT8 lev;
2476 	if ((*x)->class == 9) {
2477 		typ = (*x)->typ;
2478 		lev = (*x)->obj->mnolev;
2479 		if (lev > 0) {
2480 			OPB_StaticLink(OPT_topScope->mnolev - lev);
2481 		}
2482 		if ((*x)->obj->mode == 10) {
2483 			OPB_err(121);
2484 		}
2485 	} else if (((*x)->class == 2 && (*x)->obj->mode == 13)) {
2486 		typ = (*x)->typ;
2487 		(*x)->class = 9;
2488 		p = (*x)->left;
2489 		(*x)->left = NIL;
2490 		p->link = apar;
2491 		apar = p;
2492 		fp = (*x)->obj->link;
2493 	} else {
2494 		typ = (*x)->typ->BaseTyp;
2495 	}
2496 	OPB_BindNodes(13, typ, &*x, apar);
2497 	(*x)->obj = fp;
2498 }
2499 
OPB_Enter(OPT_Node * procdec,OPT_Node stat,OPT_Object proc)2500 void OPB_Enter (OPT_Node *procdec, OPT_Node stat, OPT_Object proc)
2501 {
2502 	OPT_Node x = NIL;
2503 	x = OPT_NewNode(18);
2504 	x->typ = OPT_notyp;
2505 	x->obj = proc;
2506 	x->left = *procdec;
2507 	x->right = stat;
2508 	*procdec = x;
2509 }
2510 
OPB_Return(OPT_Node * x,OPT_Object proc)2511 void OPB_Return (OPT_Node *x, OPT_Object proc)
2512 {
2513 	OPT_Node node = NIL;
2514 	if (proc == NIL) {
2515 		if (*x != NIL) {
2516 			OPB_err(124);
2517 		}
2518 	} else {
2519 		if (*x != NIL) {
2520 			OPB_CheckAssign(proc->typ, *x);
2521 		} else if (proc->typ != OPT_notyp) {
2522 			OPB_err(124);
2523 		}
2524 	}
2525 	node = OPT_NewNode(26);
2526 	node->typ = OPT_notyp;
2527 	node->obj = proc;
2528 	node->left = *x;
2529 	*x = node;
2530 }
2531 
OPB_Assign(OPT_Node * x,OPT_Node y)2532 void OPB_Assign (OPT_Node *x, OPT_Node y)
2533 {
2534 	OPT_Node z = NIL;
2535 	if ((*x)->class >= 7) {
2536 		OPB_err(56);
2537 	}
2538 	OPB_CheckAssign((*x)->typ, y);
2539 	if ((*x)->readonly) {
2540 		OPB_err(76);
2541 	}
2542 	if ((*x)->typ->comp == 4) {
2543 		if ((*x)->class == 5) {
2544 			z = (*x)->left;
2545 		} else {
2546 			z = *x;
2547 		}
2548 		if ((z->class == 3 && z->left->class == 5)) {
2549 			z->left = z->left->left;
2550 		}
2551 		if (((*x)->typ->strobj != NIL && (z->class == 3 || z->class == 1))) {
2552 			OPB_BindNodes(6, (*x)->typ, &z, NIL);
2553 			*x = z;
2554 		}
2555 	} else if (((((((*x)->typ->comp == 2 && (*x)->typ->BaseTyp == OPT_chartyp)) && y->typ->form == 8)) && y->conval->intval2 == 1)) {
2556 		y->typ = OPT_chartyp;
2557 		y->conval->intval = 0;
2558 		OPB_Index(&*x, OPB_NewIntConst(0));
2559 	}
2560 	OPB_BindNodes(19, OPT_notyp, &*x, y);
2561 	(*x)->subcl = 0;
2562 }
2563 
OPB_Inittd(OPT_Node * inittd,OPT_Node * last,OPT_Struct typ)2564 void OPB_Inittd (OPT_Node *inittd, OPT_Node *last, OPT_Struct typ)
2565 {
2566 	OPT_Node node = NIL;
2567 	node = OPT_NewNode(14);
2568 	node->typ = typ;
2569 	node->conval = OPT_NewConst();
2570 	node->conval->intval = typ->txtpos;
2571 	if (*inittd == NIL) {
2572 		*inittd = node;
2573 	} else {
2574 		(*last)->link = node;
2575 	}
2576 	*last = node;
2577 }
2578 
2579 
OPB__init(void)2580 export void *OPB__init(void)
2581 {
2582 	__DEFMOD;
2583 	__MODULE_IMPORT(OPM);
2584 	__MODULE_IMPORT(OPS);
2585 	__MODULE_IMPORT(OPT);
2586 	__REGMOD("OPB", 0);
2587 /* BEGIN */
2588 	OPB_maxExp = OPB_log(4611686018427387904LL);
2589 	OPB_maxExp = OPB_exp;
2590 	__ENDMOD;
2591 }
2592