FreeOberon/data/bin/voc/src/bootstrap/unix-48/OPM.c

/* voc 2.1.0 [2017/07/20]. Bootstrapping compiler for address size 8, alignment 8. xtspaSF */

#define SHORTINT INT8
#define INTEGER  INT16
#define LONGINT  INT32
#define SET      UINT32

#include "SYSTEM.h"
#include "Configuration.h"
#include "Files.h"
#include "Modules.h"
#include "Out.h"
#include "Platform.h"
#include "Strings.h"
#include "Texts.h"
#include "VT100.h"

typedef
	CHAR OPM_FileName[32];


static CHAR OPM_SourceFileName[256];
static CHAR OPM_GlobalModel[10];
export CHAR OPM_Model[10];
static INT16 OPM_GlobalAddressSize;
export INT16 OPM_AddressSize;
static INT16 OPM_GlobalAlignment;
export INT16 OPM_Alignment;
export UINT32 OPM_GlobalOptions, OPM_Options;
export INT16 OPM_ShortintSize, OPM_IntegerSize, OPM_LongintSize;
export INT64 OPM_MaxIndex;
export LONGREAL OPM_MinReal, OPM_MaxReal, OPM_MinLReal, OPM_MaxLReal;
export BOOLEAN OPM_noerr;
export INT32 OPM_curpos, OPM_errpos, OPM_breakpc;
export INT16 OPM_currFile, OPM_level, OPM_pc, OPM_entno;
export CHAR OPM_modName[32];
export CHAR OPM_objname[64];
static INT32 OPM_ErrorLineStartPos, OPM_ErrorLineLimitPos, OPM_ErrorLineNumber, OPM_lasterrpos;
static Texts_Reader OPM_inR;
static Texts_Text OPM_Log, OPM_Errors;
static Files_Rider OPM_oldSF, OPM_newSF;
static Files_Rider OPM_R[3];
static Files_File OPM_oldSFile, OPM_newSFile, OPM_HFile, OPM_BFile, OPM_HIFile;
static INT16 OPM_S;
export CHAR OPM_InstallDir[1024];
export CHAR OPM_ResourceDir[1024];


static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F);
export void OPM_CloseFiles (void);
export void OPM_CloseOldSym (void);
export void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len);
export void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len);
export void OPM_FPrint (INT32 *fp, INT64 val);
export void OPM_FPrintLReal (INT32 *fp, LONGREAL val);
export void OPM_FPrintReal (INT32 *fp, REAL val);
export void OPM_FPrintSet (INT32 *fp, UINT64 val);
static void OPM_FindInstallDir (void);
static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos);
static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len);
export void OPM_Get (CHAR *ch);
export void OPM_Init (BOOLEAN *done);
export void OPM_InitOptions (void);
export INT16 OPM_Integer (INT64 n);
static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len);
export void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len);
static void OPM_LogErrMsg (INT16 n);
export void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len);
export void OPM_LogW (CHAR ch);
export void OPM_LogWLn (void);
export void OPM_LogWNum (INT64 i, INT64 len);
export void OPM_LogWStr (CHAR *s, ADDRESS s__len);
export INT32 OPM_Longint (INT64 n);
static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len);
export void OPM_Mark (INT16 n, INT32 pos);
export void OPM_NewSym (CHAR *modName, ADDRESS modName__len);
export void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done);
export void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len);
export BOOLEAN OPM_OpenPar (void);
export void OPM_RegisterNewSym (void);
static void OPM_ScanOptions (CHAR *s, ADDRESS s__len);
static void OPM_ShowLine (INT64 pos);
export INT64 OPM_SignedMaximum (INT32 bytecount);
export INT64 OPM_SignedMinimum (INT32 bytecount);
export void OPM_SymRCh (CHAR *ch);
export INT32 OPM_SymRInt (void);
export INT64 OPM_SymRInt64 (void);
export void OPM_SymRLReal (LONGREAL *lr);
export void OPM_SymRReal (REAL *r);
export void OPM_SymRSet (UINT64 *s);
export void OPM_SymWCh (CHAR ch);
export void OPM_SymWInt (INT64 i);
export void OPM_SymWLReal (LONGREAL lr);
export void OPM_SymWReal (REAL r);
export void OPM_SymWSet (UINT64 s);
export void OPM_Write (CHAR ch);
export void OPM_WriteHex (INT64 i);
export void OPM_WriteInt (INT64 i);
export void OPM_WriteLn (void);
export void OPM_WriteReal (LONGREAL r, CHAR suffx);
export void OPM_WriteString (CHAR *s, ADDRESS s__len);
export void OPM_WriteStringVar (CHAR *s, ADDRESS s__len);
export BOOLEAN OPM_eofSF (void);
export void OPM_err (INT16 n);

#define OPM_GetAlignment(a)	struct {char c; long long l;} _s; *a = (char*)&_s.l - (char*)&_s

void OPM_LogW (CHAR ch)
{
	Out_Char(ch);
}

void OPM_LogWStr (CHAR *s, ADDRESS s__len)
{
	__DUP(s, s__len, CHAR);
	Out_String(s, s__len);
	__DEL(s);
}

void OPM_LogWNum (INT64 i, INT64 len)
{
	Out_Int(i, len);
}

void OPM_LogWLn (void)
{
	Out_Ln();
}

void OPM_LogVT100 (CHAR *vt100code, ADDRESS vt100code__len)
{
	__DUP(vt100code, vt100code__len, CHAR);
	if ((Out_IsConsole && !__IN(16, OPM_Options, 32))) {
		VT100_SetAttr(vt100code, vt100code__len);
	}
	__DEL(vt100code);
}

void OPM_LogCompiling (CHAR *modname, ADDRESS modname__len)
{
	__DUP(modname, modname__len, CHAR);
	OPM_LogWStr((CHAR*)"Compiling ", 11);
	OPM_LogWStr(modname, modname__len);
	if (__IN(18, OPM_Options, 32)) {
		OPM_LogWStr((CHAR*)", s:", 5);
		OPM_LogWNum(__ASHL(OPM_ShortintSize, 3), 1);
		OPM_LogWStr((CHAR*)" i:", 4);
		OPM_LogWNum(__ASHL(OPM_IntegerSize, 3), 1);
		OPM_LogWStr((CHAR*)" l:", 4);
		OPM_LogWNum(__ASHL(OPM_LongintSize, 3), 1);
		OPM_LogWStr((CHAR*)" adr:", 6);
		OPM_LogWNum(__ASHL(OPM_AddressSize, 3), 1);
		OPM_LogWStr((CHAR*)" algn:", 7);
		OPM_LogWNum(__ASHL(OPM_Alignment, 3), 1);
	}
	OPM_LogW('.');
	__DEL(modname);
}

INT64 OPM_SignedMaximum (INT32 bytecount)
{
	INT64 result;
	result = 1;
	result = __LSH(result, __ASHL(bytecount, 3) - 1, 64);
	return result - 1;
}

INT64 OPM_SignedMinimum (INT32 bytecount)
{
	return -OPM_SignedMaximum(bytecount) - 1;
}

INT32 OPM_Longint (INT64 n)
{
	return __VAL(INT32, n);
}

INT16 OPM_Integer (INT64 n)
{
	return __VAL(INT16, n);
}

static void OPM_ScanOptions (CHAR *s, ADDRESS s__len)
{
	INT16 i;
	__DUP(s, s__len, CHAR);
	i = 1;
	while (s[__X(i, s__len)] != 0x00) {
		switch (s[__X(i, s__len)]) {
			case 'p': 
				OPM_Options = OPM_Options ^ 0x20;
				break;
			case 'a': 
				OPM_Options = OPM_Options ^ 0x80;
				break;
			case 'r': 
				OPM_Options = OPM_Options ^ 0x04;
				break;
			case 't': 
				OPM_Options = OPM_Options ^ 0x08;
				break;
			case 'x': 
				OPM_Options = OPM_Options ^ 0x01;
				break;
			case 'e': 
				OPM_Options = OPM_Options ^ 0x0200;
				break;
			case 's': 
				OPM_Options = OPM_Options ^ 0x10;
				break;
			case 'F': 
				OPM_Options = OPM_Options ^ 0x020000;
				break;
			case 'm': 
				OPM_Options = OPM_Options ^ 0x0400;
				break;
			case 'M': 
				OPM_Options = OPM_Options ^ 0x8000;
				break;
			case 'S': 
				OPM_Options = OPM_Options ^ 0x2000;
				break;
			case 'c': 
				OPM_Options = OPM_Options ^ 0x4000;
				break;
			case 'f': 
				OPM_Options = OPM_Options ^ 0x010000;
				break;
			case 'V': 
				OPM_Options = OPM_Options ^ 0x040000;
				break;
			case 'O': 
				if (i + 1 >= Strings_Length(s, s__len)) {
					OPM_LogWStr((CHAR*)"-O option requires following size model character.", 51);
					OPM_LogWLn();
				} else {
					OPM_Model[0] = s[__X(i + 1, s__len)];
					OPM_Model[1] = 0x00;
					if ((((OPM_Model[0] != '2' && OPM_Model[0] != 'C')) && OPM_Model[0] != 'V')) {
						OPM_LogWStr((CHAR*)"Unrecognised size model character following -O.", 48);
						OPM_LogWLn();
					}
					i += 1;
				}
				break;
			case 'A': 
				if (i + 2 >= Strings_Length(s, s__len)) {
					OPM_LogWStr((CHAR*)"-M option requires two following digits.", 41);
					OPM_LogWLn();
				} else {
					OPM_AddressSize = (INT16)s[__X(i + 1, s__len)] - 48;
					OPM_Alignment = (INT16)s[__X(i + 2, s__len)] - 48;
					i += 2;
				}
				break;
			default: 
				OPM_LogWStr((CHAR*)"  warning: option ", 19);
				OPM_LogW('-');
				OPM_LogW(s[__X(i, s__len)]);
				OPM_LogWStr((CHAR*)" ignored", 9);
				OPM_LogWLn();
				break;
		}
		i += 1;
	}
	__DEL(s);
}

BOOLEAN OPM_OpenPar (void)
{
	CHAR s[256];
	if (Modules_ArgCount == 1) {
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"Oberon-2 compiler v", 20);
		OPM_LogWStr(Configuration_versionLong, 76);
		OPM_LogW('.');
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"Based on Ofront by J. Templ and Software Templ OEG.", 52);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"Further development by Norayr Chilingarian, David Brown and others.", 68);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"Loaded from ", 13);
		OPM_LogWStr(Modules_BinaryDir, 1024);
		OPM_LogWLn();
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"Usage:", 7);
		OPM_LogWLn();
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"  ", 3);
		OPM_LogWStr((CHAR*)"voc", 4);
		OPM_LogWStr((CHAR*)" options {files {options}}.", 28);
		OPM_LogWLn();
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"Options:", 9);
		OPM_LogWLn();
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"  Run time safety", 18);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"    -p   Initialise pointers to NIL. On by default.", 52);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"    -a   Halt on assertion failures. On by default.", 52);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"    -r   Halt on range check failures.", 39);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"    -t   Halt on type guard failure. On by default.", 52);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"    -x   Halt on index out of range. On by default.", 52);
		OPM_LogWLn();
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"  Symbol file management", 25);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"    -e   Allow extension of old symbol file.", 45);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"    -s   Allow generation of new symbol file.", 46);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"    -F   Force generation of new symbol file.", 46);
		OPM_LogWLn();
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"  C compiler and linker control", 32);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"    -m   This module is main. Link dynamically.", 48);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"    -M   This module is main. Link statically.", 47);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"    -S   Don't call C compiler", 31);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"    -c   Don't link.", 21);
		OPM_LogWLn();
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"  Miscellaneous", 16);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"    -f   Disable VT100 control characters in status output.", 60);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"    -V   Display compiler debugging messages.", 46);
		OPM_LogWLn();
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"  Size model for elementary types (default O2)", 47);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"    -O2   Original Oberon / Oberon-2:  8 bit SHORTINT, 16 bit INTEGER, 32 bit LONGINT and SET.", 95);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"    -OC   Component Pascal:           16 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"    -OV   Alternate large model:       8 bit SHORTINT, 32 bit INTEGER, 64 bit LONGINT and SET.", 95);
		OPM_LogWLn();
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"  Target machine address size and alignment (default is that of the running compiler binary)", 93);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"    -A44   32 bit addresses, 32 bit alignment (e.g. Unix/linux 32 bit on x86).", 79);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"    -A48   32 bit addresses, 64 bit alignment (e.g. Windows 32 bit on x86, linux 32 bit on arm).", 97);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"    -A88   64 bit addresses, 64 bit alignment (e.g. 64 bit platforms).", 71);
		OPM_LogWLn();
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"All options are off by default, except where noted above.", 58);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"Initial options specify defaults for all files.", 48);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"Options following a filename are specific to that file.", 56);
		OPM_LogWLn();
		OPM_LogWStr((CHAR*)"Repeating an option toggles its value.", 39);
		OPM_LogWLn();
		return 0;
	} else {
		OPM_AddressSize = 4;
		OPM_GetAlignment(&OPM_Alignment);
		__MOVE("2", OPM_Model, 2);
		OPM_Options = 0xa9;
		OPM_S = 1;
		s[0] = 0x00;
		Modules_GetArg(OPM_S, (void*)s, 256);
		while (s[0] == '-') {
			OPM_ScanOptions(s, 256);
			OPM_S += 1;
			s[0] = 0x00;
			Modules_GetArg(OPM_S, (void*)s, 256);
		}
		OPM_GlobalAddressSize = OPM_AddressSize;
		OPM_GlobalAlignment = OPM_Alignment;
		__MOVE(OPM_Model, OPM_GlobalModel, 10);
		OPM_GlobalOptions = OPM_Options;
		return 1;
	}
	__RETCHK;
}

void OPM_InitOptions (void)
{
	CHAR s[256];
	CHAR searchpath[1024], modules[1024];
	CHAR MODULES[1024];
	OPM_Options = OPM_GlobalOptions;
	__MOVE(OPM_GlobalModel, OPM_Model, 10);
	OPM_Alignment = OPM_GlobalAlignment;
	OPM_AddressSize = OPM_GlobalAddressSize;
	s[0] = 0x00;
	Modules_GetArg(OPM_S, (void*)s, 256);
	while (s[0] == '-') {
		OPM_ScanOptions(s, 256);
		OPM_S += 1;
		s[0] = 0x00;
		Modules_GetArg(OPM_S, (void*)s, 256);
	}
	if (__IN(15, OPM_Options, 32)) {
		OPM_Options |= __SETOF(10,32);
	}
	OPM_MaxIndex = OPM_SignedMaximum(OPM_AddressSize);
	switch (OPM_Model[0]) {
		case '2': 
			OPM_ShortintSize = 1;
			OPM_IntegerSize = 2;
			OPM_LongintSize = 4;
			break;
		case 'C': 
			OPM_ShortintSize = 2;
			OPM_IntegerSize = 4;
			OPM_LongintSize = 8;
			break;
		case 'V': 
			OPM_ShortintSize = 1;
			OPM_IntegerSize = 4;
			OPM_LongintSize = 8;
			break;
		default: 
			OPM_ShortintSize = 1;
			OPM_IntegerSize = 2;
			OPM_LongintSize = 4;
			break;
	}
	__MOVE(OPM_InstallDir, OPM_ResourceDir, 1024);
	if (OPM_ResourceDir[0] != 0x00) {
		Strings_Append((CHAR*)"/", 2, (void*)OPM_ResourceDir, 1024);
		Strings_Append(OPM_Model, 10, (void*)OPM_ResourceDir, 1024);
	}
	modules[0] = 0x00;
	Platform_GetEnv((CHAR*)"MODULES", 8, (void*)modules, 1024);
	__MOVE(".", searchpath, 2);
	Platform_GetEnv((CHAR*)"OBERON", 7, (void*)searchpath, 1024);
	Strings_Append((CHAR*)";.;", 4, (void*)searchpath, 1024);
	Strings_Append(modules, 1024, (void*)searchpath, 1024);
	Strings_Append((CHAR*)";", 2, (void*)searchpath, 1024);
	Strings_Append(OPM_ResourceDir, 1024, (void*)searchpath, 1024);
	Strings_Append((CHAR*)"/sym;", 6, (void*)searchpath, 1024);
	Files_SetSearchPath(searchpath, 1024);
}

void OPM_Init (BOOLEAN *done)
{
	Texts_Text T = NIL;
	INT32 beg, end, time;
	CHAR s[256];
	*done = 0;
	OPM_curpos = 0;
	if (OPM_S >= Modules_ArgCount) {
		return;
	}
	s[0] = 0x00;
	Modules_GetArg(OPM_S, (void*)s, 256);
	__NEW(T, Texts_TextDesc);
	Texts_Open(T, s, 256);
	OPM_LogWStr(s, 256);
	OPM_LogWStr((CHAR*)"  ", 3);
	__COPY(s, OPM_SourceFileName, 256);
	if (T->len == 0) {
		OPM_LogWStr(s, 256);
		OPM_LogWStr((CHAR*)" not found.", 12);
		OPM_LogWLn();
	} else {
		Texts_OpenReader(&OPM_inR, Texts_Reader__typ, T, 0);
		*done = 1;
	}
	OPM_S += 1;
	OPM_level = 0;
	OPM_noerr = 1;
	OPM_errpos = OPM_curpos;
	OPM_lasterrpos = OPM_curpos - 10;
	OPM_ErrorLineStartPos = 0;
	OPM_ErrorLineLimitPos = 0;
	OPM_ErrorLineNumber = 0;
}

void OPM_Get (CHAR *ch)
{
	OPM_curpos = Texts_Pos(&OPM_inR, Texts_Reader__typ);
	Texts_Read(&OPM_inR, Texts_Reader__typ, &*ch);
	if ((*ch < 0x09 && !OPM_inR.eot)) {
		*ch = ' ';
	}
}

static void OPM_MakeFileName (CHAR *name, ADDRESS name__len, CHAR *FName, ADDRESS FName__len, CHAR *ext, ADDRESS ext__len)
{
	INT16 i, j;
	CHAR ch;
	__DUP(ext, ext__len, CHAR);
	i = 0;
	for (;;) {
		ch = name[__X(i, name__len)];
		if (ch == 0x00) {
			break;
		}
		FName[__X(i, FName__len)] = ch;
		i += 1;
	}
	j = 0;
	do {
		ch = ext[__X(j, ext__len)];
		FName[__X(i, FName__len)] = ch;
		i += 1;
		j += 1;
	} while (!(ch == 0x00));
	__DEL(ext);
}

static void OPM_LogErrMsg (INT16 n)
{
	INT16 l;
	Texts_Scanner S;
	CHAR c;
	if (n >= 0) {
		OPM_LogVT100((CHAR*)"31m", 4);
		OPM_LogWStr((CHAR*)"  err ", 7);
		OPM_LogVT100((CHAR*)"0m", 3);
	} else {
		OPM_LogVT100((CHAR*)"35m", 4);
		OPM_LogWStr((CHAR*)"  warning ", 11);
		n = -n;
		OPM_LogVT100((CHAR*)"0m", 3);
	}
	OPM_LogWNum(n, 1);
	OPM_LogWStr((CHAR*)"  ", 3);
	if (OPM_Errors == NIL) {
		__NEW(OPM_Errors, Texts_TextDesc);
		Texts_Open(OPM_Errors, (CHAR*)"Errors.Txt", 11);
	}
	Texts_OpenScanner(&S, Texts_Scanner__typ, OPM_Errors, 0);
	do {
		l = S.line;
		Texts_Scan(&S, Texts_Scanner__typ);
	} while (!((((l != S.line && S.class == 3)) && S.i == n) || S.eot));
	if (!S.eot) {
		Texts_Read((void*)&S, Texts_Scanner__typ, &c);
		while ((!S.eot && c >= ' ')) {
			Out_Char(c);
			Texts_Read((void*)&S, Texts_Scanner__typ, &c);
		}
	}
}

static void OPM_FindLine (Files_File f, Files_Rider *r, ADDRESS *r__typ, INT64 pos)
{
	CHAR ch, cheol;
	if (pos < (INT64)OPM_ErrorLineStartPos) {
		OPM_ErrorLineStartPos = 0;
		OPM_ErrorLineLimitPos = 0;
		OPM_ErrorLineNumber = 0;
	}
	if (pos < (INT64)OPM_ErrorLineLimitPos) {
		Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos);
		return;
	}
	Files_Set(&*r, r__typ, f, OPM_ErrorLineLimitPos);
	Files_Read(&*r, r__typ, (void*)&ch);
	while (((INT64)OPM_ErrorLineLimitPos < pos && !(*r).eof)) {
		OPM_ErrorLineStartPos = OPM_ErrorLineLimitPos;
		OPM_ErrorLineNumber += 1;
		while ((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) {
			Files_Read(&*r, r__typ, (void*)&ch);
			OPM_ErrorLineLimitPos += 1;
		}
		cheol = ch;
		Files_Read(&*r, r__typ, (void*)&ch);
		OPM_ErrorLineLimitPos += 1;
		if ((cheol == 0x0d && ch == 0x0a)) {
			OPM_ErrorLineLimitPos += 1;
			Files_Read(&*r, r__typ, (void*)&ch);
		}
	}
	Files_Set(&*r, r__typ, f, OPM_ErrorLineStartPos);
}

static void OPM_ShowLine (INT64 pos)
{
	Files_File f = NIL;
	Files_Rider r;
	CHAR line[1023];
	INT16 i;
	CHAR ch;
	f = Files_Old(OPM_SourceFileName, 256);
	OPM_FindLine(f, &r, Files_Rider__typ, pos);
	i = 0;
	Files_Read(&r, Files_Rider__typ, (void*)&ch);
	while ((((((ch != 0x00 && ch != 0x0d)) && ch != 0x0a)) && i < 1022)) {
		line[__X(i, 1023)] = ch;
		i += 1;
		Files_Read(&r, Files_Rider__typ, (void*)&ch);
	}
	line[__X(i, 1023)] = 0x00;
	OPM_LogWLn();
	OPM_LogWLn();
	OPM_LogWNum(OPM_ErrorLineNumber, 4);
	OPM_LogWStr((CHAR*)": ", 3);
	OPM_LogWStr(line, 1023);
	OPM_LogWLn();
	OPM_LogWStr((CHAR*)"      ", 7);
	if (pos >= (INT64)OPM_ErrorLineLimitPos) {
		pos = OPM_ErrorLineLimitPos - 1;
	}
	i = (INT16)OPM_Longint(pos - (INT64)OPM_ErrorLineStartPos);
	while (i > 0) {
		OPM_LogW(' ');
		i -= 1;
	}
	OPM_LogVT100((CHAR*)"32m", 4);
	OPM_LogW('^');
	OPM_LogVT100((CHAR*)"0m", 3);
}

void OPM_Mark (INT16 n, INT32 pos)
{
	if (pos == -1) {
		pos = 0;
	}
	if (n >= 0) {
		OPM_noerr = 0;
		if (pos < OPM_lasterrpos || OPM_lasterrpos + 9 < pos) {
			OPM_lasterrpos = pos;
			OPM_ShowLine(pos);
			OPM_LogWLn();
			OPM_LogWStr((CHAR*)"  ", 3);
			if (n < 249) {
				OPM_LogWStr((CHAR*)"  pos", 6);
				OPM_LogWNum(pos, 6);
				OPM_LogErrMsg(n);
			} else if (n == 255) {
				OPM_LogWStr((CHAR*)"pos", 4);
				OPM_LogWNum(pos, 6);
				OPM_LogWStr((CHAR*)"  pc ", 6);
				OPM_LogWNum(OPM_breakpc, 1);
			} else if (n == 254) {
				OPM_LogWStr((CHAR*)"pc not found", 13);
			} else {
				OPM_LogWStr(OPM_objname, 64);
				if (n == 253) {
					OPM_LogWStr((CHAR*)" is new, compile with option e", 31);
				} else if (n == 252) {
					OPM_LogWStr((CHAR*)" is redefined, compile with option s", 37);
				} else if (n == 251) {
					OPM_LogWStr((CHAR*)" is redefined (private part only), compile with option s", 57);
				} else if (n == 250) {
					OPM_LogWStr((CHAR*)" is no longer visible, compile with option s", 45);
				} else if (n == 249) {
					OPM_LogWStr((CHAR*)" is not consistently imported, recompile imports", 49);
				}
			}
		}
	} else {
		if (pos >= 0) {
			OPM_ShowLine(pos);
			OPM_LogWLn();
			OPM_LogWStr((CHAR*)"  pos", 6);
			OPM_LogWNum(pos, 6);
		}
		OPM_LogErrMsg(n);
		if (pos < 0) {
			OPM_LogWLn();
		}
	}
}

void OPM_err (INT16 n)
{
	OPM_Mark(n, OPM_errpos);
}

static void OPM_FingerprintBytes (INT32 *fp, SYSTEM_BYTE *bytes, ADDRESS bytes__len)
{
	INT16 i;
	INT32 l;
	__ASSERT(__MASK(bytes__len, -4) == 0, 0);
	i = 0;
	while (i < bytes__len) {
		__GET((ADDRESS)&bytes[__X(i, bytes__len)], l, INT32);
		*fp = __ROTL((INT32)((UINT32)*fp ^ (UINT32)l), 1, 32);
		i += 4;
	}
}

void OPM_FPrint (INT32 *fp, INT64 val)
{
	OPM_FingerprintBytes(&*fp, (void*)&val, 8);
}

void OPM_FPrintSet (INT32 *fp, UINT64 val)
{
	OPM_FingerprintBytes(&*fp, (void*)&val, 8);
}

void OPM_FPrintReal (INT32 *fp, REAL val)
{
	OPM_FingerprintBytes(&*fp, (void*)&val, 4);
}

void OPM_FPrintLReal (INT32 *fp, LONGREAL val)
{
	OPM_FingerprintBytes(&*fp, (void*)&val, 8);
}

void OPM_SymRCh (CHAR *ch)
{
	Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&*ch);
}

INT32 OPM_SymRInt (void)
{
	INT32 k;
	Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (void*)&k, 4);
	return k;
}

INT64 OPM_SymRInt64 (void)
{
	INT64 k;
	Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (void*)&k, 8);
	return k;
}

void OPM_SymRSet (UINT64 *s)
{
	Files_ReadNum(&OPM_oldSF, Files_Rider__typ, (void*)&*s, 8);
}

void OPM_SymRReal (REAL *r)
{
	Files_ReadReal(&OPM_oldSF, Files_Rider__typ, &*r);
}

void OPM_SymRLReal (LONGREAL *lr)
{
	Files_ReadLReal(&OPM_oldSF, Files_Rider__typ, &*lr);
}

void OPM_CloseOldSym (void)
{
	Files_Close(Files_Base(&OPM_oldSF, Files_Rider__typ));
}

void OPM_OldSym (CHAR *modName, ADDRESS modName__len, BOOLEAN *done)
{
	CHAR tag, ver;
	OPM_FileName fileName;
	INT16 res;
	OPM_oldSFile = NIL;
	*done = 0;
	OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
	OPM_oldSFile = Files_Old(fileName, 32);
	*done = OPM_oldSFile != NIL;
	if (*done) {
		Files_Set(&OPM_oldSF, Files_Rider__typ, OPM_oldSFile, 0);
		Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&tag);
		Files_Read(&OPM_oldSF, Files_Rider__typ, (void*)&ver);
		if (tag != 0xf7 || ver != 0x83) {
			if (!__IN(4, OPM_Options, 32)) {
				OPM_err(-306);
			}
			OPM_CloseOldSym();
			*done = 0;
		}
	}
}

BOOLEAN OPM_eofSF (void)
{
	return OPM_oldSF.eof;
}

void OPM_SymWCh (CHAR ch)
{
	Files_Write(&OPM_newSF, Files_Rider__typ, ch);
}

void OPM_SymWInt (INT64 i)
{
	Files_WriteNum(&OPM_newSF, Files_Rider__typ, i);
}

void OPM_SymWSet (UINT64 s)
{
	Files_WriteNum(&OPM_newSF, Files_Rider__typ, (INT64)s);
}

void OPM_SymWReal (REAL r)
{
	Files_WriteReal(&OPM_newSF, Files_Rider__typ, r);
}

void OPM_SymWLReal (LONGREAL lr)
{
	Files_WriteLReal(&OPM_newSF, Files_Rider__typ, lr);
}

void OPM_RegisterNewSym (void)
{
	if (__STRCMP(OPM_modName, "SYSTEM") != 0 || __IN(10, OPM_Options, 32)) {
		Files_Register(OPM_newSFile);
	}
}

void OPM_DeleteSym (CHAR *modulename, ADDRESS modulename__len)
{
	OPM_FileName fn;
	INT16 res;
	OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".sym", 5);
	Files_Delete(fn, 32, &res);
}

void OPM_DeleteObj (CHAR *modulename, ADDRESS modulename__len)
{
	OPM_FileName fn;
	INT16 res;
	OPM_MakeFileName((void*)modulename, modulename__len, (void*)fn, 32, (CHAR*)".o", 3);
	Files_Delete(fn, 32, &res);
}

void OPM_NewSym (CHAR *modName, ADDRESS modName__len)
{
	OPM_FileName fileName;
	OPM_MakeFileName((void*)modName, modName__len, (void*)fileName, 32, (CHAR*)".sym", 5);
	OPM_newSFile = Files_New(fileName, 32);
	if (OPM_newSFile != NIL) {
		Files_Set(&OPM_newSF, Files_Rider__typ, OPM_newSFile, 0);
		Files_Write(&OPM_newSF, Files_Rider__typ, 0xf7);
		Files_Write(&OPM_newSF, Files_Rider__typ, 0x83);
	} else {
		OPM_err(153);
	}
}

void OPM_Write (CHAR ch)
{
	Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, ch);
}

void OPM_WriteString (CHAR *s, ADDRESS s__len)
{
	INT16 i;
	i = 0;
	while (s[__X(i, s__len)] != 0x00) {
		i += 1;
	}
	Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}

void OPM_WriteStringVar (CHAR *s, ADDRESS s__len)
{
	INT16 i;
	i = 0;
	while (s[__X(i, s__len)] != 0x00) {
		i += 1;
	}
	Files_WriteBytes(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, (void*)s, s__len * 1, i);
}

void OPM_WriteHex (INT64 i)
{
	CHAR s[3];
	INT32 digit;
	digit = __ASHR((INT32)i, 4);
	if (digit < 10) {
		s[0] = (CHAR)(48 + digit);
	} else {
		s[0] = (CHAR)(87 + digit);
	}
	digit = __MASK((INT32)i, -16);
	if (digit < 10) {
		s[1] = (CHAR)(48 + digit);
	} else {
		s[1] = (CHAR)(87 + digit);
	}
	s[2] = 0x00;
	OPM_WriteString(s, 3);
}

void OPM_WriteInt (INT64 i)
{
	CHAR s[26];
	INT64 i1, k;
	if ((i == OPM_SignedMinimum(2) || i == OPM_SignedMinimum(4)) || i == OPM_SignedMinimum(8)) {
		OPM_Write('(');
		OPM_WriteInt(i + 1);
		OPM_WriteString((CHAR*)"-1)", 4);
	} else {
		i1 = __ABS(i);
		if (i1 <= 2147483647) {
			k = 0;
		} else {
			__MOVE("LL", s, 3);
			k = 2;
		}
		s[__X(k, 26)] = (CHAR)(__MOD(i1, 10) + 48);
		i1 = __DIV(i1, 10);
		k += 1;
		while (i1 > 0) {
			s[__X(k, 26)] = (CHAR)(__MOD(i1, 10) + 48);
			i1 = __DIV(i1, 10);
			k += 1;
		}
		if (i < 0) {
			s[__X(k, 26)] = '-';
			k += 1;
		}
		while (k > 0) {
			k -= 1;
			OPM_Write(s[__X(k, 26)]);
		}
	}
}

void OPM_WriteReal (LONGREAL r, CHAR suffx)
{
	Texts_Writer W;
	Texts_Text T = NIL;
	Texts_Reader R;
	CHAR s[32];
	CHAR ch;
	INT16 i;
	if ((((r < OPM_SignedMaximum(OPM_LongintSize) && r > OPM_SignedMinimum(OPM_LongintSize))) && r == ((INT32)__ENTIER(r)))) {
		if (suffx == 'f') {
			OPM_WriteString((CHAR*)"(REAL)", 7);
		} else {
			OPM_WriteString((CHAR*)"(LONGREAL)", 11);
		}
		OPM_WriteInt((INT32)__ENTIER(r));
	} else {
		Texts_OpenWriter(&W, Texts_Writer__typ);
		if (suffx == 'f') {
			Texts_WriteLongReal(&W, Texts_Writer__typ, r, 16);
		} else {
			Texts_WriteLongReal(&W, Texts_Writer__typ, r, 23);
		}
		__NEW(T, Texts_TextDesc);
		Texts_Open(T, (CHAR*)"", 1);
		Texts_Append(T, W.buf);
		Texts_OpenReader(&R, Texts_Reader__typ, T, 0);
		i = 0;
		Texts_Read(&R, Texts_Reader__typ, &ch);
		while (ch != 0x00) {
			s[__X(i, 32)] = ch;
			i += 1;
			Texts_Read(&R, Texts_Reader__typ, &ch);
		}
		s[__X(i, 32)] = 0x00;
		i = 0;
		ch = s[0];
		while ((ch != 'D' && ch != 0x00)) {
			i += 1;
			ch = s[__X(i, 32)];
		}
		if (ch == 'D') {
			s[__X(i, 32)] = 'e';
		}
		OPM_WriteString(s, 32);
	}
}

void OPM_WriteLn (void)
{
	Files_Write(&OPM_R[__X(OPM_currFile, 3)], Files_Rider__typ, 0x0a);
}

static void OPM_Append (Files_Rider *R, ADDRESS *R__typ, Files_File F)
{
	Files_Rider R1;
	CHAR buffer[4096];
	if (F != NIL) {
		Files_Set(&R1, Files_Rider__typ, F, 0);
		Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, 4096, 4096);
		while (4096 - R1.res > 0) {
			Files_WriteBytes(&*R, R__typ, (void*)buffer, 4096, 4096 - R1.res);
			Files_ReadBytes(&R1, Files_Rider__typ, (void*)buffer, 4096, 4096);
		}
	}
}

void OPM_OpenFiles (CHAR *moduleName, ADDRESS moduleName__len)
{
	OPM_FileName FName;
	__COPY(moduleName, OPM_modName, 32);
	OPM_HFile = Files_New((CHAR*)"", 1);
	if (OPM_HFile != NIL) {
		Files_Set(&OPM_R[0], Files_Rider__typ, OPM_HFile, 0);
	} else {
		OPM_err(153);
	}
	OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, 32, (CHAR*)".c", 3);
	OPM_BFile = Files_New(FName, 32);
	if (OPM_BFile != NIL) {
		Files_Set(&OPM_R[1], Files_Rider__typ, OPM_BFile, 0);
	} else {
		OPM_err(153);
	}
	OPM_MakeFileName((void*)moduleName, moduleName__len, (void*)FName, 32, (CHAR*)".h", 3);
	OPM_HIFile = Files_New(FName, 32);
	if (OPM_HIFile != NIL) {
		Files_Set(&OPM_R[2], Files_Rider__typ, OPM_HIFile, 0);
	} else {
		OPM_err(153);
	}
}

void OPM_CloseFiles (void)
{
	OPM_FileName FName;
	INT16 res;
	if (OPM_noerr) {
		OPM_LogWStr((CHAR*)"  ", 3);
		OPM_LogWNum(Files_Pos(&OPM_R[1], Files_Rider__typ), 0);
		OPM_LogWStr((CHAR*)" chars.", 8);
	}
	if (OPM_noerr) {
		if (__STRCMP(OPM_modName, "SYSTEM") == 0) {
			if (!__IN(10, OPM_Options, 32)) {
				Files_Register(OPM_BFile);
			}
		} else if (!__IN(10, OPM_Options, 32)) {
			OPM_Append(&OPM_R[2], Files_Rider__typ, OPM_HFile);
			Files_Register(OPM_HIFile);
			Files_Register(OPM_BFile);
		} else {
			OPM_MakeFileName((void*)OPM_modName, 32, (void*)FName, 32, (CHAR*)".h", 3);
			Files_Delete(FName, 32, &res);
			OPM_MakeFileName((void*)OPM_modName, 32, (void*)FName, 32, (CHAR*)".sym", 5);
			Files_Delete(FName, 32, &res);
			Files_Register(OPM_BFile);
		}
	}
	OPM_HFile = NIL;
	OPM_BFile = NIL;
	OPM_HIFile = NIL;
	OPM_newSFile = NIL;
	OPM_oldSFile = NIL;
	Files_Set(&OPM_R[0], Files_Rider__typ, NIL, 0);
	Files_Set(&OPM_R[1], Files_Rider__typ, NIL, 0);
	Files_Set(&OPM_R[2], Files_Rider__typ, NIL, 0);
	Files_Set(&OPM_newSF, Files_Rider__typ, NIL, 0);
	Files_Set(&OPM_oldSF, Files_Rider__typ, NIL, 0);
}

static BOOLEAN OPM_IsProbablyInstallDir (CHAR *s, ADDRESS s__len)
{
	CHAR testpath[4096];
	Platform_FileIdentity identity;
	BOOLEAN result;
	__DUP(s, s__len, CHAR);
	__COPY(OPM_InstallDir, testpath, 4096);
	Strings_Append((CHAR*)"/voc.exe", 9, (void*)testpath, 4096);
	result = Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0;
	if (!result) {
		__COPY(OPM_InstallDir, testpath, 4096);
		Strings_Append((CHAR*)"/voc", 5, (void*)testpath, 4096);
		result = Platform_IdentifyByName(testpath, 4096, &identity, Platform_FileIdentity__typ) != 0;
	}
	__DEL(s);
	return result;
}

static void OPM_FindInstallDir (void)
{
	__COPY(Modules_BinaryDir, OPM_InstallDir, 1024);
	if (!OPM_IsProbablyInstallDir(OPM_InstallDir, 1024)) {
		__COPY("../data/bin/voc", OPM_InstallDir, 1024);
	}
	__COPY("../data/bin/voc", OPM_InstallDir, 1024);
}

static void EnumPtrs(void (*P)(void*))
{
	__ENUMR(&OPM_inR, Texts_Reader__typ, 48, 1, P);
	P(OPM_Log);
	P(OPM_Errors);
	__ENUMR(&OPM_oldSF, Files_Rider__typ, 20, 1, P);
	__ENUMR(&OPM_newSF, Files_Rider__typ, 20, 1, P);
	__ENUMR(OPM_R, Files_Rider__typ, 20, 3, P);
	P(OPM_oldSFile);
	P(OPM_newSFile);
	P(OPM_HFile);
	P(OPM_BFile);
	P(OPM_HIFile);
}


export void *OPM__init(void)
{
	__DEFMOD;
	__MODULE_IMPORT(Configuration);
	__MODULE_IMPORT(Files);
	__MODULE_IMPORT(Modules);
	__MODULE_IMPORT(Out);
	__MODULE_IMPORT(Platform);
	__MODULE_IMPORT(Strings);
	__MODULE_IMPORT(Texts);
	__MODULE_IMPORT(VT100);
	__REGMOD("OPM", EnumPtrs);
	__REGCMD("CloseFiles", OPM_CloseFiles);
	__REGCMD("CloseOldSym", OPM_CloseOldSym);
	__REGCMD("InitOptions", OPM_InitOptions);
	__REGCMD("LogWLn", OPM_LogWLn);
	__REGCMD("RegisterNewSym", OPM_RegisterNewSym);
	__REGCMD("WriteLn", OPM_WriteLn);
/* BEGIN */
	OPM_MaxReal =   3.40282346000000e+038;
	OPM_MaxLReal =   1.79769296342094e+308;
	OPM_MinReal = -OPM_MaxReal;
	OPM_MinLReal = -OPM_MaxLReal;
	OPM_FindInstallDir();
	__ENDMOD;
}