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 "Files.h"
11 #include "Modules.h"
12 #include "Out.h"
13 #include "Platform.h"
14 #include "Strings.h"
15 #include "Texts.h"
16 #include "VT100.h"
17
18 typedef
19 CHAR OPM_FileName[32];
20
21
22 static CHAR OPM_SourceFileName[256];
23 static CHAR OPM_GlobalModel[10];
24 export CHAR OPM_Model[10];
25 static INT16 OPM_GlobalAddressSize;
26 export INT16 OPM_AddressSize;
27 static INT16 OPM_GlobalAlignment;
28 export INT16 OPM_Alignment;
29 export UINT32 OPM_GlobalOptions, OPM_Options;
30 export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize;
31 export INT64 OPM_MaxIndex;
32 export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
33 export BOOLEAN OPM_noerr;
34 export INT32 OPM_curpos, OPM_errpos, OPM_breakpc;
35 export INT16 OPM_currFile, OPM_level, OPM_pc, OPM_entno;
36 export CHAR OPM_modName[32];
37 export CHAR OPM_objname[64];
38 static INT32 OPM_ErrorLineStartPos, OPM_ErrorLineLimitPos, OPM_ErrorLineNumber, OPM_lasterrpos;
39 static Texts_Reader OPM_inR;
40 static Texts_Text OPM_Log, OPM_Errors;
41 static Files_Rider OPM_oldSF, OPM_newSF;
42 static Files_Rider OPM_R[3];
43 static Files_File OPM_oldSFile, OPM_newSFile, OPM_HFile, OPM_BFile, OPM_HIFile;
44 static INT16 OPM_S;
45 export CHAR OPM_InstallDir[1024];
46 export CHAR OPM_ResourceDir[1024];
47
48
49 static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F);
50 export void OPM_CloseFiles (void);
51 export void OPM_CloseOldSym (void);
52 export void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
53 export void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
54 export void OPM_FPrint (INT32 *fp, INT64 val);
55 export void OPM_FPrintLReal (INT32 *fp, LONGREAL val);
56 export void OPM_FPrintReal (INT32 *fp, REAL val);
57 export void OPM_FPrintSet (INT32 *fp, UINT64 val);
58 static void OPM_FindInstallDir (void);
59 static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos);
60 static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len);
61 export void OPM_Get (CHAR *ch);
62 export void OPM_Init (BOOLEAN *done);
63 export void OPM_InitOptions (void);
64 export INT16 OPM_Integer (INT64 n);
65 static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len);
66 export void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len);
67 static void OPM_LogErrMsg (INT16 n);
68 export void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len);
69 export void OPM_LogW (CHAR ch);
70 export void OPM_LogWLn (void);
71 export void OPM_LogWNum (INT64 i, INT64 len);
72 export void OPM_LogWStr (CHAR *s, ADDRESS s__len);
73 export INT32 OPM_Longint (INT64 n);
74 static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len);
75 export void OPM_Mark (INT16 n, INT32 pos);
76 export void OPM_NewSym (CHAR *modName, ADDRESS modName__len);
77 export void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done);
78 export void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len);
79 export BOOLEAN OPM_OpenPar (void);
80 export void OPM_RegisterNewSym (void);
81 static void OPM_ScanOptions (CHAR *s, ADDRESS s__len);
82 static void OPM_ShowLine (INT64 pos);
83 export INT64 OPM_SignedMaximum (INT32 bytecount);
84 export INT64 OPM_SignedMinimum (INT32 bytecount);
85 export void OPM_SymRCh (CHAR *ch);
86 export INT32 OPM_SymRInt (void);
87 export INT64 OPM_SymRInt64 (void);
88 export void OPM_SymRLReal (LONGREAL *lr);
89 export void OPM_SymRReal (REAL *r);
90 export void OPM_SymRSet (UINT64 *s);
91 export void OPM_SymWCh (CHAR ch);
92 export void OPM_SymWInt (INT64 i);
93 export void OPM_SymWLReal (LONGREAL lr);
94 export void OPM_SymWReal (REAL r);
95 export void OPM_SymWSet (UINT64 s);
96 export void OPM_Write (CHAR ch);
97 export void OPM_WriteHex (INT64 i);
98 export void OPM_WriteInt (INT64 i);
99 export void OPM_WriteLn (void);
100 export void OPM_WriteReal (LONGREAL r, CHAR suffx);
101 export void OPM_WriteString (CHAR *s, ADDRESS s__len);
102 export void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
103 export BOOLEAN OPM_eofSF (void);
104 export void OPM_err (INT16 n);
105
106 #define OPM_GetAlignment(a) struct {char c; long long l;} _s; *a = (char*)&_s.l - (char*)&_s
107
OPM_LogW(CHAR ch)108 void OPM_LogW (CHAR ch)
109 {
110 Out_Char(ch);
111 }
112
OPM_LogWStr(CHAR * s,ADDRESS s__len)113 void OPM_LogWStr (CHAR *s, ADDRESS s__len)
114 {
115 __DUP(s, s__len, CHAR);
116 Out_String(s, s__len);
117 __DEL(s);
118 }
119
OPM_LogWNum(INT64 i,INT64 len)120 void OPM_LogWNum (INT64 i, INT64 len)
121 {
122 Out_Int(i, len);
123 }
124
OPM_LogWLn(void)125 void OPM_LogWLn (void)
126 {
127 Out_Ln();
128 }
129
OPM_LogVT100(CHAR * vt100code,ADDRESS vt100code__len)130 void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len)
131 {
132 __DUP(vt100code, vt100code__len, CHAR);
133 if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) {
134 VT100_SetAttr(vt100code, vt100code__len);
135 }
136 __DEL(vt100code);
137 }
138
OPM_LogCompiling(CHAR * modname,ADDRESS modname__len)139 void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len)
140 {
141 __DUP(modname, modname__len, CHAR);
142 OPM_LogWStr((CHAR*)"Compiling ", 11);
143 OPM_LogWStr(modname, modname__len);
144 if (__IN(18, OPM_Options, 32)) {
145 OPM_LogWStr((CHAR*)", s:", 5);
146 OPM_LogWNum(__ASHL(OPM_ShortintSize, 3), 1);
147 OPM_LogWStr((CHAR*)" i:", 4);
148 OPM_LogWNum(__ASHL(OPM_IntegerSize, 3), 1);
149 OPM_LogWStr((CHAR*)" l:", 4);
150 OPM_LogWNum(__ASHL(OPM_LongintSize, 3), 1);
151 OPM_LogWStr((CHAR*)" adr:", 6);
152 OPM_LogWNum(__ASHL(OPM_AddressSize, 3), 1);
153 OPM_LogWStr((CHAR*)" algn:", 7);
154 OPM_LogWNum(__ASHL(OPM_Alignment, 3), 1);
155 }
156 OPM_LogW('.');
157 __DEL(modname);
158 }
159
OPM_SignedMaximum(INT32 bytecount)160 INT64 OPM_SignedMaximum (INT32 bytecount)
161 {
162 INT64 result;
163 result = 1;
164 result = __LSH(result, __ASHL(bytecount, 3) - 1, 64);
165 return result - 1;
166 }
167
OPM_SignedMinimum(INT32 bytecount)168 INT64 OPM_SignedMinimum (INT32 bytecount)
169 {
170 return -OPM_SignedMaximum(bytecount) - 1;
171 }
172
OPM_Longint(INT64 n)173 INT32 OPM_Longint (INT64 n)
174 {
175 return __VAL(INT32, n);
176 }
177
OPM_Integer(INT64 n)178 INT16 OPM_Integer (INT64 n)
179 {
180 return __VAL(INT16, n);
181 }
182
OPM_ScanOptions(CHAR * s,ADDRESS s__len)183 static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
184 {
185 INT16 i;
186 __DUP(s, s__len, CHAR);
187 i = 1;
188 while (s[__X(i, s__len)] != 0x00) {
189 switch (s[__X(i, s__len)]) {
190 case 'p':
191 OPM_Options = OPM_Options ^ 0x20;
192 break;
193 case 'a':
194 OPM_Options = OPM_Options ^ 0x80;
195 break;
196 case 'r':
197 OPM_Options = OPM_Options ^ 0x04;
198 break;
199 case 't':
200 OPM_Options = OPM_Options ^ 0x08;
201 break;
202 case 'x':
203 OPM_Options = OPM_Options ^ 0x01;
204 break;
205 case 'e':
206 OPM_Options = OPM_Options ^ 0x0200;
207 break;
208 case 's':
209 OPM_Options = OPM_Options ^ 0x10;
210 break;
211 case 'F':
212 OPM_Options = OPM_Options ^ 0x020000;
213 break;
214 case 'm':
215 OPM_Options = OPM_Options ^ 0x0400;
216 break;
217 case 'M':
218 OPM_Options = OPM_Options ^ 0x8000;
219 break;
220 case 'S':
221 OPM_Options = OPM_Options ^ 0x2000;
222 break;
223 case 'c':
224 OPM_Options = OPM_Options ^ 0x4000;
225 break;
226 case 'f':
227 OPM_Options = OPM_Options ^ 0x010000;
228 break;
229 case 'V':
230 OPM_Options = OPM_Options ^ 0x040000;
231 break;
232 case 'O':
233 if (i + 1 >= Strings_Length(s, s__len)) {
234 OPM_LogWStr((CHAR*)"-O option requires following size model character.", 51);
235 OPM_LogWLn();
236 } else {
237 OPM_Model[0] = s[__X(i + 1, s__len)];
238 OPM_Model[1] = 0x00;
239 if ((((OPM_Model[0] != '2' && OPM_Model[0] != 'C')) && OPM_Model[0] != 'V')) {
240 OPM_LogWStr((CHAR*)"Unrecognised size model character following -O.", 48);
241 OPM_LogWLn();
242 }
243 i += 1;
244 }
245 break;
246 case 'A':
247 if (i + 2 >= Strings_Length(s, s__len)) {
248 OPM_LogWStr((CHAR*)"-M option requires two following digits.", 41);
249 OPM_LogWLn();
250 } else {
251 OPM_AddressSize = (INT16)s[__X(i + 1, s__len)] - 48;
252 OPM_Alignment = (INT16)s[__X(i + 2, s__len)] - 48;
253 i += 2;
254 }
255 break;
256 default:
257 OPM_LogWStr((CHAR*)" warning: option ", 19);
258 OPM_LogW('-');
259 OPM_LogW(s[__X(i, s__len)]);
260 OPM_LogWStr((CHAR*)" ignored", 9);
261 OPM_LogWLn();
262 break;
263 }
264 i += 1;
265 }
266 __DEL(s);
267 }
268
OPM_OpenPar(void)269 BOOLEAN OPM_OpenPar (void)
270 {
271 CHAR s[256];
272 if (Modules_ArgCount == 1) {
273 OPM_LogWLn();
274 OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20);
275 OPM_LogWStr(Configuration_versionLong, 76);
276 OPM_LogW('.');
277 OPM_LogWLn();
278 OPM_LogWStr((CHAR*)"Based on Ofront by J. Templ and Software Templ OEG.", 52);
279 OPM_LogWLn();
280 OPM_LogWStr((CHAR*)"Further development by Norayr Chilingarian, David Brown and others.", 68);
281 OPM_LogWLn();
282 OPM_LogWStr((CHAR*)"Loaded from ", 13);
283 OPM_LogWStr(Modules_BinaryDir, 1024);
284 OPM_LogWLn();
285 OPM_LogWLn();
286 OPM_LogWStr((CHAR*)"Usage:", 7);
287 OPM_LogWLn();
288 OPM_LogWLn();
289 OPM_LogWStr((CHAR*)" ", 3);
290 OPM_LogWStr((CHAR*)"voc", 4);
291 OPM_LogWStr((CHAR*)" options {files {options}}.", 28);
292 OPM_LogWLn();
293 OPM_LogWLn();
294 OPM_LogWStr((CHAR*)"Options:", 9);
295 OPM_LogWLn();
296 OPM_LogWLn();
297 OPM_LogWStr((CHAR*)" Run time safety", 18);
298 OPM_LogWLn();
299 OPM_LogWStr((CHAR*)" -p Initialise pointers to NIL. On by default.", 52);
300 OPM_LogWLn();
301 OPM_LogWStr((CHAR*)" -a Halt on assertion failures. On by default.", 52);
302 OPM_LogWLn();
303 OPM_LogWStr((CHAR*)" -r Halt on range check failures.", 39);
304 OPM_LogWLn();
305 OPM_LogWStr((CHAR*)" -t Halt on type guard failure. On by default.", 52);
306 OPM_LogWLn();
307 OPM_LogWStr((CHAR*)" -x Halt on index out of range. On by default.", 52);
308 OPM_LogWLn();
309 OPM_LogWLn();
310 OPM_LogWStr((CHAR*)" Symbol file management", 25);
311 OPM_LogWLn();
312 OPM_LogWStr((CHAR*)" -e Allow extension of old symbol file.", 45);
313 OPM_LogWLn();
314 OPM_LogWStr((CHAR*)" -s Allow generation of new symbol file.", 46);
315 OPM_LogWLn();
316 OPM_LogWStr((CHAR*)" -F Force generation of new symbol file.", 46);
317 OPM_LogWLn();
318 OPM_LogWLn();
319 OPM_LogWStr((CHAR*)" C compiler and linker control", 32);
320 OPM_LogWLn();
321 OPM_LogWStr((CHAR*)" -m This module is main. Link dynamically.", 48);
322 OPM_LogWLn();
323 OPM_LogWStr((CHAR*)" -M This module is main. Link statically.", 47);
324 OPM_LogWLn();
325 OPM_LogWStr((CHAR*)" -S Don't call C compiler", 31);
326 OPM_LogWLn();
327 OPM_LogWStr((CHAR*)" -c Don't link.", 21);
328 OPM_LogWLn();
329 OPM_LogWLn();
330 OPM_LogWStr((CHAR*)" Miscellaneous", 16);
331 OPM_LogWLn();
332 OPM_LogWStr((CHAR*)" -f Disable VT100 control characters in status output.", 60);
333 OPM_LogWLn();
334 OPM_LogWStr((CHAR*)" -V Display compiler debugging messages.", 46);
335 OPM_LogWLn();
336 OPM_LogWLn();
337 OPM_LogWStr((CHAR*)" Size model for elementary types (default O2)", 47);
338 OPM_LogWLn();
339 OPM_LogWStr((CHAR*)" -O2 Original Oberon / Oberon-2: 8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95);
340 OPM_LogWLn();
341 OPM_LogWStr((CHAR*)" -OC Component Pascal: 16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
342 OPM_LogWLn();
343 OPM_LogWStr((CHAR*)" -OV Alternate large model: 8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
344 OPM_LogWLn();
345 OPM_LogWLn();
346 OPM_LogWStr((CHAR*)" Target machine address size and alignment (default is that of the running compiler binary)", 93);
347 OPM_LogWLn();
348 OPM_LogWStr((CHAR*)" -A44 32 bit addresses, 32 bit alignment (e.g. Unix/linux 32 bit on x86).", 79);
349 OPM_LogWLn();
350 OPM_LogWStr((CHAR*)" -A48 32 bit addresses, 64 bit alignment (e.g. Windows 32 bit on x86, linux 32 bit on arm).", 97);
351 OPM_LogWLn();
352 OPM_LogWStr((CHAR*)" -A88 64 bit addresses, 64 bit alignment (e.g. 64 bit platforms).", 71);
353 OPM_LogWLn();
354 OPM_LogWLn();
355 OPM_LogWStr((CHAR*)"All options are off by default, except where noted above.", 58);
356 OPM_LogWLn();
357 OPM_LogWStr((CHAR*)"Initial options specify defaults for all files.", 48);
358 OPM_LogWLn();
359 OPM_LogWStr((CHAR*)"Options following a filename are specific to that file.", 56);
360 OPM_LogWLn();
361 OPM_LogWStr((CHAR*)"Repeating an option toggles its value.", 39);
362 OPM_LogWLn();
363 return 0;
364 } else {
365 OPM_AddressSize = 4;
366 OPM_GetAlignment(&OPM_Alignment);
367 __MOVE("2", OPM_Model, 2);
368 OPM_Options = 0xa9;
369 OPM_S = 1;
370 s[0] = 0x00;
371 Modules_GetArg(OPM_S, (void*)s, 256);
372 while (s[0] == '-') {
373 OPM_ScanOptions(s, 256);
374 OPM_S += 1;
375 s[0] = 0x00;
376 Modules_GetArg(OPM_S, (void*)s, 256);
377 }
378 OPM_GlobalAddressSize = OPM_AddressSize;
379 OPM_GlobalAlignment = OPM_Alignment;
380 __MOVE(OPM_Model, OPM_GlobalModel, 10);
381 OPM_GlobalOptions = OPM_Options;
382 return 1;
383 }
384 __RETCHK;
385 }
386
OPM_InitOptions(void)387 void OPM_InitOptions (void)
388 {
389 CHAR s[256];
390 CHAR searchpath[1024], modules[1024];
391 CHAR MODULES[1024];
392 OPM_Options = OPM_GlobalOptions;
393 __MOVE(OPM_GlobalModel, OPM_Model, 10);
394 OPM_Alignment = OPM_GlobalAlignment;
395 OPM_AddressSize = OPM_GlobalAddressSize;
396 s[0] = 0x00;
397 Modules_GetArg(OPM_S, (void*)s, 256);
398 while (s[0] == '-') {
399 OPM_ScanOptions(s, 256);
400 OPM_S += 1;
401 s[0] = 0x00;
402 Modules_GetArg(OPM_S, (void*)s, 256);
403 }
404 if (__IN(15, OPM_Options, 32)) {
405 OPM_Options |= __SETOF(10,32);
406 }
407 OPM_MaxIndex = OPM_SignedMaximum(OPM_AddressSize);
408 switch (OPM_Model[0]) {
409 case '2':
410 OPM_ShortintSize = 1;
411 OPM_IntegerSize = 2;
412 OPM_LongintSize = 4;
413 break;
414 case 'C':
415 OPM_ShortintSize = 2;
416 OPM_IntegerSize = 4;
417 OPM_LongintSize = 8;
418 break;
419 case 'V':
420 OPM_ShortintSize = 1;
421 OPM_IntegerSize = 4;
422 OPM_LongintSize = 8;
423 break;
424 default:
425 OPM_ShortintSize = 1;
426 OPM_IntegerSize = 2;
427 OPM_LongintSize = 4;
428 break;
429 }
430 __MOVE(OPM_InstallDir, OPM_ResourceDir, 1024);
431 if (OPM_ResourceDir[0] != 0x00) {
432 Strings_Append((CHAR*)"/", 2, (void*)OPM_ResourceDir, 1024);
433 Strings_Append(OPM_Model, 10, (void*)OPM_ResourceDir, 1024);
434 }
435 modules[0] = 0x00;
436 Platform_GetEnv((CHAR*)"MODULES", 8, (void*)modules, 1024);
437 __MOVE(".", searchpath, 2);
438 Platform_GetEnv((CHAR*)"OBERON", 7, (void*)searchpath, 1024);
439 Strings_Append((CHAR*)";.;", 4, (void*)searchpath, 1024);
440 Strings_Append(modules, 1024, (void*)searchpath, 1024);
441 Strings_Append((CHAR*)";", 2, (void*)searchpath, 1024);
442 Strings_Append(OPM_ResourceDir, 1024, (void*)searchpath, 1024);
443 Strings_Append((CHAR*)"/sym;", 6, (void*)searchpath, 1024);
444 Files_SetSearchPath(searchpath, 1024);
445 }
446
OPM_Init(BOOLEAN * done)447 void OPM_Init (BOOLEAN *done)
448 {
449 Texts_Text T = NIL;
450 INT32 beg, end, time;
451 CHAR s[256];
452 *done = 0;
453 OPM_curpos = 0;
454 if (OPM_S >= Modules_ArgCount) {
455 return;
456 }
457 s[0] = 0x00;
458 Modules_GetArg(OPM_S, (void*)s, 256);
459 __NEW(T, Texts_TextDesc);
460 Texts_Open(T, s, 256);
461 OPM_LogWStr(s, 256);
462 OPM_LogWStr((CHAR*)" ", 3);
463 __COPY(s, OPM_SourceFileName, 256);
464 if (T->len == 0) {
465 OPM_LogWStr(s, 256);
466 OPM_LogWStr((CHAR*)" not found.", 12);
467 OPM_LogWLn();
468 } else {
469 Texts_OpenReader(&OPM_inR, Texts_Reader__typ, T, 0);
470 *done = 1;
471 }
472 OPM_S += 1;
473 OPM_level = 0;
474 OPM_noerr = 1;
475 OPM_errpos = OPM_curpos;
476 OPM_lasterrpos = OPM_curpos - 10;
477 OPM_ErrorLineStartPos = 0;
478 OPM_ErrorLineLimitPos = 0;
479 OPM_ErrorLineNumber = 0;
480 }
481
OPM_Get(CHAR * ch)482 void OPM_Get (CHAR *ch)
483 {
484 OPM_curpos = Texts_Pos(&OPM_inR, Texts_Reader__typ);
485 Texts_Read(&OPM_inR, Texts_Reader__typ, &*ch);
486 if ((*ch < 0x09 && !OPM_inR.eot)) {
487 *ch = ' ';
488 }
489 }
490
OPM_MakeFileName(CHAR * name,ADDRESS name__len,CHAR * FName,ADDRESS FName__len,CHAR * ext,ADDRESS ext__len)491 static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len)
492 {
493 INT16 i, j;
494 CHAR ch;
495 __DUP(ext, ext__len, CHAR);
496 i = 0;
497 for (;;) {
498 ch = name[__X(i, name__len)];
499 if (ch == 0x00) {
500 break;
501 }
502 FName[__X(i, FName__len)] = ch;
503 i += 1;
504 }
505 j = 0;
506 do {
507 ch = ext[__X(j, ext__len)];
508 FName[__X(i, FName__len)] = ch;
509 i += 1;
510 j += 1;
511 } while (!(ch == 0x00));
512 __DEL(ext);
513 }
514
OPM_LogErrMsg(INT16 n)515 static void OPM_LogErrMsg (INT16 n)
516 {
517 INT16 l;
518 Texts_Scanner S;
519 CHAR c;
520 if (n >= 0) {
521 OPM_LogVT100((CHAR*)"31m", 4);
522 OPM_LogWStr((CHAR*)" err ", 7);
523 OPM_LogVT100((CHAR*)"0m", 3);
524 } else {
525 OPM_LogVT100((CHAR*)"35m", 4);
526 OPM_LogWStr((CHAR*)" warning ", 11);
527 n = -n;
528 OPM_LogVT100((CHAR*)"0m", 3);
529 }
530 OPM_LogWNum(n, 1);
531 OPM_LogWStr((CHAR*)" ", 3);
532 if (OPM_Errors == NIL) {
533 __NEW(OPM_Errors, Texts_TextDesc);
534 Texts_Open(OPM_Errors, (CHAR*)"Errors.Txt", 11);
535 }
536 Texts_OpenScanner(&S, Texts_Scanner__typ, OPM_Errors, 0);
537 do {
538 l = S.line;
539 Texts_Scan(&S, Texts_Scanner__typ);
540 } while (!((((l != S.line && S.class == 3)) && S.i == n) || S.eot));
541 if (!S.eot) {
542 Texts_Read((void*)&S, Texts_Scanner__typ, &c);
543 while ((!S.eot && c >= ' ')) {
544 Out_Char(c);
545 Texts_Read((void*)&S, Texts_Scanner__typ, &c);
546 }
547 }
548 }
549
OPM_FindLine(Files_File f,Files_Rider * r,ADDRESS * r__typ,INT64 pos)550 static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos)
551 {
552 CHAR ch, cheol;
553 if (pos < (INT64)OPM_ErrorLineStartPos) {
554 OPM_ErrorLineStartPos = 0;
555 OPM_ErrorLineLimitPos = 0;
556 OPM_ErrorLineNumber = 0;
557 }
558 if (pos < (INT64)OPM_ErrorLineLimitPos) {
559 Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos);
560 return;
561 }
562 Files_Set(&*r, r__typ, f, OPM_ErrorLineLimitPos);
563 Files_Read(&*r, r__typ, (void*)&ch);
564 while (((INT64)OPM_ErrorLineLimitPos < pos && !(*r).eof)) {
565 OPM_ErrorLineStartPos = OPM_ErrorLineLimitPos;
566 OPM_ErrorLineNumber += 1;
567 while ((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) {
568 Files_Read(&*r, r__typ, (void*)&ch);
569 OPM_ErrorLineLimitPos += 1;
570 }
571 cheol = ch;
572 Files_Read(&*r, r__typ, (void*)&ch);
573 OPM_ErrorLineLimitPos += 1;
574 if ((cheol == 0x0d && ch == 0x0a)) {
575 OPM_ErrorLineLimitPos += 1;
576 Files_Read(&*r, r__typ, (void*)&ch);
577 }
578 }
579 Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos);
580 }
581
OPM_ShowLine(INT64 pos)582 static void OPM_ShowLine (INT64 pos)
583 {
584 Files_File f = NIL;
585 Files_Rider r;
586 CHAR line[1023];
587 INT16 i;
588 CHAR ch;
589 f = Files_Old(OPM_SourceFileName, 256);
590 OPM_FindLine(f, &r, Files_Rider__typ, pos);
591 i = 0;
592 Files_Read(&r, Files_Rider__typ, (void*)&ch);
593 while ((((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) && i < 1022)) {
594 line[__X(i, 1023)] = ch;
595 i += 1;
596 Files_Read(&r, Files_Rider__typ, (void*)&ch);
597 }
598 line[__X(i, 1023)] = 0x00;
599 OPM_LogWLn();
600 OPM_LogWLn();
601 OPM_LogWNum(OPM_ErrorLineNumber, 4);
602 OPM_LogWStr((CHAR*)": ", 3);
603 OPM_LogWStr(line, 1023);
604 OPM_LogWLn();
605 OPM_LogWStr((CHAR*)" ", 7);
606 if (pos >= (INT64)OPM_ErrorLineLimitPos) {
607 pos = OPM_ErrorLineLimitPos - 1;
608 }
609 i = __SHORTF(OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos), 32768);
610 while (i > 0) {
611 OPM_LogW(' ');
612 i -= 1;
613 }
614 OPM_LogVT100((CHAR*)"32m", 4);
615 OPM_LogW('^');
616 OPM_LogVT100((CHAR*)"0m", 3);
617 }
618
OPM_Mark(INT16 n,INT32 pos)619 void OPM_Mark (INT16 n, INT32 pos)
620 {
621 if (pos == -1) {
622 pos = 0;
623 }
624 if (n >= 0) {
625 OPM_noerr = 0;
626 if (pos < OPM_lasterrpos || OPM_lasterrpos + 9 < pos) {
627 OPM_lasterrpos = pos;
628 OPM_ShowLine(pos);
629 OPM_LogWLn();
630 OPM_LogWStr((CHAR*)" ", 3);
631 if (n < 249) {
632 OPM_LogWStr((CHAR*)" pos", 6);
633 OPM_LogWNum(pos, 6);
634 OPM_LogErrMsg(n);
635 } else if (n == 255) {
636 OPM_LogWStr((CHAR*)"pos", 4);
637 OPM_LogWNum(pos, 6);
638 OPM_LogWStr((CHAR*)" pc ", 6);
639 OPM_LogWNum(OPM_breakpc, 1);
640 } else if (n == 254) {
641 OPM_LogWStr((CHAR*)"pc not found", 13);
642 } else {
643 OPM_LogWStr(OPM_objname, 64);
644 if (n == 253) {
645 OPM_LogWStr((CHAR*)" is new, compile with option e", 31);
646 } else if (n == 252) {
647 OPM_LogWStr((CHAR*)" is redefined, compile with option s", 37);
648 } else if (n == 251) {
649 OPM_LogWStr((CHAR*)" is redefined (private part only), compile with option s", 57);
650 } else if (n == 250) {
651 OPM_LogWStr((CHAR*)" is no longer visible, compile with option s", 45);
652 } else if (n == 249) {
653 OPM_LogWStr((CHAR*)" is not consistently imported, recompile imports", 49);
654 }
655 }
656 }
657 } else {
658 if (pos >= 0) {
659 OPM_ShowLine(pos);
660 OPM_LogWLn();
661 OPM_LogWStr((CHAR*)" pos", 6);
662 OPM_LogWNum(pos, 6);
663 }
664 OPM_LogErrMsg(n);
665 if (pos < 0) {
666 OPM_LogWLn();
667 }
668 }
669 }
670
OPM_err(INT16 n)671 void OPM_err (INT16 n)
672 {
673 OPM_Mark(n, OPM_errpos);
674 }
675
OPM_FingerprintBytes(INT32 * fp,SYSTEM_BYTE * bytes,ADDRESS bytes__len)676 static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len)
677 {
678 INT16 i;
679 INT32 l;
680 __ASSERT(__MASK(bytes__len, -4) == 0, 0);
681 i = 0;
682 while (i < bytes__len) {
683 __GET((ADDRESS)&bytes[__X(i, bytes__len)], l, INT32);
684 *fp = __ROTL((INT32)((UINT32)*fp ^ (UINT32)l), 1, 32);
685 i += 4;
686 }
687 }
688
OPM_FPrint(INT32 * fp,INT64 val)689 void OPM_FPrint (INT32 *fp, INT64 val)
690 {
691 OPM_FingerprintBytes(&*fp, (void*)&val, 8);
692 }
693
OPM_FPrintSet(INT32 * fp,UINT64 val)694 void OPM_FPrintSet (INT32 *fp, UINT64 val)
695 {
696 OPM_FingerprintBytes(&*fp, (void*)&val, 8);
697 }
698
OPM_FPrintReal(INT32 * fp,REAL val)699 void OPM_FPrintReal (INT32 *fp, REAL val)
700 {
701 OPM_FingerprintBytes(&*fp, (void*)&val, 4);
702 }
703
OPM_FPrintLReal(INT32 * fp,LONGREAL val)704 void OPM_FPrintLReal (INT32 *fp, LONGREAL val)
705 {
706 OPM_FingerprintBytes(&*fp, (void*)&val, 8);
707 }
708
OPM_SymRCh(CHAR * ch)709 void OPM_SymRCh (CHAR *ch)
710 {
711 Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&*ch);
712 }
713
OPM_SymRInt(void)714 INT32 OPM_SymRInt (void)
715 {
716 INT32 k;
717 Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (void*)&k, 4);
718 return k;
719 }
720
OPM_SymRInt64(void)721 INT64 OPM_SymRInt64 (void)
722 {
723 INT64 k;
724 Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (void*)&k, 8);
725 return k;
726 }
727
OPM_SymRSet(UINT64 * s)728 void OPM_SymRSet (UINT64 *s)
729 {
730 Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (void*)&*s, 8);
731 }
732
OPM_SymRReal(REAL * r)733 void OPM_SymRReal (REAL *r)
734 {
735 Files_ReadReal(&OPM_oldSF, Files_Rider__typ, &*r);
736 }
737
OPM_SymRLReal(LONGREAL * lr)738 void OPM_SymRLReal (LONGREAL *lr)
739 {
740 Files_ReadLReal(&OPM_oldSF, Files_Rider__typ, &*lr);
741 }
742
OPM_CloseOldSym(void)743 void OPM_CloseOldSym (void)
744 {
745 Files_Close(Files_Base(&OPM_oldSF, Files_Rider__typ));
746 }
747
OPM_OldSym(CHAR * modName,ADDRESS modName__len,BOOLEAN * done)748 void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done)
749 {
750 CHAR tag, ver;
751 OPM_FileName fileName;
752 INT16 res;
753 OPM_oldSFile = NIL;
754 *done = 0;
755 OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
756 OPM_oldSFile = Files_Old(fileName, 32);
757 *done = OPM_oldSFile != NIL;
758 if (*done) {
759 Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, 0);
760 Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&tag);
761 Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ver);
762 if (tag != 0xf7 || ver != 0x83) {
763 if (!__IN(4, OPM_Options, 32)) {
764 OPM_err(-306);
765 }
766 OPM_CloseOldSym();
767 *done = 0;
768 }
769 }
770 }
771
OPM_eofSF(void)772 BOOLEAN OPM_eofSF (void)
773 {
774 return OPM_oldSF.eof;
775 }
776
OPM_SymWCh(CHAR ch)777 void OPM_SymWCh (CHAR ch)
778 {
779 Files_Write(&OPM_newSF, Files_Rider__typ, ch);
780 }
781
OPM_SymWInt(INT64 i)782 void OPM_SymWInt (INT64 i)
783 {
784 Files_WriteNum(&OPM_newSF, Files_Rider__typ, i);
785 }
786
OPM_SymWSet(UINT64 s)787 void OPM_SymWSet (UINT64 s)
788 {
789 Files_WriteNum(&OPM_newSF, Files_Rider__typ, (INT64)s);
790 }
791
OPM_SymWReal(REAL r)792 void OPM_SymWReal (REAL r)
793 {
794 Files_WriteReal(&OPM_newSF, Files_Rider__typ, r);
795 }
796
OPM_SymWLReal(LONGREAL lr)797 void OPM_SymWLReal (LONGREAL lr)
798 {
799 Files_WriteLReal(&OPM_newSF, Files_Rider__typ, lr);
800 }
801
OPM_RegisterNewSym(void)802 void OPM_RegisterNewSym (void)
803 {
804 if (__STRCMP(OPM_modName, "SYSTEM") != 0 || __IN(10, OPM_Options, 32)) {
805 Files_Register(OPM_newSFile);
806 }
807 }
808
OPM_DeleteSym(CHAR * modulename,ADDRESS modulename__len)809 void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len)
810 {
811 OPM_FileName fn;
812 INT16 res;
813 OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".sym", 5);
814 Files_Delete(fn, 32, &res);
815 }
816
OPM_DeleteObj(CHAR * modulename,ADDRESS modulename__len)817 void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len)
818 {
819 OPM_FileName fn;
820 INT16 res;
821 OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".o", 3);
822 Files_Delete(fn, 32, &res);
823 }
824
OPM_NewSym(CHAR * modName,ADDRESS modName__len)825 void OPM_NewSym (CHAR *modName, ADDRESS modName__len)
826 {
827 OPM_FileName fileName;
828 OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
829 OPM_newSFile = Files_New(fileName, 32);
830 if (OPM_newSFile != NIL) {
831 Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, 0);
832 Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7);
833 Files_Write(&OPM_newSF, Files_Rider__typ, 0x83);
834 } else {
835 OPM_err(153);
836 }
837 }
838
OPM_Write(CHAR ch)839 void OPM_Write (CHAR ch)
840 {
841 Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, ch);
842 }
843
OPM_WriteString(CHAR * s,ADDRESS s__len)844 void OPM_WriteString (CHAR *s, ADDRESS s__len)
845 {
846 INT16 i;
847 i = 0;
848 while (s[__X(i, s__len)] != 0x00) {
849 i += 1;
850 }
851 Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
852 }
853
OPM_WriteStringVar(CHAR * s,ADDRESS s__len)854 void OPM_WriteStringVar (CHAR *s, ADDRESS s__len)
855 {
856 INT16 i;
857 i = 0;
858 while (s[__X(i, s__len)] != 0x00) {
859 i += 1;
860 }
861 Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
862 }
863
OPM_WriteHex(INT64 i)864 void OPM_WriteHex (INT64 i)
865 {
866 CHAR s[3];
867 INT32 digit;
868 digit = __ASHR(__SHORT(i, 2147483648LL), 4);
869 if (digit < 10) {
870 s[0] = __CHR(48 + digit);
871 } else {
872 s[0] = __CHR(87 + digit);
873 }
874 digit = __MASK(__SHORT(i, 2147483648LL), -16);
875 if (digit < 10) {
876 s[1] = __CHR(48 + digit);
877 } else {
878 s[1] = __CHR(87 + digit);
879 }
880 s[2] = 0x00;
881 OPM_WriteString(s, 3);
882 }
883
OPM_WriteInt(INT64 i)884 void OPM_WriteInt (INT64 i)
885 {
886 CHAR s[26];
887 INT64 i1, k;
888 if ((i == OPM_SignedMinimum(2) || i == OPM_SignedMinimum(4)) || i == OPM_SignedMinimum(8)) {
889 OPM_Write('(');
890 OPM_WriteInt(i + 1);
891 OPM_WriteString((CHAR*)"-1)", 4);
892 } else {
893 i1 = __ABS(i);
894 if (i1 <= 2147483647) {
895 k = 0;
896 } else {
897 __MOVE("LL", s, 3);
898 k = 2;
899 }
900 s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
901 i1 = __DIV(i1, 10);
902 k += 1;
903 while (i1 > 0) {
904 s[__X(k, 26)] = __CHR(__MOD(i1, 10) + 48);
905 i1 = __DIV(i1, 10);
906 k += 1;
907 }
908 if (i < 0) {
909 s[__X(k, 26)] = '-';
910 k += 1;
911 }
912 while (k > 0) {
913 k -= 1;
914 OPM_Write(s[__X(k, 26)]);
915 }
916 }
917 }
918
OPM_WriteReal(LONGREAL r,CHAR suffx)919 void OPM_WriteReal (LONGREAL r, CHAR suffx)
920 {
921 Texts_Writer W;
922 Texts_Text T = NIL;
923 Texts_Reader R;
924 CHAR s[32];
925 CHAR ch;
926 INT16 i;
927 if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == (__SHORT(__ENTIER(r), 2147483648LL)))) {
928 if (suffx == 'f') {
929 OPM_WriteString((CHAR*)"(REAL)", 7);
930 } else {
931 OPM_WriteString((CHAR*)"(LONGREAL)", 11);
932 }
933 OPM_WriteInt(__SHORT(__ENTIER(r), 2147483648LL));
934 } else {
935 Texts_OpenWriter(&W, Texts_Writer__typ);
936 if (suffx == 'f') {
937 Texts_WriteLongReal(&W, Texts_Writer__typ, r, 16);
938 } else {
939 Texts_WriteLongReal(&W, Texts_Writer__typ, r, 23);
940 }
941 __NEW(T, Texts_TextDesc);
942 Texts_Open(T, (CHAR*)"", 1);
943 Texts_Append(T, W.buf);
944 Texts_OpenReader(&R, Texts_Reader__typ, T, 0);
945 i = 0;
946 Texts_Read(&R, Texts_Reader__typ, &ch);
947 while (ch != 0x00) {
948 s[__X(i, 32)] = ch;
949 i += 1;
950 Texts_Read(&R, Texts_Reader__typ, &ch);
951 }
952 s[__X(i, 32)] = 0x00;
953 i = 0;
954 ch = s[0];
955 while ((ch != 'D' && ch != 0x00)) {
956 i += 1;
957 ch = s[__X(i, 32)];
958 }
959 if (ch == 'D') {
960 s[__X(i, 32)] = 'e';
961 }
962 OPM_WriteString(s, 32);
963 }
964 }
965
OPM_WriteLn(void)966 void OPM_WriteLn (void)
967 {
968 Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, 0x0a);
969 }
970
OPM_Append(Files_Rider * R,ADDRESS * R__typ,Files_File F)971 static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F)
972 {
973 Files_Rider R1;
974 CHAR buffer[4096];
975 if (F != NIL) {
976 Files_Set(&R1, Files_Rider__typ, F, 0);
977 Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, 4096, 4096);
978 while (4096 - R1.res > 0) {
979 Files_WriteBytes(&*R, R__typ, (void*)buffer, 4096, 4096 - R1.res);
980 Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, 4096, 4096);
981 }
982 }
983 }
984
OPM_OpenFiles(CHAR * moduleName,ADDRESS moduleName__len)985 void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len)
986 {
987 OPM_FileName FName;
988 __COPY(moduleName, OPM_modName, 32);
989 OPM_HFile = Files_New((CHAR*)"", 1);
990 if (OPM_HFile != NIL) {
991 Files_Set(&OPM_R[0], Files_Rider__typ, OPM_HFile, 0);
992 } else {
993 OPM_err(153);
994 }
995 OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, 32, (CHAR*)".c", 3);
996 OPM_BFile = Files_New(FName, 32);
997 if (OPM_BFile != NIL) {
998 Files_Set(&OPM_R[1], Files_Rider__typ, OPM_BFile, 0);
999 } else {
1000 OPM_err(153);
1001 }
1002 OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, 32, (CHAR*)".h", 3);
1003 OPM_HIFile = Files_New(FName, 32);
1004 if (OPM_HIFile != NIL) {
1005 Files_Set(&OPM_R[2], Files_Rider__typ, OPM_HIFile, 0);
1006 } else {
1007 OPM_err(153);
1008 }
1009 }
1010
OPM_CloseFiles(void)1011 void OPM_CloseFiles (void)
1012 {
1013 OPM_FileName FName;
1014 INT16 res;
1015 if (OPM_noerr) {
1016 OPM_LogWStr((CHAR*)" ", 3);
1017 OPM_LogWNum(Files_Pos(&OPM_R[1], Files_Rider__typ), 0);
1018 OPM_LogWStr((CHAR*)" chars.", 8);
1019 }
1020 if (OPM_noerr) {
1021 if (__STRCMP(OPM_modName, "SYSTEM") == 0) {
1022 if (!__IN(10, OPM_Options, 32)) {
1023 Files_Register(OPM_BFile);
1024 }
1025 } else if (!__IN(10, OPM_Options, 32)) {
1026 OPM_Append(&OPM_R[2], Files_Rider__typ, OPM_HFile);
1027 Files_Register(OPM_HIFile);
1028 Files_Register(OPM_BFile);
1029 } else {
1030 OPM_MakeFileName((void*)OPM_modName, 32, (void*)FName, 32, (CHAR*)".h", 3);
1031 Files_Delete(FName, 32, &res);
1032 OPM_MakeFileName((void*)OPM_modName, 32, (void*)FName, 32, (CHAR*)".sym", 5);
1033 Files_Delete(FName, 32, &res);
1034 Files_Register(OPM_BFile);
1035 }
1036 }
1037 OPM_HFile = NIL;
1038 OPM_BFile = NIL;
1039 OPM_HIFile = NIL;
1040 OPM_newSFile = NIL;
1041 OPM_oldSFile = NIL;
1042 Files_Set(&OPM_R[0], Files_Rider__typ, NIL, 0);
1043 Files_Set(&OPM_R[1], Files_Rider__typ, NIL, 0);
1044 Files_Set(&OPM_R[2], Files_Rider__typ, NIL, 0);
1045 Files_Set(&OPM_newSF, Files_Rider__typ, NIL, 0);
1046 Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, 0);
1047 }
1048
OPM_IsProbablyInstallDir(CHAR * s,ADDRESS s__len)1049 static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len)
1050 {
1051 CHAR testpath[4096];
1052 Platform_FileIdentity identity;
1053 __DUP(s, s__len, CHAR);
1054 __COPY(OPM_InstallDir, testpath, 4096);
1055 Strings_Append((CHAR*)"/lib/lib", 9, (void*)testpath, 4096);
1056 Strings_Append((CHAR*)"voc", 4, (void*)testpath, 4096);
1057 Strings_Append((CHAR*)"-O2.a", 6, (void*)testpath, 4096);
1058 if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
1059 __DEL(s);
1060 return 0;
1061 }
1062 __COPY(OPM_InstallDir, testpath, 4096);
1063 Strings_Append((CHAR*)"/2/include/Oberon.h", 20, (void*)testpath, 4096);
1064 if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
1065 __DEL(s);
1066 return 0;
1067 }
1068 __COPY(OPM_InstallDir, testpath, 4096);
1069 Strings_Append((CHAR*)"/2/sym/Files.sym", 17, (void*)testpath, 4096);
1070 if (Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0) {
1071 __DEL(s);
1072 return 0;
1073 }
1074 __DEL(s);
1075 return 1;
1076 }
1077
OPM_FindInstallDir(void)1078 static void OPM_FindInstallDir (void)
1079 {
1080 INT16 i;
1081 __COPY(Modules_BinaryDir, OPM_InstallDir, 1024);
1082 Strings_Append((CHAR*)"/", 2, (void*)OPM_InstallDir, 1024);
1083 Strings_Append((CHAR*)"voc", 4, (void*)OPM_InstallDir, 1024);
1084 Strings_Append((CHAR*)".d", 3, (void*)OPM_InstallDir, 1024);
1085 if (OPM_IsProbablyInstallDir(OPM_InstallDir, 1024)) {
1086 return;
1087 }
1088 __COPY(Modules_BinaryDir, OPM_InstallDir, 1024);
1089 i = Strings_Length(OPM_InstallDir, 1024);
1090 while ((i > 0 && OPM_InstallDir[__X(i - 1, 1024)] != '/')) {
1091 i -= 1;
1092 }
1093 if ((i > 0 && OPM_InstallDir[__X(i - 1, 1024)] == '/')) {
1094 OPM_InstallDir[__X(i - 1, 1024)] = 0x00;
1095 if (OPM_IsProbablyInstallDir(OPM_InstallDir, 1024)) {
1096 return;
1097 }
1098 }
1099 __COPY("", OPM_InstallDir, 1024);
1100 }
1101
EnumPtrs(void (* P)(void *))1102 static void EnumPtrs(void (*P)(void*))
1103 {
1104 __ENUMR(&OPM_inR, Texts_Reader__typ, 48, 1, P);
1105 P(OPM_Log);
1106 P(OPM_Errors);
1107 __ENUMR(&OPM_oldSF, Files_Rider__typ, 20, 1, P);
1108 __ENUMR(&OPM_newSF, Files_Rider__typ, 20, 1, P);
1109 __ENUMR(OPM_R, Files_Rider__typ, 20, 3, P);
1110 P(OPM_oldSFile);
1111 P(OPM_newSFile);
1112 P(OPM_HFile);
1113 P(OPM_BFile);
1114 P(OPM_HIFile);
1115 }
1116
1117
OPM__init(void)1118 export void *OPM__init(void)
1119 {
1120 __DEFMOD;
1121 __MODULE_IMPORT(Configuration);
1122 __MODULE_IMPORT(Files);
1123 __MODULE_IMPORT(Modules);
1124 __MODULE_IMPORT(Out);
1125 __MODULE_IMPORT(Platform);
1126 __MODULE_IMPORT(Strings);
1127 __MODULE_IMPORT(Texts);
1128 __MODULE_IMPORT(VT100);
1129 __REGMOD("OPM", EnumPtrs);
1130 __REGCMD("CloseFiles", OPM_CloseFiles);
1131 __REGCMD("CloseOldSym", OPM_CloseOldSym);
1132 __REGCMD("InitOptions", OPM_InitOptions);
1133 __REGCMD("LogWLn", OPM_LogWLn);
1134 __REGCMD("RegisterNewSym", OPM_RegisterNewSym);
1135 __REGCMD("WriteLn", OPM_WriteLn);
1136 /* BEGIN */
1137 OPM_MaxReal = 3.40282346000000e+038;
1138 OPM_MaxLReal = 1.79769296342094e+308;
1139 OPM_MinReal = -OPM_MaxReal;
1140 OPM_MinLReal = -OPM_MaxLReal;
1141 OPM_FindInstallDir();
1142 __ENDMOD;
1143 }
1144