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 "Configuration.h"
10 #include "OPM.h"
11 #include "OPT.h"
12 
13 
14 static INT16 OPC_indentLevel;
15 static INT8 OPC_hashtab[105];
16 static CHAR OPC_keytab[50][9];
17 static BOOLEAN OPC_GlbPtrs;
18 static CHAR OPC_BodyNameExt[13];
19 
20 
21 export void OPC_Andent (OPT_Struct typ);
22 static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames);
23 export OPT_Object OPC_BaseTProc (OPT_Object obj);
24 export void OPC_BegBlk (void);
25 export void OPC_BegStat (void);
26 static void OPC_CProcDefs (OPT_Object obj, INT16 vis);
27 export void OPC_Case (INT64 caseVal, INT16 form);
28 static void OPC_CharacterLiteral (INT64 c);
29 export void OPC_Cmp (INT16 rel);
30 export void OPC_CompleteIdent (OPT_Object obj);
31 export void OPC_Constant (OPT_Const con, INT16 form);
32 static void OPC_DeclareBase (OPT_Object dcl);
33 static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef);
34 static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro);
35 static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty);
36 static void OPC_DefAnonRecs (OPT_Node n);
37 export void OPC_DefineInter (OPT_Object proc);
38 static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty);
39 static void OPC_DefineTProcTypes (OPT_Object obj);
40 static void OPC_DefineType (OPT_Struct str);
41 export void OPC_EndBlk (void);
42 export void OPC_EndBlk0 (void);
43 export void OPC_EndStat (void);
44 export void OPC_EnterBody (void);
45 export void OPC_EnterProc (OPT_Object proc);
46 export void OPC_ExitBody (void);
47 export void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet);
48 static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, INT32 *off, INT32 *n, INT32 *curAlign);
49 static void OPC_FillGap (INT32 gap, INT32 off, INT32 align, INT32 *n, INT32 *curAlign);
50 export void OPC_GenBdy (OPT_Node n);
51 static void OPC_GenDynTypes (OPT_Node n, INT16 vis);
52 export void OPC_GenEnumPtrs (OPT_Object var);
53 export void OPC_GenHdr (OPT_Node n);
54 export void OPC_GenHdrIncludes (void);
55 static void OPC_GenHeaderMsg (void);
56 export void OPC_Halt (INT32 n);
57 export void OPC_Ident (OPT_Object obj);
58 static void OPC_IdentList (OPT_Object obj, INT16 vis);
59 static void OPC_Include (CHAR *name, ADDRESS name__len);
60 static void OPC_IncludeImports (OPT_Object obj, INT16 vis);
61 export void OPC_Increment (BOOLEAN decrement);
62 export void OPC_Indent (INT16 count);
63 export void OPC_Init (void);
64 static void OPC_InitImports (OPT_Object obj);
65 static void OPC_InitKeywords (void);
66 export void OPC_InitTDesc (OPT_Struct typ);
67 static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj);
68 export void OPC_IntLiteral (INT64 n, INT32 size);
69 export void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim);
70 static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName);
71 static INT16 OPC_Length (CHAR *s, ADDRESS s__len);
72 export BOOLEAN OPC_NeedsRetval (OPT_Object proc);
73 export INT32 OPC_NofPtrs (OPT_Struct typ);
74 static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len);
75 static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len);
76 static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define);
77 static void OPC_ProcPredefs (OPT_Object obj, INT8 vis);
78 static void OPC_PutBase (OPT_Struct typ);
79 static void OPC_PutPtrOffsets (OPT_Struct typ, INT32 adr, INT32 *cnt);
80 static void OPC_RegCmds (OPT_Object obj);
81 export void OPC_SetInclude (BOOLEAN exclude);
82 static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause);
83 static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x);
84 static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l);
85 export void OPC_TDescDecl (OPT_Struct typ);
86 export void OPC_TypeDefs (OPT_Object obj, INT16 vis);
87 export void OPC_TypeOf (OPT_Object ap);
88 static BOOLEAN OPC_Undefined (OPT_Object obj);
89 
90 
OPC_Init(void)91 void OPC_Init (void)
92 {
93 	OPC_indentLevel = 0;
94 	__MOVE("__init(void)", OPC_BodyNameExt, 13);
95 }
96 
OPC_Indent(INT16 count)97 void OPC_Indent (INT16 count)
98 {
99 	OPC_indentLevel += count;
100 }
101 
OPC_BegStat(void)102 void OPC_BegStat (void)
103 {
104 	INT16 i;
105 	i = OPC_indentLevel;
106 	while (i > 0) {
107 		OPM_Write(0x09);
108 		i -= 1;
109 	}
110 }
111 
OPC_EndStat(void)112 void OPC_EndStat (void)
113 {
114 	OPM_Write(';');
115 	OPM_WriteLn();
116 }
117 
OPC_BegBlk(void)118 void OPC_BegBlk (void)
119 {
120 	OPM_Write('{');
121 	OPM_WriteLn();
122 	OPC_indentLevel += 1;
123 }
124 
OPC_EndBlk(void)125 void OPC_EndBlk (void)
126 {
127 	OPC_indentLevel -= 1;
128 	OPC_BegStat();
129 	OPM_Write('}');
130 	OPM_WriteLn();
131 }
132 
OPC_EndBlk0(void)133 void OPC_EndBlk0 (void)
134 {
135 	OPC_indentLevel -= 1;
136 	OPC_BegStat();
137 	OPM_Write('}');
138 }
139 
OPC_Str1(CHAR * s,ADDRESS s__len,INT32 x)140 static void OPC_Str1 (CHAR *s, ADDRESS s__len, INT32 x)
141 {
142 	CHAR ch;
143 	INT16 i;
144 	__DUP(s, s__len, CHAR);
145 	ch = s[0];
146 	i = 0;
147 	while (ch != 0x00) {
148 		if (ch == '#') {
149 			OPM_WriteInt(x);
150 		} else {
151 			OPM_Write(ch);
152 		}
153 		i += 1;
154 		ch = s[__X(i, s__len)];
155 	}
156 	__DEL(s);
157 }
158 
OPC_Length(CHAR * s,ADDRESS s__len)159 static INT16 OPC_Length (CHAR *s, ADDRESS s__len)
160 {
161 	INT16 i;
162 	i = 0;
163 	while (s[__X(i, s__len)] != 0x00) {
164 		i += 1;
165 	}
166 	return i;
167 }
168 
OPC_PerfectHash(CHAR * s,ADDRESS s__len)169 static INT16 OPC_PerfectHash (CHAR *s, ADDRESS s__len)
170 {
171 	INT16 i, h;
172 	i = 0;
173 	h = 0;
174 	while ((s[__X(i, s__len)] != 0x00 && i < 5)) {
175 		h = 3 * h + (INT16)s[__X(i, s__len)];
176 		i += 1;
177 	}
178 	return (int)__MOD(h, 105);
179 }
180 
OPC_Ident(OPT_Object obj)181 void OPC_Ident (OPT_Object obj)
182 {
183 	INT16 mode, level, h;
184 	mode = obj->mode;
185 	level = obj->mnolev;
186 	if ((__IN(mode, 0x62, 32) && level > 0) || __IN(mode, 0x14, 32)) {
187 		OPM_WriteStringVar((void*)obj->name, 256);
188 		h = OPC_PerfectHash((void*)obj->name, 256);
189 		if (OPC_hashtab[__X(h, 105)] >= 0) {
190 			if (__STRCMP(OPC_keytab[__X(OPC_hashtab[__X(h, 105)], 50)], obj->name) == 0) {
191 				OPM_Write('_');
192 			}
193 		}
194 	} else if ((mode == 5 && __IN(obj->typ->form, 0x90, 32))) {
195 		if (obj->typ == OPT_adrtyp) {
196 			OPM_WriteString((CHAR*)"ADDRESS", 8);
197 		} else {
198 			if (obj->typ->form == 4) {
199 				OPM_WriteString((CHAR*)"INT", 4);
200 			} else {
201 				OPM_WriteString((CHAR*)"UINT", 5);
202 			}
203 			OPM_WriteInt(__ASHL(obj->typ->size, 3));
204 		}
205 	} else {
206 		if (mode != 5 || obj->linkadr != 2) {
207 			if (mode == 13) {
208 				OPC_Ident(obj->link->typ->strobj);
209 			} else if (level < 0) {
210 				OPM_WriteStringVar((void*)OPT_GlbMod[__X(-level, 64)]->name, 256);
211 				if (OPM_currFile == 0) {
212 					OPT_GlbMod[__X(-level, 64)]->vis = 1;
213 				}
214 			} else {
215 				OPM_WriteStringVar((void*)OPM_modName, 32);
216 			}
217 			OPM_Write('_');
218 		} else if (obj == OPT_sysptrtyp->strobj || obj == OPT_bytetyp->strobj) {
219 			OPM_WriteString((CHAR*)"SYSTEM_", 8);
220 		}
221 		OPM_WriteStringVar((void*)obj->name, 256);
222 	}
223 }
224 
OPC_Stars(OPT_Struct typ,BOOLEAN * openClause)225 static void OPC_Stars (OPT_Struct typ, BOOLEAN *openClause)
226 {
227 	INT16 pointers;
228 	*openClause = 0;
229 	if (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->comp != 4)) {
230 		if (__IN(typ->comp, 0x0c, 32)) {
231 			OPC_Stars(typ->BaseTyp, &*openClause);
232 			*openClause = typ->comp == 2;
233 		} else if (typ->form == 12) {
234 			OPM_Write('(');
235 			OPM_Write('*');
236 		} else {
237 			pointers = 0;
238 			while (((typ->strobj == NIL || typ->strobj->name[0] == 0x00) && typ->form == 11)) {
239 				pointers += 1;
240 				typ = typ->BaseTyp;
241 			}
242 			if (pointers > 0) {
243 				if (typ->comp != 3) {
244 					OPC_Stars(typ, &*openClause);
245 				}
246 				if (*openClause) {
247 					OPM_Write('(');
248 					*openClause = 0;
249 				}
250 				while (pointers > 0) {
251 					OPM_Write('*');
252 					pointers -= 1;
253 				}
254 			}
255 		}
256 	}
257 }
258 
OPC_DeclareObj(OPT_Object dcl,BOOLEAN scopeDef)259 static void OPC_DeclareObj (OPT_Object dcl, BOOLEAN scopeDef)
260 {
261 	OPT_Struct typ = NIL;
262 	BOOLEAN varPar, openClause;
263 	INT16 form, comp;
264 	typ = dcl->typ;
265 	varPar = ((dcl->mode == 2 && typ->comp != 2) || typ->comp == 3) || scopeDef;
266 	OPC_Stars(typ, &openClause);
267 	if (varPar) {
268 		if (openClause) {
269 			OPM_Write('(');
270 		}
271 		OPM_Write('*');
272 	}
273 	if (dcl->name[0] != 0x00) {
274 		OPC_Ident(dcl);
275 	}
276 	if ((varPar && openClause)) {
277 		OPM_Write(')');
278 	}
279 	openClause = 0;
280 	for (;;) {
281 		form = typ->form;
282 		comp = typ->comp;
283 		if (((typ->strobj != NIL && typ->strobj->name[0] != 0x00) || form == 10) || comp == 4) {
284 			break;
285 		} else if ((form == 11 && typ->BaseTyp->comp != 3)) {
286 			openClause = 1;
287 		} else if (form == 12 || __IN(comp, 0x0c, 32)) {
288 			if (openClause) {
289 				OPM_Write(')');
290 				openClause = 0;
291 			}
292 			if (form == 12) {
293 				OPM_Write(')');
294 				OPC_AnsiParamList(typ->link, 0);
295 				break;
296 			} else if (comp == 2) {
297 				OPM_Write('[');
298 				OPM_WriteInt(typ->n);
299 				OPM_Write(']');
300 			}
301 		} else {
302 			break;
303 		}
304 		typ = typ->BaseTyp;
305 	}
306 }
307 
OPC_Andent(OPT_Struct typ)308 void OPC_Andent (OPT_Struct typ)
309 {
310 	if (typ->strobj == NIL || typ->align >= 65536) {
311 		OPM_WriteStringVar((void*)OPM_modName, 32);
312 		OPC_Str1((CHAR*)"__#", 4, __ASHR(typ->align, 16));
313 	} else {
314 		OPC_Ident(typ->strobj);
315 	}
316 }
317 
OPC_Undefined(OPT_Object obj)318 static BOOLEAN OPC_Undefined (OPT_Object obj)
319 {
320 	return obj->name[0] == 0x00 || (((obj->mnolev >= 0 && obj->linkadr != (3 + OPM_currFile))) && obj->linkadr != 2);
321 }
322 
OPC_DeclareBase(OPT_Object dcl)323 static void OPC_DeclareBase (OPT_Object dcl)
324 {
325 	OPT_Struct typ = NIL, prev = NIL;
326 	OPT_Object obj = NIL;
327 	INT16 nofdims;
328 	INT32 off, n, dummy;
329 	typ = dcl->typ;
330 	prev = typ;
331 	while ((((((((typ->strobj == NIL || typ->comp == 3) || OPC_Undefined(typ->strobj)) && typ->comp != 4)) && typ->form != 10)) && !((typ->form == 11 && typ->BaseTyp->comp == 3)))) {
332 		prev = typ;
333 		typ = typ->BaseTyp;
334 	}
335 	obj = typ->strobj;
336 	if (typ->form == 10) {
337 		OPM_WriteString((CHAR*)"void", 5);
338 	} else if ((obj != NIL && !OPC_Undefined(obj))) {
339 		OPC_Ident(obj);
340 	} else if (typ->comp == 4) {
341 		OPM_WriteString((CHAR*)"struct ", 8);
342 		OPC_Andent(typ);
343 		if ((prev->form != 11 && (obj != NIL || dcl->name[0] == 0x00))) {
344 			if ((typ->BaseTyp != NIL && typ->BaseTyp->strobj->vis != 0)) {
345 				OPM_WriteString((CHAR*)" { /* ", 7);
346 				OPC_Ident(typ->BaseTyp->strobj);
347 				OPM_WriteString((CHAR*)" */", 4);
348 				OPM_WriteLn();
349 				OPC_Indent(1);
350 			} else {
351 				OPM_Write(' ');
352 				OPC_BegBlk();
353 			}
354 			OPC_FieldList(typ, 1, &off, &n, &dummy);
355 			OPC_EndBlk0();
356 		}
357 	} else if ((typ->form == 11 && typ->BaseTyp->comp == 3)) {
358 		typ = typ->BaseTyp->BaseTyp;
359 		nofdims = 1;
360 		while (typ->comp == 3) {
361 			nofdims += 1;
362 			typ = typ->BaseTyp;
363 		}
364 		OPM_WriteString((CHAR*)"struct ", 8);
365 		OPC_BegBlk();
366 		OPC_BegStat();
367 		OPC_Str1((CHAR*)"ADDRESS len[#]", 15, nofdims);
368 		OPC_EndStat();
369 		OPC_BegStat();
370 		__NEW(obj, OPT_ObjDesc);
371 		__NEW(obj->typ, OPT_StrDesc);
372 		obj->typ->form = 13;
373 		obj->typ->comp = 2;
374 		obj->typ->n = 1;
375 		obj->typ->BaseTyp = typ;
376 		obj->mode = 4;
377 		__MOVE("data", obj->name, 5);
378 		obj->linkadr = 0;
379 		OPC_DeclareBase(obj);
380 		OPM_Write(' ');
381 		OPC_DeclareObj(obj, 0);
382 		OPC_EndStat();
383 		OPC_EndBlk0();
384 	}
385 }
386 
OPC_NofPtrs(OPT_Struct typ)387 INT32 OPC_NofPtrs (OPT_Struct typ)
388 {
389 	OPT_Object fld = NIL;
390 	OPT_Struct btyp = NIL;
391 	INT32 n;
392 	if ((typ->form == 11 && typ->sysflag == 0)) {
393 		return 1;
394 	} else if ((typ->comp == 4 && __MASK(typ->sysflag, -256) == 0)) {
395 		btyp = typ->BaseTyp;
396 		if (btyp != NIL) {
397 			n = OPC_NofPtrs(btyp);
398 		} else {
399 			n = 0;
400 		}
401 		fld = typ->link;
402 		while ((fld != NIL && fld->mode == 4)) {
403 			if (__STRCMP(fld->name, "@ptr") != 0) {
404 				n = n + OPC_NofPtrs(fld->typ);
405 			} else {
406 				n += 1;
407 			}
408 			fld = fld->link;
409 		}
410 		return n;
411 	} else if (typ->comp == 2) {
412 		btyp = typ->BaseTyp;
413 		n = typ->n;
414 		while (btyp->comp == 2) {
415 			n = btyp->n * n;
416 			btyp = btyp->BaseTyp;
417 		}
418 		return OPC_NofPtrs(btyp) * n;
419 	} else {
420 		return 0;
421 	}
422 	__RETCHK;
423 }
424 
OPC_PutPtrOffsets(OPT_Struct typ,INT32 adr,INT32 * cnt)425 static void OPC_PutPtrOffsets (OPT_Struct typ, INT32 adr, INT32 *cnt)
426 {
427 	OPT_Object fld = NIL;
428 	OPT_Struct btyp = NIL;
429 	INT32 n, i;
430 	if ((typ->form == 11 && typ->sysflag == 0)) {
431 		OPM_WriteInt(adr);
432 		OPM_WriteString((CHAR*)", ", 3);
433 		*cnt += 1;
434 		if (__MASK(*cnt, -16) == 0) {
435 			OPM_WriteLn();
436 			OPM_Write(0x09);
437 		}
438 	} else if ((typ->comp == 4 && __MASK(typ->sysflag, -256) == 0)) {
439 		btyp = typ->BaseTyp;
440 		if (btyp != NIL) {
441 			OPC_PutPtrOffsets(btyp, adr, &*cnt);
442 		}
443 		fld = typ->link;
444 		while ((fld != NIL && fld->mode == 4)) {
445 			if (__STRCMP(fld->name, "@ptr") != 0) {
446 				OPC_PutPtrOffsets(fld->typ, adr + fld->adr, &*cnt);
447 			} else {
448 				OPM_WriteInt(adr + fld->adr);
449 				OPM_WriteString((CHAR*)", ", 3);
450 				*cnt += 1;
451 				if (__MASK(*cnt, -16) == 0) {
452 					OPM_WriteLn();
453 					OPM_Write(0x09);
454 				}
455 			}
456 			fld = fld->link;
457 		}
458 	} else if (typ->comp == 2) {
459 		btyp = typ->BaseTyp;
460 		n = typ->n;
461 		while (btyp->comp == 2) {
462 			n = btyp->n * n;
463 			btyp = btyp->BaseTyp;
464 		}
465 		if (OPC_NofPtrs(btyp) > 0) {
466 			i = 0;
467 			while (i < n) {
468 				OPC_PutPtrOffsets(btyp, adr + i * btyp->size, &*cnt);
469 				i += 1;
470 			}
471 		}
472 	}
473 }
474 
OPC_InitTProcs(OPT_Object typ,OPT_Object obj)475 static void OPC_InitTProcs (OPT_Object typ, OPT_Object obj)
476 {
477 	if (obj != NIL) {
478 		OPC_InitTProcs(typ, obj->left);
479 		if (obj->mode == 13) {
480 			OPC_BegStat();
481 			OPM_WriteString((CHAR*)"__INITBP(", 10);
482 			OPC_Ident(typ);
483 			OPM_WriteString((CHAR*)", ", 3);
484 			OPC_Ident(obj);
485 			OPC_Str1((CHAR*)", #)", 5, __ASHR(obj->adr, 16));
486 			OPC_EndStat();
487 		}
488 		OPC_InitTProcs(typ, obj->right);
489 	}
490 }
491 
OPC_PutBase(OPT_Struct typ)492 static void OPC_PutBase (OPT_Struct typ)
493 {
494 	if (typ != NIL) {
495 		OPC_PutBase(typ->BaseTyp);
496 		OPC_Ident(typ->strobj);
497 		OPM_WriteString((CHAR*)"__typ", 6);
498 		OPM_WriteString((CHAR*)", ", 3);
499 	}
500 }
501 
OPC_LenList(OPT_Object par,BOOLEAN ansiDefine,BOOLEAN showParamName)502 static void OPC_LenList (OPT_Object par, BOOLEAN ansiDefine, BOOLEAN showParamName)
503 {
504 	OPT_Struct typ = NIL;
505 	INT16 dim;
506 	if (showParamName) {
507 		OPC_Ident(par);
508 		OPM_WriteString((CHAR*)"__len", 6);
509 	}
510 	dim = 1;
511 	typ = par->typ->BaseTyp;
512 	while (typ->comp == 3) {
513 		if (ansiDefine) {
514 			OPM_WriteString((CHAR*)", ADDRESS ", 11);
515 		} else {
516 			OPM_WriteString((CHAR*)", ", 3);
517 		}
518 		if (showParamName) {
519 			OPC_Ident(par);
520 			OPM_WriteString((CHAR*)"__len", 6);
521 			OPM_WriteInt(dim);
522 		}
523 		typ = typ->BaseTyp;
524 		dim += 1;
525 	}
526 }
527 
OPC_DeclareParams(OPT_Object par,BOOLEAN macro)528 static void OPC_DeclareParams (OPT_Object par, BOOLEAN macro)
529 {
530 	OPM_Write('(');
531 	while (par != NIL) {
532 		if (macro) {
533 			OPM_WriteStringVar((void*)par->name, 256);
534 		} else {
535 			if ((par->mode == 1 && par->typ->form == 5)) {
536 				OPM_Write('_');
537 			}
538 			OPC_Ident(par);
539 		}
540 		if (par->typ->comp == 3) {
541 			OPM_WriteString((CHAR*)", ", 3);
542 			OPC_LenList(par, 0, 1);
543 		} else if ((par->mode == 2 && par->typ->comp == 4)) {
544 			OPM_WriteString((CHAR*)", ", 3);
545 			OPM_WriteStringVar((void*)par->name, 256);
546 			OPM_WriteString((CHAR*)"__typ", 6);
547 		}
548 		par = par->link;
549 		if (par != NIL) {
550 			OPM_WriteString((CHAR*)", ", 3);
551 		}
552 	}
553 	OPM_Write(')');
554 }
555 
OPC_DefineTProcTypes(OPT_Object obj)556 static void OPC_DefineTProcTypes (OPT_Object obj)
557 {
558 	OPT_Object par = NIL;
559 	if (obj->typ != OPT_notyp) {
560 		OPC_DefineType(obj->typ);
561 	}
562 	par = obj->link;
563 	while (par != NIL) {
564 		OPC_DefineType(par->typ);
565 		par = par->link;
566 	}
567 }
568 
OPC_DeclareTProcs(OPT_Object obj,BOOLEAN * empty)569 static void OPC_DeclareTProcs (OPT_Object obj, BOOLEAN *empty)
570 {
571 	if (obj != NIL) {
572 		OPC_DeclareTProcs(obj->left, &*empty);
573 		if (obj->mode == 13) {
574 			if (obj->typ != OPT_notyp) {
575 				OPC_DefineType(obj->typ);
576 			}
577 			if (OPM_currFile == 0) {
578 				if (obj->vis == 1) {
579 					OPC_DefineTProcTypes(obj);
580 					OPM_WriteString((CHAR*)"import ", 8);
581 					*empty = 0;
582 					OPC_ProcHeader(obj, 0);
583 				}
584 			} else {
585 				*empty = 0;
586 				OPC_DefineTProcTypes(obj);
587 				if (obj->vis == 0) {
588 					OPM_WriteString((CHAR*)"static ", 8);
589 				} else {
590 					OPM_WriteString((CHAR*)"export ", 8);
591 				}
592 				OPC_ProcHeader(obj, 0);
593 			}
594 		}
595 		OPC_DeclareTProcs(obj->right, &*empty);
596 	}
597 }
598 
OPC_BaseTProc(OPT_Object obj)599 OPT_Object OPC_BaseTProc (OPT_Object obj)
600 {
601 	OPT_Struct typ = NIL, base = NIL;
602 	INT32 mno;
603 	typ = obj->link->typ;
604 	if (typ->form == 11) {
605 		typ = typ->BaseTyp;
606 	}
607 	base = typ->BaseTyp;
608 	mno = __ASHR(obj->adr, 16);
609 	while ((base != NIL && mno < base->n)) {
610 		typ = base;
611 		base = typ->BaseTyp;
612 	}
613 	OPT_FindField(obj->name, typ, &obj);
614 	return obj;
615 }
616 
OPC_DefineTProcMacros(OPT_Object obj,BOOLEAN * empty)617 static void OPC_DefineTProcMacros (OPT_Object obj, BOOLEAN *empty)
618 {
619 	if (obj != NIL) {
620 		OPC_DefineTProcMacros(obj->left, &*empty);
621 		if ((((obj->mode == 13 && obj == OPC_BaseTProc(obj))) && (OPM_currFile != 0 || obj->vis == 1))) {
622 			OPM_WriteString((CHAR*)"#define __", 11);
623 			OPC_Ident(obj);
624 			OPC_DeclareParams(obj->link, 1);
625 			OPM_WriteString((CHAR*)" __SEND(", 9);
626 			if (obj->link->typ->form == 11) {
627 				OPM_WriteString((CHAR*)"__TYPEOF(", 10);
628 				OPC_Ident(obj->link);
629 				OPM_Write(')');
630 			} else {
631 				OPC_Ident(obj->link);
632 				OPM_WriteString((CHAR*)"__typ", 6);
633 			}
634 			OPC_Str1((CHAR*)", #, ", 6, __ASHR(obj->adr, 16));
635 			if (obj->typ == OPT_notyp) {
636 				OPM_WriteString((CHAR*)"void", 5);
637 			} else {
638 				OPC_Ident(obj->typ->strobj);
639 			}
640 			OPM_WriteString((CHAR*)"(*)", 4);
641 			OPC_AnsiParamList(obj->link, 0);
642 			OPM_WriteString((CHAR*)", ", 3);
643 			OPC_DeclareParams(obj->link, 1);
644 			OPM_Write(')');
645 			OPM_WriteLn();
646 		}
647 		OPC_DefineTProcMacros(obj->right, &*empty);
648 	}
649 }
650 
OPC_DefineType(OPT_Struct str)651 static void OPC_DefineType (OPT_Struct str)
652 {
653 	OPT_Object obj = NIL, field = NIL, par = NIL;
654 	BOOLEAN empty;
655 	if (OPM_currFile == 1 || str->ref < 255) {
656 		obj = str->strobj;
657 		if (obj == NIL || OPC_Undefined(obj)) {
658 			if (obj != NIL) {
659 				if (obj->linkadr == 1) {
660 					if (str->form != 11) {
661 						OPM_Mark(244, str->txtpos);
662 						obj->linkadr = 2;
663 					}
664 				} else {
665 					obj->linkadr = 1;
666 				}
667 			}
668 			if (str->comp == 4) {
669 				if (str->BaseTyp != NIL) {
670 					OPC_DefineType(str->BaseTyp);
671 				}
672 				field = str->link;
673 				while ((field != NIL && field->mode == 4)) {
674 					if (field->vis != 0 || OPM_currFile == 1) {
675 						OPC_DefineType(field->typ);
676 					}
677 					field = field->link;
678 				}
679 			} else if (str->form == 11) {
680 				if (str->BaseTyp->comp != 4) {
681 					OPC_DefineType(str->BaseTyp);
682 				}
683 			} else if (__IN(str->comp, 0x0c, 32)) {
684 				if ((str->BaseTyp->strobj != NIL && str->BaseTyp->strobj->linkadr == 1)) {
685 					OPM_Mark(244, str->txtpos);
686 					str->BaseTyp->strobj->linkadr = 2;
687 				}
688 				OPC_DefineType(str->BaseTyp);
689 			} else if (str->form == 12) {
690 				if (str->BaseTyp != OPT_notyp) {
691 					OPC_DefineType(str->BaseTyp);
692 				}
693 				field = str->link;
694 				while (field != NIL) {
695 					OPC_DefineType(field->typ);
696 					field = field->link;
697 				}
698 			}
699 		}
700 		if ((obj != NIL && OPC_Undefined(obj))) {
701 			OPM_WriteString((CHAR*)"typedef", 8);
702 			OPM_WriteLn();
703 			OPM_Write(0x09);
704 			OPC_Indent(1);
705 			obj->linkadr = 1;
706 			OPC_DeclareBase(obj);
707 			OPM_Write(' ');
708 			obj->typ->strobj = NIL;
709 			OPC_DeclareObj(obj, 0);
710 			obj->typ->strobj = obj;
711 			obj->linkadr = 3 + OPM_currFile;
712 			OPC_EndStat();
713 			OPC_Indent(-1);
714 			OPM_WriteLn();
715 			if (obj->typ->comp == 4) {
716 				empty = 1;
717 				OPC_DeclareTProcs(str->link, &empty);
718 				OPC_DefineTProcMacros(str->link, &empty);
719 				if (!empty) {
720 					OPM_WriteLn();
721 				}
722 			}
723 		}
724 	}
725 }
726 
OPC_Prefixed(OPT_ConstExt x,CHAR * y,ADDRESS y__len)727 static BOOLEAN OPC_Prefixed (OPT_ConstExt x, CHAR *y, ADDRESS y__len)
728 {
729 	INT16 i;
730 	__DUP(y, y__len, CHAR);
731 	i = 0;
732 	while ((*x)[__X(i + 1, 256)] == y[__X(i, y__len)]) {
733 		i += 1;
734 	}
735 	__DEL(y);
736 	return y[__X(i, y__len)] == 0x00;
737 }
738 
OPC_CProcDefs(OPT_Object obj,INT16 vis)739 static void OPC_CProcDefs (OPT_Object obj, INT16 vis)
740 {
741 	INT16 i;
742 	OPT_ConstExt ext = NIL;
743 	INT16 _for__7;
744 	if (obj != NIL) {
745 		OPC_CProcDefs(obj->left, vis);
746 		if ((((obj->mode == 9 && (INT16)obj->vis >= vis)) && obj->adr == 1)) {
747 			ext = obj->conval->ext;
748 			i = 1;
749 			if (((*ext)[1] != '#' && !(OPC_Prefixed(ext, (CHAR*)"extern ", 8) || OPC_Prefixed(ext, (CHAR*)"import ", 8)))) {
750 				OPM_WriteString((CHAR*)"#define ", 9);
751 				OPC_Ident(obj);
752 				OPC_DeclareParams(obj->link, 1);
753 				OPM_Write(0x09);
754 			}
755 			_for__7 = (INT16)(*obj->conval->ext)[0];
756 			i = i;
757 			while (i <= _for__7) {
758 				OPM_Write((*obj->conval->ext)[__X(i, 256)]);
759 				i += 1;
760 			}
761 			OPM_WriteLn();
762 		}
763 		OPC_CProcDefs(obj->right, vis);
764 	}
765 }
766 
OPC_TypeDefs(OPT_Object obj,INT16 vis)767 void OPC_TypeDefs (OPT_Object obj, INT16 vis)
768 {
769 	if (obj != NIL) {
770 		OPC_TypeDefs(obj->left, vis);
771 		if ((obj->mode == 5 && obj->typ->txtpos > 0)) {
772 			OPC_DefineType(obj->typ);
773 		}
774 		OPC_TypeDefs(obj->right, vis);
775 	}
776 }
777 
OPC_DefAnonRecs(OPT_Node n)778 static void OPC_DefAnonRecs (OPT_Node n)
779 {
780 	OPT_Object o = NIL;
781 	OPT_Struct typ = NIL;
782 	while ((n != NIL && n->class == 14)) {
783 		typ = n->typ;
784 		if ((typ->strobj == NIL && (OPM_currFile == 1 || typ->ref < 255))) {
785 			OPC_DefineType(typ);
786 			__NEW(o, OPT_ObjDesc);
787 			o->typ = typ;
788 			o->name[0] = 0x00;
789 			OPC_DeclareBase(o);
790 			OPC_EndStat();
791 			OPM_WriteLn();
792 		}
793 		n = n->link;
794 	}
795 }
796 
OPC_TDescDecl(OPT_Struct typ)797 void OPC_TDescDecl (OPT_Struct typ)
798 {
799 	INT32 nofptrs;
800 	OPT_Object o = NIL;
801 	OPC_BegStat();
802 	OPM_WriteString((CHAR*)"__TDESC(", 9);
803 	OPC_Andent(typ);
804 	OPC_Str1((CHAR*)", #", 4, typ->n + 1);
805 	OPC_Str1((CHAR*)", #) = {__TDFLDS(", 18, OPC_NofPtrs(typ));
806 	OPM_Write('"');
807 	if (typ->strobj != NIL) {
808 		OPM_WriteStringVar((void*)typ->strobj->name, 256);
809 	}
810 	OPM_Write('"');
811 	OPC_Str1((CHAR*)", #), {", 8, typ->size);
812 	nofptrs = 0;
813 	OPC_PutPtrOffsets(typ, 0, &nofptrs);
814 	OPC_Str1((CHAR*)"#}}", 4, -((nofptrs + 1) * OPM_AddressSize));
815 	OPC_EndStat();
816 }
817 
OPC_InitTDesc(OPT_Struct typ)818 void OPC_InitTDesc (OPT_Struct typ)
819 {
820 	OPC_BegStat();
821 	OPM_WriteString((CHAR*)"__INITYP(", 10);
822 	OPC_Andent(typ);
823 	OPM_WriteString((CHAR*)", ", 3);
824 	if (typ->BaseTyp != NIL) {
825 		OPC_Andent(typ->BaseTyp);
826 	} else {
827 		OPC_Andent(typ);
828 	}
829 	OPC_Str1((CHAR*)", #)", 5, typ->extlev);
830 	OPC_EndStat();
831 	if (typ->strobj != NIL) {
832 		OPC_InitTProcs(typ->strobj, typ->link);
833 	}
834 }
835 
OPC_FillGap(INT32 gap,INT32 off,INT32 align,INT32 * n,INT32 * curAlign)836 static void OPC_FillGap (INT32 gap, INT32 off, INT32 align, INT32 *n, INT32 *curAlign)
837 {
838 	INT32 adr;
839 	adr = off;
840 	OPT_Align(&adr, align);
841 	if ((*curAlign < align && gap - (adr - off) >= align)) {
842 		gap -= (adr - off) + align;
843 		OPC_BegStat();
844 		switch (align) {
845 			case 2:
846 				OPM_WriteString((CHAR*)"INT16", 6);
847 				break;
848 			case 4:
849 				OPM_WriteString((CHAR*)"INT32", 6);
850 				break;
851 			case 8:
852 				OPM_WriteString((CHAR*)"INT64", 6);
853 				break;
854 			default:
855 				OPM_LogWLn();
856 				OPM_LogWStr((CHAR*)"Unexpected enclosing alignment in FillGap.", 43);
857 				break;
858 		}
859 		OPC_Str1((CHAR*)" _prvt#", 8, *n);
860 		*n += 1;
861 		OPC_EndStat();
862 		*curAlign = align;
863 	}
864 	if (gap > 0) {
865 		OPC_BegStat();
866 		OPC_Str1((CHAR*)"char _prvt#", 12, *n);
867 		*n += 1;
868 		OPC_Str1((CHAR*)"[#]", 4, gap);
869 		OPC_EndStat();
870 	}
871 }
872 
OPC_FieldList(OPT_Struct typ,BOOLEAN last,INT32 * off,INT32 * n,INT32 * curAlign)873 static void OPC_FieldList (OPT_Struct typ, BOOLEAN last, INT32 *off, INT32 *n, INT32 *curAlign)
874 {
875 	OPT_Object fld = NIL;
876 	OPT_Struct base = NIL;
877 	INT32 gap, adr, align, fldAlign;
878 	fld = typ->link;
879 	align = __MASK(typ->align, -65536);
880 	if (typ->BaseTyp != NIL) {
881 		OPC_FieldList(typ->BaseTyp, 0, &*off, &*n, &*curAlign);
882 	} else {
883 		*off = 0;
884 		*n = 0;
885 		*curAlign = 1;
886 	}
887 	while ((fld != NIL && fld->mode == 4)) {
888 		if ((OPM_currFile == 0 && fld->vis == 0) || (((OPM_currFile == 1 && fld->vis == 0)) && typ->mno != 0)) {
889 			fld = fld->link;
890 			while ((((fld != NIL && fld->mode == 4)) && fld->vis == 0)) {
891 				fld = fld->link;
892 			}
893 		} else {
894 			adr = *off;
895 			fldAlign = OPT_BaseAlignment(fld->typ);
896 			OPT_Align(&adr, fldAlign);
897 			gap = fld->adr - adr;
898 			if (fldAlign > *curAlign) {
899 				*curAlign = fldAlign;
900 			}
901 			if (gap > 0) {
902 				OPC_FillGap(gap, *off, align, &*n, &*curAlign);
903 			}
904 			OPC_BegStat();
905 			OPC_DeclareBase(fld);
906 			OPM_Write(' ');
907 			OPC_DeclareObj(fld, 0);
908 			*off = fld->adr + fld->typ->size;
909 			base = fld->typ;
910 			fld = fld->link;
911 			while ((((((((fld != NIL && fld->mode == 4)) && fld->typ == base)) && fld->adr == *off)) && ((OPM_currFile == 1 || fld->vis != 0) || fld->typ->strobj == NIL))) {
912 				OPM_WriteString((CHAR*)", ", 3);
913 				OPC_DeclareObj(fld, 0);
914 				*off = fld->adr + fld->typ->size;
915 				fld = fld->link;
916 			}
917 			OPC_EndStat();
918 		}
919 	}
920 	if (last) {
921 		adr = typ->size - __ASHR(typ->sysflag, 8);
922 		if (adr == 0) {
923 			gap = 1;
924 		} else {
925 			gap = adr - *off;
926 		}
927 		if (gap > 0) {
928 			OPC_FillGap(gap, *off, align, &*n, &*curAlign);
929 		}
930 	}
931 }
932 
OPC_IdentList(OPT_Object obj,INT16 vis)933 static void OPC_IdentList (OPT_Object obj, INT16 vis)
934 {
935 	OPT_Struct base = NIL;
936 	BOOLEAN first;
937 	INT16 lastvis;
938 	base = NIL;
939 	first = 1;
940 	while ((obj != NIL && obj->mode != 13)) {
941 		if ((__IN(vis, 0x05, 32) || (vis == 1 && obj->vis != 0)) || (vis == 3 && !obj->leaf)) {
942 			if (obj->typ != base || (INT16)obj->vis != lastvis) {
943 				if (!first) {
944 					OPC_EndStat();
945 				}
946 				first = 0;
947 				base = obj->typ;
948 				lastvis = obj->vis;
949 				OPC_BegStat();
950 				if ((vis == 1 && obj->vis != 0)) {
951 					OPM_WriteString((CHAR*)"import ", 8);
952 				} else if ((obj->mnolev == 0 && vis == 0)) {
953 					if (obj->vis == 0) {
954 						OPM_WriteString((CHAR*)"static ", 8);
955 					} else {
956 						OPM_WriteString((CHAR*)"export ", 8);
957 					}
958 				}
959 				if ((((vis == 2 && obj->mode == 1)) && base->form == 5)) {
960 					OPM_WriteString((CHAR*)"double", 7);
961 				} else {
962 					OPC_DeclareBase(obj);
963 				}
964 			} else {
965 				OPM_Write(',');
966 			}
967 			OPM_Write(' ');
968 			if ((((vis == 2 && obj->mode == 1)) && base->form == 5)) {
969 				OPM_Write('_');
970 			}
971 			OPC_DeclareObj(obj, vis == 3);
972 			if (obj->typ->comp == 3) {
973 				OPC_EndStat();
974 				OPC_BegStat();
975 				base = OPT_adrtyp;
976 				OPM_WriteString((CHAR*)"ADDRESS ", 9);
977 				OPC_LenList(obj, 0, 1);
978 			} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
979 				OPC_EndStat();
980 				OPC_BegStat();
981 				OPM_WriteString((CHAR*)"ADDRESS *", 10);
982 				OPC_Ident(obj);
983 				OPM_WriteString((CHAR*)"__typ", 6);
984 				base = NIL;
985 			} else if ((((((__IN(5, OPM_Options, 32) && vis == 0)) && obj->mnolev > 0)) && obj->typ->form == 11)) {
986 				OPM_WriteString((CHAR*)" = NIL", 7);
987 			}
988 		}
989 		obj = obj->link;
990 	}
991 	if (!first) {
992 		OPC_EndStat();
993 	}
994 }
995 
OPC_AnsiParamList(OPT_Object obj,BOOLEAN showParamNames)996 static void OPC_AnsiParamList (OPT_Object obj, BOOLEAN showParamNames)
997 {
998 	CHAR name[32];
999 	OPM_Write('(');
1000 	if (obj == NIL || obj->mode == 13) {
1001 		OPM_WriteString((CHAR*)"void", 5);
1002 	} else {
1003 		for (;;) {
1004 			OPC_DeclareBase(obj);
1005 			if (showParamNames) {
1006 				OPM_Write(' ');
1007 				OPC_DeclareObj(obj, 0);
1008 			} else {
1009 				__COPY(obj->name, name, 32);
1010 				obj->name[0] = 0x00;
1011 				OPC_DeclareObj(obj, 0);
1012 				__COPY(name, obj->name, 256);
1013 			}
1014 			if (obj->typ->comp == 3) {
1015 				OPM_WriteString((CHAR*)", ADDRESS ", 11);
1016 				OPC_LenList(obj, 1, showParamNames);
1017 			} else if ((obj->mode == 2 && obj->typ->comp == 4)) {
1018 				OPM_WriteString((CHAR*)", ADDRESS *", 12);
1019 				if (showParamNames) {
1020 					OPC_Ident(obj);
1021 					OPM_WriteString((CHAR*)"__typ", 6);
1022 				}
1023 			}
1024 			if (obj->link == NIL || obj->link->mode == 13) {
1025 				break;
1026 			}
1027 			OPM_WriteString((CHAR*)", ", 3);
1028 			obj = obj->link;
1029 		}
1030 	}
1031 	OPM_Write(')');
1032 }
1033 
OPC_ProcHeader(OPT_Object proc,BOOLEAN define)1034 static void OPC_ProcHeader (OPT_Object proc, BOOLEAN define)
1035 {
1036 	if (proc->typ == OPT_notyp) {
1037 		OPM_WriteString((CHAR*)"void", 5);
1038 	} else {
1039 		OPC_Ident(proc->typ->strobj);
1040 	}
1041 	OPM_Write(' ');
1042 	OPC_Ident(proc);
1043 	OPM_Write(' ');
1044 	OPC_AnsiParamList(proc->link, 1);
1045 	if (!define) {
1046 		OPM_Write(';');
1047 	}
1048 	OPM_WriteLn();
1049 }
1050 
OPC_ProcPredefs(OPT_Object obj,INT8 vis)1051 static void OPC_ProcPredefs (OPT_Object obj, INT8 vis)
1052 {
1053 	if (obj != NIL) {
1054 		OPC_ProcPredefs(obj->left, vis);
1055 		if ((((__IN(obj->mode, 0xc0, 32) && obj->vis >= vis)) && (obj->history != 4 || obj->mode == 6))) {
1056 			if (vis == 1) {
1057 				OPM_WriteString((CHAR*)"import ", 8);
1058 			} else if (obj->vis == 0) {
1059 				OPM_WriteString((CHAR*)"static ", 8);
1060 			} else {
1061 				OPM_WriteString((CHAR*)"export ", 8);
1062 			}
1063 			OPC_ProcHeader(obj, 0);
1064 		}
1065 		OPC_ProcPredefs(obj->right, vis);
1066 	}
1067 }
1068 
OPC_Include(CHAR * name,ADDRESS name__len)1069 static void OPC_Include (CHAR *name, ADDRESS name__len)
1070 {
1071 	__DUP(name, name__len, CHAR);
1072 	OPM_WriteString((CHAR*)"#include ", 10);
1073 	OPM_Write('"');
1074 	OPM_WriteStringVar((void*)name, name__len);
1075 	OPM_WriteString((CHAR*)".h", 3);
1076 	OPM_Write('"');
1077 	OPM_WriteLn();
1078 	__DEL(name);
1079 }
1080 
OPC_IncludeImports(OPT_Object obj,INT16 vis)1081 static void OPC_IncludeImports (OPT_Object obj, INT16 vis)
1082 {
1083 	if (obj != NIL) {
1084 		OPC_IncludeImports(obj->left, vis);
1085 		if ((((obj->mode == 11 && obj->mnolev != 0)) && (INT16)OPT_GlbMod[__X(-obj->mnolev, 64)]->vis >= vis)) {
1086 			OPC_Include(OPT_GlbMod[__X(-obj->mnolev, 64)]->name, 256);
1087 		}
1088 		OPC_IncludeImports(obj->right, vis);
1089 	}
1090 }
1091 
OPC_GenDynTypes(OPT_Node n,INT16 vis)1092 static void OPC_GenDynTypes (OPT_Node n, INT16 vis)
1093 {
1094 	OPT_Struct typ = NIL;
1095 	while ((n != NIL && n->class == 14)) {
1096 		typ = n->typ;
1097 		if (vis == 0 || typ->ref < 255) {
1098 			OPC_BegStat();
1099 			if (vis == 1) {
1100 				OPM_WriteString((CHAR*)"import ", 8);
1101 			} else if ((typ->strobj != NIL && typ->strobj->mnolev > 0)) {
1102 				OPM_WriteString((CHAR*)"static ", 8);
1103 			} else {
1104 				OPM_WriteString((CHAR*)"export ", 8);
1105 			}
1106 			OPM_WriteString((CHAR*)"ADDRESS *", 10);
1107 			OPC_Andent(typ);
1108 			OPM_WriteString((CHAR*)"__typ", 6);
1109 			OPC_EndStat();
1110 		}
1111 		n = n->link;
1112 	}
1113 }
1114 
OPC_GenHdr(OPT_Node n)1115 void OPC_GenHdr (OPT_Node n)
1116 {
1117 	OPM_currFile = 0;
1118 	OPC_DefAnonRecs(n);
1119 	OPC_TypeDefs(OPT_topScope->right, 1);
1120 	OPM_WriteLn();
1121 	OPC_IdentList(OPT_topScope->scope, 1);
1122 	OPM_WriteLn();
1123 	OPC_GenDynTypes(n, 1);
1124 	OPM_WriteLn();
1125 	OPC_ProcPredefs(OPT_topScope->right, 1);
1126 	OPM_WriteString((CHAR*)"import ", 8);
1127 	OPM_WriteString((CHAR*)"void *", 7);
1128 	OPM_WriteStringVar((void*)OPM_modName, 32);
1129 	OPM_WriteString(OPC_BodyNameExt, 13);
1130 	OPC_EndStat();
1131 	OPM_WriteLn();
1132 	OPC_CProcDefs(OPT_topScope->right, 1);
1133 	OPM_WriteLn();
1134 	OPM_WriteString((CHAR*)"#endif // ", 11);
1135 	OPM_WriteStringVar((void*)OPM_modName, 32);
1136 	OPM_WriteLn();
1137 }
1138 
OPC_GenHeaderMsg(void)1139 static void OPC_GenHeaderMsg (void)
1140 {
1141 	INT16 i;
1142 	OPM_WriteString((CHAR*)"/* ", 4);
1143 	OPM_WriteString((CHAR*)"voc", 4);
1144 	OPM_Write(' ');
1145 	OPM_WriteString(Configuration_versionLong, 76);
1146 	OPM_Write(' ');
1147 	i = 0;
1148 	while (i <= 31) {
1149 		if (__IN(i, OPM_Options, 32)) {
1150 			switch (i) {
1151 				case 0:
1152 					OPM_Write('x');
1153 					break;
1154 				case 2:
1155 					OPM_Write('r');
1156 					break;
1157 				case 3:
1158 					OPM_Write('t');
1159 					break;
1160 				case 4:
1161 					OPM_Write('s');
1162 					break;
1163 				case 5:
1164 					OPM_Write('p');
1165 					break;
1166 				case 7:
1167 					OPM_Write('a');
1168 					break;
1169 				case 9:
1170 					OPM_Write('e');
1171 					break;
1172 				case 10:
1173 					OPM_Write('m');
1174 					break;
1175 				case 13:
1176 					OPM_Write('S');
1177 					break;
1178 				case 14:
1179 					OPM_Write('c');
1180 					break;
1181 				case 15:
1182 					OPM_Write('M');
1183 					break;
1184 				case 16:
1185 					OPM_Write('f');
1186 					break;
1187 				case 17:
1188 					OPM_Write('F');
1189 					break;
1190 				case 18:
1191 					OPM_Write('v');
1192 					break;
1193 				default:
1194 					OPM_LogWStr((CHAR*)"( more options defined in OPM than checked in OPC.GenHeaderMsg, if you are a compiler developer, add them to OPC.GenHeaderMsg", 126);
1195 					OPM_LogWLn();
1196 					break;
1197 			}
1198 		}
1199 		i += 1;
1200 	}
1201 	OPM_WriteString((CHAR*)" */", 4);
1202 	OPM_WriteLn();
1203 }
1204 
OPC_GenHdrIncludes(void)1205 void OPC_GenHdrIncludes (void)
1206 {
1207 	OPM_currFile = 2;
1208 	OPC_GenHeaderMsg();
1209 	OPM_WriteLn();
1210 	OPM_WriteString((CHAR*)"#ifndef ", 9);
1211 	OPM_WriteStringVar((void*)OPM_modName, 32);
1212 	OPM_WriteString((CHAR*)"__h", 4);
1213 	OPM_WriteLn();
1214 	OPM_WriteString((CHAR*)"#define ", 9);
1215 	OPM_WriteStringVar((void*)OPM_modName, 32);
1216 	OPM_WriteString((CHAR*)"__h", 4);
1217 	OPM_WriteLn();
1218 	OPM_WriteLn();
1219 	OPC_Include((CHAR*)"SYSTEM", 7);
1220 	OPC_IncludeImports(OPT_topScope->right, 1);
1221 	OPM_WriteLn();
1222 }
1223 
OPC_GenBdy(OPT_Node n)1224 void OPC_GenBdy (OPT_Node n)
1225 {
1226 	OPM_currFile = 1;
1227 	OPC_GenHeaderMsg();
1228 	OPM_WriteLn();
1229 	OPM_WriteString((CHAR*)"#define SHORTINT INT", 21);
1230 	OPM_WriteInt(__ASHL(OPT_sinttyp->size, 3));
1231 	OPM_WriteLn();
1232 	OPM_WriteString((CHAR*)"#define INTEGER  INT", 21);
1233 	OPM_WriteInt(__ASHL(OPT_inttyp->size, 3));
1234 	OPM_WriteLn();
1235 	OPM_WriteString((CHAR*)"#define LONGINT  INT", 21);
1236 	OPM_WriteInt(__ASHL(OPT_linttyp->size, 3));
1237 	OPM_WriteLn();
1238 	OPM_WriteString((CHAR*)"#define SET      UINT", 22);
1239 	OPM_WriteInt(__ASHL(OPT_settyp->size, 3));
1240 	OPM_WriteLn();
1241 	OPM_WriteLn();
1242 	OPC_Include((CHAR*)"SYSTEM", 7);
1243 	OPC_IncludeImports(OPT_topScope->right, 0);
1244 	OPM_WriteLn();
1245 	OPC_DefAnonRecs(n);
1246 	OPC_TypeDefs(OPT_topScope->right, 0);
1247 	OPM_WriteLn();
1248 	OPC_IdentList(OPT_topScope->scope, 0);
1249 	OPM_WriteLn();
1250 	OPC_GenDynTypes(n, 0);
1251 	OPM_WriteLn();
1252 	OPC_ProcPredefs(OPT_topScope->right, 0);
1253 	OPM_WriteLn();
1254 	OPC_CProcDefs(OPT_topScope->right, 0);
1255 	OPM_WriteLn();
1256 }
1257 
OPC_RegCmds(OPT_Object obj)1258 static void OPC_RegCmds (OPT_Object obj)
1259 {
1260 	if (obj != NIL) {
1261 		OPC_RegCmds(obj->left);
1262 		if ((obj->mode == 7 && obj->history != 4)) {
1263 			if ((((obj->vis != 0 && obj->link == NIL)) && obj->typ == OPT_notyp)) {
1264 				OPC_BegStat();
1265 				OPM_WriteString((CHAR*)"__REGCMD(\"", 11);
1266 				OPM_WriteStringVar((void*)obj->name, 256);
1267 				OPM_WriteString((CHAR*)"\", ", 4);
1268 				OPC_Ident(obj);
1269 				OPM_Write(')');
1270 				OPC_EndStat();
1271 			}
1272 		}
1273 		OPC_RegCmds(obj->right);
1274 	}
1275 }
1276 
OPC_InitImports(OPT_Object obj)1277 static void OPC_InitImports (OPT_Object obj)
1278 {
1279 	if (obj != NIL) {
1280 		OPC_InitImports(obj->left);
1281 		if ((obj->mode == 11 && obj->mnolev != 0)) {
1282 			OPC_BegStat();
1283 			OPM_WriteString((CHAR*)"__MODULE_IMPORT(", 17);
1284 			OPM_WriteStringVar((void*)OPT_GlbMod[__X(-obj->mnolev, 64)]->name, 256);
1285 			OPM_Write(')');
1286 			OPC_EndStat();
1287 		}
1288 		OPC_InitImports(obj->right);
1289 	}
1290 }
1291 
OPC_GenEnumPtrs(OPT_Object var)1292 void OPC_GenEnumPtrs (OPT_Object var)
1293 {
1294 	OPT_Struct typ = NIL;
1295 	INT32 n;
1296 	OPC_GlbPtrs = 0;
1297 	while (var != NIL) {
1298 		typ = var->typ;
1299 		if (OPC_NofPtrs(typ) > 0) {
1300 			if (!OPC_GlbPtrs) {
1301 				OPC_GlbPtrs = 1;
1302 				OPM_WriteString((CHAR*)"static void EnumPtrs(void (*P)(void*))", 39);
1303 				OPM_WriteLn();
1304 				OPC_BegBlk();
1305 			}
1306 			OPC_BegStat();
1307 			if (typ->form == 11) {
1308 				OPM_WriteString((CHAR*)"P(", 3);
1309 				OPC_Ident(var);
1310 				OPM_Write(')');
1311 			} else if (typ->comp == 4) {
1312 				OPM_WriteString((CHAR*)"__ENUMR(&", 10);
1313 				OPC_Ident(var);
1314 				OPM_WriteString((CHAR*)", ", 3);
1315 				OPC_Andent(typ);
1316 				OPM_WriteString((CHAR*)"__typ", 6);
1317 				OPC_Str1((CHAR*)", #", 4, typ->size);
1318 				OPM_WriteString((CHAR*)", 1, P)", 8);
1319 			} else if (typ->comp == 2) {
1320 				n = typ->n;
1321 				typ = typ->BaseTyp;
1322 				while (typ->comp == 2) {
1323 					n = n * typ->n;
1324 					typ = typ->BaseTyp;
1325 				}
1326 				if (typ->form == 11) {
1327 					OPM_WriteString((CHAR*)"__ENUMP(", 9);
1328 					OPC_Ident(var);
1329 					OPC_Str1((CHAR*)", #, P)", 8, n);
1330 				} else if (typ->comp == 4) {
1331 					OPM_WriteString((CHAR*)"__ENUMR(", 9);
1332 					OPC_Ident(var);
1333 					OPM_WriteString((CHAR*)", ", 3);
1334 					OPC_Andent(typ);
1335 					OPM_WriteString((CHAR*)"__typ", 6);
1336 					OPC_Str1((CHAR*)", #", 4, typ->size);
1337 					OPC_Str1((CHAR*)", #, P)", 8, n);
1338 				}
1339 			}
1340 			OPC_EndStat();
1341 		}
1342 		var = var->link;
1343 	}
1344 	if (OPC_GlbPtrs) {
1345 		OPC_EndBlk();
1346 		OPM_WriteLn();
1347 	}
1348 }
1349 
OPC_EnterBody(void)1350 void OPC_EnterBody (void)
1351 {
1352 	OPM_WriteLn();
1353 	OPM_WriteString((CHAR*)"export ", 8);
1354 	if (__IN(10, OPM_Options, 32)) {
1355 		OPM_WriteString((CHAR*)"int main(int argc, char **argv)", 32);
1356 		OPM_WriteLn();
1357 	} else {
1358 		OPM_WriteString((CHAR*)"void *", 7);
1359 		OPM_WriteString(OPM_modName, 32);
1360 		OPM_WriteString(OPC_BodyNameExt, 13);
1361 		OPM_WriteLn();
1362 	}
1363 	OPC_BegBlk();
1364 	OPC_BegStat();
1365 	if (__IN(10, OPM_Options, 32)) {
1366 		OPM_WriteString((CHAR*)"__INIT(argc, argv)", 19);
1367 	} else {
1368 		OPM_WriteString((CHAR*)"__DEFMOD", 9);
1369 	}
1370 	OPC_EndStat();
1371 	if ((__IN(10, OPM_Options, 32) && 0)) {
1372 		OPC_BegStat();
1373 		OPM_WriteString((CHAR*)"/*don`t do it!*/ printf(\"DEMO VERSION: DO NOT USE THIS PROGRAM FOR ANY COMMERCIAL PURPOSE\\n\")", 94);
1374 		OPC_EndStat();
1375 	}
1376 	OPC_InitImports(OPT_topScope->right);
1377 	OPC_BegStat();
1378 	if (__IN(10, OPM_Options, 32)) {
1379 		OPM_WriteString((CHAR*)"__REGMAIN(\"", 12);
1380 	} else {
1381 		OPM_WriteString((CHAR*)"__REGMOD(\"", 11);
1382 	}
1383 	OPM_WriteString(OPM_modName, 32);
1384 	if (OPC_GlbPtrs) {
1385 		OPM_WriteString((CHAR*)"\", EnumPtrs)", 13);
1386 	} else {
1387 		OPM_WriteString((CHAR*)"\", 0)", 6);
1388 	}
1389 	OPC_EndStat();
1390 	if (__STRCMP(OPM_modName, "SYSTEM") != 0) {
1391 		OPC_RegCmds(OPT_topScope);
1392 	}
1393 }
1394 
OPC_ExitBody(void)1395 void OPC_ExitBody (void)
1396 {
1397 	OPC_BegStat();
1398 	if (__IN(10, OPM_Options, 32)) {
1399 		OPM_WriteString((CHAR*)"__FINI;", 8);
1400 	} else {
1401 		OPM_WriteString((CHAR*)"__ENDMOD;", 10);
1402 	}
1403 	OPM_WriteLn();
1404 	OPC_EndBlk();
1405 }
1406 
OPC_DefineInter(OPT_Object proc)1407 void OPC_DefineInter (OPT_Object proc)
1408 {
1409 	OPT_Object scope = NIL;
1410 	scope = proc->scope;
1411 	OPM_WriteString((CHAR*)"static ", 8);
1412 	OPM_WriteString((CHAR*)"struct ", 8);
1413 	OPM_WriteStringVar((void*)scope->name, 256);
1414 	OPM_Write(' ');
1415 	OPC_BegBlk();
1416 	OPC_IdentList(proc->link, 3);
1417 	OPC_IdentList(scope->scope, 3);
1418 	OPC_BegStat();
1419 	OPM_WriteString((CHAR*)"struct ", 8);
1420 	OPM_WriteStringVar((void*)scope->name, 256);
1421 	OPM_Write(' ');
1422 	OPM_Write('*');
1423 	OPM_WriteString((CHAR*)"lnk", 4);
1424 	OPC_EndStat();
1425 	OPC_EndBlk0();
1426 	OPM_Write(' ');
1427 	OPM_Write('*');
1428 	OPM_WriteStringVar((void*)scope->name, 256);
1429 	OPM_WriteString((CHAR*)"_s", 3);
1430 	OPC_EndStat();
1431 	OPM_WriteLn();
1432 	OPC_ProcPredefs(scope->right, 0);
1433 	OPM_WriteLn();
1434 }
1435 
OPC_NeedsRetval(OPT_Object proc)1436 BOOLEAN OPC_NeedsRetval (OPT_Object proc)
1437 {
1438 	return (proc->typ != OPT_notyp && !proc->scope->leaf);
1439 }
1440 
OPC_EnterProc(OPT_Object proc)1441 void OPC_EnterProc (OPT_Object proc)
1442 {
1443 	OPT_Object var = NIL, scope = NIL;
1444 	OPT_Struct typ = NIL;
1445 	INT16 dim;
1446 	if (proc->vis != 1) {
1447 		OPM_WriteString((CHAR*)"static ", 8);
1448 	}
1449 	OPC_ProcHeader(proc, 1);
1450 	OPC_BegBlk();
1451 	scope = proc->scope;
1452 	OPC_IdentList(scope->scope, 0);
1453 	if (!scope->leaf) {
1454 		OPC_BegStat();
1455 		OPM_WriteString((CHAR*)"struct ", 8);
1456 		OPM_WriteStringVar((void*)scope->name, 256);
1457 		OPM_Write(' ');
1458 		OPM_WriteString((CHAR*)"_s", 3);
1459 		OPC_EndStat();
1460 	}
1461 	if (OPC_NeedsRetval(proc)) {
1462 		OPC_BegStat();
1463 		OPC_Ident(proc->typ->strobj);
1464 		OPM_WriteString((CHAR*)" __retval", 10);
1465 		OPC_EndStat();
1466 	}
1467 	var = proc->link;
1468 	while (var != NIL) {
1469 		if ((var->typ->comp == 2 && var->mode == 1)) {
1470 			OPC_BegStat();
1471 			if (var->typ->strobj == NIL) {
1472 				OPM_Mark(200, var->typ->txtpos);
1473 			} else {
1474 				OPC_Ident(var->typ->strobj);
1475 			}
1476 			OPM_Write(' ');
1477 			OPC_Ident(var);
1478 			OPM_WriteString((CHAR*)"__copy", 7);
1479 			OPC_EndStat();
1480 		}
1481 		var = var->link;
1482 	}
1483 	var = proc->link;
1484 	while (var != NIL) {
1485 		if ((((__IN(var->typ->comp, 0x0c, 32) && var->mode == 1)) && var->typ->sysflag == 0)) {
1486 			OPC_BegStat();
1487 			if (var->typ->comp == 2) {
1488 				OPM_WriteString((CHAR*)"__DUPARR(", 10);
1489 				OPC_Ident(var);
1490 				OPM_WriteString((CHAR*)", ", 3);
1491 				if (var->typ->strobj == NIL) {
1492 					OPM_Mark(200, var->typ->txtpos);
1493 				} else {
1494 					OPC_Ident(var->typ->strobj);
1495 				}
1496 			} else {
1497 				OPM_WriteString((CHAR*)"__DUP(", 7);
1498 				OPC_Ident(var);
1499 				OPM_WriteString((CHAR*)", ", 3);
1500 				OPC_Ident(var);
1501 				OPM_WriteString((CHAR*)"__len", 6);
1502 				typ = var->typ->BaseTyp;
1503 				dim = 1;
1504 				while (typ->comp == 3) {
1505 					OPM_WriteString((CHAR*)" * ", 4);
1506 					OPC_Ident(var);
1507 					OPM_WriteString((CHAR*)"__len", 6);
1508 					OPM_WriteInt(dim);
1509 					typ = typ->BaseTyp;
1510 					dim += 1;
1511 				}
1512 				OPM_WriteString((CHAR*)", ", 3);
1513 				if (typ->strobj == NIL) {
1514 					OPM_Mark(200, typ->txtpos);
1515 				} else {
1516 					OPC_Ident(typ->strobj);
1517 				}
1518 			}
1519 			OPM_Write(')');
1520 			OPC_EndStat();
1521 		}
1522 		var = var->link;
1523 	}
1524 	if (!scope->leaf) {
1525 		var = proc->link;
1526 		while (var != NIL) {
1527 			if (!var->leaf) {
1528 				OPC_BegStat();
1529 				OPM_WriteString((CHAR*)"_s", 3);
1530 				OPM_Write('.');
1531 				OPC_Ident(var);
1532 				OPM_WriteString((CHAR*)" = ", 4);
1533 				if (__IN(var->typ->comp, 0x0c, 32)) {
1534 					OPM_WriteString((CHAR*)"(void*)", 8);
1535 				} else if (var->mode != 2) {
1536 					OPM_Write('&');
1537 				}
1538 				OPC_Ident(var);
1539 				if (var->typ->comp == 3) {
1540 					typ = var->typ;
1541 					dim = 0;
1542 					do {
1543 						OPM_WriteString((CHAR*)"; ", 3);
1544 						OPM_WriteString((CHAR*)"_s", 3);
1545 						OPM_Write('.');
1546 						OPC_Ident(var);
1547 						OPM_WriteString((CHAR*)"__len", 6);
1548 						if (dim != 0) {
1549 							OPM_WriteInt(dim);
1550 						}
1551 						OPM_WriteString((CHAR*)" = ", 4);
1552 						OPC_Ident(var);
1553 						OPM_WriteString((CHAR*)"__len", 6);
1554 						if (dim != 0) {
1555 							OPM_WriteInt(dim);
1556 						}
1557 						typ = typ->BaseTyp;
1558 					} while (!(typ->comp != 3));
1559 				} else if ((var->mode == 2 && var->typ->comp == 4)) {
1560 					OPM_WriteString((CHAR*)"; ", 3);
1561 					OPM_WriteString((CHAR*)"_s", 3);
1562 					OPM_Write('.');
1563 					OPC_Ident(var);
1564 					OPM_WriteString((CHAR*)"__typ", 6);
1565 					OPM_WriteString((CHAR*)" = ", 4);
1566 					OPC_Ident(var);
1567 					OPM_WriteString((CHAR*)"__typ", 6);
1568 				}
1569 				OPC_EndStat();
1570 			}
1571 			var = var->link;
1572 		}
1573 		var = scope->scope;
1574 		while (var != NIL) {
1575 			if (!var->leaf) {
1576 				OPC_BegStat();
1577 				OPM_WriteString((CHAR*)"_s", 3);
1578 				OPM_Write('.');
1579 				OPC_Ident(var);
1580 				OPM_WriteString((CHAR*)" = ", 4);
1581 				if (var->typ->comp != 2) {
1582 					OPM_Write('&');
1583 				} else {
1584 					OPM_WriteString((CHAR*)"(void*)", 8);
1585 				}
1586 				OPC_Ident(var);
1587 				OPC_EndStat();
1588 			}
1589 			var = var->link;
1590 		}
1591 		OPC_BegStat();
1592 		OPM_WriteString((CHAR*)"_s", 3);
1593 		OPM_Write('.');
1594 		OPM_WriteString((CHAR*)"lnk", 4);
1595 		OPM_WriteString((CHAR*)" = ", 4);
1596 		OPM_WriteStringVar((void*)scope->name, 256);
1597 		OPM_WriteString((CHAR*)"_s", 3);
1598 		OPC_EndStat();
1599 		OPC_BegStat();
1600 		OPM_WriteStringVar((void*)scope->name, 256);
1601 		OPM_WriteString((CHAR*)"_s", 3);
1602 		OPM_WriteString((CHAR*)" = ", 4);
1603 		OPM_Write('&');
1604 		OPM_WriteString((CHAR*)"_s", 3);
1605 		OPC_EndStat();
1606 	}
1607 }
1608 
OPC_ExitProc(OPT_Object proc,BOOLEAN eoBlock,BOOLEAN implicitRet)1609 void OPC_ExitProc (OPT_Object proc, BOOLEAN eoBlock, BOOLEAN implicitRet)
1610 {
1611 	OPT_Object var = NIL;
1612 	BOOLEAN indent;
1613 	indent = eoBlock;
1614 	if ((implicitRet && proc->typ != OPT_notyp)) {
1615 		OPM_Write(0x09);
1616 		OPM_WriteString((CHAR*)"__RETCHK;", 10);
1617 		OPM_WriteLn();
1618 	} else if (!eoBlock || implicitRet) {
1619 		if (!proc->scope->leaf) {
1620 			if (indent) {
1621 				OPC_BegStat();
1622 			} else {
1623 				indent = 1;
1624 			}
1625 			OPM_WriteStringVar((void*)proc->scope->name, 256);
1626 			OPM_WriteString((CHAR*)"_s", 3);
1627 			OPM_WriteString((CHAR*)" = ", 4);
1628 			OPM_WriteString((CHAR*)"_s", 3);
1629 			OPM_Write('.');
1630 			OPM_WriteString((CHAR*)"lnk", 4);
1631 			OPC_EndStat();
1632 		}
1633 		var = proc->link;
1634 		while (var != NIL) {
1635 			if ((((var->typ->comp == 3 && var->mode == 1)) && var->typ->sysflag == 0)) {
1636 				if (indent) {
1637 					OPC_BegStat();
1638 				} else {
1639 					indent = 1;
1640 				}
1641 				OPM_WriteString((CHAR*)"__DEL(", 7);
1642 				OPC_Ident(var);
1643 				OPM_Write(')');
1644 				OPC_EndStat();
1645 			}
1646 			var = var->link;
1647 		}
1648 	}
1649 	if (eoBlock) {
1650 		OPC_EndBlk();
1651 		OPM_WriteLn();
1652 	} else if (indent) {
1653 		OPC_BegStat();
1654 	}
1655 }
1656 
OPC_CompleteIdent(OPT_Object obj)1657 void OPC_CompleteIdent (OPT_Object obj)
1658 {
1659 	INT16 comp, level;
1660 	level = obj->mnolev;
1661 	if (obj->adr == 1) {
1662 		if (obj->typ->comp == 4) {
1663 			OPC_Ident(obj);
1664 			OPM_WriteString((CHAR*)"__", 3);
1665 		} else {
1666 			OPM_WriteString((CHAR*)"(*(", 4);
1667 			OPC_Ident(obj->typ->strobj);
1668 			OPM_WriteString((CHAR*)"*)&", 4);
1669 			OPC_Ident(obj);
1670 			OPM_Write(')');
1671 		}
1672 	} else if ((level != OPM_level && level > 0)) {
1673 		comp = obj->typ->comp;
1674 		if ((obj->mode != 2 && comp != 3)) {
1675 			OPM_Write('*');
1676 		}
1677 		OPM_WriteStringVar((void*)obj->scope->name, 256);
1678 		OPM_WriteString((CHAR*)"_s", 3);
1679 		OPM_WriteString((CHAR*)"->", 3);
1680 		OPC_Ident(obj);
1681 	} else {
1682 		OPC_Ident(obj);
1683 	}
1684 }
1685 
OPC_TypeOf(OPT_Object ap)1686 void OPC_TypeOf (OPT_Object ap)
1687 {
1688 	INT16 i;
1689 	__ASSERT(ap->typ->comp == 4, 0);
1690 	if (ap->mode == 2) {
1691 		if ((INT16)ap->mnolev != OPM_level) {
1692 			OPM_WriteStringVar((void*)ap->scope->name, 256);
1693 			OPM_WriteString((CHAR*)"_s->", 5);
1694 			OPC_Ident(ap);
1695 		} else {
1696 			OPC_Ident(ap);
1697 		}
1698 		OPM_WriteString((CHAR*)"__typ", 6);
1699 	} else if (ap->typ->strobj != NIL) {
1700 		OPC_Ident(ap->typ->strobj);
1701 		OPM_WriteString((CHAR*)"__typ", 6);
1702 	} else {
1703 		OPC_Andent(ap->typ);
1704 	}
1705 }
1706 
OPC_Cmp(INT16 rel)1707 void OPC_Cmp (INT16 rel)
1708 {
1709 	switch (rel) {
1710 		case 9:
1711 			OPM_WriteString((CHAR*)" == ", 5);
1712 			break;
1713 		case 10:
1714 			OPM_WriteString((CHAR*)" != ", 5);
1715 			break;
1716 		case 11:
1717 			OPM_WriteString((CHAR*)" < ", 4);
1718 			break;
1719 		case 12:
1720 			OPM_WriteString((CHAR*)" <= ", 5);
1721 			break;
1722 		case 13:
1723 			OPM_WriteString((CHAR*)" > ", 4);
1724 			break;
1725 		case 14:
1726 			OPM_WriteString((CHAR*)" >= ", 5);
1727 			break;
1728 		default:
1729 			OPM_LogWStr((CHAR*)"unhandled case in OPC.Cmp, rel = ", 34);
1730 			OPM_LogWNum(rel, 0);
1731 			OPM_LogWLn();
1732 			break;
1733 	}
1734 }
1735 
OPC_CharacterLiteral(INT64 c)1736 static void OPC_CharacterLiteral (INT64 c)
1737 {
1738 	if (c < 32 || c > 126) {
1739 		OPM_WriteString((CHAR*)"0x", 3);
1740 		OPM_WriteHex(c);
1741 	} else {
1742 		OPM_Write('\'');
1743 		if ((c == 92 || c == 39) || c == 63) {
1744 			OPM_Write('\\');
1745 		}
1746 		OPM_Write(__CHR(c));
1747 		OPM_Write('\'');
1748 	}
1749 }
1750 
OPC_StringLiteral(CHAR * s,ADDRESS s__len,INT32 l)1751 static void OPC_StringLiteral (CHAR *s, ADDRESS s__len, INT32 l)
1752 {
1753 	INT32 i;
1754 	INT16 c;
1755 	__DUP(s, s__len, CHAR);
1756 	OPM_Write('"');
1757 	i = 0;
1758 	while (i < l) {
1759 		c = (INT16)s[__X(i, s__len)];
1760 		if (c < 32 || c > 126) {
1761 			OPM_Write('\\');
1762 			OPM_Write(__CHR(48 + __ASHR(c, 6)));
1763 			c = __MASK(c, -64);
1764 			OPM_Write(__CHR(48 + __ASHR(c, 3)));
1765 			c = __MASK(c, -8);
1766 			OPM_Write(__CHR(48 + c));
1767 		} else {
1768 			if ((c == 92 || c == 34) || c == 63) {
1769 				OPM_Write('\\');
1770 			}
1771 			OPM_Write(__CHR(c));
1772 		}
1773 		i += 1;
1774 	}
1775 	OPM_Write('"');
1776 	__DEL(s);
1777 }
1778 
OPC_Case(INT64 caseVal,INT16 form)1779 void OPC_Case (INT64 caseVal, INT16 form)
1780 {
1781 	CHAR ch;
1782 	OPM_WriteString((CHAR*)"case ", 6);
1783 	switch (form) {
1784 		case 3:
1785 			OPC_CharacterLiteral(caseVal);
1786 			break;
1787 		case 4:
1788 			OPM_WriteInt(caseVal);
1789 			break;
1790 		default:
1791 			OPM_LogWStr((CHAR*)"unhandled case in OPC.Case, form = ", 36);
1792 			OPM_LogWNum(form, 0);
1793 			OPM_LogWLn();
1794 			break;
1795 	}
1796 	OPM_WriteString((CHAR*)": ", 3);
1797 }
1798 
OPC_SetInclude(BOOLEAN exclude)1799 void OPC_SetInclude (BOOLEAN exclude)
1800 {
1801 	if (exclude) {
1802 		OPM_WriteString((CHAR*)" &= ~", 6);
1803 	} else {
1804 		OPM_WriteString((CHAR*)" |= ", 5);
1805 	}
1806 }
1807 
OPC_Increment(BOOLEAN decrement)1808 void OPC_Increment (BOOLEAN decrement)
1809 {
1810 	if (decrement) {
1811 		OPM_WriteString((CHAR*)" -= ", 5);
1812 	} else {
1813 		OPM_WriteString((CHAR*)" += ", 5);
1814 	}
1815 }
1816 
OPC_Halt(INT32 n)1817 void OPC_Halt (INT32 n)
1818 {
1819 	OPC_Str1((CHAR*)"__HALT(#)", 10, n);
1820 }
1821 
OPC_IntLiteral(INT64 n,INT32 size)1822 void OPC_IntLiteral (INT64 n, INT32 size)
1823 {
1824 	if ((((size > 4 && n <= 2147483647)) && n > (-2147483647-1))) {
1825 		OPM_WriteString((CHAR*)"((INT", 6);
1826 		OPM_WriteInt(__ASHL(size, 3));
1827 		OPM_WriteString((CHAR*)")(", 3);
1828 		OPM_WriteInt(n);
1829 		OPM_WriteString((CHAR*)"))", 3);
1830 	} else {
1831 		OPM_WriteInt(n);
1832 	}
1833 }
1834 
OPC_Len(OPT_Object obj,OPT_Struct array,INT64 dim)1835 void OPC_Len (OPT_Object obj, OPT_Struct array, INT64 dim)
1836 {
1837 	INT64 d;
1838 	d = dim;
1839 	while (d > 0) {
1840 		array = array->BaseTyp;
1841 		d -= 1;
1842 	}
1843 	if (array->comp == 3) {
1844 		OPC_CompleteIdent(obj);
1845 		OPM_WriteString((CHAR*)"__len", 6);
1846 		if (dim != 0) {
1847 			OPM_WriteInt(dim);
1848 		}
1849 	} else {
1850 		OPM_WriteInt(array->n);
1851 	}
1852 }
1853 
OPC_Constant(OPT_Const con,INT16 form)1854 void OPC_Constant (OPT_Const con, INT16 form)
1855 {
1856 	INT16 i;
1857 	UINT64 s;
1858 	INT64 hex;
1859 	BOOLEAN skipLeading;
1860 	switch (form) {
1861 		case 1:
1862 			OPM_WriteInt(con->intval);
1863 			break;
1864 		case 2:
1865 			OPM_WriteInt(con->intval);
1866 			break;
1867 		case 3:
1868 			OPC_CharacterLiteral(con->intval);
1869 			break;
1870 		case 4:
1871 			OPM_WriteInt(con->intval);
1872 			break;
1873 		case 5:
1874 			OPM_WriteReal(con->realval, 'f');
1875 			break;
1876 		case 6:
1877 			OPM_WriteReal(con->realval, 0x00);
1878 			break;
1879 		case 7:
1880 			OPM_WriteString((CHAR*)"0x", 3);
1881 			skipLeading = 1;
1882 			s = con->setval;
1883 			i = 64;
1884 			do {
1885 				hex = 0;
1886 				do {
1887 					i -= 1;
1888 					hex = __ASHL(hex, 1);
1889 					if (__IN(i, s, 64)) {
1890 						hex += 1;
1891 					}
1892 				} while (!(__MASK(i, -8) == 0));
1893 				if (hex != 0 || !skipLeading) {
1894 					OPM_WriteHex(hex);
1895 					skipLeading = 0;
1896 				}
1897 			} while (!(i == 0));
1898 			if (skipLeading) {
1899 				OPM_Write('0');
1900 			}
1901 			break;
1902 		case 8:
1903 			OPC_StringLiteral(*con->ext, 256, con->intval2 - 1);
1904 			break;
1905 		case 9:
1906 			OPM_WriteString((CHAR*)"NIL", 4);
1907 			break;
1908 		default:
1909 			OPM_LogWStr((CHAR*)"unhandled case in OPC.Constant, form = ", 40);
1910 			OPM_LogWNum(form, 0);
1911 			OPM_LogWLn();
1912 			break;
1913 	}
1914 }
1915 
1916 static struct InitKeywords__46 {
1917 	INT8 *n;
1918 	struct InitKeywords__46 *lnk;
1919 } *InitKeywords__46_s;
1920 
1921 static void Enter__47 (CHAR *s, ADDRESS s__len);
1922 
Enter__47(CHAR * s,ADDRESS s__len)1923 static void Enter__47 (CHAR *s, ADDRESS s__len)
1924 {
1925 	INT16 h;
1926 	__DUP(s, s__len, CHAR);
1927 	h = OPC_PerfectHash((void*)s, s__len);
1928 	OPC_hashtab[__X(h, 105)] = *InitKeywords__46_s->n;
1929 	__COPY(s, OPC_keytab[__X(*InitKeywords__46_s->n, 50)], 9);
1930 	*InitKeywords__46_s->n += 1;
1931 	__DEL(s);
1932 }
1933 
OPC_InitKeywords(void)1934 static void OPC_InitKeywords (void)
1935 {
1936 	INT8 n, i;
1937 	struct InitKeywords__46 _s;
1938 	_s.n = &n;
1939 	_s.lnk = InitKeywords__46_s;
1940 	InitKeywords__46_s = &_s;
1941 	n = 0;
1942 	i = 0;
1943 	while (i <= 104) {
1944 		OPC_hashtab[__X(i, 105)] = -1;
1945 		i += 1;
1946 	}
1947 	Enter__47((CHAR*)"ADDRESS", 8);
1948 	Enter__47((CHAR*)"INT16", 6);
1949 	Enter__47((CHAR*)"INT32", 6);
1950 	Enter__47((CHAR*)"INT64", 6);
1951 	Enter__47((CHAR*)"INT8", 5);
1952 	Enter__47((CHAR*)"UINT16", 7);
1953 	Enter__47((CHAR*)"UINT32", 7);
1954 	Enter__47((CHAR*)"UINT64", 7);
1955 	Enter__47((CHAR*)"UINT8", 6);
1956 	Enter__47((CHAR*)"asm", 4);
1957 	Enter__47((CHAR*)"auto", 5);
1958 	Enter__47((CHAR*)"break", 6);
1959 	Enter__47((CHAR*)"case", 5);
1960 	Enter__47((CHAR*)"char", 5);
1961 	Enter__47((CHAR*)"const", 6);
1962 	Enter__47((CHAR*)"continue", 9);
1963 	Enter__47((CHAR*)"default", 8);
1964 	Enter__47((CHAR*)"do", 3);
1965 	Enter__47((CHAR*)"double", 7);
1966 	Enter__47((CHAR*)"else", 5);
1967 	Enter__47((CHAR*)"enum", 5);
1968 	Enter__47((CHAR*)"extern", 7);
1969 	Enter__47((CHAR*)"export", 7);
1970 	Enter__47((CHAR*)"float", 6);
1971 	Enter__47((CHAR*)"for", 4);
1972 	Enter__47((CHAR*)"fortran", 8);
1973 	Enter__47((CHAR*)"goto", 5);
1974 	Enter__47((CHAR*)"if", 3);
1975 	Enter__47((CHAR*)"import", 7);
1976 	Enter__47((CHAR*)"int", 4);
1977 	Enter__47((CHAR*)"long", 5);
1978 	Enter__47((CHAR*)"register", 9);
1979 	Enter__47((CHAR*)"return", 7);
1980 	Enter__47((CHAR*)"short", 6);
1981 	Enter__47((CHAR*)"signed", 7);
1982 	Enter__47((CHAR*)"sizeof", 7);
1983 	Enter__47((CHAR*)"size_t", 7);
1984 	Enter__47((CHAR*)"static", 7);
1985 	Enter__47((CHAR*)"struct", 7);
1986 	Enter__47((CHAR*)"switch", 7);
1987 	Enter__47((CHAR*)"typedef", 8);
1988 	Enter__47((CHAR*)"union", 6);
1989 	Enter__47((CHAR*)"unsigned", 9);
1990 	Enter__47((CHAR*)"void", 5);
1991 	Enter__47((CHAR*)"volatile", 9);
1992 	Enter__47((CHAR*)"while", 6);
1993 	InitKeywords__46_s = _s.lnk;
1994 }
1995 
1996 
OPC__init(void)1997 export void *OPC__init(void)
1998 {
1999 	__DEFMOD;
2000 	__MODULE_IMPORT(Configuration);
2001 	__MODULE_IMPORT(OPM);
2002 	__MODULE_IMPORT(OPT);
2003 	__REGMOD("OPC", 0);
2004 	__REGCMD("BegBlk", OPC_BegBlk);
2005 	__REGCMD("BegStat", OPC_BegStat);
2006 	__REGCMD("EndBlk", OPC_EndBlk);
2007 	__REGCMD("EndBlk0", OPC_EndBlk0);
2008 	__REGCMD("EndStat", OPC_EndStat);
2009 	__REGCMD("EnterBody", OPC_EnterBody);
2010 	__REGCMD("ExitBody", OPC_ExitBody);
2011 	__REGCMD("GenHdrIncludes", OPC_GenHdrIncludes);
2012 	__REGCMD("Init", OPC_Init);
2013 /* BEGIN */
2014 	OPC_InitKeywords();
2015 	__ENDMOD;
2016 }
2017