A2OS/source/FoxBinarySymbolFile.Mod

MODULE FoxBinarySymbolFile; (** AUTHOR "fof"; PURPOSE "Symbol File - Binary Format"; *)

IMPORT
	 Basic := FoxBasic, Scanner := FoxScanner,  SyntaxTree := FoxSyntaxTree, Global := FoxGlobal,
	 Files,Streams, Kernel, SYSTEM, D := Debugging,  Diagnostics, Options, Formats := FoxFormats, InterfaceComparison := FoxInterfaceComparison
	 ,Commands, Printout := FoxPrintout, SemanticChecker := FoxSemanticChecker,
	 Machine
	 ;

(** Symbol File Format

	SymbolFile    = codeOptions:RawSet
	                Imports
	                [sfSysFlag sysFlags:RawNum]
	                [sfConst {Symbol Value}]
	                [sfVar {Symbol}]
	                [sfXProcedure {Symbol ParameterList}]
	                [sfOperator {Symbol ParameterList [sfInline Inline]}]
	                [sfCProcedure {Symbol ParameterList Inline}]
	                [sfAlias {Type name:RawString}]
	                [sfType {Type}]
	                sfEnd.

	Imports       = {moduleName:RawString} 0X

	Symbol        = [sfObjFlag flag:RawNum] [sfReadOnly]
	                Type name:RawString

	Value         = [ RawNum | RawHInt | RawReal | RawLReal | RawString ]

	Type          = TypeReference
	                | BasicType
	                | ImportedType
	                | UserType.

	TypeReference = number<0:RawNum

	BasicType     = sfTypeBoolean |  .. |  sfLastType.

	ImportedType  = ModuleNumber (structName:RawString | 0X typeIndex:RawNum)

	ModuleNumber  = sfMod1 | .. | sfModOther-1 | sfModOther moduleNumber:RawNum

	UserType      = [sfInvisible] [sfSysFlag sysFlag:RawNum] UserType2

	UserType2     =  sfTypeOpenArray baseType:Type name:RawString
	                 | sfTypeStaticArray  baseType:Type name:RawString length:RawNum
	                 | sfTypePointer baseType:Type name:RawString
	                 | sfTypeRecord baseType:Type name:RawString Record
	                 | sfTypeProcedure baseType:Type name:RawString flags:RawNum
	                   ParameterList

	Record        =  mode:RawNum priority:Char {variable:Symbol}
	                 [sfTProcedure {Symbol [name:RawString] ParameterList [sfInline Inline]} ]
	                 sfEnd.

	ParameterList = {
	                [sfObjflag ( sfCParam | sfDarwinCParam | sfWinAPIParam )]
	                [sfVar] [sfReadOnly] Type name:RawString
	                } sfEnd.

	Inline        = {len:Char {c:Char}} 0X.

*)


CONST
		TraceImport=0;
		TraceExport=1;
		Trace = {} ;

		(* FoxProgTools.Enum --start=1 sfTypeBoolean sfTypeChar8 sfTypeChar16 sfTypeChar32
		sfTypeShortint sfTypeInteger sfTypeLongint sfTypeHugeint sfTypeReal sfTypeLongreal sfTypeSet
		sfTypeString sfTypeNoType sfTypeNilType sfTypeByte sfTypeSptr sfMod1 ~

		FoxProgTools.Enum --start=2DH --hex sfModOther  sfTypeOpenArray sfTypeStaticArray sfTypePointer sfTypeRecord sfTypeProcedure
		sfSysFlag sfInvisible sfReadOnly sfObjFlag sfConst sfVar sfLProcedure sfXProcedure sfOperator sfTProcedure sfCProcedure sfAlias sfType sfEnd ~
		*)

		sfTypeBoolean= 1;
		sfTypeChar8= 2;
		sfTypeChar16= 3;
		sfTypeChar32= 4;
		sfTypeShortint= 5;
		sfTypeInteger= 6;
		sfTypeLongint= 7;
		sfTypeHugeint =   8;
		sfTypeReal =   9;
		sfTypeLongreal =  10;
		sfTypeSet =  11;
		sfTypeString =  12;
		sfTypeNoType =  13;
		sfTypeNilType =  14;
		sfTypeByte =  15;
		sfTypeAny =  16;
		sfTypeObject = 17;
		sfTypeAddress= 18;
		sfTypeSize = 19;
		sfTypeUnsigned8=20;
		sfTypeUnsigned16=21;
		sfTypeUnsigned32=22;
		sfTypeUnsigned64=23;

		sfLastType = 23;
		sfMod1 =  sfLastType+1;

		sfModOther=2DH;
		sfTypeOpenArray=2EH;
		(*
		sfTypeDynamicArray=2FH;
		*)
		sfTypeStaticArray=30H;
		sfTypePointer=31H;
		sfTypeRecord=32H;
		sfTypeProcedure=33H;
		sfSysFlag=34H;
		sfInvisible=35H;
		sfHidden = 0ACH;

		sfReadOnly=36H;
		sfObjFlag = 37H; (* fof: very (!) bad idea to have same number for two type flags *)
		sfConst=37H;
		sfVar=38H;
		sfTypeEnumeration=39H;
		(*
		sfLProcedure=39H;
		*)
		sfXProcedure=3AH;
		sfOperator=3BH;
		sfTProcedure=3CH;
		sfCProcedure = sfTProcedure;
		sfAlias=3DH;
		sfType=3EH;
		sfEnd= 3FH;
		sfTypeOpenMathArray = 40H;
		sfTypeTensor=42H;
		sfTypeStaticMathArray = 43H;
		sfTypeAll = 44H;
		sfTypeRange = 45H;
		sfTypeComplex = 46H;
		sfTypeLongcomplex = 47H;


		(* workaround: handle inlined operators *)
		sfInline = 0ABH;

		sfProtected = 0;
		sfActive=1;
		sfSafe=2;
		sfClass=16;
		sfDelegate = 5;
		sfUntraced = 4;
		sfWinAPIParam = 13; (* ejz *)
		sfCParam= 14; (* fof for linux *)
		sfDarwinCParam= 15; (* fld for darwin *)
		sfRealtime= 21;
		sfDynamic = 22;
		sfUnsafe= 23;
		sfDisposable= 24;
		sfFictive = 25;

		Undef=MIN(LONGINT);

CONST
		FileTag = 0BBX;				(* same constants are defined in Linker and AosLoader *)
		NoZeroCompress = 0ADX;		(* do. *)
		FileVersion* = 0B1X;			(* do. *)
		FileVersionOC*=0B2X;
		FileVersionCurrent*=0B4X;
TYPE
	(* TypeReference provides a link between a type and a number for the purpose of late fixes while importing.
		When a type number is encountered while importing, a type reference will be used as a placeholder for the final type.
		After the import process has collected all types, the references are replaced by the referenced types (cf. Resolver Object) *)
	TypeReference = OBJECT (SyntaxTree.Type)
		VAR nr: LONGINT;

		PROCEDURE & InitTypeReference(nr: LONGINT);
		BEGIN
			InitType(Basic.invalidPosition); SELF.nr := nr;
		END InitTypeReference;

	END TypeReference;

	(* IndexToType provides a link between numbers and a type. Lists like this are typically filled while importing and provide the base
		for the type resolving, cf. Resolver below
	 *)
	IndexToType= OBJECT(Basic.List)

		PROCEDURE PutType(nr: LONGINT; type: SyntaxTree.Type);
		BEGIN GrowAndSet(nr,type);
		END PutType;

		PROCEDURE GetType(nr: LONGINT): SyntaxTree.Type;
		VAR node: ANY;
		BEGIN node := Get(nr); IF node = NIL THEN RETURN NIL ELSE RETURN node(SyntaxTree.Type) END;
		END GetType;

	END IndexToType;


	LateFix= POINTER TO RECORD (* contains a late fix to be resolved in a later step: type fixes and implementations *)
		p: ANY; (*scope: SyntaxTree.Scope;*)
		next: LateFix;
	END;

	LateFixList = OBJECT (* fifo queue for items to be resolved later on - deferred fixes *)
	VAR first,last: LateFix;

		PROCEDURE & Init;
		BEGIN first := NIL; last := NIL;
		END Init;

		(* get and remove element from list *)
		PROCEDURE Get((*VAR scope: SyntaxTree.Scope*)): ANY;
		VAR p: ANY;
		BEGIN
			IF first # NIL THEN p := first.p; (*scope := first.scope;*) first := first.next ELSE p := NIL; END;
			IF first = NIL THEN last := NIL END;
			RETURN p;
		END Get;

		(* add unresolved type to list *)
		PROCEDURE Add(p: ANY (*; scope: SyntaxTree.Scope*));
		VAR next: LateFix;
		BEGIN
			(*ASSERT(scope # NIL);*)
			NEW(next); next.p := p; (* next.scope := scope;*)
			next.next := NIL;
			IF first = NIL THEN first := next; last := next;
			ELSE last.next := next; last := next
			END;
		END Add;

	END LateFixList;


	(*
		The resolver object is used to replace type references in a SyntaxTree.Module tree with the respective types from a given type list.
		To do so, the resolver traverses the module tree partially with direct procedural recursion and partially using the visitor pattern.
	*)
	Resolver=OBJECT (SyntaxTree.Visitor)
	VAR typeList: IndexToType; system: Global.System; typeFixes: LateFixList;

		checker: SemanticChecker.Checker;

		PROCEDURE & Init(system: Global.System; symbolFile: BinarySymbolFile; importCache: SyntaxTree.ModuleScope);
		VAR streamDiagnostics: Diagnostics.StreamDiagnostics;
		BEGIN
			typeList := NIL; SELF.system := system; NEW(typeFixes);
			NEW(streamDiagnostics, D.Log);
			checker := SemanticChecker.NewChecker(streamDiagnostics,FALSE,FALSE,TRUE,system,symbolFile,importCache,"");
		END Init;

		(* types that do not refer to other types *)

		PROCEDURE VisitType*(x: SyntaxTree.Type);
		BEGIN END VisitType;

		PROCEDURE VisitBasicType*(x: SyntaxTree.BasicType);
		BEGIN END VisitBasicType;

		PROCEDURE VisitByteType*(x: SyntaxTree.ByteType);
		BEGIN END VisitByteType;

		PROCEDURE VisitBooleanType*(x: SyntaxTree.BooleanType);
		BEGIN END VisitBooleanType;

		PROCEDURE VisitSetType*(x: SyntaxTree.SetType);
		BEGIN END VisitSetType;

		PROCEDURE VisitAddressType*(x: SyntaxTree.AddressType);
		BEGIN END VisitAddressType;

		PROCEDURE VisitSizeType*(x: SyntaxTree.SizeType);
		BEGIN END VisitSizeType;

		PROCEDURE VisitAnyType*(x: SyntaxTree.AnyType);
		BEGIN END VisitAnyType;

		PROCEDURE VisitObjectType*(x: SyntaxTree.ObjectType);
		BEGIN END VisitObjectType;

		PROCEDURE VisitNilType*(x: SyntaxTree.NilType);
		BEGIN END VisitNilType;

		PROCEDURE VisitCharacterType*(x: SyntaxTree.CharacterType);
		BEGIN END VisitCharacterType;

		PROCEDURE VisitIntegerType*(x: SyntaxTree.IntegerType);
		BEGIN END VisitIntegerType;

		PROCEDURE VisitFloatType*(x: SyntaxTree.FloatType);
		BEGIN END VisitFloatType;

		PROCEDURE VisitComplexType*(x: SyntaxTree.ComplexType);
		BEGIN END VisitComplexType;

		PROCEDURE VisitQualifiedType*(x: SyntaxTree.QualifiedType);
		BEGIN
			x.SetResolved(ResolveType(x.resolved))
		END VisitQualifiedType;

		PROCEDURE VisitStringType*(x: SyntaxTree.StringType);
		BEGIN END VisitStringType;

		PROCEDURE VisitRangeType*(x: SyntaxTree.RangeType);
		BEGIN END VisitRangeType;

		(* types containing links to other types *)

		(**
			check enumeration scope: enter symbols and check for duplicate names
		**)
		PROCEDURE CheckEnumerationScope(x: SyntaxTree.EnumerationScope);
		VAR e: SyntaxTree.Constant; lowest, highest,value: Basic.Integer;
		BEGIN
			lowest := 0; highest := 0;
			e := x.firstConstant;
			WHILE (e # NIL) DO
				e.SetType(x.ownerEnumeration);
				e.SetState(SyntaxTree.Resolved);
				value := e.value(SyntaxTree.EnumerationValue).value;
				IF value < lowest THEN lowest := value END;
				IF value > highest THEN highest := value END;
				e := e.nextConstant;
			END;
			x.ownerEnumeration.SetRange(lowest,highest);
		END CheckEnumerationScope;

		(**
			resolve enumeration type: check enumeration scope
		**)
		PROCEDURE VisitEnumerationType*(x: SyntaxTree.EnumerationType);
		VAR baseScope: SyntaxTree.EnumerationScope; resolved: SyntaxTree.Type; enumerationBase: SyntaxTree.EnumerationType;
		BEGIN
			x.SetEnumerationBase(ResolveType(x.enumerationBase));
			IF x.enumerationBase # NIL THEN
				resolved := x.enumerationBase.resolved;
				enumerationBase := resolved(SyntaxTree.EnumerationType);
				baseScope := enumerationBase.enumerationScope;
			END;
			CheckEnumerationScope(x.enumerationScope);
			x.SetState(SyntaxTree.Resolved);
		END VisitEnumerationType;

		PROCEDURE VisitArrayType*(arrayType: SyntaxTree.ArrayType);
		BEGIN
			ASSERT(arrayType.arrayBase # NIL);
			arrayType.SetArrayBase(ResolveType(arrayType.arrayBase));
			arrayType.SetHasPointers(arrayType.arrayBase.resolved.hasPointers);
			arrayType.SetState(SyntaxTree.Resolved);
		END VisitArrayType;

		PROCEDURE VisitMathArrayType*(arrayType: SyntaxTree.MathArrayType);
		BEGIN
			arrayType.SetArrayBase(ResolveType(arrayType.arrayBase));
			IF arrayType.form = SyntaxTree.Static THEN
				arrayType.SetIncrement(system.SizeOf(arrayType.arrayBase));
				arrayType.SetHasPointers(arrayType.arrayBase.resolved.hasPointers);
			ELSE
				arrayType.SetHasPointers(TRUE)
			END;
			arrayType.SetState(SyntaxTree.Resolved);
		END VisitMathArrayType;

		PROCEDURE VisitPointerType*(pointerType: SyntaxTree.PointerType);
		VAR recordType: SyntaxTree.RecordType;
		BEGIN
			IF ~(SyntaxTree.Resolved IN pointerType.state) THEN
				typeFixes.Add(pointerType);
				pointerType.SetState(SyntaxTree.Resolved);
			END;
			(*
			pointerType.SetPointerBase(ResolveType(pointerType.pointerBase));

			IF pointerType.pointerBase.resolved IS SyntaxTree.RecordType THEN
				recordType := pointerType.pointerBase.resolved(SyntaxTree.RecordType);
				IF (recordType.typeDeclaration = NIL) THEN
					recordType.SetPointerType(pointerType);
					recordType.SetTypeDeclaration(pointerType.typeDeclaration)
				END;
			END;

			pointerType.SetState(SyntaxTree.Resolved);
			*)
		END VisitPointerType;

		PROCEDURE FixPointerType(pointerType: SyntaxTree.PointerType);
		VAR recordType: SyntaxTree.RecordType;
		BEGIN
			pointerType.SetPointerBase(ResolveType(pointerType.pointerBase));

			IF pointerType.pointerBase.resolved IS SyntaxTree.RecordType THEN
				recordType := pointerType.pointerBase.resolved(SyntaxTree.RecordType);
				IF (recordType.typeDeclaration = NIL) THEN
					recordType.SetPointerType(pointerType);
					recordType.SetTypeDeclaration(pointerType.typeDeclaration)
				END;
			END;

		END FixPointerType;



		PROCEDURE VisitRecordType*(recordType: SyntaxTree.RecordType);
		VAR recordBase: SyntaxTree.RecordType; numberMethods: LONGINT; procedure,super,testsuper: SyntaxTree.Procedure; recordScope: SyntaxTree.RecordScope;
			pointerType: SyntaxTree.Type; typeDeclaration: SyntaxTree.TypeDeclaration; symbol: SyntaxTree.Symbol; size: HUGEINT; hasPointer: BOOLEAN;
			var: SyntaxTree.Variable;
		BEGIN
			recordType.SetBaseType(ResolveType(recordType.baseType));

			recordScope := recordType.recordScope;
			recordBase := recordType.GetBaseRecord();
			hasPointer := FALSE;
			IF recordBase = NIL THEN numberMethods := 0;
			ELSE
				recordBase.Accept(SELF); numberMethods := recordBase.recordScope.numberMethods;
			END;
			symbol := recordScope.firstSymbol; (* must use the sorted list here, important! *)
			WHILE symbol # NIL DO
				IF (symbol IS SyntaxTree.Procedure) THEN
					procedure := symbol(SyntaxTree.Procedure);
					IF procedure IS SyntaxTree.Operator THEN FixProcedureType(procedure.type(SyntaxTree.ProcedureType)) END;
					super := SemanticChecker.FindSuperProcedure(recordScope, procedure);
					procedure.SetSuper(super);
					IF super # NIL THEN
						procedure.SetAccess(procedure.access+super.access);
					END;

					IF procedure.super # NIL THEN
						procedure.SetMethodNumber(procedure.super.methodNumber)
					ELSE
						procedure.SetMethodNumber(numberMethods);
						INC(numberMethods);
					END;
				END;
				symbol := symbol.nextSymbol;
			END;

			recordScope.SetNumberMethods(numberMethods);

			IF (recordScope.firstProcedure # NIL) OR (recordBase # NIL) & (recordBase.isObject) THEN
				recordType.IsObject(TRUE)
			END;

			IF (recordBase # NIL) &  recordBase.hasPointers THEN hasPointer := TRUE END;

			Scope(recordType.recordScope);
			var := recordType.recordScope.firstVariable;
			WHILE var # NIL DO
				hasPointer := hasPointer OR var.type.resolved.hasPointers & ~var.untraced;
				var := var.nextVariable;
			END;
			recordType.SetHasPointers(hasPointer);

			checker.SetCurrentScope(recordType.recordScope);
			checker.ResolveArrayStructure(recordType);

			recordType.SetState(SyntaxTree.Resolved);
			size := system.SizeOf(recordType); (* generate field offsets *)

			IF (recordType.typeDeclaration = NIL) & (recordType.pointerType # NIL) THEN
				pointerType := recordType.pointerType.resolved;
				typeDeclaration := pointerType.typeDeclaration;
				recordType.SetTypeDeclaration(typeDeclaration);
			END;
		END VisitRecordType;


		PROCEDURE VisitProcedureType*(procedureType: SyntaxTree.ProcedureType);
		VAR parameter: SyntaxTree.Parameter;
		BEGIN
			IF ~(SyntaxTree.Resolved IN procedureType.state) THEN
				typeFixes.Add(procedureType);
				IF procedureType.isDelegate THEN
					procedureType.SetHasPointers(TRUE);
				END;
				procedureType.SetState(SyntaxTree.Resolved);
			END;
		END VisitProcedureType;


		PROCEDURE FixProcedureType(procedureType: SyntaxTree.ProcedureType);
		VAR parameter: SyntaxTree.Parameter; returnType: SyntaxTree.Type;
		BEGIN
			(* parameter list *)
			parameter := procedureType.firstParameter;
			WHILE(parameter # NIL) DO
				parameter.SetType(ResolveType(parameter.type));
				parameter := parameter.nextParameter;
			END;
			(* return type *)
			returnType := ResolveType(procedureType.returnType);
			procedureType.SetReturnType(ResolveType(returnType));
			IF returnType# NIL THEN
				parameter := SyntaxTree.NewParameter(Basic.invalidPosition,procedureType,Global.ReturnParameterName,SyntaxTree.VarParameter);
				parameter.SetType(returnType);
				parameter.SetState(SyntaxTree.Resolved);
				procedureType.SetReturnParameter(parameter);
			END;
		END FixProcedureType;

		(* a type reference is resolved by replacing it with the respective element of the type list, all other types remain *)
		PROCEDURE ResolveType(type: SyntaxTree.Type): SyntaxTree.Type;
		BEGIN
			IF type = NIL THEN RETURN NIL
			ELSIF (type IS TypeReference) THEN
				type :=  typeList.GetType(type(TypeReference).nr);
			END;
			IF ~(SyntaxTree.Resolved IN type.state)  THEN
				type.Accept(SELF);
				type.SetState(SyntaxTree.Resolved);
			END;
			RETURN type;
		END ResolveType;

		(** resolve all pending types (late resolving).
			- type fixes are resolved at the end of the declaration phase
			- type fixes may imply new type fixes that are also entered at the end of the list
		**)
		PROCEDURE FixTypes;
		VAR p: ANY; prevScope: SyntaxTree.Scope;
		BEGIN
			(*prevScope := currentScope;*)
			p := typeFixes.Get((*currentScope*));
			WHILE p # NIL DO
				ASSERT(p IS SyntaxTree.Type);

				IF p IS SyntaxTree.PointerType THEN
					FixPointerType(p(SyntaxTree.PointerType))
				ELSIF p IS SyntaxTree.ProcedureType THEN
					FixProcedureType(p(SyntaxTree.ProcedureType))
				ELSE
					HALT(100);
				END;
				p := typeFixes.Get((*currentScope*));
			END;
			(*currentScope :=prevScope;*)
		END FixTypes;

		(* scope traversal *)
		PROCEDURE Scope(scope: SyntaxTree.Scope);
		VAR typeDeclaration: SyntaxTree.TypeDeclaration; variable: SyntaxTree.Variable; procedure: SyntaxTree.Procedure;
		BEGIN
			(* type declarations *)
			typeDeclaration := scope.firstTypeDeclaration;
			WHILE(typeDeclaration # NIL) DO
				typeDeclaration.SetDeclaredType(ResolveType(typeDeclaration.declaredType));
				IF ~(typeDeclaration.declaredType IS SyntaxTree.BasicType) THEN
					typeDeclaration.declaredType.SetTypeDeclaration(typeDeclaration);
				END;
				typeDeclaration := typeDeclaration.nextTypeDeclaration;
			END;
			(* variables *)
			variable := scope.firstVariable;
			WHILE(variable # NIL) DO
				variable.SetType(ResolveType(variable.type));
				ASSERT (~(variable.type IS TypeReference));
				ASSERT(~(variable.type.resolved IS TypeReference));
				variable := variable.nextVariable;
			END;
			(* procedures *)
			procedure := scope.firstProcedure;
			WHILE(procedure # NIL) DO
				Scope(procedure.procedureScope);
				procedure.SetType(ResolveType(procedure.type));
				procedure := procedure.nextProcedure;
			END;
		END Scope;

		(* replace all TypeReferences in module by referenced types in typeList *)
		PROCEDURE Resolve(module: SyntaxTree.Module; typeList: IndexToType);
		BEGIN
			SELF.typeList := typeList;
			Scope(module.moduleScope);
			FixTypes;
			module.SetState(SyntaxTree.Resolved);
		END Resolve;

	END Resolver;

	(*
		An Index is the data structure containing a number to be mapped to types via the object TypeToIndex below.
		Used for type enumeration when exporting.
	*)
	Index =POINTER TO RECORD tag: LONGINT END;

	(*
		The TypeToIndex object provides the link between a type and a module and type number. It is the inverse of the IndexToType and is used
		for exporting. It is implemented using a hash table mapping a SyntaxTree.Type to a Index object.
	*)
	TypeToIndex= OBJECT (Basic.HashTable)

		PROCEDURE GetIndex(type: SyntaxTree.Type): LONGINT;
		VAR t:ANY;
		BEGIN
			t := Get(type);
			IF t # NIL THEN RETURN t(Index).tag ELSE RETURN Undef END;
		END GetIndex;

		PROCEDURE PutIndex(type:SyntaxTree.Type; nr: LONGINT);
		VAR t: Index;
		BEGIN
			ASSERT(nr # Undef);
			NEW(t); t.tag := nr; Put(type,t);
		END PutIndex;

	END TypeToIndex;

	Attribute = OBJECT
	VAR
		numberTypes: LONGINT;
		indexToType: IndexToType;
		typeToIndex: TypeToIndex;

		PROCEDURE &Init;
		BEGIN numberTypes := 0; NEW(indexToType,16); NEW(typeToIndex,100);
		END Init;
	END Attribute;

	IndexToAttribute= OBJECT(Basic.List)

		PROCEDURE PutAttribute(nr: LONGINT; attribute: Attribute);
		BEGIN GrowAndSet(nr,attribute);
		END PutAttribute;

		PROCEDURE GetAttribute(nr: LONGINT): Attribute;
		VAR node: ANY; attribute: Attribute;
		BEGIN
			IF Length() <= nr THEN node := NIL ELSE node := Get(nr) END;
			IF node # NIL THEN attribute := node(Attribute)
			ELSE NEW(attribute); PutAttribute(nr,attribute);
			END;
			RETURN attribute
		END GetAttribute;

	END IndexToAttribute;

	BinarySymbolFile*=OBJECT (Formats.SymbolFileFormat)
	VAR file-: Files.File; extension-: Basic.FileName;
			noRedefinition, noModification, noInterfaceCheck: BOOLEAN;
			version: CHAR;

		(** Import - Symbol Table Loader Plugin *)
		PROCEDURE Import*(CONST moduleName: ARRAY OF CHAR; importCache: SyntaxTree.ModuleScope): SyntaxTree.Module;
		VAR
			module: SyntaxTree.Module;
			moduleIdentifier,contextIdentifier: SyntaxTree.Identifier;
			moduleScope: SyntaxTree.ModuleScope;

			fileName: Files.FileName;
			R: Streams.Reader;
			tag, i: LONGINT;

			visibility: SET;

			type: SyntaxTree.Type;
			variable: SyntaxTree.Variable;
			constant: SyntaxTree.Constant;
			procedure: SyntaxTree.Procedure;
			procedureType: SyntaxTree.ProcedureType;
			procedureScope: SyntaxTree.ProcedureScope;
			typeDeclaration: SyntaxTree.TypeDeclaration;

			resolver: Resolver;

			allTypes: IndexToType; numberReimports, numberTypes : LONGINT;

			name: SyntaxTree.IdentifierString;

			value: SyntaxTree.Value;

			stamp: LONGINT;
			b: BOOLEAN;

			indexToAttribute: IndexToAttribute;
			predefType: ARRAY sfLastType+1 OF SyntaxTree.Type;

			PROCEDURE NewTypeReference(nr: LONGINT): SyntaxTree.Type;
			VAR typeReference: TypeReference;
			BEGIN
				NEW(typeReference,nr); RETURN typeReference;
			END NewTypeReference;


			(* Imports = {moduleName:RawString} 0X *)
			PROCEDURE Imports;
			VAR moduleName: SyntaxTree.IdentifierString; import: SyntaxTree.Import; importedModule: SyntaxTree.Module; moduleIdentifier,moduleContext: SyntaxTree.Identifier; b: BOOLEAN;
			BEGIN
				R.RawString(moduleName);
				WHILE	moduleName # ""	DO
					ASSERT(moduleName # "SYSTEM");
					IF TraceImport IN Trace THEN D.Str("import module: "); D.Str(moduleName); D.Ln; END;

					(* as the context is not encoded in the symbol file, we have to deduce it from the filename, this is ugly but necessary
						to keep consistency with old compiler
					*)

					Global.ContextFromName(moduleName,moduleIdentifier,moduleContext);

					import := importCache.ImportByModuleName(moduleIdentifier,moduleContext);

					IF import # NIL THEN
						IF import.module = NIL THEN (* has not yet been imported by parent module *)
							(* adjust import symbol in parent *)
							importedModule := Import(moduleName,importCache);
							import.SetModule(importedModule);
						ELSE
							(* take module from parent *)
							importedModule := import.module;
						END
					ELSE
						importedModule := Import(moduleName,importCache);
						IF importedModule # NIL THEN
							import := SyntaxTree.NewImport(Basic.invalidPosition,importedModule.name,importedModule.name,FALSE);
							import.SetContext(importedModule.context);
							import.SetModule(importedModule);
							import.SetState(SyntaxTree.Resolved);
							importCache.AddImport(import);
						END;
					END;

					(* create new import symbol for this module scope *)
					IF importedModule # NIL THEN
						import := SyntaxTree.NewImport(Basic.invalidPosition,moduleIdentifier,moduleIdentifier,TRUE);
						import.SetModule(importedModule);
						import.SetContext(moduleContext);
						import.SetState(SyntaxTree.Resolved);
						module.moduleScope.AddImport(import);
						module.moduleScope.EnterSymbol(import,b);
					END;
					R.RawString(moduleName);
				END
			END Imports;

			(* Value = [ RawNum | RawHInt | RawReal | RawLReal | RawString ] *)
			PROCEDURE Value(type: SyntaxTree.Type): SyntaxTree.Value;
			VAR i: LONGINT; huge: HUGEINT;  r: REAL;  lr: LONGREAL; string: SyntaxTree.String; length: LONGINT; set: SET;
				value: SyntaxTree.Value; size: LONGINT;
			BEGIN
				size := type.sizeInBits;
				IF type IS SyntaxTree.BooleanType THEN R.RawNum(i);
					IF TraceImport IN Trace THEN D.Str("InConst / Bool / "); D.Int(i,1); D.Ln;  END;
					IF	i = 0	THEN	value := Global.NewBooleanValue(system,Basic.invalidPosition,FALSE)	 ELSE value := Global.NewBooleanValue(system,Basic.invalidPosition,TRUE)	END
				ELSIF (type IS SyntaxTree.CharacterType) THEN
					IF  (size=8) OR (size=16) OR (size=32) THEN
						R.RawNum(i);
						IF TraceImport IN Trace THEN D.Str("InConst / Char / "); D.Int(i,1); D.Ln;  END;
						value := SyntaxTree.NewCharacterValue(Basic.invalidPosition,CHR(i));
					END;
				ELSIF type IS SyntaxTree.IntegerType THEN
					IF (size = 32) & ~type(SyntaxTree.IntegerType).signed THEN
						R.RawHInt(huge);
						IF TraceImport IN Trace THEN  D.Str("InConst / Unsigned32 / "); D.Ln END;
						value := SyntaxTree.NewIntegerValue (Basic.invalidPosition,huge);
					ELSIF size <=32 THEN
						R.RawNum(i);
						IF TraceImport IN Trace THEN  D.Str("InConst / Int"); D.Int(size,1); D.String(" "); D.Int(i,1); D.Ln END;
						value := SyntaxTree.NewIntegerValue(Basic.invalidPosition,i);
					ELSIF size=64 THEN
						R.RawHInt(huge);
						IF TraceImport IN Trace THEN  D.Str("InConst / HInt / "); D.Ln END;
						value := SyntaxTree.NewIntegerValue (Basic.invalidPosition,huge);
					END;
				ELSIF type IS SyntaxTree.SetType THEN R.RawNum(SYSTEM.VAL(LONGINT, set));
					IF TraceImport IN Trace THEN  D.Str("InConst / Set / "); D.Hex(SYSTEM.VAL(LONGINT, set),1); D.Ln END;
					value := SyntaxTree.NewSetValue(Basic.invalidPosition,set);
				ELSIF type IS SyntaxTree.FloatType THEN
					IF size = 32 THEN
						R.RawReal(r);
						IF TraceImport IN Trace THEN  D.Str("InConst / Real / "); D.Ln END;
						value := SyntaxTree.NewRealValue(Basic.invalidPosition,r);
					ELSIF size = 64 THEN
						R.RawLReal(lr);
						IF TraceImport IN Trace THEN  D.Str("InConst / LongReal / "); D.Ln END;
						value := SyntaxTree.NewRealValue(Basic.invalidPosition,lr);
					END;
				ELSIF type IS SyntaxTree.StringType THEN
					IF version <= FileVersionOC THEN NEW(string, 256)
					ELSE R.RawLInt(length); NEW(string, length)
					END;
					R.RawString(string^);
					IF TraceImport IN Trace THEN  D.Str("InConst / String / "); D.Str(string^); D.Ln END;
					value := SyntaxTree.NewStringValue(Basic.invalidPosition,string);
					type(SyntaxTree.StringType).SetLength(value(SyntaxTree.StringValue).length);
					type.SetState(SyntaxTree.Resolved);
				ELSIF type IS SyntaxTree.EnumerationType THEN R.RawNum(i);
					IF TraceImport IN Trace THEN  D.Str("InConst / LInt / "); D.Int(i,1); D.Ln END;
					value := SyntaxTree.NewEnumerationValue(Basic.invalidPosition,i);
				ELSIF type IS SyntaxTree.NilType THEN
					IF TraceImport IN Trace THEN  D.Str("InConst / Nil"); D.Ln END;
					value := SyntaxTree.NewNilValue(Basic.invalidPosition);
				END;
				value.SetType(type);
				value.SetState(SyntaxTree.Resolved);
				RETURN value
			END Value;

			(* EnumerationList = {name:RawString} sfEnd *)
			PROCEDURE EnumerationList(enumerationScope: SyntaxTree.EnumerationScope);
			VAR enumerator: SyntaxTree.Constant; visibility,flags: SET; b: BOOLEAN;
				type: SyntaxTree.Type; name: SyntaxTree.IdentifierString; identifier: SyntaxTree.Identifier;
			BEGIN
				R.RawString(name);
				WHILE name # "" DO
					identifier := SyntaxTree.NewIdentifier(name);
					enumerator := SyntaxTree.NewConstant(Basic.invalidPosition,identifier);
					enumerationScope.AddConstant(enumerator);
					enumerationScope.EnterSymbol(enumerator,b);
					IF name # "@" THEN enumerationScope.lastConstant.SetAccess(SyntaxTree.Public+SyntaxTree.Internal+SyntaxTree.Protected)
					ELSE enumerationScope.lastConstant.SetAccess(SyntaxTree.Internal)
					END;
					value := Value(enumerationScope.ownerEnumeration);
					enumerator.SetValue(value);
					enumerator.SetType(enumerationScope.ownerEnumeration);
					R.RawString(name);
				END;



			END EnumerationList;


			(* ParameterList = { [sfObjflag ( sfCParam | sfDarwinCParam | sfWinAPIParam )] [sfVar] [sfReadOnly] Type name:RawString } sfEnd *)
			PROCEDURE ParameterList(VAR callingConvention: LONGINT; parentScope: SyntaxTree.Scope; procedureType: SyntaxTree.ProcedureType);
			VAR name: SyntaxTree.IdentifierString; type: SyntaxTree.Type; f: LONGINT;
				kind: LONGINT;
				parameter: SyntaxTree.Parameter;
			BEGIN
				IF TraceImport IN Trace THEN
					D.Str("ParameterList "); D.Ln
				END;
				callingConvention := SyntaxTree.OberonCallingConvention;

				R.RawNum(tag);
				WHILE  tag#sfEnd  DO
					IF tag = sfObjFlag THEN (*! the calling convention should not be expressed via the parameters (compatiblity with old compiler) *)
						R.RawNum(f);
						IF f = sfCParam THEN (* fof for Linux *)
							callingConvention := SyntaxTree.CCallingConvention
						ELSIF f = sfDarwinCParam THEN (* fld for darwin *)
							callingConvention := SyntaxTree.DarwinCCallingConvention
						ELSIF f=sfWinAPIParam THEN
							callingConvention := SyntaxTree.WinAPICallingConvention
						ELSE HALT(100)
						END;
						R.RawNum(tag);
					END;
					IF  tag=sfVar  THEN
						R.RawNum(tag);
						kind := SyntaxTree.VarParameter;
					ELSE
						kind := SyntaxTree.ValueParameter;
					END;
					IF tag = sfReadOnly THEN  (* var const *)
						R.RawNum(tag);
						kind := SyntaxTree.ConstParameter;
					END;

					type := Type();

					R.RawString(name);

					parameter := SyntaxTree.NewParameter(Basic.invalidPosition,procedureType,SyntaxTree.NewIdentifier(name),kind);
					parameter.SetType(type);
					parameter.SetState(SyntaxTree.Resolved);
					(*! remove this after a rebuild of the release - for compatibility only *)
					IF (parameter.name=Global.SelfParameterName)
						OR (parameter.name=Global.ReturnParameterName)
						OR (parameter.name=Global.PointerReturnName)
						OR (parameter.name=Global.ResultName) THEN (* ignore *)
					ELSE
					procedureType.AddParameter(parameter);
					END;

					R.RawNum(tag)
				END;

				IF callingConvention # SyntaxTree.OberonCallingConvention THEN
					procedureType.RevertParameters;
				END;
			END ParameterList;

			(* returns the index of module importedModule in the list of module module *)
			PROCEDURE ModuleByIndex(module: SyntaxTree.Module; index: LONGINT): SyntaxTree.Module;
			VAR import: SyntaxTree.Import;
			BEGIN import := module.moduleScope.firstImport;
				WHILE (import # NIL) & (index > 0) DO
					IF (* (import.direct) & *)  ~Global.IsSystemModule(import.module) THEN DEC(index) END;
					import := import.nextImport;
				END;
				ASSERT(import # NIL);
				(* ASSERT(import.direct); *)
				RETURN import.module;
			END ModuleByIndex;

			(*
				Record =
					mode:RawNum priority:Char {variable:Symbol}
					[sfTProcedure {Symbol [name:RawString] ParameterList [sfInline Inline]} ]
					sfEnd
			*)
			PROCEDURE Record(recordType: SyntaxTree.RecordType; baseType: SyntaxTree.Type);
			VAR
				mode: SET;
				priority: LONGINT;
				visibility: SET;

				active, safe, isOperator, isDynamic, isFictive: BOOLEAN;
				untraced, realtime, constructor: BOOLEAN;
				fOffset: LONGINT;

				variable: SyntaxTree.Variable;
				procedure: SyntaxTree.Procedure;
				operator: SyntaxTree.Operator;
				procedureType: SyntaxTree.ProcedureType;
				recordScope: SyntaxTree.RecordScope;
				recordBody: SyntaxTree.Body;
				name: SyntaxTree.IdentifierString;

				ch: CHAR;
				callingConvention: LONGINT;

			BEGIN
				recordScope := recordType.recordScope;

				R.RawNum(SYSTEM.VAL(LONGINT, mode));
				IF sfActive IN mode THEN active := TRUE ELSE active := FALSE END;
				IF sfProtected IN mode THEN recordType.SetProtected(TRUE) END;
				IF sfSafe IN mode THEN safe := TRUE ELSE safe := FALSE END;

				R.Char(ch);
				priority := ORD(ch); (* body priority, if active object *)
				IF TraceImport IN Trace THEN
					D.Str("Rec / Mode / "); D.Hex(SYSTEM.VAL(LONGINT, mode),1); D.Ln;
					D.Str("Rec / Prio / "); D.Int(priority,1); D.Ln
				END;

				R.RawNum(tag);
				WHILE  (tag < sfTProcedure) OR (tag > sfEnd) DO	(*read fields*)
					isOperator := FALSE;
					Symbol(recordScope,type,name,visibility,untraced, realtime, constructor, isOperator, isDynamic, isFictive, fOffset);
					ASSERT(type # NIL);
					IF  name = "" THEN visibility := SyntaxTree.Internal END;
					variable := SyntaxTree.NewVariable(Basic.invalidPosition,SyntaxTree.NewIdentifier(name));
					variable.SetType(type);
					variable.SetUntraced(untraced);
					variable.SetAccess(visibility);
					IF isFictive THEN
						TRACE(fOffset);
						variable.SetFictive(fOffset);
						variable.SetUntraced(TRUE);
					END;
					variable.SetState(SyntaxTree.Resolved);
					recordScope.AddVariable(variable);
					recordScope.EnterSymbol(variable,b);
					R.RawNum(tag);
				END;

				IF tag=sfTProcedure THEN
					R.RawNum(tag);
					WHILE  tag#sfEnd  DO
						isOperator := FALSE;
						Symbol(recordScope,type,name, visibility,untraced, realtime, constructor, isOperator, isDynamic, isFictive, fOffset);
						IF  name = "" THEN  R.RawString(name)  END;

						procedureScope := SyntaxTree.NewProcedureScope(recordScope);
						IF isOperator THEN
							operator := SyntaxTree.NewOperator(Basic.invalidPosition,SyntaxTree.NewIdentifier(name),procedureScope);
							procedure := operator
						ELSE
							procedure := SyntaxTree.NewProcedure(Basic.invalidPosition,SyntaxTree.NewIdentifier(name),procedureScope);
						END;
						procedureType := SyntaxTree.NewProcedureType(Basic.invalidPosition,recordScope);
						procedureType.SetReturnType(type);
						procedureType.SetRealtime(realtime);
						procedure.SetConstructor(constructor);
						procedureType.SetDelegate(TRUE);
						procedure.SetType(procedureType);
						procedure.SetAccess(visibility);
						procedure.SetState(SyntaxTree.Resolved);
						IF constructor THEN
							recordScope.SetConstructor(procedure); (*! redundant *)
						END;

						ParameterList(callingConvention,procedureScope,procedureType);

						recordScope.AddProcedure(procedure);
						IF isOperator THEN
							recordScope.AddOperator(operator);
						END;
						recordScope.EnterSymbol(procedure,b);

						(* This identifies a inlined Indexer *)
						R.RawNum(tag);
						IF tag = sfInline THEN
							Inline(procedureScope);
							(*
							INCL(flag, SyntaxTree.Inline);
							INCL(flag, SyntaxTree.Indexer);
							INCL(flag, SyntaxTree.Operator);
							mscope.code := Inline();
							*)
							R.RawNum(tag)
						END;
						IF (procedure.name=Global.RecordBodyName) THEN
							recordScope.SetBodyProcedure(procedure);
							recordBody := SyntaxTree.NewBody(Basic.invalidPosition,procedureScope);
							recordBody.SetSafe(safe);
							recordBody.SetActive(active);
							procedureScope.SetBody(recordBody);
						END;
					END

				ELSE ASSERT(tag = sfEnd);
				END;

				(*
				ASSERT((bodyFlags = {}) OR (recordScope.bodyProcedure # NIL));
				*)

				recordType.SetBaseType(baseType);

			END Record;

			(*
				Type =
					TypeReference
					|BasicType
					|ImportedType
					|UserType.

				TypeReference = number:RawNum(<0)
				BasicType = sfTypeBoolean |  .. |  sfLastType.
				ImportedType = ModuleNumber (structName:RawString | 0X typeIndex:RawNum)
				ModuleNumber = sfMod1 | .. | sfModOther-1 | sfModOther moduleNumber:RawNum

				UserType = [sfInvisible] [sfSysFlag sysFlag:RawNum] UserType2
				UserType2=
					sfTypeOpenArray baseType:Type name:RawString flags:RawNum
					|sfTypeStaticArray baseType:Type name:RawString flags:RawNum length:RawNum
					|sfOpenMathArray baseType:Type name:RawString
					|sfStaticMathArray baseType:Type name:RawString length:RawNum
					|sfTypeTensor baseType:Type name:RawString
					|sfTypePointer baseType:Type name:RawString flags:RawNum
					|sfTypeRecord baseType:Type name:RawString flags:RawNum Record
					|sfTypeProcedure baseType:Type name:RawString flags:RawNum ParameterList
					|sfTypeEnumeration enumerationBase:Type name:RawString
			*)
			PROCEDURE Type(): SyntaxTree.Type;
				VAR
					typtag,len: LONGINT;

				name: SyntaxTree.IdentifierString;

				type, baseType: SyntaxTree.Type;
				typeDeclaration: SyntaxTree.TypeDeclaration;
				arrayType: SyntaxTree.ArrayType;
				mathArrayType: SyntaxTree.MathArrayType;
				pointerType: SyntaxTree.PointerType;
				procedureType: SyntaxTree.ProcedureType;
				recordType: SyntaxTree.RecordType;
				recordScope: SyntaxTree.RecordScope;
				qualifiedType: SyntaxTree.QualifiedType;
				enumerationScope: SyntaxTree.EnumerationScope;
				enumerationType: SyntaxTree.EnumerationType;
				(*import: SyntaxTree.Import;*)
				importedModule: SyntaxTree.Module;
				identifier: SyntaxTree.Identifier;
				thisIndex : LONGINT;
				typeAdr: LONGINT;
				size: SyntaxTree.Value;

				visibility: SET;

				typeName: SyntaxTree.IdentifierString;

				sysflag: LONGINT; flags: SET;

				attribute: Attribute;
				callingConvention: LONGINT;

			BEGIN
				visibility := SyntaxTree.Public + SyntaxTree.Protected + SyntaxTree.Internal; flags := {};

				IF tag <= 0 THEN (* TypeReference = number:RawNum(<0) *)
					type := NewTypeReference(-tag);
					IF TraceImport IN Trace THEN
						D.Str("Type / OldStr "); D.Int(-tag,1); D.Ln
					END
				ELSIF tag = sfTypeString THEN
					type := SyntaxTree.NewStringType(Basic.invalidPosition,system.characterType,0);
					IF TraceImport IN Trace THEN
						D.Str("Type / String "); D.Int(tag,1); D.Ln
					END
				ELSIF tag <= sfLastType THEN  (* BasicType = sfTypeBoolean |  .. |  sfLastType. *)
					type := predefType[tag];
					ASSERT((tag = sfTypeNoType) OR (type # NIL));
					IF TraceImport IN Trace THEN
						D.Str("Type / Basic "); D.Int(tag,1); D.Ln
					END
				ELSIF tag = sfTypeRange THEN
					type := system.rangeType;
				ELSIF tag = sfTypeComplex THEN
					type := system.complexType;
				ELSIF tag = sfTypeLongcomplex THEN
					type := system.longcomplexType;
				ELSIF tag <= sfModOther THEN
					(* ImportedType = ModuleNumber (structName:RawString | 0X typeIndex:RawNum) *)
					(* ModuleNumber = sfMod1 | .. | sfModOther-1 | sfModOther moduleNumber:RawNum *)


					IF tag = sfModOther THEN
						R.RawNum(tag);
						ASSERT(tag >= 0);
					ELSE
						tag := tag-sfMod1
					END;	(*tag = [0 .. +oo[ *)

					importedModule := ModuleByIndex(module,tag);
					ASSERT(importedModule # NIL);

					R.RawString(typeName);

					type := NIL;

					attribute := indexToAttribute.GetAttribute(tag);

					IF typeName # "" THEN (* first import of struct *)
						identifier := SyntaxTree.NewIdentifier(typeName);
						typeDeclaration := importedModule.moduleScope.FindTypeDeclaration(identifier); (* find type in module *)
						IF (typeDeclaration # NIL) THEN
							qualifiedType := SyntaxTree.NewQualifiedType(Basic.invalidPosition,moduleScope,SyntaxTree.NewQualifiedIdentifier(Basic.invalidPosition,importedModule.name,identifier));
							qualifiedType.SetResolved(typeDeclaration.declaredType);
							qualifiedType.SetTypeDeclaration(typeDeclaration);
							type := qualifiedType;
						END;
						(* add reimport *)
						attribute.indexToType.PutType(attribute.numberTypes,type);
						INC(attribute.numberTypes);
						IF TraceImport IN Trace THEN
							D.Str("Type / Reimport "); D.Str(typeName); D.Str(" in "); D.Str0(importedModule.name); D.Str(":"); D.Int(tag,1-sfMod1);  D.Ln;
						END;
					ELSE
						R.RawNum(typeAdr);
						type := attribute.indexToType.GetType(typeAdr);
						IF TraceImport IN Trace THEN
							D.Str("Type / Reimport "); D.Int(typeAdr,1); D.Str(" in "); D.Str0(importedModule.name); D.Str(":"); D.Int(tag,1-sfMod1);  D.Ln;
						END;
					END;
				ELSE (* UserType = [sfInvisible] [sfSysFlag flag] UserType2 *)
					IF TraceImport IN Trace THEN
						D.Str("Type / User "); D.Str(name); D.Ln
					END;
					thisIndex := numberTypes; INC(numberTypes);

					IF tag = sfInvisible THEN visibility := SyntaxTree.Internal;  R.RawNum(tag)  END;
					IF tag = sfHidden THEN visibility := SyntaxTree.Hidden; R.RawNum(tag) END;
					IF tag = sfSysFlag THEN R.RawNum(sysflag); R.RawNum(tag)  END;


					(* UserType2 *)
					typtag := tag;
					R.RawNum(tag);

					baseType := Type();
					R.RawString(name);

					CASE typtag OF
					| sfTypeOpenArray:
							IF TraceImport IN Trace THEN
								D.Str("Type / User / OpenArr "); D.Str(name); D.Ln
							END;
							ASSERT(baseType # NIL);
							arrayType := SyntaxTree.NewArrayType(Basic.invalidPosition,moduleScope,SyntaxTree.Open);
							arrayType.SetArrayBase(baseType);
							type := arrayType;
							R.RawNum(SYSTEM.VAL(LONGINT,flags));
							IF sfRealtime IN flags THEN type.SetRealtime(TRUE) END;
					| sfTypeStaticArray:
							IF TraceImport IN Trace THEN
								D.Str("Type / User / Array ");
								D.Int(len,1); D.Str(name); D.Ln
							END;
							ASSERT(baseType # NIL);
							arrayType :=SyntaxTree.NewArrayType(Basic.invalidPosition,moduleScope,SyntaxTree.Static);
							arrayType.SetArrayBase(baseType);
							type := arrayType;
							R.RawNum(SYSTEM.VAL(LONGINT,flags));
							IF sfRealtime IN flags THEN type.SetRealtime(TRUE) END;
							R.RawNum(len);
							size := SyntaxTree.NewIntegerValue(Basic.invalidPosition,len);
							size.SetType(system.longintType);
							arrayType.SetLength(size);
					| sfTypeOpenMathArray:
							IF TraceImport IN Trace THEN
								D.Str("Type / User / MathArray (open) "); D.Str(name); D.Ln
							END;
							ASSERT(baseType # NIL);
							mathArrayType := SyntaxTree.NewMathArrayType(Basic.invalidPosition,moduleScope,SyntaxTree.Open);
							mathArrayType.SetArrayBase(baseType);
							type := mathArrayType;
							R.RawNum(SYSTEM.VAL(LONGINT,flags));
							IF sfRealtime IN flags THEN type.SetRealtime(TRUE) END;
					| sfTypeTensor:
							IF TraceImport IN Trace THEN
								D.Str("Type / User / Tensor "); D.Str(name); D.Ln
							END;
							mathArrayType := SyntaxTree.NewMathArrayType(Basic.invalidPosition,moduleScope,SyntaxTree.Tensor);
							mathArrayType.SetArrayBase(baseType);
							type := mathArrayType;
							R.RawNum(SYSTEM.VAL(LONGINT,flags));
							IF sfRealtime IN flags THEN type.SetRealtime(TRUE) END;
					| sfTypeStaticMathArray:
							IF TraceImport IN Trace THEN
								D.Str("Type / User / MathArray (Static) ");
								D.Int(len,1); D.Str(name); D.Ln
							END;
							ASSERT(baseType # NIL);
							mathArrayType :=SyntaxTree.NewMathArrayType(Basic.invalidPosition,moduleScope,SyntaxTree.Static);
							mathArrayType.SetArrayBase(baseType);
							type := mathArrayType;
							R.RawNum(SYSTEM.VAL(LONGINT,flags));
							IF sfRealtime IN flags THEN type.SetRealtime(TRUE) END;
							R.RawNum(len);
							size := SyntaxTree.NewIntegerValue(Basic.invalidPosition,len);
							size.SetType(system.longintType);
							mathArrayType.SetLength(size);
					| sfTypePointer:
							IF TraceImport IN Trace THEN
								D.Str("Type / User / Pointer "); D.Str(name); D.Ln
							END;
							pointerType := SyntaxTree.NewPointerType(Basic.invalidPosition,moduleScope);
							type := pointerType;
							pointerType.SetPointerBase(baseType);
							R.RawNum(SYSTEM.VAL(LONGINT,flags));
							WITH type: SyntaxTree.PointerType DO
								IF sfUnsafe IN flags THEN type.SetUnsafe(TRUE) END;
								IF sfRealtime IN flags THEN type.SetRealtime(TRUE) END;
								IF sfDisposable IN flags THEN type.SetDisposable(TRUE) END;
							END;
					| sfTypeRecord:
							IF TraceImport IN Trace THEN
								D.Str("Type / User / Record "); D.Str(name); D.Ln
							END;
							recordScope := SyntaxTree.NewRecordScope(moduleScope);
							recordType := SyntaxTree.NewRecordType(Basic.invalidPosition,moduleScope,recordScope);
							type := recordType;
							R.RawNum(SYSTEM.VAL(LONGINT,flags));
							IF sfRealtime IN flags THEN type.SetRealtime(TRUE) END;
							Record(recordType,baseType);
					| sfTypeProcedure:
							IF TraceImport IN Trace THEN
								D.Str("Type / User / Proc "); D.Str(name); D.Ln
							END;
							procedureScope := SyntaxTree.NewProcedureScope(NIL);
							procedureType := SyntaxTree.NewProcedureType(Basic.invalidPosition,moduleScope);
							procedureType.SetReturnType(baseType);
							type := procedureType;

							IF sysflag = sfDelegate THEN procedureType.SetDelegate(TRUE)  END;

							R.RawNum(SYSTEM.VAL(LONGINT,flags));
							IF sfWinAPIParam IN flags THEN procedureType.SetCallingConvention(SyntaxTree.WinAPICallingConvention)
							ELSIF sfCParam IN flags THEN procedureType.SetCallingConvention(SyntaxTree.CCallingConvention)
							ELSIF sfDarwinCParam IN flags THEN procedureType.SetCallingConvention(SyntaxTree.DarwinCCallingConvention)
							END;
							IF sfRealtime IN flags THEN procedureType.SetRealtime(TRUE) END;

							ParameterList(callingConvention,procedureScope,procedureType);
					| sfTypeEnumeration:
							IF TraceImport IN Trace THEN
								D.Str("Type / User / Enumerator "); D.Str(name); D.Ln
							END;
							enumerationScope := SyntaxTree.NewEnumerationScope(moduleScope);
							enumerationType := SyntaxTree.NewEnumerationType(Basic.invalidPosition,moduleScope,enumerationScope);
							type := enumerationType;
							enumerationType.SetEnumerationBase(baseType);
							EnumerationList(enumerationScope);
					END;

					IF name # "" THEN
						typeDeclaration := SyntaxTree.NewTypeDeclaration(Basic.invalidPosition,SyntaxTree.NewIdentifier(name));
						typeDeclaration.SetDeclaredType(type);
						type.SetTypeDeclaration(typeDeclaration);
						typeDeclaration.SetAccess(visibility);
						typeDeclaration.SetState(SyntaxTree.Resolved);
						qualifiedType := SyntaxTree.NewQualifiedType(Basic.invalidPosition,moduleScope, SyntaxTree.NewQualifiedIdentifier(Basic.invalidPosition,SyntaxTree.invalidIdentifier,typeDeclaration.name));
						qualifiedType.SetResolved(type);
						type := qualifiedType;
						type.SetTypeDeclaration(typeDeclaration);

						module.moduleScope.AddTypeDeclaration(typeDeclaration);  (* do not replace module.moduleScope by parentScope ! *)
						module.moduleScope.EnterSymbol(typeDeclaration,b);
					END;

					allTypes.PutType(thisIndex,type);

					IF TraceImport IN Trace THEN
						D.Str("resolver.AddType "); D.Str(name); D.Str(" "); D.Int(thisIndex,1); D.Str("");
						D.Ln
					END;

				END;
				RETURN type;
			END Type;

			(*
				Inline = {len:Char {c:Char}} 0X
			*)
			PROCEDURE Inline(scope: SyntaxTree.ProcedureScope);
			VAR ch: CHAR;  pos, len: LONGINT; array: SyntaxTree.BinaryCode; newcode: SyntaxTree.Code;
				body: SyntaxTree.Body;

			PROCEDURE Append(ch: CHAR);
			BEGIN
				array.Resize(pos+8);
				array.SetBits(pos,8,ORD(ch));
				INC(pos,8);
			END Append;

			BEGIN
				NEW(array,128*8);
				R.Char(ch);pos := 0;
				REPEAT
					len := ORD(ch);
					WHILE len > 0 DO  R.Char(ch); Append(ch);  DEC(len)  END;
					R.Char(ch);
				UNTIL ch = 0X;
				body := SyntaxTree.NewBody(Basic.invalidPosition,scope);
				newcode := SyntaxTree.NewCode(Basic.invalidPosition,body);
				body.SetCode(newcode);
				scope.SetBody(body);
				newcode.SetBinaryCode(array);
			END Inline;

			(* Symbol = [sfObjFlag flag:RawNum] [sfReadOnly] Type name:RawString *)
			PROCEDURE Symbol(parentScope: SyntaxTree.Scope; VAR type: SyntaxTree.Type; VAR name: SyntaxTree.IdentifierString;  VAR visibility: SET; VAR untraced, realtime, constructor, operator, isDynamic, isFictive: BOOLEAN; VAR fictiveOffset: LONGINT);
			VAR  f,i: LONGINT;
			BEGIN
				IF TraceImport IN Trace THEN
					D.Str("Symbol: --> "); D.Ln
				END;
				untraced := FALSE; realtime := FALSE; constructor := FALSE; isDynamic := FALSE; isFictive := FALSE;
				visibility:=SyntaxTree.Public+SyntaxTree.Protected+SyntaxTree.Internal;
				WHILE tag=sfObjFlag DO
					R.RawNum(f);
					IF f = sfFictive THEN isFictive := TRUE;  untraced := TRUE; TRACE(fictiveOffset); R.RawNum(fictiveOffset); 
					ELSIF f = sfUntraced THEN untraced := TRUE
					ELSIF f = sfRealtime THEN realtime := TRUE
					ELSIF f = sfOperator THEN operator := TRUE;
					ELSIF f = sfDynamic THEN isDynamic := TRUE;
					ELSE D.Str("Object: unknown objflag"); D.Ln
					END;
					R.RawNum(tag);
				END;
				IF tag=sfReadOnly THEN  visibility := visibility * SyntaxTree.ReadOnly; R.RawNum(tag) END;
				type := Type();
				R.RawString(name);
				IF ~operator & (name[0] = "&") THEN
					constructor := TRUE;
					i := 0; REPEAT  name[i] := name[i+1]; INC(i)  UNTIL name[i] = 0X;
				END;
				IF name = "" THEN
					visibility := visibility * SyntaxTree.Internal;
				END;
				IF TraceImport IN Trace THEN
					D.Str("<-- "); D.Str(name); D.Ln
				END;

			END Symbol;

			(*
				SymbolFile =
				coeOptions:RawSet
				Imports
				[sfSysFlag sysFlags:Number]
				[sfConst {Symbol Value}]
				[sfVar {Symbol}]
				[sfXProcedure {Symbol ParameterList}]
				[sfOperator {Symbol ParameterList [sfInline Inline]}]
				[sfCProcedure {Symbol ParameterList Inline}]
				[sfAlias {Type name:RawString}]
				[sfType {Type}]
				sfEnd
			*)

			PROCEDURE Module;
			VAR flags: SET; untraced, realtime, constructor,operator, isDynamic, isFictive: BOOLEAN; callingConvention: LONGINT; fOffset: LONGINT;
			BEGIN
				R.RawSet(flags);

				Imports;

				R.RawNum(tag);
				flags := {};
				IF tag = sfSysFlag THEN
					R.RawNum(SYSTEM.VAL(LONGINT, flags));
					R.RawNum(tag);
				END;

				IF TraceImport IN Trace THEN  D.Str("importing constants"); D.Ln; END;
				IF tag=sfConst	THEN R.RawNum(tag);
					WHILE	(tag < sfVar) OR (tag > sfEnd) DO
						operator := FALSE;
						Symbol(moduleScope,type,name, visibility,untraced,realtime,constructor,operator, isDynamic, isFictive, fOffset);
						ASSERT(type # NIL);
						value := Value(type);
						constant := SyntaxTree.NewConstant(Basic.invalidPosition,SyntaxTree.NewIdentifier(name));
						constant.SetValue(value);
						constant.SetType(value.type);
						constant.SetAccess(visibility);
						constant.SetState(SyntaxTree.Resolved);
						moduleScope.AddConstant(constant);
						moduleScope.EnterSymbol(constant,b);
						R.RawNum(tag)
					END
				END;

				IF TraceImport IN Trace THEN  D.Str("importing variables"); D.Ln; END;
				IF	tag=sfVar	THEN	R.RawNum(tag);
					WHILE	(tag < sfXProcedure) OR (tag > sfEnd)	DO
						operator := FALSE;
						Symbol(moduleScope,type,name, visibility,untraced,realtime,constructor,operator, isDynamic,isFictive, fOffset);
						ASSERT(type # NIL);
						variable := SyntaxTree.NewVariable(Basic.invalidPosition,SyntaxTree.NewIdentifier(name));
						variable.SetType(type);
						variable.SetAccess(visibility);
						variable.SetState(SyntaxTree.Resolved);
						IF isFictive THEN
							TRACE(fOffset);
							variable.SetFictive(fOffset);
							variable.SetUntraced(TRUE);
						END;
						moduleScope.AddVariable(variable);
						moduleScope.EnterSymbol(variable,b);
						R.RawNum(tag)
					END
				END;

				IF TraceImport IN Trace THEN  D.Str("importing procedures"); D.Ln; END;
				IF	tag=sfXProcedure	THEN	R.RawNum(tag);
					WHILE	(tag < sfOperator) OR (tag > sfEnd)	DO
						operator := FALSE;
						Symbol(moduleScope,type,name, visibility,untraced,realtime,constructor,operator, isDynamic, isFictive, fOffset);
						ASSERT(~(constructor));
						procedureScope := SyntaxTree.NewProcedureScope(moduleScope);
						procedureType := SyntaxTree.NewProcedureType(Basic.invalidPosition,moduleScope);
						procedureType.SetReturnType(type);
						procedure := SyntaxTree.NewProcedure(Basic.invalidPosition,SyntaxTree.NewIdentifier(name),procedureScope);
						procedure.SetType(procedureType);
						procedure.SetAccess(visibility);
						ParameterList(callingConvention,procedureScope,procedureType);
						procedureType.SetRealtime(realtime);
						procedure.SetState(SyntaxTree.Resolved);
						procedure.SetConstructor(constructor);
						moduleScope.AddProcedure(procedure);
						moduleScope.EnterSymbol(procedure,b);
						R.RawNum(tag)
					END
				END;

				IF TraceImport IN Trace THEN  D.Str("importing operators"); D.Ln; END;
				IF	tag=sfOperator	THEN	R.RawNum(tag);
					WHILE	(tag < sfCProcedure) OR (tag > sfEnd)	DO
						operator := TRUE;
						Symbol(moduleScope,type,name, visibility,untraced,realtime,constructor,operator, isDynamic, isFictive, fOffset);
						ASSERT(~(constructor));
						procedureScope := SyntaxTree.NewProcedureScope(moduleScope);
						procedureType := SyntaxTree.NewProcedureType(Basic.invalidPosition,moduleScope);
						procedureType.SetReturnType(type);
						procedureType.SetRealtime(realtime);
						procedure := SyntaxTree.NewOperator(Basic.invalidPosition,SyntaxTree.NewIdentifier(name),procedureScope);
						procedure.SetType(procedureType);
						procedure.SetAccess(visibility);
						procedure(SyntaxTree.Operator).SetDynamic(isDynamic);
						ParameterList(callingConvention,procedureScope,procedureType);
						procedureType.SetCallingConvention(callingConvention);
						procedure.SetState(SyntaxTree.Resolved);
						module.moduleScope.AddProcedure(procedure);
						module.moduleScope.AddOperator(procedure(SyntaxTree.Operator));
						module.moduleScope.EnterSymbol(procedure,b);
						R.RawNum(tag);
						IF tag = sfInline THEN
							Inline(procedureScope);
							procedure.SetInline(TRUE);
							R.RawNum(tag);
						END;
					END
				END;
				IF TraceImport IN Trace THEN  D.Str("importing inline procedures"); D.Ln; END;
				IF  tag = sfCProcedure  THEN	R.RawNum(tag);
					WHILE	(tag < sfAlias) OR (tag > sfEnd)	DO
						operator := FALSE;
						Symbol(moduleScope,type,name, visibility,untraced, realtime, constructor,operator, isDynamic, isFictive, fOffset);
						ASSERT(~(constructor));
						procedureScope := SyntaxTree.NewProcedureScope(moduleScope);
						procedureType := SyntaxTree.NewProcedureType(Basic.invalidPosition,moduleScope);
						procedure := SyntaxTree.NewProcedure(Basic.invalidPosition,SyntaxTree.NewIdentifier(name),procedureScope);
						procedureType.SetReturnType(type);
						procedure.SetInline(TRUE);
						procedure.SetType(procedureType);
						procedure.SetAccess(visibility);
						ParameterList(callingConvention,procedureScope,procedureType);
						procedure.SetState(SyntaxTree.Resolved);
						module.moduleScope.AddProcedure(procedure);
						module.moduleScope.EnterSymbol(procedure,b);
						Inline(procedureScope);
						R.RawNum(tag);
					END
				END;
				IF TraceImport IN Trace THEN  D.Str("importing type declaration aliases"); D.Ln; END;
				IF	tag=sfAlias	THEN	R.RawNum(tag);
					WHILE	(tag < sfType) OR (tag > sfEnd)	DO
						type := Type();
						R.RawString(name);
						IF TraceImport IN Trace  THEN  D.Str("alias:"); D.Str(name); D.Ln  END;
						typeDeclaration := SyntaxTree.NewTypeDeclaration(Basic.invalidPosition,SyntaxTree.NewIdentifier(name));
						typeDeclaration.SetDeclaredType(type);
						visibility := SyntaxTree.Public+SyntaxTree.Protected+SyntaxTree.Internal;
						typeDeclaration.SetAccess(visibility);
						typeDeclaration.SetState(SyntaxTree.Resolved);
						IF ~(type IS SyntaxTree.BasicType) THEN
							type.SetTypeDeclaration(typeDeclaration);
						END;
						module.moduleScope.AddTypeDeclaration(typeDeclaration);
						module.moduleScope.EnterSymbol(typeDeclaration,b);
						R.RawNum(tag)
					END
				END;
				IF TraceImport IN Trace THEN  D.Str("importing type declaration"); D.Ln; END;
				IF	tag=sfType	THEN
					R.RawNum(tag);
					WHILE	tag # sfEnd	DO
						type := Type();
						R.RawNum(tag)
					END
				END;
			END Module;

		PROCEDURE InitBasic(type: SyntaxTree.Type; tag: LONGINT);
		BEGIN
			predefType[tag] := type;
		END InitBasic;

		PROCEDURE Init;
		BEGIN
			(*Built-In types*)
			InitBasic(system.booleanType,sfTypeBoolean);
			InitBasic(system.characterType,sfTypeChar8);
			InitBasic(Global.Character16,sfTypeChar16);
			InitBasic(Global.Character32,sfTypeChar32);
			InitBasic(system.shortintType, sfTypeShortint);
			InitBasic(system.integerType, sfTypeInteger);
			InitBasic(system.longintType, sfTypeLongint);
			InitBasic(system.hugeintType, sfTypeHugeint);
			InitBasic(Global.Unsigned8, sfTypeUnsigned8);
			InitBasic(Global.Unsigned16, sfTypeUnsigned16);
			InitBasic(Global.Unsigned32, sfTypeUnsigned32);
			InitBasic(Global.Unsigned64, sfTypeUnsigned64);
			InitBasic(Global.Float32, sfTypeReal);
			InitBasic(Global.Float64, sfTypeLongreal);
			InitBasic(system.setType, sfTypeSet);
			InitBasic(system.anyType, sfTypeAny);
			InitBasic(system.objectType, sfTypeObject);
			InitBasic(system.nilType, sfTypeNilType);
			InitBasic(NIL, sfTypeNoType);
			InitBasic(system.byteType, sfTypeByte);
			InitBasic(system.sizeType, sfTypeSize);
			InitBasic(system.addressType, sfTypeAddress);
		END Init;

		BEGIN
			Init;
			i := 0; numberTypes := 0; numberReimports := 0;
			COPY(moduleName,fileName);
			NEW(allTypes,32); NEW(indexToAttribute,32);
			ASSERT(fileName # "SYSTEM");

			IF ~OpenSymFile(fileName, path, extension, R, version) THEN (*! reintroduce flexible extension *)
				RETURN NIL
			END;

			IF TraceImport IN Trace THEN
				D.Str("BINARY SYMBOL FILE IMPORT "); D.Str(moduleName); D.Ln;
			END;

			(* as the context is not encoded in the symbol file, we have to deduce it from the filename, this is ugly but necessary
				to keep consistency with old compiler
			*)
			Global.ContextFromName(moduleName,moduleIdentifier,contextIdentifier);

			moduleScope := SyntaxTree.NewModuleScope();
			module:= SyntaxTree.NewModule(fileName,Basic.invalidPosition,moduleIdentifier,moduleScope,Scanner.Uppercase);
			module.SetContext(contextIdentifier);
			IF importCache = NIL THEN importCache := SyntaxTree.NewModuleScope(); END;

			Module;

			stamp := Kernel.GetTicks();
			NEW(resolver,system,SELF,importCache);
			resolver.Resolve(module,allTypes);
			module.SetState(SyntaxTree.Resolved);

			IF TraceImport IN Trace THEN
					D.Str("BINARY SYMBOL FILE IMPORT DONE "); D.Str(moduleName); D.Ln;
			END;
			(* if import error then module := NIL *)
			RETURN module
		END Import;

		PROCEDURE Export*(module: SyntaxTree.Module; importCache: SyntaxTree.ModuleScope): BOOLEAN;
		VAR w: Files.Writer; lookup: TypeToIndex; indexToAttribute: IndexToAttribute; numberType: LONGINT; flags: SET;


			(* Imports = {moduleName:RawString} 0X *)
			PROCEDURE Imports(import: SyntaxTree.Import);
			VAR name: SyntaxTree.IdentifierString;
			BEGIN
				WHILE import # NIL DO
					IF  ~Global.IsSystemModule(import.module) THEN
						Global.ModuleFileName(import.module.name,import.module.context,name);
						(*! maybe the context and module name should be stored as different names ? *)
						IF TraceExport IN Trace THEN
							D.Str("import: "); D.Str(name); D.Ln;
						END;
						w.RawString(name);
					END;
					import := import.nextImport;
				END;
				w.RawNum(0); (* end of imports *)
			END Imports;

			(* Value = [RawNum | RawHInt | RawReal | RawLReal | RawString] *)
			PROCEDURE Value(v: SyntaxTree.Value);
			VAR type: SyntaxTree.Type;
			BEGIN
				type := v.type.resolved;
				IF type IS SyntaxTree.BooleanType THEN w.RawNum(SYSTEM.VAL(SHORTINT,v(SyntaxTree.BooleanValue).value))
				ELSIF type IS SyntaxTree.CharacterType THEN w.RawNum(ORD(v(SyntaxTree.CharacterValue).value));
				(*
				ELSIF type = Global.Char16 THEN  w.RawNum(ORD(v(SyntaxTree.CharacterValue).value));
				ELSIF type = Global.Char32 THEN w.RawNum(ORD(v(SyntaxTree.CharacterValue).value));
				*)
				ELSIF type IS SyntaxTree.IntegerType THEN w.RawHInt(v(SyntaxTree.IntegerValue).value);
				ELSIF type IS SyntaxTree.SetType THEN   w.RawNum(SYSTEM.VAL(LONGINT,v(SyntaxTree.SetValue).value));
				ELSIF type IS SyntaxTree.FloatType THEN
					IF type.sizeInBits = 32 THEN w.RawReal(SHORT(v(SyntaxTree.RealValue).value));
					ELSE w.RawLReal(v(SyntaxTree.RealValue).value);
					END;
				ELSIF type IS SyntaxTree.StringType THEN  w.RawLInt(v(SyntaxTree.StringValue).length); w.RawString(v(SyntaxTree.StringValue).value^);
				ELSIF type IS SyntaxTree.NilType THEN
				ELSIF type IS SyntaxTree.ByteType THEN HALT(100)
				ELSIF type IS SyntaxTree.EnumerationType THEN w.RawHInt(v(SyntaxTree.EnumerationValue).value);
				ELSE HALT(200);
				END;
			END Value;

			(*
				Record =
					mode:RawNum priority:Char {variable:Symbol}
					[sfTProcedure {Symbol [name:RawString] ParameterList [sfInline Inline]} ]
					sfEnd
			*)
			PROCEDURE Record(record: SyntaxTree.RecordType);
			VAR scope: SyntaxTree.RecordScope; variable: SyntaxTree.Variable; procedure: SyntaxTree.Procedure; name: SyntaxTree.IdentifierString; flags,mode: SET;
				procedureType: SyntaxTree.ProcedureType; body: SyntaxTree.Body; first: BOOLEAN;
			BEGIN
				scope := record.recordScope;
				IF record.recordScope.bodyProcedure # NIL THEN
					body := record.recordScope.bodyProcedure.procedureScope.body;
					IF body.isActive THEN INCL(mode,sfActive) END;
					IF body.isSafe THEN INCL(mode,sfSafe) END;
				END;
				IF record.IsProtected() THEN INCL(mode,sfProtected) END;
				IF record.pointerType # NIL THEN INCL(mode,sfClass) END;
				w.RawNum(SYSTEM.VAL(LONGINT,mode));

				w.Char(0X); (*! record priority *)
				variable := scope.firstVariable;
				WHILE variable # NIL DO
					ASSERT(variable.type # NIL);
					Symbol(variable.type,variable.name,variable.access,variable.untraced,FALSE, FALSE, FALSE, FALSE, variable.fictive, variable.fictiveOffset);
					variable := variable.nextVariable;
				END;

				procedure := scope.firstProcedure;
				IF procedure # NIL THEN
					w.RawNum(sfTProcedure);
					WHILE procedure # NIL DO
						procedureType := procedure.type(SyntaxTree.ProcedureType);
						IF (procedure.access * SyntaxTree.Internal = procedure.access) THEN  (* not exported method *)
							Symbol(procedureType.returnType,procedure.name,procedure.access,FALSE, procedureType.isRealtime,procedure.isConstructor,procedure IS SyntaxTree.Operator, FALSE, FALSE, 0);
							procedure.GetName(name);
							w.RawString(name);
						ELSE (* exported method *)
							Symbol(procedureType.returnType,procedure.name,SyntaxTree.Public (*! for compatiblity should be procedure.access *),
							FALSE, procedureType.isRealtime,procedure.isConstructor, procedure IS SyntaxTree.Operator, FALSE, FALSE, 0
							);
						END;
						ParameterList(procedure.type(SyntaxTree.ProcedureType));
						(*! inline *)
						procedure := procedure.nextProcedure;
					END;
				END;
				w.RawNum(sfEnd);
			END Record;

			(* returns the index of module importedModule in the list of module module *)
			PROCEDURE ModuleIndex(module: SyntaxTree.Module; importedModule: SyntaxTree.Module): LONGINT;
			VAR import: SyntaxTree.Import; index: LONGINT;
			BEGIN import := module.moduleScope.firstImport;
				index := 0;
				WHILE (import # NIL) & (import.module # importedModule) DO
					IF (* (import.direct) & *)  ~Global.IsSystemModule(import.module) THEN INC(index) END;
					import := import.nextImport;
				END;
				ASSERT(import # NIL);
				RETURN index;
			END ModuleIndex;

			(*
				Type =
					TypeReference
					|BasicType
					|ImportedType
					|UserType.

				TypeReference = number:RawNum(<0)
				BasicType = sfTypeBoolean |  .. |  sfLastType.
				ImportedType = ModuleNumber (structName:RawString | 0X typeIndex:RawNum)
				ModuleNumber = sfMod1 | .. | sfModOther-1 | sfModOther moduleNumber:RawNum

				UserType = [sfInvisible] [sfSysFlag sysFlag:RawNum] UserType2
				UserType2=
					sfTypeOpenArray baseType:Type name:RawString flags:RawNum
					|sfTypeStaticArray baseType:Type name:RawString flags:RawNum length:RawNum
					|sfOpenMathArray baseType:Type name:RawString
					|sfStaticMathArray baseType:Type name:RawString length:RawNum
					|sfTypeTensor baseType:Type name:RawString
					|sfTypePointer baseType:Type name:RawString flags:RawNum
					|sfTypeRecord baseType:Type name:RawString flags:RawNum Record
					|sfTypeProcedure baseType:Type name:RawString flags:RawNum ParameterList
					|sfTypeEnumeration enumerationBase:Type name:RawString
			*)
			PROCEDURE Type(type: SyntaxTree.Type);
			VAR typeIndex,moduleIndex: LONGINT; name:SyntaxTree.IdentifierString; importedModule: SyntaxTree.Module; attribute: Attribute;
				baseType: SyntaxTree.Type; typeDeclaration : SyntaxTree.TypeDeclaration; flags: SET; size: LONGINT;
			BEGIN
				IF type = NIL THEN
					IF TraceExport IN Trace THEN
						D.Str("Type / Basic / NIL "); D.Ln
					END;
					w.RawNum(sfTypeNoType); RETURN
				END;

				type := type.resolved;
				typeDeclaration := type.typeDeclaration;
				IF (typeDeclaration # NIL) & (typeDeclaration.declaredType.resolved # type) THEN  typeDeclaration := NIL END;
				size := type.sizeInBits;
				IF type IS SyntaxTree.BasicType THEN (* BasicType  *)
					IF type IS SyntaxTree.BooleanType THEN w.RawNum(sfTypeBoolean);
					IF TraceExport IN Trace THEN
						D.Str("Type / Basic / Boolean "); D.Ln
					END;
					ELSIF type IS SyntaxTree.CharacterType THEN
						IF size = 8 THEN
							w.RawNum(sfTypeChar8);
							IF TraceExport IN Trace THEN
								D.Str("Type / Basic / Char8"); D.Ln
							END;
						ELSIF size = 16 THEN
							w.RawNum(sfTypeChar16);
							IF TraceExport IN Trace THEN
								D.Str("Type / Basic / Char16"); D.Ln
							END;
						ELSIF size = 32 THEN
							w.RawNum(sfTypeChar32);
							IF TraceExport IN Trace THEN
								D.Str("Type / Basic / Char32"); D.Ln
							END;
						END
					ELSIF type IS SyntaxTree.IntegerType THEN
						IF type(SyntaxTree.IntegerType).signed THEN
							IF size = 8 THEN
								w.RawNum(sfTypeShortint);
								IF TraceExport IN Trace THEN
									D.Str("Type / Basic / Shortint"); D.Ln
								END;
							ELSIF size = 16 THEN
								w.RawNum(sfTypeInteger);
								IF TraceExport IN Trace THEN
									D.Str("Type / Basic / Integer"); D.Ln
								END;
							ELSIF size = 32 THEN
								w.RawNum(sfTypeLongint);
								IF TraceExport IN Trace THEN
									D.Str("Type / Basic / Longint"); D.Ln
								END;
							ELSIF size = 64 THEN w.RawNum(sfTypeHugeint);
								IF TraceExport IN Trace THEN
									D.Str("Type / Basic / Hugeint"); D.Ln
								END;
							END;
						ELSE
							IF size = 8 THEN
								w.RawNum(sfTypeUnsigned8);
								IF TraceExport IN Trace THEN
									D.Str("Type / Basic / Unsigned8"); D.Ln
								END;
							ELSIF size = 16 THEN
								w.RawNum(sfTypeUnsigned16);
								IF TraceExport IN Trace THEN
									D.Str("Type / Basic / Unsigned16"); D.Ln
								END;
							ELSIF size = 32 THEN
								w.RawNum(sfTypeUnsigned32);
								IF TraceExport IN Trace THEN
									D.Str("Type / Basic / Unsigned32"); D.Ln
								END;
							ELSIF size = 64 THEN w.RawNum(sfTypeUnsigned64);
								IF TraceExport IN Trace THEN
									D.Str("Type / Basic / Unsigned64"); D.Ln
								END;
							END;
						END;
					ELSIF type IS SyntaxTree.FloatType THEN
						IF size = 32 THEN
							w.RawNum(sfTypeReal);
							IF TraceExport IN Trace THEN
								D.Str("Type / Basic / Real"); D.Ln
							END;
						ELSIF size = 64 THEN
							w.RawNum(sfTypeLongreal);
							IF TraceExport IN Trace THEN
								D.Str("Type / Basic / Longreal"); D.Ln
							END;
						END;

					ELSIF type IS SyntaxTree.ComplexType THEN
						IF size = 64 THEN
							w.RawNum(sfTypeComplex);
							IF TraceExport IN Trace THEN
								D.Str("Type / Basic / Complex"); D.Ln
							END;
						ELSIF size = 128 THEN
							w.RawNum(sfTypeLongcomplex);
							IF TraceExport IN Trace THEN
								D.Str("Type / Basic / Longcomplex"); D.Ln
							END;
						END;

					ELSIF type IS SyntaxTree.SetType THEN
						w.RawNum(sfTypeSet);
						IF TraceExport IN Trace THEN
							D.Str("Type / Basic / Set"); D.Ln
						END;
					ELSIF type IS SyntaxTree.NilType THEN w.RawNum(sfTypeNilType);
						IF TraceExport IN Trace THEN
							D.Str("Type / Basic / NilType"); D.Ln
						END;
					ELSIF type IS SyntaxTree.AnyType THEN w.RawNum(sfTypeAny);
						IF TraceExport IN Trace THEN
							D.Str("Type / Basic / Any"); D.Ln
						END;
					ELSIF type IS SyntaxTree.ObjectType THEN
						w.RawNum(sfTypeObject);
						IF TraceExport IN Trace THEN
							D.Str("Type / Basic / Object"); D.Ln
						END;
					ELSIF type IS SyntaxTree.ByteType THEN
						w.RawNum(sfTypeByte);
						IF TraceExport IN Trace THEN
							D.Str("Type / Basic / Byte"); D.Ln
						END;
					ELSIF type IS SyntaxTree.RangeType THEN w.RawNum(sfTypeRange);
						IF TraceExport IN Trace THEN
							D.Str("Type / Basic / Range"); D.Ln
						END;

					ELSIF type IS SyntaxTree.AddressType THEN w.RawNum(sfTypeAddress) (*! compatibility with PACO *)
					ELSIF type IS SyntaxTree.SizeType THEN w.RawNum(sfTypeSize)
					ELSE HALT(100)
					END;
				ELSIF type IS SyntaxTree.StringType THEN (* special case BasicType : StringType *)
					IF TraceExport IN Trace THEN
						D.Str("Type / String "); D.Ln
					END;
					w.RawNum(sfTypeString); (*! string length should be written here also *)
				ELSIF (typeDeclaration # NIL) & (typeDeclaration.scope # NIL) & (typeDeclaration.scope.ownerModule # module) THEN (* ImportedType *)
					(* imported, reexport:
						ImportedType = ModuleNumber (structName:RawString | 0X typeIndex:RawNum)
						ModuleNumber = sfMod1 | .. | sfModOther-1 | sfModOther moduleNumber:RawNum
					*)
					typeDeclaration.GetName(name);

					importedModule := typeDeclaration.scope.ownerModule;
					moduleIndex := ModuleIndex(module,importedModule);
					ASSERT(moduleIndex >= 0);

					IF moduleIndex >= sfModOther - sfMod1 THEN w.RawNum(sfModOther); w.RawNum(moduleIndex)
					ELSE w.RawNum(sfMod1 + moduleIndex)
					END;
					attribute := indexToAttribute.GetAttribute(moduleIndex);
					typeIndex := attribute.typeToIndex.GetIndex(type);

					IF TraceExport IN Trace THEN
						D.Str("Type / Reexport "); D.Str(name); D.Str(":"); D.Int(typeIndex,1); D.String(" in "); D.Str0(importedModule.name); D.String(":"); D.Int(moduleIndex,1);D.Ln
					END;
					IF typeIndex = Undef THEN (* not yet written import: structName:RawString *)
						type.typeDeclaration.GetName(name);
						w.RawString(name);
						attribute.typeToIndex.PutIndex(type,attribute.numberTypes); INC(attribute.numberTypes);
					ELSE (* previously written import: 0X typeIndex:RawNum *)
						w.Char(0X); w.RawNum(typeIndex);
					END;
				ELSE
					IF TraceExport IN Trace THEN
						D.Str("Type / User "); D.Ln
					END;
					typeIndex := lookup.GetIndex(type);

					IF typeIndex # Undef THEN (* already written: TypeReference = number:RawNum (<0)*)
						IF TraceExport IN Trace THEN
							D.Str("Type / User / AlreadyWritten "); D.Ln
						END;
						w.RawNum(-typeIndex)
					ELSE (* UserType *)
						IF TraceExport IN Trace THEN D.Str("Type / UserType "); D.Ln END;
						lookup.PutIndex(type,numberType); INC(numberType);

						name:="";
						IF  typeDeclaration#NIL THEN typeDeclaration.GetName(name);
							IF typeDeclaration.access  = SyntaxTree.Hidden THEN
								w.RawNum(sfHidden);
							ELSIF typeDeclaration.access* SyntaxTree.Public={} THEN
								w.RawNum(sfInvisible);
							END;
						END;

						flags := {};
						IF  type IS SyntaxTree.RecordType THEN
							IF TraceExport IN Trace THEN D.Str("Type / UserType / RecordType "); D.Str(name); D.Ln END;
							WITH type: SyntaxTree.RecordType DO
								w.RawNum(sfTypeRecord);
								baseType := type.baseType;
								Type(baseType);
								w.RawString(name);
								IF type.isRealtime THEN INCL(flags,sfRealtime) END;
								w.RawNum(SYSTEM.VAL(LONGINT,flags));
								Record(type)
							END
						ELSIF type IS SyntaxTree.PointerType THEN
							IF TraceExport IN Trace THEN D.Str("Type / UserType / PointerType "); D.Str(name); D.Ln END;
							w.RawNum(sfTypePointer);
							Type(type(SyntaxTree.PointerType).pointerBase);
							w.RawString(name);
							WITH type: SyntaxTree.PointerType DO
								IF type.isUnsafe THEN INCL(flags,sfUnsafe) END;
								IF type.isRealtime THEN INCL(flags,sfRealtime) END;
								IF type.isDisposable THEN INCL(flags,sfDisposable) END;
							END;
							w.RawNum(SYSTEM.VAL(LONGINT,flags));
						ELSIF type IS SyntaxTree.ArrayType THEN
							IF TraceExport IN Trace THEN D.Str("Type / UserType / ArrayType "); D.Str(name); D.Ln END;
							WITH type: SyntaxTree.ArrayType DO
								IF type.form = SyntaxTree.Open THEN
									w.RawNum(sfTypeOpenArray)
								ELSIF type.form = SyntaxTree.Static THEN
									w.RawNum(sfTypeStaticArray)
								ELSE HALT(100)
								END;
								Type(type.arrayBase);
								w.RawString(name);
								IF type.isRealtime THEN INCL(flags,sfRealtime) END;
								w.RawNum(SYSTEM.VAL(LONGINT,flags));
								IF type.form = SyntaxTree.Static THEN
									w.RawNum(type.staticLength);
								END;
							END;
						ELSIF type IS SyntaxTree.MathArrayType THEN
							IF TraceExport IN Trace THEN D.Str("Type / UserType / MathArrayType "); D.Str(name); D.Ln END;
							WITH type: SyntaxTree.MathArrayType DO
								IF type.form = SyntaxTree.Open THEN
									w.RawNum(sfTypeOpenMathArray)
								ELSIF type.form = SyntaxTree.Static THEN
									w.RawNum(sfTypeStaticMathArray)
								ELSIF type.form = SyntaxTree.Tensor THEN
									w.RawNum(sfTypeTensor)
								ELSE HALT(100)
								END;
								Type(type.arrayBase);
								w.RawString(name);
								IF type.isRealtime THEN INCL(flags,sfRealtime) END;
								w.RawNum(SYSTEM.VAL(LONGINT,flags));
								IF type.form = SyntaxTree.Static THEN
									w.RawNum(type.staticLength);
								END;
							END;
						ELSIF type IS SyntaxTree.ProcedureType THEN
							IF TraceExport IN Trace THEN D.Str("Type / UserType / ProcedureType"); D.Str(name); D.Ln END;
							WITH type: SyntaxTree.ProcedureType DO
								IF type.isDelegate THEN
									w.RawNum(sfSysFlag); w.RawNum(sfDelegate);
								END;
								w.RawNum(sfTypeProcedure);
								Type(type.returnType);
								w.RawString(name);

								IF type.callingConvention =  SyntaxTree.WinAPICallingConvention THEN
									INCL(flags,sfWinAPIParam);
								ELSIF  type.callingConvention =  SyntaxTree.CCallingConvention  THEN
									INCL(flags,sfCParam);
								ELSIF  type.callingConvention =  SyntaxTree.DarwinCCallingConvention  THEN
									INCL(flags,sfDarwinCParam);
								END;
								IF type.isRealtime THEN
									INCL(flags,sfRealtime)
								END;
								w.RawNum(SYSTEM.VAL(LONGINT,flags));

								ParameterList(type);
							END;
						ELSIF type IS SyntaxTree.EnumerationType THEN
							IF TraceExport IN Trace THEN D.Str("Type / UserType / EnumerationType"); D.Str(name); D.Ln END;
							WITH type: SyntaxTree.EnumerationType DO
								w.RawNum(sfTypeEnumeration);
								Type(type.enumerationBase);
								w.RawString(name);
								EnumerationList(type.enumerationScope);
							END;
						ELSE HALT(200)
						END;
					END;
				END;
			END Type;

			(*
			EnumerationList = {name:RawString} 0X;
			*)
			PROCEDURE EnumerationList(enumerationScope: SyntaxTree.EnumerationScope);
			VAR name: SyntaxTree.IdentifierString; enumerator: SyntaxTree.Constant;
			BEGIN
				enumerator := enumerationScope.firstConstant;
				WHILE enumerator # NIL DO
					enumerator.GetName(name);
					IF enumerator.access * SyntaxTree.Public = {} THEN
						w.RawString("@");
					ELSE
						w.RawString(name);
					END;
					Value(enumerator.value.resolved);
					enumerator := enumerator.nextConstant;
				END;
				w.RawString("");
			END EnumerationList;

			(* ParameterList =
				{ [sfObjFlag sfWinAPIParam | sfObjFlag sfCParam | sfObjFlag sfDarwinCParam] [sfVar] [sfReadOnly] Type name:RawString } sfEnd
			*)
			PROCEDURE ParameterList(procedureType: SyntaxTree.ProcedureType);
			VAR flags: SET; name: SyntaxTree.IdentifierString;
				PROCEDURE Parameters(parameter: SyntaxTree.Parameter; reverse: BOOLEAN);
				VAR procedureType: SyntaxTree.ProcedureType;
				BEGIN
					WHILE parameter # NIL DO
						(*! the calling convention should not be expressed via the parameters (compatiblity with old compiler) *)
						procedureType := parameter.ownerType(SyntaxTree.ProcedureType);
						IF  procedureType.callingConvention = SyntaxTree.WinAPICallingConvention THEN
							w.RawNum(sfObjFlag); w.RawNum(sfWinAPIParam);
						ELSIF procedureType.callingConvention = SyntaxTree.CCallingConvention THEN
							w.RawNum(sfObjFlag); w.RawNum(sfCParam);
						ELSIF procedureType.callingConvention = SyntaxTree.DarwinCCallingConvention THEN
							w.RawNum(sfObjFlag); w.RawNum(sfDarwinCParam);
						END;

						IF parameter.kind = SyntaxTree.VarParameter THEN
							w.RawNum(sfVar)
						ELSIF parameter.kind = SyntaxTree.ConstParameter THEN
							IF (parameter.type.resolved IS SyntaxTree.ArrayType) OR (parameter.type.resolved IS SyntaxTree.RecordType) THEN
								w.RawNum(sfVar);
							END; (* cf. FingerPrint.FPSignature *)
							w.RawNum(sfReadOnly);
						END;
						Type(parameter.type);
						parameter.GetName(name);
						w.RawString(name);
						IF reverse THEN
							parameter := parameter.prevParameter
						ELSE
							parameter := parameter.nextParameter
						END;
					END;
				END Parameters;

			BEGIN
				IF procedureType.callingConvention # SyntaxTree.OberonCallingConvention  THEN
					(*! if a procedure has a return type, then it has a return parameter (new)
					ASSERT(procedureType.returnParameter = NIL);
					*)
					Parameters(procedureType.lastParameter,TRUE);
				ELSE
					Parameters(procedureType.firstParameter,FALSE);
				END;
				w.RawNum(sfEnd);
			END ParameterList;

			PROCEDURE Inline(procedureScope: SyntaxTree.ProcedureScope);
			VAR len,count,pos: LONGINT; code: SyntaxTree.Code; ch: CHAR;
			BEGIN
				code := procedureScope.body.code;
				IF code.inlineCode # NIL THEN
					len := code.inlineCode.GetSize() DIV 8;
				ELSE
					len := 0
				END;
				count := 0; pos := 0;

				IF len = 0 THEN
					w.Char(0X);
				ELSE
					WHILE pos < len DO
						IF count = 0 THEN
							count := 255;
							IF len < 255 THEN count := len END;
							w.Char(CHR(count))
						END;
						ch := CHR(code.inlineCode.GetBits(pos*8,8));
						w.Char(ch);
						INC(pos); DEC(count)
					END;
				END;
				w.Char(0X);
			END Inline;

			(* Symbol =
				[sfObjFlag flag:RawNum] [sfReadOnly] Type Name
			*)
			PROCEDURE Symbol(type: SyntaxTree.Type; name: SyntaxTree.Identifier; visibility: SET;untraced, realtime, constructor, operator, isDynamic, isFictive: BOOLEAN; fOffset: LONGINT);
			VAR string,string2: SyntaxTree.IdentifierString;
			BEGIN
				IF TraceExport IN Trace THEN
					Basic.GetString(name,string);
					D.Str("Symbol "); D.Str(string); D.Ln;
				END;
				IF isFictive THEN w.RawNum(sfObjFlag); w.RawNum(sfFictive); TRACE(fOffset); w.RawNum(fOffset);
				ELSIF untraced THEN w.RawNum(sfObjFlag); w.RawNum(sfUntraced)
				ELSIF realtime  THEN w.RawNum(sfObjFlag); w.RawNum(sfRealtime)
				END;
				IF operator THEN w.RawNum(sfObjFlag); w.RawNum(sfOperator) END;
				IF isDynamic THEN w.RawNum(sfObjFlag); w.RawNum(sfDynamic) END;
				IF (SyntaxTree.PublicRead IN visibility) & ~(SyntaxTree.PublicWrite IN visibility) THEN
					w.RawNum(sfReadOnly);
				END;
				Type(type);
				IF visibility * SyntaxTree.Internal = visibility THEN
					string2 := "";
					IF constructor THEN string2 := "&" END;
				ELSE Basic.GetString(name,string);
					IF constructor THEN
						Basic.Concat(string2,"&",string,"");
					ELSE
						string2 := string
					END;
				END;
				w.RawString(string2);
			END Symbol;

			(*
				SymbolFile =
				flags:RawSet
				Imports
				[sfSysFlag flags:Number]
				[sfConst {Symbol Value}]
				[sfVar {Symbol}]
				[sfXProcedure {Symbol ParameterList}]
				[sfOperator {Symbol ParameterList [sfInline Inline]}]
				[sfCProcedure {Symbol ParameterList Inline}]
				[sfAlias {declaredType:Type Name}]
				[sfType {declaredType:Type}]
				sfEnd
			*)
			PROCEDURE Module(module: SyntaxTree.Module);
			VAR constant: SyntaxTree.Constant; name: SyntaxTree.IdentifierString; first: BOOLEAN;
				variable: SyntaxTree.Variable; typeDeclaration: SyntaxTree.TypeDeclaration; procedure: SyntaxTree.Procedure;
				procedureType: SyntaxTree.ProcedureType;
			BEGIN
				IF TraceExport IN Trace THEN
					module.GetName(name);
					D.Str("BINARY SYMBOL FILE EXPORT "); D.Str(name); D.Ln;
				END;

				w.RawSet({}); (* compilation flags *)

				(* overloading flags omitted *)

				(* import section: write names of imported modules *)
				Imports(module.moduleScope.firstImport);

				(* constants *)
				IF TraceExport IN Trace THEN
					D.Str("exporting constants "); D.Ln;
				END;
				first :=TRUE;
				constant := module.moduleScope.firstConstant;
				WHILE constant # NIL DO
					IF constant.access * SyntaxTree.Public # {} THEN
						IF first THEN w.RawNum(sfConst); first := FALSE END;
						Symbol(constant.type,constant.name,SyntaxTree.Public (*! for compatiblity should be constant.access *) ,FALSE,FALSE,FALSE,FALSE, FALSE, FALSE, 0);
						constant.GetName(name);
						Value(constant.value.resolved(SyntaxTree.Value))
					END;
					constant := constant.nextConstant;
				END;

				(* variables *)
				IF TraceExport IN Trace THEN
					D.Str("exporting variables "); D.Ln;
				END;
				first := TRUE;
				variable := module.moduleScope.firstVariable;
				WHILE variable # NIL DO
					IF variable.access * SyntaxTree.Public # {} THEN
						IF first THEN w.RawNum(sfVar); first := FALSE END;
						Symbol(variable.type,variable.name,variable.access,variable.untraced, FALSE, FALSE, FALSE, FALSE, variable.fictive, variable.fictiveOffset);
					END;
					variable := variable.nextVariable;
				END;

				(* procedures: normal *)
				IF TraceExport IN Trace THEN
					D.Str("exporting procedures "); D.Ln;
				END;
				first := TRUE;
				procedure := module.moduleScope.firstProcedure;
				WHILE procedure # NIL DO
					IF (procedure.access * SyntaxTree.Public # {}) & ~(procedure IS SyntaxTree.Operator)  THEN
						procedureType := procedure.type(SyntaxTree.ProcedureType);
						IF ~procedure.isInline  THEN
							IF first THEN w.RawNum(sfXProcedure); first := FALSE END;
							Symbol(procedureType.returnType,procedure.name,SyntaxTree.Public (*! for compatiblity should be procedure.access *),
							FALSE, procedureType.isRealtime, procedure.isConstructor, FALSE, FALSE, FALSE, 0);
							ParameterList(procedureType);
						END;
					END;
					procedure := procedure.nextProcedure;
				END;

				(* procedures: operators *)
				IF TraceExport IN Trace THEN
					D.Str("exporting operators"); D.Ln;
				END;
				first := TRUE;
				procedure := module.moduleScope.firstProcedure;
				WHILE procedure # NIL DO
					IF (procedure.access * SyntaxTree.Public # {}) & (procedure IS SyntaxTree.Operator)  THEN
						procedureType := procedure.type(SyntaxTree.ProcedureType);
						IF first THEN w.RawNum(sfOperator); first := FALSE END;
						Symbol(procedureType.returnType,procedure.name,SyntaxTree.Public (*! for compatiblity should be procedure.access *),
						FALSE, procedure.isInline, procedure.isConstructor, FALSE, procedure(SyntaxTree.Operator).isDynamic, FALSE, 0);
						ParameterList(procedureType);
						IF procedure.isInline THEN
							w.RawNum(sfInline); Inline(procedure.procedureScope);
						END;
					END;
					procedure := procedure.nextProcedure;
				END;

				(* procedures: inline *)
				IF TraceExport IN Trace THEN
					D.Str("exporting inline procedures"); D.Ln;
				END;
				first := TRUE;
				procedure := module.moduleScope.firstProcedure;
				WHILE procedure # NIL DO
					IF (procedure.access * SyntaxTree.Public # {}) & ~(procedure IS SyntaxTree.Operator)  THEN
						procedureType := procedure.type(SyntaxTree.ProcedureType);
						IF procedure.isInline THEN
							IF first THEN w.RawNum(sfCProcedure); first := FALSE END;
							Symbol(procedureType.returnType,procedure.name,SyntaxTree.Public (*! for compatiblity should be procedure.access *),
							FALSE, procedure.isInline, procedure.isConstructor, FALSE, FALSE, FALSE, 0);
							ParameterList(procedureType);
							Inline(procedure.procedureScope);
						END;
					END;
					procedure := procedure.nextProcedure;
				END;

				(* type declarations: aliases *)
				IF TraceExport IN Trace THEN
					D.Str("exporting type declarations aliases"); D.Ln;
				END;
				first := TRUE;
				typeDeclaration := module.moduleScope.firstTypeDeclaration;
				WHILE typeDeclaration # NIL DO
					IF typeDeclaration.access * SyntaxTree.Public # {} THEN
						IF typeDeclaration.declaredType IS SyntaxTree.QualifiedType THEN
							IF first THEN w.RawNum(sfAlias); first := FALSE END;
							Type(typeDeclaration.declaredType);
							typeDeclaration.GetName(name);
							w.RawString(name);
						END;
					END;
					typeDeclaration := typeDeclaration.nextTypeDeclaration;
				END;

				(* type declarations: declarations *)
				IF TraceExport IN Trace THEN
					D.Str("exporting type declarations"); D.Ln;
				END;
				first := TRUE;
				typeDeclaration := module.moduleScope.firstTypeDeclaration;
				WHILE typeDeclaration # NIL DO
					IF typeDeclaration.access * SyntaxTree.Public # {} THEN
						IF ~(typeDeclaration.declaredType IS SyntaxTree.QualifiedType) THEN
							IF first THEN w.RawNum(sfType); first := FALSE END;
							Type(typeDeclaration.declaredType);
						END;
					END;
					typeDeclaration := typeDeclaration.nextTypeDeclaration;
				END;

				IF TraceExport IN Trace THEN
					module.GetName(name);
					D.Str("BINARY SYMBOL FILE EXPORT DONE "); D.Str(name); D.Ln;
				END;

				w.RawNum(sfEnd);
			END Module;

		BEGIN
			file := Files.New("");

			IF ~noInterfaceCheck THEN
				InterfaceComparison.CompareThis(module,SELF,diagnostics,importCache,flags);

				IF noRedefinition OR noModification THEN
					IF (InterfaceComparison.Redefined IN flags) THEN
						Basic.Error(diagnostics, module.sourceName, Basic.invalidPosition, " no redefinition of symbol file allowed");
						RETURN FALSE;
					END;
				END;
				IF noModification THEN
					IF (InterfaceComparison.Extended IN flags) THEN
						Basic.Error(diagnostics, module.sourceName,Basic.invalidPosition, " no extension of symbol file allowed");
						RETURN FALSE;
					END;
				END;
			END;

			NEW(w,file,0);
			NEW(lookup,100); NEW(indexToAttribute,16);
			numberType := 0;
			Module(module);
			w.Update();
			Files.Register(file);
			RETURN TRUE
		END Export;


		PROCEDURE DefineOptions*(options: Options.Options);
		BEGIN
			options.Add(0X,"symbolFileExtension",Options.String);
			options.Add(0X,"noRedefinition",Options.Flag);
			options.Add(0X,"noModification",Options.Flag);
			options.Add(0X,"noInterfaceCheck",Options.Flag);
		END DefineOptions;

		PROCEDURE GetOptions*(options: Options.Options);
		BEGIN
			IF ~options.GetString("symbolFileExtension",extension) THEN
				extension := Machine.DefaultObjectFileExtension
			END;
			noRedefinition := options.GetFlag("noRedefinition");
			noModification := options.GetFlag("noModification");
			noInterfaceCheck := options.GetFlag("noInterfaceCheck");
		END GetOptions;

	END BinarySymbolFile;

	VAR


	(* move to basic *)
	PROCEDURE MakeFileName(VAR file: ARRAY OF CHAR; CONST name, prefix, suffix: ARRAY OF CHAR);
	VAR i, j: LONGINT;
	BEGIN
		i := 0; WHILE prefix[i] # 0X DO  file[i] := prefix[i];  INC(i)  END;
		j := 0; WHILE name[j] # 0X DO  file[i+j] := name[j];  INC(j)  END;
		INC(i, j);
		j := 0; WHILE suffix[j] # 0X DO file[i+j] := suffix[j]; INC(j)  END;
		file[i+j] := 0X;
	END MakeFileName;

	(** OpenSymFile - Open a symfile for reading *)

	PROCEDURE OpenSymFile(CONST name,prefix,suffix: ARRAY OF CHAR;  VAR r: Streams.Reader; VAR version: CHAR): BOOLEAN;
		VAR res: BOOLEAN;  file: Files.FileName;  f: Files.File; R: Files.Reader; dummy: LONGINT; ch: CHAR;
	BEGIN
		res := FALSE;
		MakeFileName(file, name, prefix, suffix);
		f := Files.Old(file);
		IF f # NIL THEN
			NEW(R,f,0);
			r := R;
			r.Char(ch);
			IF ch = FileTag THEN
				r.Char(version);
				ASSERT(version = NoZeroCompress); r.Char(version);
				IF version = FileVersion THEN
					r.RawNum(dummy);	(*skip symfile size*)
				ELSIF (version >= FileVersionOC) & (version <= FileVersionCurrent) THEN
					r.RawLInt(dummy); (* new in OC: symbol file size uncompressed *)
				ELSE
					HALT(100)
				END;
				res := TRUE
			END
		END;
		RETURN res
	END OpenSymFile;



PROCEDURE Get*(): Formats.SymbolFileFormat;
VAR symbolFileFormat: BinarySymbolFile;
BEGIN
	NEW(symbolFileFormat); symbolFileFormat.file := Files.New("");  RETURN symbolFileFormat
END Get;


PROCEDURE Test*(context: Commands.Context);
VAR moduleName: SyntaxTree.IdentifierString; module: SyntaxTree.Module;
		log2: Basic.Writer; time: LONGINT;
		p: Printout.Printer;
		symbolFileFormat: BinarySymbolFile;
		options: Options.Options;
		extension: Basic.FileName;
BEGIN
	NEW(options);
		NEW(symbolFileFormat);
		symbolFileFormat.DefineOptions(options);
	IF options.Parse(context.arg,context.error) THEN
		symbolFileFormat.GetOptions(options);
		context.arg.SkipWhitespace; context.arg.String(moduleName);
		time := Kernel.GetTicks();
		symbolFileFormat.Initialize(NIL,Global.DefaultSystem(),"");
		module := symbolFileFormat.Import(moduleName,NIL);
		time := Kernel.GetTicks()-time;
		D.Str("importer elapsed ms: "); D.Int(time,10); D.Ln;
		D.Update;

		log2 := Basic.GetWriter(Basic.GetDebugWriter("SymbolFile"));
		p := Printout.NewPrinter(log2,Printout.SymbolFile,FALSE);
		log2.String("Interface of "); log2.String(moduleName); log2.Ln;
		log2.Ln;

		p.Module(module);
		log2.Ln;
		log2.Ln;
		log2.String(" -------------------------------------------------------------- "); log2.Ln;
		log2.Ln;
		log2.Ln;

		p := Printout.NewPrinter(log2,Printout.All,TRUE);
		p.Module(module);
		log2.Update;
	END;
END Test;


END FoxBinarySymbolFile.


SystemTools.Free FoxBinarySymbolFile ~
FoxBinarySymbolFile.Test  Visualizer   ~

Compiler.Compile -PCtp Visualizer.Sym ~

FoxBinarySymbolFile.Test  Oberon.Oberon   ~
FoxBinarySymbolFile.Test   --symbolFileExtension=".Obw" Dump    ~