Moved TRM backend from OC to A2 trunk.

git-svn-id: https://svn.inf.ethz.ch/svn/lecturers/a2/trunk@6328 8c9fc860-2736-0410-a75d-ab315db34111

source/FoxIntermediateLinker.Mod

@@ -0,0 +1,971 @@
+MODULE FoxIntermediateLinker;
+IMPORT
+	Strings, Diagnostics, D := Debugging, SyntaxTree := FoxSyntaxTree, Sections := FoxSections,
+	IntermediateCode := FoxIntermediateCode, Basic := FoxBasic, Streams, Files, Backend := FoxBackend,
+	Global := FoxGlobal, Formats := FoxFormats, ActiveCells := FoxActiveCells,
+	ObjectFile, BinaryCode := FoxBinaryCode, GenericLinker, StaticLinker, Commands, Options, IRObjectFile := FoxIntermediateObjectFile;
+
+CONST
+	TraceLinking = FALSE;
+	DefaultBackend = "AMD";
+
+TYPE
+	FileName = ARRAY 256 OF CHAR;
+	MessageString= ARRAY 256 OF CHAR;
+	SectionName = ARRAY 256 OF CHAR; (*! move *)
+
+	(** the assemblinker **)
+	Linker = OBJECT
+	CONST
+		Trace = FALSE;
+		RequireSortedSections = FALSE; (* whether the sections in the generated modules are sorted w.r.t. their fixed positions *)
+	TYPE
+		ArrangementRestriction = RECORD
+			fixed: BOOLEAN;
+			positionOrAlignment: LONGINT;
+		END;
+	VAR
+		backend-: Backend.Backend;
+		diagnostics: Diagnostics.Diagnostics;
+		platformName, irFilePath: SyntaxTree.IdentifierString;
+		importList, loadedModules: Sections.NameList;
+		allSections: Sections.SectionList;
+		isSorted, alreadyPrearrangedSinceLastSort: BOOLEAN;
+		originalRestrictions: POINTER TO ARRAY OF ArrangementRestriction;
+		objectFile: IRObjectFile.ObjectFileFormat;
+
+		PROCEDURE & Init(diagnostics: Diagnostics.Diagnostics; defaultBackend: Backend.Backend; irFilePath: SyntaxTree.IdentifierString);
+		BEGIN
+			IF diagnostics = NIL THEN
+				SELF.diagnostics := Basic.GetDefaultDiagnostics()
+			ELSE
+				SELF.diagnostics := diagnostics;
+			END;
+			SELF.irFilePath := irFilePath;
+			backend := defaultBackend;
+			defaultBackend.GetDescription(platformName);
+			NEW(allSections);
+			NEW(importList, 128);
+			NEW(loadedModules, 128);
+			NEW(objectFile); objectFile.Initialize(diagnostics,"");
+			isSorted := FALSE
+		END Init;
+
+		PROCEDURE PatchStackSize(CONST typeName: SectionName; size: LONGINT);
+		VAR sectionName: SectionName; section: Sections.Section; pooledName: Basic.SegmentedName; op1, op2, op3: IntermediateCode.Operand; instruction: IntermediateCode.Instruction;
+		BEGIN
+			TRACE(size);
+			COPY(typeName, sectionName);
+			Strings.Append(sectionName,".@StackAllocation");
+			Basic.ToSegmentedName(sectionName, pooledName);
+			section := allSections.FindByName(pooledName);
+			instruction := section(IntermediateCode.Section).instructions[0];
+			op1 := instruction.op1;
+			op2 := instruction.op2;
+			op3 := instruction.op3;
+			IntermediateCode.SetIntValue(op2, size);
+			section(IntermediateCode.Section).PatchOperands(0, op1, op2, op3);
+		END PatchStackSize;
+
+
+		PROCEDURE LoadModule(CONST moduleFileName: ARRAY OF CHAR; recursive: BOOLEAN): BOOLEAN;
+		VAR
+			filename, moduleName: SyntaxTree.IdentifierString;
+			msg: ARRAY 128 OF CHAR;
+			i: LONGINT;
+			module: Sections.Module;
+			name: SyntaxTree.IdentifierString;
+		BEGIN
+			FileNameToModuleName(moduleFileName, moduleName);
+			(* check if the module has already been incorporated *)
+			IF loadedModules.ContainsName(moduleName) THEN
+				IF Trace THEN D.String(">>> module "); D.String(moduleName); D.String(" has already been loaded"); D.Ln END;
+				RETURN TRUE
+			ELSE
+				IF moduleName = "SYSTEM" THEN
+					(* nothing to do *)
+				ELSE
+					(* open corresponding intermediate code file *)
+					module := objectFile.Import(moduleName, backend.GetSystem());
+					IF module = NIL THEN
+						msg := "failed to import IR file ";
+						Strings.Append(msg, moduleFileName);
+						diagnostics.Error(filename, Diagnostics.Invalid, Diagnostics.Invalid, msg);
+						RETURN FALSE
+					ELSE
+						loadedModules.AddName(moduleName); (* to avoid recursive reloading this must be done before parsing *)
+						IF recursive THEN
+							FOR i := 0 TO module.imports.Length()-1 DO
+								name := module.imports.GetName(i);
+								IF  ~LoadModule(name, recursive) THEN
+									msg := "failed to import ";
+									Strings.Append(msg, name);
+									diagnostics.Error(filename, Diagnostics.Invalid, Diagnostics.Invalid, msg);
+									RETURN FALSE
+								END;
+							END;
+						END;
+						CopySections(module.allSections, allSections);
+
+						IF Trace THEN
+							D.String(">>> IR file successfully parsed: "); D.String(filename); D.Ln;
+							DumpSections(D.Log, allSections);
+						END;
+						isSorted := FALSE; (* sections are not sorted anymore *)
+
+						RETURN TRUE
+					END
+				END;
+				RETURN TRUE
+			END
+		END LoadModule;
+
+		(** mark a section with a certain name as reachable **)
+		PROCEDURE MarkAsReachableByName(CONST name: ARRAY OF CHAR);
+		VAR
+			section: Sections.Section;
+			pooledName: Basic.SegmentedName;
+		BEGIN
+			Basic.ToSegmentedName(name, pooledName);
+			section:= allSections.FindByName(pooledName);
+			ASSERT(section # NIL);
+			MarkAsReachable(section)
+		END MarkAsReachableByName;
+
+		(** mark all sections whose names start with a certain prefix as reachable **)
+		PROCEDURE MarkAsReachableStartingWith(CONST prefix: Basic.SegmentedName; allowedSections: SET);
+		VAR
+			section: Sections.Section; name: Basic.SegmentedName;
+			i: LONGINT;
+		BEGIN
+			(* TODO: could or should one make this faster using a hash table? *)
+			(* go through all sections *)
+			FOR i := 0 TO allSections.Length() - 1 DO
+				section := allSections.GetSection(i);
+				IF section.type IN allowedSections THEN
+					IF Basic.IsPrefix(prefix, section.name) THEN
+						name := section.name;
+						Basic.RemoveSuffix(name);
+						IF prefix = name THEN
+							MarkAsReachable(section)
+						END
+					END
+				END;
+			END
+		END MarkAsReachableStartingWith;
+
+		PROCEDURE ModuleIsReachable(CONST name: Basic.String): BOOLEAN;
+		VAR i: LONGINT; section: Sections.Section;
+		BEGIN
+			FOR i := 0 TO allSections.Length()-1 DO
+				section := allSections.GetSection(i);
+				IF (section.name[0] = name) & section.isReachable THEN
+					RETURN TRUE
+				END;
+			END;
+			RETURN FALSE
+		END ModuleIsReachable;
+
+		PROCEDURE OperandSection(CONST operand: IntermediateCode.Operand): Sections.Section;
+		VAR section: Sections.Section;
+		BEGIN
+			section := allSections.FindByName(operand.symbol.name);
+			IF section = NIL THEN D.String("not found section: "); Basic.WriteSegmentedName(D.Log, operand.symbol.name); D.Ln END;
+			RETURN allSections.FindByName(operand.symbol.name);
+		END OperandSection;
+
+		(** mark a section as reachable and do the same recursively for all referenced sections **)
+		PROCEDURE MarkAsReachable(section: Sections.Section);
+		VAR
+			intermediateCodeSection: IntermediateCode.Section;
+			i: LONGINT;
+			procedureName, moduleName: SyntaxTree.IdentifierString;
+			prefix: Basic.SegmentedName;
+		BEGIN
+			IF ~section.isReachable THEN
+				IF Trace THEN D.String(">>> MarkAsReachable "); Basic.WriteSegmentedName(D.Log, section.name); D.Ln END;
+				section.SetReachability(TRUE);
+				prefix := section.name; Basic.RemoveSuffix(prefix);
+				MarkAsReachableStartingWith(prefix, {Sections.InitCodeSection});
+				ASSERT(section IS IntermediateCode.Section);
+				intermediateCodeSection := section(IntermediateCode.Section);
+				(* go through all instructions in the section *)
+				FOR i := 0 TO intermediateCodeSection.pc - 1 DO
+					IF  ~backend(IntermediateCode.IntermediateBackend).SupportedInstruction(intermediateCodeSection.instructions[i], moduleName, procedureName) THEN
+						Strings.Append(moduleName,".");
+						Strings.Append(moduleName, procedureName);
+						MarkAsReachableByName(moduleName);
+					END;
+					IF intermediateCodeSection.instructions[i].op1.symbol.name # "" THEN MarkAsReachable(OperandSection(intermediateCodeSection.instructions[i].op1)) END;
+					IF intermediateCodeSection.instructions[i].op2.symbol.name # "" THEN MarkAsReachable(OperandSection(intermediateCodeSection.instructions[i].op2)) END;
+					IF intermediateCodeSection.instructions[i].op3.symbol.name # "" THEN MarkAsReachable(OperandSection(intermediateCodeSection.instructions[i].op3)) END
+				END
+			END
+		END MarkAsReachable;
+
+		(** mark all sections as either reachable or unreachable **)
+		PROCEDURE MarkReachabilityOfAll(isReachable: BOOLEAN);
+		VAR
+			section: Sections.Section;
+			i: LONGINT;
+		BEGIN
+			IF Trace THEN D.String(">>> MarkReachabilityOfAll "); IF isReachable THEN D.String("TRUE") ELSE D.String("FALSE") END; D.Ln END;
+			FOR i := 0 TO allSections.Length() - 1 DO
+				section := allSections.GetSection(i);
+				section.SetReachability(isReachable)
+			END
+		END MarkReachabilityOfAll;
+
+		(** dump all sections (both reachable and not) **)
+		PROCEDURE DumpSections(writer: Streams.Writer; sections: Sections.SectionList);
+		VAR
+			section: Sections.Section;
+			i: LONGINT;
+		BEGIN
+			FOR i := 0 TO sections.Length() - 1 DO
+				section := sections.GetSection(i);
+				IF section.isReachable THEN
+					writer.String("REACHABLE ")
+				ELSE
+					writer.String("unreachable ")
+				END;
+				section.Dump(writer)
+			END;
+			writer.Update
+		END DumpSections;
+
+		(** store the original arrangment restrictions of all sections **)
+		PROCEDURE StoreOriginalRestrictions;
+		VAR
+			section: Sections.Section;
+			i: LONGINT;
+		BEGIN
+			NEW(originalRestrictions, allSections.Length());
+			FOR i := 0 TO allSections.Length() - 1 DO
+				section := allSections.GetSection(i);
+				originalRestrictions[i].fixed := section.fixed;
+				originalRestrictions[i].positionOrAlignment := section.positionOrAlignment
+			END
+		END StoreOriginalRestrictions;
+
+		(** restore the original arrangment restrictions of all sections **)
+		PROCEDURE RestoreOriginalRestrictions;
+		VAR
+			section: Sections.Section;
+			i: LONGINT;
+		BEGIN
+			ASSERT(LEN(originalRestrictions) = allSections.Length());
+			FOR i := 0 TO allSections.Length() - 1 DO
+				section := allSections.GetSection(i);
+				section.SetPositionOrAlignment(originalRestrictions[i].fixed, originalRestrictions[i].positionOrAlignment)
+			END
+		END RestoreOriginalRestrictions;
+
+		PROCEDURE PrearrangeReachableDataSections;
+		VAR
+			fixedDataSections, flexibleDataSections: Sections.SectionList;
+			section, fixedDataSection, flexibleDataSection: Sections.Section;
+			i, currentAddress, nextOccupiedAddress, flexibleDataSectionIndex, fixedDataSectionIndex, startAddress, endAddress: LONGINT;
+			done: BOOLEAN;
+		BEGIN
+			(* sort sections if necessary *)
+			IF ~isSorted THEN
+				IF Trace THEN D.String("++++++++++ before sorting ++++++++++"); DumpSections(D.Log, allSections) END;
+				FOR i:= 0 TO allSections.Length() - 1 DO
+					allSections.GetSection(i).SetOffset(i)
+				END;
+				allSections.Sort(SectionPositionAndSizeComparison);
+				IF Trace THEN D.String("++++++++++ after sorting ++++++++++"); DumpSections(D.Log, allSections) END;
+				isSorted := TRUE;
+				alreadyPrearrangedSinceLastSort := FALSE
+			END;
+			ASSERT(isSorted);
+			IF alreadyPrearrangedSinceLastSort THEN RestoreOriginalRestrictions ELSE StoreOriginalRestrictions END;
+
+			IF Trace THEN D.String("before prearrangement"); D.Ln; DumpSections(D.Log, allSections); D.Ln END;
+
+			(* create new lists for reachable data sections that are fixed or flexible, respectively *)
+			NEW(fixedDataSections);
+			NEW(flexibleDataSections);
+
+			(* go through all reachable data sections, and put them into one of two lists *)
+			FOR i:= 0 TO allSections.Length() - 1 DO
+				section := allSections.GetSection(i);
+				IF section.isReachable & ((section.type = Sections.ConstSection) OR (section.type = Sections.VarSection)) THEN
+					IF section.fixed THEN
+						fixedDataSections.AddSection(section)
+					ELSE
+						flexibleDataSections.AddSection(section)
+					END
+				END
+			END;
+
+			IF Trace THEN
+				D.String("++++++++++ reachable fixed data sections ++++++++++"); fixedDataSections.Dump(D.Log); D.Ln;
+				D.String("++++++++++ reachable flexible data sections ++++++++++"); flexibleDataSections.Dump(D.Log); D.Ln;
+			END;
+
+			(* arrange the sections (i.e. set the fixed attribute) such that the given fixed-positions and alignments are respected *)
+			currentAddress := 0;
+			flexibleDataSectionIndex := 0;
+			(* go through all fixed data sections of the cell *)
+			FOR fixedDataSectionIndex := 0 TO fixedDataSections.Length() DO (* note: the index may be out-of-bounds! *)
+				IF fixedDataSectionIndex < fixedDataSections.Length() THEN
+					fixedDataSection := fixedDataSections.GetSection(fixedDataSectionIndex);
+					ASSERT(fixedDataSection.fixed);
+					nextOccupiedAddress := fixedDataSection.positionOrAlignment
+				ELSE
+					(* there is no more fixed data section *)
+					nextOccupiedAddress := MAX(LONGINT)
+				END;
+
+				done := FALSE;
+				WHILE ~done DO
+					IF flexibleDataSectionIndex < flexibleDataSections.Length() THEN
+						flexibleDataSection := flexibleDataSections.GetSection(flexibleDataSectionIndex);
+
+						(* determine start-address of the next section (respect alignment) *)
+						IF flexibleDataSection.IsAligned() & ((currentAddress MOD flexibleDataSection.positionOrAlignment) # 0) THEN
+							startAddress := currentAddress + flexibleDataSection.positionOrAlignment - (currentAddress MOD flexibleDataSection.positionOrAlignment)
+						ELSE
+							startAddress := currentAddress
+						END;
+
+						(* determine end-address fo the next section *)
+						endAddress := startAddress + flexibleDataSection.GetSize();
+
+						IF endAddress <= nextOccupiedAddress THEN
+							(* there is enough space for the section *)
+							flexibleDataSection.SetPositionOrAlignment(TRUE, startAddress); (* position is set for section *)
+							INC(flexibleDataSectionIndex);
+							currentAddress := endAddress
+						ELSE
+							(* there is no more space for sections *)
+							done := TRUE
+						END
+					ELSE
+						(* there are no more flexible data sections *)
+						done := TRUE
+					END
+				END;
+
+				IF fixedDataSectionIndex < fixedDataSections.Length() THEN
+					ASSERT(fixedDataSection.GetSize() # Sections.UnknownSize);
+					currentAddress := fixedDataSection.positionOrAlignment + fixedDataSection.GetSize()
+				END
+			END;
+
+			alreadyPrearrangedSinceLastSort := TRUE;
+
+			IF Trace THEN D.String("after prearrangement"); D.Ln; DumpSections(D.Log, allSections); D.Ln END;
+		END PrearrangeReachableDataSections;
+
+		PROCEDURE PatchValueInSection*(CONST sectionName: Basic.SegmentedName; syntaxTreeValue: SyntaxTree.Value);
+		VAR
+			section: Sections.Section;
+			emptyOperand, dataOperand: IntermediateCode.Operand;
+			dataInstruction: IntermediateCode.Instruction;
+			hugeintValue: HUGEINT;
+		BEGIN
+			section := allSections.FindByName(sectionName);
+			ASSERT(section # NIL);
+
+			IF syntaxTreeValue IS SyntaxTree.BooleanValue THEN
+				(* BOOLEAN *)
+				IF syntaxTreeValue(SyntaxTree.BooleanValue).value THEN hugeintValue := 1 ELSE hugeintValue := 0 END
+			ELSIF syntaxTreeValue IS SyntaxTree.IntegerValue THEN
+				(* INTEGER *)
+				hugeintValue := syntaxTreeValue(SyntaxTree.IntegerValue).hvalue;
+			ELSE
+				HALT(100)
+			END;
+
+			IntermediateCode.InitImmediate(dataOperand, IntermediateCode.GetType(backend.GetSystem(), syntaxTreeValue.type.resolved), hugeintValue);
+			IntermediateCode.InitOperand(emptyOperand);
+			IntermediateCode.InitInstruction(dataInstruction, -1, IntermediateCode.data, dataOperand, emptyOperand, emptyOperand);
+
+			ASSERT(section IS IntermediateCode.Section);
+			section(IntermediateCode.Section).EmitAt(0, dataInstruction)
+		END PatchValueInSection;
+
+		(** get all reachable sections in the form of an intermediate code module with a certain name **)
+		PROCEDURE ExtractModuleWithName(CONST desiredName: ARRAY OF CHAR): Sections.Module;
+		VAR
+			result: Sections.Module;
+			section: Sections.Section;
+			i: LONGINT;
+		BEGIN
+			NEW(result, NIL, backend.GetSystem()); (* note: there is no syntax tree *)
+			result.SetModuleName(desiredName);
+			result.SetPlatformName(platformName);
+			result.SetImports(importList);
+
+			(* add all of the reachable sections from the cumulative section list into the resulting module's section list *)
+			FOR i := 0 TO allSections.Length() - 1 DO
+				section := allSections.GetSection(i);
+
+				(* remove any previously generated code *)
+				ASSERT(section IS IntermediateCode.Section);
+				section(IntermediateCode.Section).SetResolved(NIL);
+
+				IF section.isReachable THEN result.allSections.AddSection(section) END
+			END;
+
+			IF RequireSortedSections THEN result.allSections.Sort(SectionPositionComparison) END;
+
+			IF Trace THEN D.String("+++++++++ intermediate code module ++++++++++"); D.Ln; result.Dump(D.Log); D.Ln; END;
+
+			RETURN result
+		END ExtractModuleWithName;
+
+		PROCEDURE SectionPositionComparison(leftObject, rightObject: ANY): BOOLEAN;
+		VAR
+			leftSection, rightSection: Sections.Section;
+			leftPosition, rightPosition: LONGINT;
+		BEGIN
+			ASSERT((leftObject IS Sections.Section) & (rightObject IS Sections.Section));
+			leftSection := leftObject(Sections.Section);
+			rightSection := rightObject(Sections.Section);
+
+			IF leftSection.fixed THEN
+				leftPosition := leftSection.positionOrAlignment
+			ELSE
+				leftPosition := MAX(LONGINT)
+			END;
+			IF rightSection.fixed THEN
+				rightPosition := rightSection.positionOrAlignment
+			ELSE
+				rightPosition := MAX(LONGINT)
+			END;
+			IF leftSection.IsCode() & rightSection.IsCode() THEN RETURN FALSE END;
+			RETURN leftPosition < rightPosition
+		END SectionPositionComparison;
+
+		(** whether a section should appear before another one in an assembly (used for sorting)
+			- 1st priority: when sections have fixed positions, the ones with smaller addresses come first
+			- 2nd priority: smaller sections come first
+		**)
+		PROCEDURE SectionPositionAndSizeComparison(leftObject, rightObject: ANY): BOOLEAN;
+		VAR
+			leftSection, rightSection: Sections.Section;
+			leftPosition, rightPosition, leftSize, rightSize: LONGINT;
+		BEGIN
+			ASSERT((leftObject IS Sections.Section) & (rightObject IS Sections.Section));
+			leftSection := leftObject(Sections.Section);
+			rightSection := rightObject(Sections.Section);
+
+			IF leftSection.fixed THEN
+				leftPosition := leftSection.positionOrAlignment
+			ELSE
+				leftPosition := MAX(LONGINT)
+			END;
+			IF rightSection.fixed THEN
+				rightPosition := rightSection.positionOrAlignment
+			ELSE
+				rightPosition := MAX(LONGINT)
+			END;
+
+			IF ~leftSection.IsCode() & rightSection.IsCode() THEN (* data sections first *)
+				RETURN TRUE
+			ELSIF leftSection.IsCode() & ~rightSection.IsCode() THEN (* data sections first *)
+				RETURN FALSE
+			ELSIF leftSection.IsCode() & rightSection.IsCode() THEN (* code sections: sorted by linking preference, stable w.r.t. loading order *)
+				IF GetPriority(leftSection) < GetPriority(rightSection) THEN
+					RETURN TRUE
+				ELSIF GetPriority(leftSection) = GetPriority(rightSection) THEN
+					RETURN (leftSection.priority < rightSection.priority) OR (leftSection.priority = rightSection.priority) & (leftSection.offset < rightSection.offset) (* must keep order as provided by loader *)
+				ELSE
+					RETURN FALSE
+				END
+			ELSIF leftPosition < rightPosition THEN (* data sections sorted by position *)
+				RETURN TRUE
+			ELSIF leftPosition > rightPosition THEN (* data sections sorted by position *)
+				RETURN FALSE
+			ELSE (* data section sorted by size, if no position provided *)
+				ASSERT(leftPosition = rightPosition); (* note: this is the case for sections without fixed positions *)
+				leftSize := leftSection.GetSize();
+				rightSize := rightSection.GetSize();
+				IF (leftSize = Sections.UnknownSize) OR (leftSize = 0) THEN leftSize := MAX(LONGINT) END;
+				IF (rightSize = Sections.UnknownSize) OR (rightSize = 0) THEN rightSize := MAX(LONGINT) END;
+				IF leftSize = rightSize THEN
+					RETURN leftSection.offset < rightSection.offset (* keeping order as provided by loader, cosmetic *)
+				ELSE
+					RETURN leftSize < rightSize
+				END
+			END
+		END SectionPositionAndSizeComparison;
+
+		(* set address of sections to a fixed position after compilation *)
+		PROCEDURE FixSections(binaryModule: Sections.Module; VAR sizes: ARRAY OF LONGINT);
+		VAR adr,i: LONGINT; section: Sections.Section; is: BinaryCode.Section;
+		BEGIN
+			adr := 0;
+			FOR i := 0 TO binaryModule.allSections.Length()-1 DO
+				section := binaryModule.allSections.GetSection(i);
+				is := section(IntermediateCode.Section).resolved;
+				IF (is # NIL) & section.IsCode() THEN
+					(*
+					Basic.WriteSegmentedName(D.Log,section.name);
+					D.String(" @ "); D.Int(adr,1); D.Ln;
+					*)
+					backend.CheckCodeAddress(adr);
+					is.SetAlignment(TRUE, adr);
+					IF is.pc > sizes[i] THEN sizes[i] := is.pc END;
+					adr := adr + sizes[i];
+				END;
+				is.Reset; (* enable recompilation *)
+			END;
+		END FixSections;
+
+		(* check if any of the addresses of sections have changed during last compilation *)
+		PROCEDURE Conflict(binaryModule: Sections.Module; VAR sizes: ARRAY OF LONGINT): BOOLEAN;
+		VAR adr,i: LONGINT; section: Sections.Section;is: BinaryCode.Section;
+		BEGIN
+			adr := 0;
+			FOR i := 0 TO binaryModule.allSections.Length()-1 DO
+				section := binaryModule.allSections.GetSection(i);
+				is := section(IntermediateCode.Section).resolved;
+				IF (is # NIL) & section.IsCode() THEN
+					IF is.pc > sizes[i] THEN RETURN TRUE
+					(*
+					not necessary, the linker places correctly.
+					ELSIF is.pc < sizes[i] THEN is.SetPC(sizes[i]) (* set section size to maximal observed size *)
+					*)
+					END;
+				END;
+			END;
+			RETURN FALSE
+		END Conflict;
+
+		(* generate binary code and write an object file with a desired module name *)
+		PROCEDURE GenerateObjectFile*(objectFileFormat: Formats.ObjectFileFormat; log: Streams.Writer; CONST desiredName: ARRAY OF CHAR): BOOLEAN;
+		VAR
+			count: LONGINT;
+			intermediateCodeModule: Sections.Module;
+			binaryModule: Formats.GeneratedModule;
+			result: BOOLEAN;
+			sizes: POINTER TO ARRAY OF LONGINT; i: LONGINT;
+			objectFileExtension: ARRAY 32 OF CHAR; objectFileName: Files.FileName;
+		BEGIN
+			intermediateCodeModule := ExtractModuleWithName(desiredName);
+			result := TRUE;
+
+			(* generate binary code *)
+			backend.Initialize(diagnostics, log, {}, NIL, backend.GetSystem(), NIL);
+			binaryModule := backend.ProcessIntermediateCodeModule(intermediateCodeModule); count := 0;
+
+			(* iterative compilation until all sections remain fixed at their position *)
+			NEW(sizes, binaryModule(Sections.Module).allSections.Length());
+			FOR i := 0 TO LEN(sizes)-1 DO sizes[i] := 0 END;
+			REPEAT
+				INC(count);
+				(* fix all section addresses *)
+				FixSections(binaryModule(Sections.Module),sizes^);
+				(* compile *)
+				binaryModule := backend.ProcessIntermediateCodeModule(intermediateCodeModule);
+				(* and repeat if any of the section addresses have to be adapted *)
+			UNTIL ~Conflict(binaryModule(Sections.Module),sizes^) OR (count > 10) ;
+			ASSERT(count <=10);
+
+
+			IF binaryModule = NIL THEN
+				diagnostics.Error(desiredName, Diagnostics.Invalid, Diagnostics.Invalid, "the specified backend cannot process intermediate code");
+				result := FALSE
+			ELSIF backend.error THEN
+				diagnostics.Error(desiredName, Diagnostics.Invalid, Diagnostics.Invalid, "binary code could not be generated (backend error)");
+				result := FALSE
+			ELSE
+				IF Trace THEN D.String(">>> binary code successfully generated"); D.Ln END;
+				IF objectFileFormat = NIL THEN
+					diagnostics.Error(desiredName, Diagnostics.Invalid, Diagnostics.Invalid, "no object file format specified");
+					result := FALSE
+				ELSE
+					(* write the generated code into an object file *)
+					objectFileFormat.Initialize(diagnostics,"");
+					IF objectFileFormat.Export(binaryModule, NIL) THEN
+						IF log # NIL THEN
+							log.String("assembled "); log.String(desiredName); log.String(" => ");
+							objectFileFormat.GetExtension(objectFileExtension);
+							Files.JoinExtension(desiredName, objectFileExtension, objectFileName);
+							log.String(objectFileName); log.Ln;
+						END;
+						IF Trace THEN D.String(">>> object file successfully written"); D.Ln END;
+					ELSE
+						diagnostics.Error(desiredName, Diagnostics.Invalid, Diagnostics.Invalid, "object file could not be written");
+						result := FALSE
+					END
+				END
+			END;
+			RETURN result
+		END GenerateObjectFile;
+
+	END Linker;
+
+	SpecificationLinker=OBJECT (Backend.Backend)
+	VAR objectFileFormat: Formats.ObjectFileFormat;
+
+		PROCEDURE &Init;
+		BEGIN
+			InitBackend;
+			objectFileFormat := Formats.GetObjectFileFormat("Generic");
+		END Init;
+
+		PROCEDURE Emit(backend: Backend.Backend): BOOLEAN;
+		BEGIN
+			RETURN LinkActiveCells(activeCellsSpecification, backend, objectFileFormat);
+		END Emit;
+
+		PROCEDURE DefineOptions(options: Options.Options);
+		BEGIN
+			objectFileFormat.DefineOptions(options);
+		END DefineOptions;
+
+		PROCEDURE GetOptions(options: Options.Options);
+		BEGIN
+			objectFileFormat.GetOptions(options);
+		END GetOptions;
+
+
+	END SpecificationLinker;
+
+	PROCEDURE Get*(): Backend.Backend;
+	VAR backend: SpecificationLinker;
+	BEGIN
+		NEW(backend); RETURN backend
+	END Get;
+
+	PROCEDURE GetPriority*(block: Sections.Section): LONGINT;
+	CONST Fixed=0; InitCode=1; BodyCode=2;Code=3; Data=4; Const=5; Empty =6;
+	BEGIN
+		IF block.fixed THEN RETURN Fixed END;
+		IF block.type = ObjectFile.InitCode THEN RETURN InitCode END;
+		IF block.type = ObjectFile.BodyCode THEN RETURN Code END; (* BodyCode does not necessarily have to be in front of code *)
+		IF block.GetSize () = 0 THEN RETURN Empty END;
+		IF block.type = ObjectFile.Code THEN RETURN Code END;
+		IF block.type = ObjectFile.Data THEN RETURN Code END;
+		IF block.type = ObjectFile.Const THEN RETURN Code END;
+		HALT(100); (* undefined type *)
+	END GetPriority;
+
+	PROCEDURE CopySections*(from, to: Sections.SectionList);
+	VAR section, copy: IntermediateCode.Section; i,j: LONGINT; s: Sections.Section; instruction: IntermediateCode.Instruction;
+	BEGIN
+		FOR i := 0 TO from.Length()-1 DO
+			s := from.GetSection(i);
+			section := s(IntermediateCode.Section);
+			copy := IntermediateCode.NewSection(to, section.type, section.name, NIL, FALSE);
+			copy.SetBitsPerUnit(section.bitsPerUnit);
+			copy.SetPositionOrAlignment(section.fixed, section.positionOrAlignment);
+			copy.SetFingerprint(section.fingerprint);
+			copy.SetPriority(section.priority);
+			FOR j := 0 TO section.pc-1 DO
+				instruction := section.instructions[j];
+				copy.Emit(instruction);
+			END;
+		END;
+	END CopySections;
+
+	PROCEDURE FileNameToModuleName(CONST filename: ARRAY OF CHAR; VAR moduleName: ARRAY OF CHAR);
+	VAR extension: FileName;
+	BEGIN
+		Files.SplitExtension(filename, moduleName, extension);
+	END FileNameToModuleName;
+
+	PROCEDURE LinkActiveCells*(activeCellsSpecification: ActiveCells.Specification; backend: Backend.Backend; objectFileFormat: Formats.ObjectFileFormat): BOOLEAN;
+	TYPE
+		LinkerObject= OBJECT
+		VAR
+			specification: ActiveCells.Specification;
+			backend: Backend.Backend;
+			diagnostics: Diagnostics.Diagnostics;
+			irLinker: Linker;
+			objectFileFormat: Formats.ObjectFileFormat;
+			error: BOOLEAN;
+			system: Global.System;
+
+			PROCEDURE &Init(activeCellsSpecification: ActiveCells.Specification; b: Backend.Backend; objectFileFormat: Formats.ObjectFileFormat);
+			BEGIN
+				error := FALSE;
+				SELF.specification := activeCellsSpecification;
+				SELF.backend := b;
+				SELF.diagnostics := specification.diagnostics;
+				IF diagnostics = NIL THEN diagnostics := Basic.GetDefaultDiagnostics() END;
+				SELF.objectFileFormat := objectFileFormat;
+				NEW(irLinker, specification.diagnostics, backend, ""); (* TODO: pass an optional path as third parameter *)
+				IF ~irLinker.LoadModule(backend(IntermediateCode.IntermediateBackend).runtimeModuleName, TRUE) THEN
+					error := TRUE;
+					diagnostics.Error(backend(IntermediateCode.IntermediateBackend).runtimeModuleName,Diagnostics.Invalid, Diagnostics.Invalid, "could not load ir file");
+				END;
+				IF ~irLinker.LoadModule(specification.name,TRUE) THEN
+					error := TRUE;
+					diagnostics.Error(specification.name,Diagnostics.Invalid, Diagnostics.Invalid, "could not load ir file");
+				END;
+				backend := irLinker.backend;
+				system := backend.system;
+			END Init;
+
+			PROCEDURE LinkInstance(instance: ActiveCells.Instance): BOOLEAN;
+			VAR
+				codeFileName, dataFileName: Files.FileName;
+				typeName, instanceName, linkRoot: SectionName;
+				code, data: StaticLinker.Arrangement; linker: GenericLinker.Linker;
+				i: LONGINT;
+				logFile: Files.File; linkerLog: Files.Writer;
+				type: ActiveCells.Type;
+				msg: MessageString;
+				objectFileExtension: ARRAY 32 OF CHAR;
+				instructionMemorySize, dataMemorySize: LONGINT;
+				parameter: ActiveCells.Parameter;
+				value: SyntaxTree.Value;
+				pooledName: Basic.SegmentedName;
+				device: ActiveCells.Device;
+				error : BOOLEAN;
+			CONST MinimalStackSize=64;
+			BEGIN
+				error := FALSE;
+				type := instance.instanceType;
+				type.GetFullName(typeName,NIL);
+				instance.GetFullName(instanceName,NIL);
+				IF TraceLinking THEN
+					D.String("assembling instance "); D.String(instanceName); D.String(" of type "); D.String(typeName); D.Ln;
+				END;
+				IF instance.IsEngine() THEN
+					IF TraceLinking THEN
+						D.String("instance "); D.String(instanceName); D.String(" is engine "); D.Ln;
+					END;
+					RETURN TRUE;
+				END;
+
+				backend.SetCapabilities(instance.capabilities);
+				irLinker.MarkReachabilityOfAll(FALSE);
+				COPY(typeName, linkRoot);
+				Strings.Append(linkRoot,".@BodyStub");
+				irLinker.MarkAsReachableByName(linkRoot);
+				irLinker.PatchStackSize(typeName, instance.dataMemorySize);
+
+				FOR i := 0 TO instance.parameters.Length()-1 DO
+					parameter := instance.parameters.GetParameter(i);
+					IF parameter.parameterType = 0 THEN (* Boolean *)
+						value := SyntaxTree.NewBooleanValue(-1, parameter.boolean); value.SetType(system.booleanType);
+					ELSE
+						value := SyntaxTree.NewIntegerValue(-1, parameter.integer); value.SetType(system.integerType);
+					END;
+					Basic.ToSegmentedName(parameter.name, pooledName);
+					irLinker.PatchValueInSection(pooledName,value);
+				END;
+
+				FOR i := 0 TO type.specification.supportedDevices.Length()-1 DO
+					device := type.specification.supportedDevices.GetDevice(i);
+					IF instance.instanceType.devices.ByName(device.name) = NIL THEN
+						IF irLinker.ModuleIsReachable(Basic.MakeString(device.name)) THEN
+							msg := "Missing device capability ";
+							Strings.Append(msg, device.name);
+							Strings.Append(msg," in cell ");
+							instance.AppendToMsg(msg);
+							diagnostics.Error(specification.name,Diagnostics.Invalid, Diagnostics.Invalid, msg);
+							error := TRUE;
+						END;
+					ELSE
+						IF ~irLinker.ModuleIsReachable(Basic.MakeString(device.name)) THEN
+							msg := "Unused device ";
+							Strings.Append(msg, device.name);
+							Strings.Append(msg," in cell ");
+							instance.AppendToMsg(msg);
+							diagnostics.Warning(specification.name,Diagnostics.Invalid,Diagnostics.Invalid,msg);
+						END;
+					END;
+				END;
+
+				IF error THEN RETURN FALSE END;
+
+				objectFileFormat.GetExtension(objectFileExtension);
+				irLinker.PrearrangeReachableDataSections;
+				IF ~irLinker.GenerateObjectFile(objectFileFormat, specification.log, instanceName) THEN
+					diagnostics.Error(specification.name,Diagnostics.Invalid, Diagnostics.Invalid, "could not generate object file");
+					RETURN FALSE
+				END;
+
+				IF TraceLinking THEN
+					D.String("assembling instance done. "); D.Ln;
+				END;
+
+				NEW (code, 0); NEW (data, 0);
+				COPY(instanceName, msg); Strings.Append(msg,".log");	logFile := Files.New(msg);
+				IF logFile # NIL THEN NEW(linkerLog,logFile,0) ELSE logFile := NIL END;
+				NEW (linker, specification.diagnostics, linkerLog, GenericLinker.UseInitCode, code, data);
+
+				linker.SetLinkRoot("" (* linkRoot *)); (* take all initcode sections *)
+				StaticLinker.ReadObjectFile(instanceName, "",objectFileExtension,linker);
+
+				(* do linking after having read in all blocks to account for potential constraints *)
+				IF ~linker.error THEN linker.Link; END;
+
+				system := backend.GetSystem();
+
+				instructionMemorySize := instance.instructionMemorySize;
+				dataMemorySize := instance.dataMemorySize;
+
+				IF instructionMemorySize = 0 THEN
+					instructionMemorySize := type.instructionMemorySize
+				END;
+				IF dataMemorySize = 0 THEN
+					dataMemorySize := type.dataMemorySize
+				END;
+
+				IF (instructionMemorySize > 0) & (instructionMemorySize < code.SizeInBits() DIV system.codeUnit) THEN
+					diagnostics.Error(instanceName,Diagnostics.Invalid, Diagnostics.Invalid, "specified instruction memory size too small");
+					error := TRUE;
+				ELSIF instructionMemorySize = 0 THEN
+					instructionMemorySize := code.SizeInBits() DIV system.codeUnit;
+				END;
+
+				dataMemorySize := MAX(data.SizeInBits() DIV system.dataUnit, dataMemorySize);
+				instance.SetInstructionMemorySize(instructionMemorySize);
+				instance.SetDataMemorySize(dataMemorySize);
+
+				IF (dataMemorySize - data.SizeInBits() DIV system.dataUnit) < MinimalStackSize THEN
+					diagnostics.Error(specification.name,Diagnostics.Invalid, Diagnostics.Invalid, "specified data memory size too small");
+					error := TRUE;
+				END;
+
+				Files.JoinExtension(instanceName,ActiveCells.CodeFileExtension,codeFileName);
+				Files.JoinExtension(instanceName,ActiveCells.DataFileExtension,dataFileName);
+
+				IF ~linker.error THEN
+					StaticLinker.WriteOutputFile (code, codeFileName, linker, StaticLinker.WriteTRMCodeFile);
+					StaticLinker.WriteOutputFile (data, dataFileName, linker, StaticLinker.WriteTRMDataFile);
+					IF linkerLog # NIL THEN linkerLog.Update; Files.Register(logFile) END;
+					IF specification.log # NIL THEN
+						specification.log.String(instanceName);
+						specification.log.String(" linked. IM = ");specification.log.Int(instructionMemorySize,1);
+						specification.log.String(" (used: "); specification.log.Int(code.SizeInBits() DIV system.codeUnit,1);
+						specification.log.String("), DM = "); specification.log.Int(dataMemorySize,1);
+						specification.log.String(" (used: "); specification.log.Int(data.SizeInBits() DIV system.dataUnit,1);
+						specification.log.String(")");
+						specification.log.Ln; specification.log.Update;
+
+						specification.log.String("generated code file: ");specification.log.String(codeFileName); specification.log.Ln;
+						specification.log.String("generated data file: ");specification.log.String(dataFileName); specification.log.Ln;
+
+
+					END;
+				ELSE
+					msg := "could not link ";
+					Strings.Append(msg,linkRoot);
+					diagnostics.Error("",Diagnostics.Invalid, Diagnostics.Invalid, msg);
+				END;
+				RETURN ~linker.error & ~error
+			END LinkInstance;
+
+		END LinkerObject;
+
+	VAR obj: LinkerObject; spec: ActiveCells.Specification;
+	BEGIN
+		spec := ActiveCells.Clone(activeCellsSpecification)(ActiveCells.Specification);
+		ActiveCells.FlattenNetwork(spec);
+		NEW(obj,spec,backend,objectFileFormat);
+		IF obj.error THEN RETURN FALSE END;
+		RETURN spec.ForEachInstanceDo(obj.LinkInstance);
+	END LinkActiveCells;
+
+
+	PROCEDURE Link*(context: Commands.Context);
+	VAR
+		input: Streams.Reader;
+		diagnostics: Diagnostics.StreamDiagnostics;
+		defaultBackend: Backend.Backend;
+		objectFileFormat: Formats.ObjectFileFormat;
+		filename, name, targetFile: Files.FileName;
+		assemblinker: Linker;
+		error, result, parsed: BOOLEAN;
+		options:Options.Options;
+		position: LONGINT;
+		moduleName: SyntaxTree.IdentifierString;
+
+		PROCEDURE Error(CONST error: ARRAY OF CHAR);
+		BEGIN
+			IF diagnostics # NIL THEN
+				diagnostics.Error("",Diagnostics.Invalid,Diagnostics.Invalid,error);
+			END;
+		END Error;
+
+	BEGIN
+		input := context.arg;
+		NEW(diagnostics, context.out);
+		result := TRUE;
+		NEW(options);
+		options.Add("b","backend",Options.String);
+		options.Add(0X, "objectFile", Options.String);
+		options.Add(0X, "targetFile", Options.String);
+
+		position := input.Pos();
+		parsed := options.Parse(input,NIL);
+
+		IF options.GetString("b", name) THEN
+			IF name = "" THEN defaultBackend := NIL
+			ELSE
+				defaultBackend := Backend.GetBackendByName(name);
+				IF (defaultBackend = NIL)  THEN
+					Error("backend could not be installed"); result := FALSE;
+				END;
+			END;
+		ELSE defaultBackend := Backend.GetBackendByName(DefaultBackend);
+			IF defaultBackend = NIL THEN Error("default backend could not be installed"); result := FALSE END;
+		END;
+
+		IF options.GetString("objectFile",name) THEN
+			IF name = "" THEN objectFileFormat := NIL
+			ELSE
+				objectFileFormat := Formats.GetObjectFileFormat(name);
+				IF objectFileFormat = NIL THEN Error("object file format could not be installed"); result := FALSE END;
+			END;
+		ELSIF defaultBackend # NIL THEN
+			objectFileFormat := defaultBackend.DefaultObjectFileFormat();
+		END;
+		IF defaultBackend # NIL THEN defaultBackend.DefineOptions (options); END;
+		IF objectFileFormat # NIL THEN objectFileFormat.DefineOptions(options); END;
+
+		IF result & ~parsed THEN
+			options.Clear;
+			input.SetPos(position);
+			result := options.Parse(input,context.error)
+		END;
+
+		IF result THEN
+			IF defaultBackend # NIL THEN defaultBackend.GetOptions (options) END;
+			IF objectFileFormat # NIL THEN objectFileFormat.GetOptions(options) END;
+			IF ~options.GetString("targetFile",targetFile) THEN targetFile := "" END;
+		END;
+
+		error := ~result;
+		IF targetFile # "" THEN
+			NEW(assemblinker, diagnostics, defaultBackend, "");
+		END;
+		WHILE Basic.GetStringParameter(input,filename) & ~error DO
+			IF targetFile = "" THEN NEW(assemblinker, diagnostics, defaultBackend, "") 	END;
+			IF assemblinker.LoadModule(filename, FALSE) THEN
+				assemblinker.MarkReachabilityOfAll(TRUE);
+				FileNameToModuleName(filename, moduleName);
+				IF (targetFile = "") & assemblinker.GenerateObjectFile(objectFileFormat, context.out, moduleName) THEN
+					diagnostics.Information(filename, Diagnostics.Invalid, Diagnostics.Invalid, "done.")
+				ELSIF targetFile # "" THEN
+					diagnostics.Information(filename,  Diagnostics.Invalid, Diagnostics.Invalid, "loaded.")
+				ELSE
+					error := TRUE
+				END
+			ELSE
+				error := TRUE
+			END
+		END;
+		IF ~error & (targetFile # "") THEN
+			assemblinker.PrearrangeReachableDataSections;
+			IF 	assemblinker.GenerateObjectFile(objectFileFormat, context.out, targetFile)
+			THEN
+				diagnostics.Information(targetFile, Diagnostics.Invalid, Diagnostics.Invalid, "generated.")
+			ELSE error := FALSE
+			END;
+		END;
+	END Link;
+
+
+END FoxIntermediateLinker.

source/FoxIntermediateObjectFile.Mod

@@ -0,0 +1,548 @@
+MODULE FoxIntermediateObjectFile; (** AUTHOR ""; PURPOSE "Intermediate Object File Writer"; *)
+
+IMPORT
+	Formats := FoxFormats, Sections := FoxSections, IntermediateCode := FoxIntermediateCode, ObjectFile,
+	Files, Strings, Options, Diagnostics, TextualSymbolFile := FoxTextualSymbolFile, Streams, Basic := FoxBasic,
+	SyntaxTree := FoxSyntaxTree,  D := Debugging, Global := FoxGlobal, Parser := FoxIntermediateParser, Commands,  KernelLog, Backend := FoxBackend;
+
+CONST
+	Trace = FALSE;
+	DeveloperVersion=TRUE;
+	Version=2;
+
+TYPE ObjectFileFormat* = OBJECT (Formats.ObjectFileFormat)
+	VAR prefix, extension: Files.FileName; textual: BOOLEAN;
+
+		PROCEDURE & InitObjectFileFormat*;
+		BEGIN
+			Init;
+			prefix := ""; extension := ".Fil";
+		END InitObjectFileFormat;
+
+		PROCEDURE ExportModuleTextual(module: Sections.Module; writer: Streams.Writer);
+		VAR
+			section: Sections.Section;
+			intermediateCodeSection: IntermediateCode.Section;
+			i: LONGINT;
+		BEGIN
+			(* prepare sections for output *)
+			FOR i := 0 TO module.allSections.Length() - 1 DO
+				section := module.allSections.GetSection(i);
+				ASSERT(section IS IntermediateCode.Section);
+				intermediateCodeSection := section(IntermediateCode.Section);
+				intermediateCodeSection.SetResolved(NIL); (* remove generated binary code *)
+				intermediateCodeSection.DeleteComments (* remove comments *)
+			END;
+			module.Dump(writer)
+		END ExportModuleTextual;
+
+		PROCEDURE ExportModuleBinary(module: Sections.Module; w: Streams.Writer; poolMap: ObjectFile.PoolMap);
+		VAR
+			section: Sections.Section;
+			intermediateCodeSection: IntermediateCode.Section;
+
+			PROCEDURE SectionName(sectionName: ObjectFile.SegmentedName);
+			VAR name: ObjectFile.SectionName; i,num: LONGINT;
+			BEGIN
+				i := 0;
+				REPEAT
+					num := poolMap.Get(sectionName[i]);
+					w.RawNum(num);
+					INC(i);
+				UNTIL (i = LEN(sectionName)) OR (num < 0);
+			END SectionName;
+
+			PROCEDURE WriteOperand(CONST operand: IntermediateCode.Operand);
+
+				PROCEDURE Type(t: IntermediateCode.Type);
+				BEGIN
+					w.RawSInt(t.form);
+					w.RawInt(t.sizeInBits);
+				END Type;
+
+				PROCEDURE RegisterClass(c: IntermediateCode.RegisterClass);
+				BEGIN
+					w.RawSInt(c.class);
+					w.RawInt(c.number);
+				END RegisterClass;
+
+			BEGIN
+				Type(operand.type);
+				w.RawNum(operand.mode);
+				CASE operand.mode OF
+				IntermediateCode.Undefined:
+				|IntermediateCode.ModeMemory:
+						IF operand.register # IntermediateCode.None THEN
+							w.RawNum(0);
+							w.RawNum(operand.register);
+							w.RawNum(operand.offset);
+						ELSIF operand.symbol.name # "" THEN
+							w.RawNum(1);
+							SectionName(operand.symbol.name);
+							w.RawNum(operand.symbolOffset);
+							w.RawNum(operand.offset);
+						ELSE
+							w.RawNum(2);
+							w.RawHInt(operand.intValue)
+						END;
+				|IntermediateCode.ModeRegister:
+					w.RawNum(operand.register);
+					RegisterClass(operand.registerClass);
+					w.RawNum(operand.offset);
+				|IntermediateCode.ModeImmediate:
+					IF operand.symbol.name # "" THEN
+						w.RawNum(0);
+						SectionName(operand.symbol.name);
+						w.RawNum(operand.symbolOffset);
+						w.RawNum(operand.offset);
+					ELSE
+						w.RawNum(1);
+						IF operand.type.form IN IntermediateCode.Integer THEN
+							w.RawHInt(operand.intValue);
+						ELSE
+							w.RawLReal(operand.floatValue);
+						END;
+					END;
+				|IntermediateCode.ModeString:
+					w.RawNum(Strings.Length(operand.string^));
+					w.RawString(operand.string^);
+				|IntermediateCode.ModeNumber:
+					w.RawHInt(operand.intValue);
+				END;
+
+			END WriteOperand;
+
+			PROCEDURE WriteInstruction(CONST instr: IntermediateCode.Instruction);
+			BEGIN
+				w.RawNum(instr.opcode);
+				IF instr.opcode = IntermediateCode.special THEN w.RawNum(instr.subtype) END;
+				WriteOperand(instr.op1);
+				WriteOperand(instr.op2);
+				WriteOperand(instr.op3);
+			END WriteInstruction;
+
+			PROCEDURE WriteSection(section: IntermediateCode.Section);
+			VAR i: LONGINT;
+			BEGIN
+				w.RawLInt(section.type);
+				SectionName(section.name);
+				w.RawBool(section.fixed);
+				w.RawNum(section.positionOrAlignment);
+				w.RawNum(section.priority);
+				w.RawNum(section.fingerprint);
+				w.RawNum(section.bitsPerUnit);
+
+				w.RawNum(section.pc);
+				FOR i := 0 TO section.pc-1 DO
+					WriteInstruction(section.instructions[i]);
+				END;
+			END WriteSection;
+
+			PROCEDURE SectionList(list: Sections.SectionList);
+			VAR section: Sections.Section;i: LONGINT;
+			BEGIN
+				w.RawNum(list.Length());
+				FOR i := 0 TO list.Length() - 1 DO
+					section := list.GetSection(i);
+					WriteSection(section(IntermediateCode.Section));
+				END;
+			END SectionList;
+
+			PROCEDURE Imports(imports: Sections.NameList);
+			VAR name: SyntaxTree.IdentifierString;i: LONGINT;
+			BEGIN
+				w.RawNum(imports.Length());
+				FOR i := 0 TO imports.Length()-1 DO
+					name := imports.GetName(i);
+					w.RawString(name);
+				END;
+			END Imports;
+
+		BEGIN
+			w.RawString(module.moduleName);
+			w.RawString(module.platformName);
+
+			Imports(module.imports);
+
+			SectionList(module.allSections);
+		END ExportModuleBinary;
+
+		PROCEDURE Export*(module: Formats.GeneratedModule; symbolFileFormat: Formats.SymbolFileFormat): BOOLEAN;
+		VAR
+			filename: Files.FileName;
+			file: Files.File;
+			writer: Files.Writer;
+			poolMap: ObjectFile.PoolMap;
+		BEGIN
+			IF Trace THEN D.String(">>> export intermediate object file"); D.Ln END;
+
+			IF ~(module IS Sections.Module) THEN
+				diagnostics.Error(module.moduleName, Diagnostics.Invalid, Diagnostics.Invalid, "generated module format does not match object file format");
+				RETURN FALSE;
+			END;
+
+			IF prefix # "" THEN Files.JoinPath(prefix, module.moduleName, filename); ELSE COPY (module.moduleName, filename); END;
+			Files.JoinExtension(filename, extension, filename);
+
+			IF Trace THEN D.String(">>> filename: "); D.String(filename); D.Ln END;
+
+			file := Files.New(filename);
+			IF file = NIL THEN
+				diagnostics.Error(module.moduleName, Diagnostics.Invalid,Diagnostics.Invalid, "failed to open object file for writting");
+				RETURN FALSE
+			END;
+
+			Files.OpenWriter(writer, file, 0);
+			IF textual THEN
+				WriteHeader(writer, FALSE, module(Sections.Module).allSections, poolMap);
+				ExportModuleTextual(module(Sections.Module),writer);
+			ELSE
+				WriteHeader(writer, TRUE, module(Sections.Module).allSections, poolMap);
+				ExportModuleBinary(module(Sections.Module),writer, poolMap);
+			END;
+			writer.Update;
+			file.Update;
+			Files.Register(file);
+
+			RETURN TRUE
+		END Export;
+
+		PROCEDURE ImportModuleBinary(r: Streams.Reader; module: Sections.Module; system: Global.System; poolMap: ObjectFile.PoolMap): BOOLEAN;
+		VAR
+			section: Sections.Section;
+			name: ObjectFile.SectionName;
+			addressType: IntermediateCode.Type;
+
+			PROCEDURE SectionName(VAR sectionName: ObjectFile.SegmentedName);
+			VAR name: ObjectFile.SectionName; i, num: LONGINT;
+			BEGIN
+				i := 0;
+				REPEAT
+					r.RawNum(num);
+					sectionName[i] := poolMap.Get(num);
+					INC(i);
+				UNTIL (i = LEN(sectionName)) OR (num < 0);
+				WHILE i < LEN(sectionName) DO
+					sectionName[i] := -1; INC(i);
+				END;
+			END SectionName;
+
+			PROCEDURE ReadOperand(VAR operand: IntermediateCode.Operand);
+			VAR type: IntermediateCode.Type; mode, subMode: LONGINT; register: LONGINT; registerClass: IntermediateCode.RegisterClass;
+				offset: LONGINT; int: HUGEINT; real: LONGREAL; name: ObjectFile.SegmentedName; symbolOffset: LONGINT;
+				string: Strings.String; len: LONGINT;
+				symbolSection: Sections.Section;
+
+				PROCEDURE Type(VAR t: IntermediateCode.Type);
+				VAR form: SHORTINT; sizeInBits: INTEGER;
+				BEGIN
+					r.RawSInt(form);
+					r.RawInt(sizeInBits);
+					IntermediateCode.InitType(t, form, sizeInBits)
+				END Type;
+
+				PROCEDURE RegisterClass(VAR c: IntermediateCode.RegisterClass);
+				VAR class: SHORTINT; number: INTEGER;
+				BEGIN
+					r.RawSInt(class);
+					r.RawInt(number);
+					IntermediateCode.InitRegisterClass(c, class, number)
+				END RegisterClass;
+
+			BEGIN
+				Type(type);
+				IntermediateCode.SetType(operand, type);
+				r.RawNum(mode);
+				CASE mode OF
+				IntermediateCode.Undefined:
+					IntermediateCode.InitOperand(operand); (* no operand *)
+				|IntermediateCode.ModeMemory:
+						r.RawNum(subMode);
+						IF subMode = 0 THEN
+							r.RawNum(register);
+							r.RawNum(offset);
+							IntermediateCode.InitRegister(operand, addressType, IntermediateCode.GeneralPurposeRegister, register);
+						ELSIF subMode = 1 THEN
+							SectionName(name);
+							r.RawNum(symbolOffset);
+							r.RawNum(offset);
+							IntermediateCode.InitAddress(operand, addressType, name, 0, symbolOffset);
+						ELSE
+							offset := 0;
+							ASSERT(subMode = 2);
+							r.RawHInt(int);
+							IntermediateCode.InitImmediate(operand, addressType, int);
+						END;
+						IntermediateCode.InitMemory(operand, type, operand, offset);
+				|IntermediateCode.ModeRegister:
+					r.RawNum(register); RegisterClass(registerClass); r.RawNum(offset);
+					IntermediateCode.InitRegister(operand, type, registerClass, register);
+					IntermediateCode.AddOffset(operand, offset);
+				|IntermediateCode.ModeImmediate:
+					r.RawNum(subMode);
+					IF subMode = 0 THEN (* ?? *)
+						SectionName(name);
+						r.RawNum(symbolOffset);
+						r.RawNum(offset);
+						IntermediateCode.InitAddress(operand, type, name, 0, symbolOffset);
+						IntermediateCode.AddOffset(operand, offset);
+					ELSE
+						ASSERT(subMode = 1);
+						IF operand.type.form IN IntermediateCode.Integer THEN
+							r.RawHInt(int);
+							IntermediateCode.InitImmediate(operand, type, int);
+						ELSE
+							r.RawLReal(real);
+							IntermediateCode.InitFloatImmediate(operand, type, real);
+						END;
+					END;
+				|IntermediateCode.ModeString:
+					r.RawNum(len);
+					NEW(string, len);
+					r.RawString(string^);
+					IntermediateCode.InitString(operand, string);
+				|IntermediateCode.ModeNumber:
+					r.RawHInt(int);
+					IntermediateCode.InitNumber(operand, int)
+				END;
+			END ReadOperand;
+
+			PROCEDURE ReadInstruction(section: IntermediateCode.Section);
+			VAR opcode, subtype: LONGINT; instruction: IntermediateCode.Instruction; op1, op2, op3: IntermediateCode.Operand;
+			BEGIN
+				r.RawNum(opcode);
+				IF opcode = IntermediateCode.special THEN r.RawNum(subtype) END;
+
+				ReadOperand(op1);
+				ReadOperand(op2);
+				ReadOperand(op3);
+				IntermediateCode.InitInstruction(instruction, 0, SHORTINT(opcode), op1, op2, op3);
+				IntermediateCode.SetSubType(instruction, SHORTINT(subtype));
+				section.Emit(instruction);
+			END ReadInstruction;
+
+			PROCEDURE ReadSection(sectionList: Sections.SectionList);
+			VAR section: IntermediateCode.Section;
+				isDefinition: BOOLEAN;
+				name: Basic.SegmentedName;
+				symbol: SyntaxTree.Symbol;
+				comment: BOOLEAN;
+				type: LONGINT;
+				fixed: BOOLEAN;
+				positionOrAlignment, priority, fingerprint, bitsPerUnit: LONGINT;
+				pc,i: LONGINT;
+			BEGIN
+				r.RawLInt(type);
+				SectionName(name);
+				r.RawBool(fixed);
+				r.RawNum(positionOrAlignment);
+				r.RawNum(priority);
+				r.RawNum(fingerprint);
+				r.RawNum(bitsPerUnit);
+
+				section := IntermediateCode.NewSection(sectionList, SHORTINT(type), name, NIL, FALSE); (* keeps section if already present *)				
+				IF bitsPerUnit < 0 THEN (* unknown *)
+					IF (type = Sections.VarSection) OR (type = Sections.ConstSection) THEN
+						bitsPerUnit := system.dataUnit
+					ELSE
+						(*bitsPerUnit := system.codeUnit*)
+						(*Unit is already set.*)						
+					END;
+				END;
+				section.SetBitsPerUnit(bitsPerUnit);
+				section.SetFingerprint(fingerprint);
+				section.SetPriority(INTEGER(priority));
+				section.SetPositionOrAlignment(fixed, positionOrAlignment);
+
+				r.RawNum(pc);
+				FOR i := 0 TO pc-1 DO
+					ReadInstruction(section);
+				END;
+			END ReadSection;
+
+			PROCEDURE SectionList(list: Sections.SectionList);
+			VAR section: Sections.Section; length,i: LONGINT;
+			BEGIN
+				r.RawNum(length);
+				FOR i := 0 TO length - 1 DO
+					ReadSection(list);
+				END;
+			END SectionList;
+
+			PROCEDURE Imports(imports: Sections.NameList);
+			VAR name: SyntaxTree.IdentifierString; length,i: LONGINT;
+			BEGIN
+				r.RawNum(length);
+				FOR i := 0 TO length-1 DO
+					r.RawString(name);
+					imports.AddName(name);
+				END;
+			END Imports;
+
+		BEGIN
+			addressType := IntermediateCode.UnsignedIntegerType(system.addressSize);
+			r.RawString(name); module.SetModuleName(name);
+			r.RawString(name); module.SetPlatformName(name);
+			Imports(module.imports);
+			SectionList(module.allSections);
+			RETURN TRUE
+		END ImportModuleBinary;
+
+		PROCEDURE ImportModuleTextual(r: Streams.Reader; module: Sections.Module; system: Global.System): BOOLEAN;
+		BEGIN
+			RETURN Parser.ParseReader(r, diagnostics, module)
+		END ImportModuleTextual;
+
+		PROCEDURE Import*(CONST moduleName: ARRAY OF CHAR; system: Global.System): Sections.Module;
+		VAR module: Sections.Module; file: Files.File; reader: Files.Reader; binary: BOOLEAN; filename: Files.FileName; poolMap: ObjectFile.PoolMap;
+		BEGIN
+			IF prefix # "" THEN Files.JoinPath(prefix, moduleName, filename); ELSE COPY (moduleName, filename); END;
+			Files.JoinExtension(filename, extension, filename);
+
+			file := Files.Old(filename);
+			IF file = NIL THEN RETURN NIL END;
+			NEW(reader, file, 0);
+			ReadHeader(reader, binary, poolMap);
+			NEW(module, NIL, system);
+			IF binary & ImportModuleBinary(reader, module, system, poolMap) OR  ~binary & ImportModuleTextual(reader, module, system) THEN
+				RETURN module
+			ELSE
+				RETURN NIL
+			END;
+		END Import;
+
+		PROCEDURE DefineOptions* (options: Options.Options);
+		BEGIN
+			options.Add(0X,"objectFileExtension",Options.String);
+			options.Add(0X,"objectFilePrefix",Options.String);
+			options.Add(0X,"textualObjectFile",Options.Flag);
+		END DefineOptions;
+
+		PROCEDURE GetOptions* (options: Options.Options);
+		BEGIN
+			IF ~options.GetString("objectFileExtension",extension) THEN extension := "Fil"; END;
+			IF ~options.GetString("objectFilePrefix",prefix) THEN prefix := ""; END;
+			textual := options.GetFlag("textualObjectFile");
+		END GetOptions;
+
+		PROCEDURE DefaultSymbolFileFormat(): Formats.SymbolFileFormat;
+		BEGIN RETURN TextualSymbolFile.Get();
+		END DefaultSymbolFileFormat;
+
+		PROCEDURE GetExtension(VAR ext: ARRAY OF CHAR);
+		BEGIN COPY(extension, ext)
+		END GetExtension;
+
+	END ObjectFileFormat;
+
+	PROCEDURE Get*(): Formats.ObjectFileFormat;
+	VAR intermediateObjectFileFormat: ObjectFileFormat;
+	BEGIN NEW(intermediateObjectFileFormat); RETURN intermediateObjectFileFormat
+	END Get;
+
+	PROCEDURE ReadHeader(reader: Streams.Reader; VAR binary: BOOLEAN; VAR poolMap: ObjectFile.PoolMap);
+	VAR ch: CHAR; version: LONGINT; string: ARRAY 32 OF CHAR; i,j,pos,size: LONGINT; name: ObjectFile.SectionName;
+	BEGIN
+		reader.String(string);
+		binary := string="FoxILB";
+		IF ~binary THEN ASSERT(string="FoxILT") END;
+		reader.SkipWhitespace;
+		reader.Char(ch); ASSERT(ch='v');
+		reader.Int(version,FALSE);
+		IF version < Version THEN KernelLog.String("warning: old object file encountered"); KernelLog.Ln END;
+		reader.Char(ch); ASSERT(ch='.');
+		IF ~binary THEN reader.SkipWhitespace
+		ELSE
+			NEW(poolMap, 64);
+			poolMap.Read(reader);
+		END;
+	END ReadHeader;
+
+	PROCEDURE WriteHeader(writer: Streams.Writer; binary: BOOLEAN; sections: Sections.SectionList; VAR poolMap: ObjectFile.PoolMap);
+	VAR p1,p2, size,i: LONGINT; section: Sections.Section; fixups: LONGINT; fixupList: ObjectFile.Fixups;
+
+		PROCEDURE ProcessOperand(CONST operand: IntermediateCode.Operand);
+		BEGIN
+			IF operand.symbol.name # "" THEN
+				poolMap.PutSegmentedName(operand.symbol.name)
+			END;
+		END ProcessOperand;
+
+		PROCEDURE ProcessInstruction(CONST instruction: IntermediateCode.Instruction);
+		BEGIN
+			ProcessOperand(instruction.op1);
+			ProcessOperand(instruction.op2);
+			ProcessOperand(instruction.op3);
+		END ProcessInstruction;
+
+		PROCEDURE ProcessSection(section: IntermediateCode.Section);
+		VAR i: LONGINT; index: LONGINT;
+		BEGIN
+			IF section.resolved # NIL THEN
+				poolMap.PutSegmentedName(section.name);
+				FOR i := 0 TO section.pc-1 DO
+					ProcessInstruction(section.instructions[i]);
+				END;
+			END;
+		END ProcessSection;
+
+	BEGIN
+		IF binary THEN writer.String("FoxILB");
+		ELSE writer.String("FoxILT");
+		END;
+		writer.Char(' ');
+		writer.Char('v'); writer.Int(Version,0); writer.Char(".");
+		IF ~binary THEN writer.Ln
+		ELSE
+			NEW(poolMap,512);
+			poolMap.BeginWriting(writer);
+			FOR i := 0 TO sections.Length()-1 DO
+				section := sections.GetSection(i);
+				ProcessSection(section(IntermediateCode.Section));
+			END;
+			poolMap.EndWriting;
+		END;
+	END WriteHeader;
+
+
+	(* test code to display --not public *)
+	PROCEDURE Show*(context: Commands.Context);
+	VAR
+		fileName: Files.FileName; file: Files.File; reader: Files.Reader; writer: Streams.Writer;
+		section: ObjectFile.Section; binary: BOOLEAN; poolMap, poolMapDummy: ObjectFile.PoolMap;
+		objectFile: ObjectFileFormat; module: Sections.Module; backend: Backend.Backend;
+	BEGIN
+		IF DeveloperVersion THEN
+			IF context.arg.GetString(fileName) THEN
+				backend := Backend.GetBackendByName("TRM");
+				NEW(objectFile);
+				module := objectFile.Import(fileName, backend.GetSystem());
+				ASSERT(module # NIL); 
+				writer := Basic.GetWriter(Basic.GetDebugWriter(fileName));
+				objectFile.ExportModuleTextual(module, writer);
+				writer.Update;
+			ELSE
+				context.error.String("no file specificed"); context.error.Ln
+			END;
+		ELSE HALT(200)
+		END;
+	END Show;
+
+END FoxIntermediateObjectFile.
+
+SystemTools.FreeDownTo FoxIntermediateObjectFile ~
+FoxIntermediateObjectFile.Show TRMRuntime  ~
+
+			(* test code to compare ..
+			backend: Backend.Backend;
+			IF prefix # "" THEN Files.JoinPath(prefix, module.moduleName, filename); ELSE COPY (module.moduleName, filename); END;
+			Files.JoinExtension(filename, "fil2", filename);
+			file := Files.New(filename);
+			backend := Backend.GetBackendByName("TRM");
+			Files.OpenWriter(writer, file, 0);
+			module := Import(module.moduleName, backend.GetSystem());
+			ExportModuleTextual(module(Sections.Module), writer);
+			writer.Update;
+			Files.Register(file);
+			*)
+

source/FoxIntermediateParser.Mod

@@ -1,1060 +1,630 @@
 MODULE FoxIntermediateParser;
-
 IMPORT
-  Basic := FoxBasic, 
-  Scanner := FoxIntermediateScanner, 
-  Fs	:= FoxScanner,
-  D := Debugging, 
-  SyntaxTree := FoxSyntaxTree, 
-(*  Global := FoxGlobal,  *)
-  Diagnostics;
+	Strings, Diagnostics, D := Debugging, SyntaxTree := FoxSyntaxTree, Scanner := FoxScanner, Sections := FoxSections,
+	IntermediateCode := FoxIntermediateCode, Basic := FoxBasic, Streams, Files, Global := FoxGlobal;
 
 CONST
-  Trace = TRUE;
-(*  CascadedWithSupport = FALSE;*)
-
-(**
-  Module        = 'module' SymbolName [Import] { Section } .
-  Import        = 'imports' SymbolName { ',' SymbolName } .
-  SectionOffset = 'offset' '=' Int .
-  Section       = 'bodycode' SymbolName SectionOffset { Stmt }
-                | 'inlinecode' SymbolName SectionOffset { Stmt }
-                | 'initcode' SymbolName SectionOffset { Stmt }
-                | 'var' SymbolName SectionOffset { Var }
-                | 'const' SymbolName SectionOffset { Const }
-                | 'code' SymbolName SectionOffset { Stmt }
-                .
-  Var           = 'reserve' Int .
-  Const         = 'data' Operand .
-  Stmt          = 'nop'
-                | 'mov'     Operand ',' Operand [ ',' Operand ]
-                | 'conv'    Operand ',' Operand
-                | 'call'    Operand ',' Operand
-                | 'enter'   Operand ',' Operand
-                | 'leave'   Operand
-                | 'return'  Operand
-                | 'exit'    Operand
-                | 'result'  Operand
-                | 'trap'    Operand
-                | 'br'      Operand
-                | 'breq'    Operand ',' Operand ',' Operand
-                | 'brne'    Operand ',' Operand ',' Operand
-                | 'brlt'    Operand ',' Operand ',' Operand
-                | 'brge'    Operand ',' Operand ',' Operand
-                | 'pop'     Operand
-                | 'push'    Operand
-                | 'not'     Operand ',' Operand
-                | 'neg'     Operand ',' Operand
-                | 'abs'     Operand ',' Operand
-                | 'mul'     Operand ',' Operand ',' Operand
-                | 'div'     Operand ',' Operand ',' Operand
-                | 'mod'     Operand ',' Operand ',' Operand
-                | 'sub'     Operand ',' Operand ',' Operand
-                | 'add'     Operand ',' Operand ',' Operand
-                | 'and'     Operand ',' Operand ',' Operand
-                | 'or'      Operand ',' Operand ',' Operand
-                | 'xor'     Operand ',' Operand ',' Operand
-                | 'shl'     Operand ',' Operand ',' Operand
-                | 'shr'     Operand ',' Operand ',' Operand
-                | 'rol'     Operand ',' Operand ',' Operand
-                | 'ror'     Operand ',' Operand ',' Operand
-                | 'copy'    Operand ',' Operand ',' Operand
-                | 'fill'    Operand ',' Operand ',' Operand
-                | 'asm'     String
-                .
-  Operand       = Type '[' MemoryAddr ']'       ; Memory Operand
-                | Type Register [ Int ]         ; Register Operand
-                | Type OpImmediate              ; Immediate Operand
-                | Type String                   ; String Operand
-                | Int                           ; Number Operand
-                .
-  OpImmediate   = Symbol
-                | Int
-                | Hex
-                | Float
-                .
-  MemoryAddr    = Register [ Int ]
-                | Symbol
-                | Int
-                .
-  Register      = '$' 'SP'
-                | '$' 'FP'
-                | '$' Int
-                | '$' 'R' '#' Int
-                .
-  Symbol        = SymbolName ':' Int [ SymbolOffset ] .
-  SymbolOffset  = '(' '@' Int ')' .
-  SymbolName    = Id
-                | '$' Id
-                | '$' '$' Id
-                .
-  Type          = Id .
-  Int           = ['-'|'+']('0'..'9')+           ; Integer
-  Hex           = ('0'..'9')('0'..'9'|'A'..'F')+'H'
-  Float         = ['-']('0'..'9')+'.'('0'..'9')+['E'('-'|'+')('0'..'9')+]
-  Id            = ('a'..'z'|'A'..'Z')('a'..'z'|'A'..'Z'|'0'..'9'|'_'|'.'|'@'|'$')+  ; Identifier
-  String        = '\'' { (Byte - '\'')|'\\\'' }  '\''
-
-**)
+	IntermediateCodeExtension = "Fil"; (* TODO: move to a better place *)
+	Trace=FALSE;
 
 TYPE
-  Parser* = OBJECT
-  VAR 
-    scanner: Scanner.AssemblerScanner;
-    symbol-: Fs.Symbol;
-    diagnostics: Diagnostics.Diagnostics;
-    currentScope: SyntaxTree.Scope;
-    recentSymbol: SyntaxTree.Symbol;
-    recentComment: SyntaxTree.Comment;
-    moduleScope: SyntaxTree.ModuleScope;
-    error-: BOOLEAN;
-
-    indent: LONGINT;   (* for debugging purposes only *)
-
-    PROCEDURE S( CONST s: ARRAY OF CHAR );   (* for debugging purposes only *)
-    VAR i: LONGINT;
-    BEGIN
-      D.Ln;  INC( indent );  D.Int( indent,1 );
-      FOR i := 1 TO indent DO D.Str( "  " );  END;
-      D.Str( "start: " );  D.Str( s );  D.Str( " at pos " );  D.Int( symbol.start,1 );
-    END S;
-
-    PROCEDURE E( CONST s: ARRAY OF CHAR );   (* for debugging purposes only *)
-    VAR i: LONGINT;
-    BEGIN
-      D.Ln;  D.Int( indent,1 );
-      FOR i := 1 TO indent DO D.Str( "  " );  END;
-      D.Str( "end : " );  D.Str( s );  D.Str( " at pos " );  D.Int( symbol.start,1 );
-    END E;
-
-(*    PROCEDURE EE( CONST s, t: ARRAY OF CHAR );   (* for debugging purposes only *)
-    VAR i: LONGINT;
-    BEGIN
-      D.Ln;  D.Int( indent,1 );
-      FOR i := 1 TO indent DO D.Str( "  " );  END;
-      D.Str( "end : " );  D.Str( s );  D.Str( " (" );  D.Str( t );  D.Str( ") at pos " );
-    END EE;*)
-
-    (** constructor, init parser with scanner providing input and with diagnostics for error output *)
-    PROCEDURE & Init*( scanner: Scanner.AssemblerScanner; diagnostics: Diagnostics.Diagnostics );
-    BEGIN
-      SELF.scanner := scanner;
-      SELF.diagnostics := diagnostics;
-      error := ~scanner.GetNextSymbol(symbol);
-      recentSymbol := NIL; recentComment := NIL;
-      (* debugging *)
-      indent := 0;
-    END Init;
-
-    (** output error message and / or given code *)
-    PROCEDURE Error(position: LONGINT; code: LONGINT; CONST message: ARRAY OF CHAR);
-    VAR errorMessage: ARRAY 256 OF CHAR;
-    BEGIN
-      IF diagnostics # NIL THEN
-        Basic.GetErrorMessage(code,message,errorMessage);
-        diagnostics.Error(scanner.source, position, code, errorMessage);
-      END;
-      error := TRUE
-    END Error;
-
-    (** helper procedures interfacing to the scanner **)
-
-    (** Get next symbol from scanner and store it in object-local variable 'symbol' *)
-    PROCEDURE NextSymbol;
-    VAR comment: SyntaxTree.Comment;
-    BEGIN
-      error := ~scanner.GetNextSymbol(symbol) OR error;
-      WHILE ~error & (symbol.token = Scanner.TK_Comment) DO
-        comment := SyntaxTree.NewComment(symbol.start, currentScope, symbol.source^,symbol.stringLength);
-        moduleScope.AddComment(comment);
-        recentComment := comment; comment.SetPreviousSymbol(recentSymbol);
-        error := ~scanner.GetNextSymbol(symbol);
-      END;
-    END NextSymbol;
-
-    (** Check if current symbol equals sym. If yes then return true, return false otherwise *)
-    PROCEDURE Peek(token: Fs.Token): BOOLEAN;
-    VAR comment: SyntaxTree.Comment;
-    BEGIN
-      WHILE ~error & (symbol.token = Scanner.TK_Comment) DO
-        comment := SyntaxTree.NewComment(symbol.start, currentScope, symbol.source^,symbol.stringLength);
-        moduleScope.AddComment(comment);
-        recentComment := comment; comment.SetPreviousSymbol(recentSymbol);
-        error := ~scanner.GetNextSymbol(symbol);
-      END;
-      RETURN symbol.token = token
-    END Peek;
-
-    (** Check if the current symbol equals sym.If yes then read next symbol, report error otherwise. returns success value  *)
-    PROCEDURE Mandatory( token: Fs.Token): BOOLEAN;
-    BEGIN
-      ASSERT( token # Scanner.TK_Identifier );  ASSERT( token # Scanner.TK_String );  ASSERT( token # Scanner.TK_Number );   (* because of NextSymbol ! *)
-      IF ~Peek(token) THEN
-        Error( symbol.start, token, "" );
-        RETURN FALSE
-      ELSE
-        NextSymbol;
-        RETURN TRUE
-      END
-    END Mandatory;
-
-    PROCEDURE MandatoryInteger( VAR value: HUGEINT ): BOOLEAN;
-    BEGIN
-      IF Peek( Scanner.TK_Number ) THEN
-        value := symbol.integer;
-        NextSymbol;
-        RETURN	TRUE;
-      ELSE
-        Error( symbol.start, Scanner.TK_Number, "" );
-        value := 0;
-        RETURN FALSE;
-      END;
-    END MandatoryInteger;
-
-
-(*    (** Check if the current symbol equals sym. If yes then read next symbol, report error otherwise  *)
-    PROCEDURE Check( token: Scanner.Token );
-    VAR b: BOOLEAN;
-    BEGIN
-      b := Mandatory( token );
-    END Check;*)
-
-    (** Check if current symbol is an identifier. If yes then copy identifier to name and get next symbol,
-    report error otherwise and set name to empty name. returns success value *)
-    PROCEDURE MandatoryIdentifier( VAR name: Fs.StringType): BOOLEAN;
-    BEGIN
-      IF Peek(Scanner.TK_Identifier) THEN
-        name := symbol.string;
-        NextSymbol;
-        RETURN TRUE
-      ELSE
-        Error( symbol.start, Scanner.TK_Identifier, "" );
-        name := "";
-        RETURN FALSE
-      END
-    END MandatoryIdentifier;
-
-    (** Expect an identifier (using MandatoryIdentifier) and return identifier object **)
-    PROCEDURE Identifier(): SyntaxTree.Identifier;
-    VAR position: LONGINT; name: Fs.StringType; identifier: SyntaxTree.Identifier;
-    BEGIN
-      position := symbol.start;
-      IF MandatoryIdentifier(name) THEN
-        identifier := SyntaxTree.NewIdentifier(position,name);
-      ELSE
-        identifier := SyntaxTree.invalidIdentifier;
-      END;
-      RETURN identifier
-    END Identifier;
-
-    (** Check if current symbol is a string (or string-like character). If yes then copy identifier to name and get next symbol,
-    report error otherwise and set name to empty name. returns success value*)
-(*    PROCEDURE MandatoryString( VAR name: Fs.StringType ): BOOLEAN;
-    BEGIN
-      IF Peek( Scanner.TK_String) THEN
-        name := symbol.string;
-        NextSymbol;
-        RETURN TRUE
-      ELSIF Peek( Scanner.TK_Character) THEN (* for compatibility with release: characters treated as strings *)
-        name := symbol.string;
-        NextSymbol;
-        RETURN TRUE
-      ELSE
-        Error( symbol.start, Scanner.TK_String, "" );
-        name := "";
-        RETURN FALSE
-      END
-    END MandatoryString;*)
-
-    (** Check if current symbol is an identifier and if the name matches. If yes then get next symbol, report error otherwise. returns success value*)
-(*    PROCEDURE ExpectThisIdentifier( name: SyntaxTree.Identifier ): BOOLEAN;
-    VAR string: ARRAY 64 OF CHAR;
-    BEGIN
-      IF name = NIL THEN (* nothing to be expected *)
-        RETURN TRUE
-      ELSIF (symbol.token # Scanner.TK_Identifier) OR (Basic.MakeString(symbol.string) #  name.name) THEN
-        Basic.GetString(name.name,string);
-        Error( symbol.start, Scanner.TK_Identifier, string );
-        RETURN FALSE
-      ELSE
-        NextSymbol;
-        RETURN TRUE
-      END
-    END ExpectThisIdentifier;*)
-
-    (** Check if current symbol is an identifier and if the name matches. If yes then get next symbol, report error otherwise. returns success value*)
-(*    PROCEDURE ExpectThisString( CONST name: ARRAY OF CHAR ): BOOLEAN;
-    BEGIN
-      IF (Peek(Scanner.TK_String) OR Peek(Scanner.TK_Character) OR Peek(Scanner.TK_Identifier)) & (symbol.string = name) THEN
-        NextSymbol;
-        RETURN TRUE
-      ELSE
-        Error( symbol.start, Scanner.TK_String, name );
-        RETURN FALSE
-      END
-    END ExpectThisString;*)
-
-    (** Check if current symbol equals sym. If yes then get next symbol, return false otherwise *)
-    PROCEDURE Optional( token: Fs.Token ): BOOLEAN;
-    BEGIN
-      (* do not use for Identifier, String or Number, if the result is needed ! *)
-      IF Peek(token) THEN
-        NextSymbol;
-        RETURN TRUE
-      ELSE
-        RETURN FALSE
-      END
-    END Optional;
-
-(*    (* ignore one ore more symbols of type token *)
-    PROCEDURE Ignore(token: Scanner.Token);
-    BEGIN WHILE Optional(token) DO END;
-    END Ignore;
-
-    (** Parsing according to the EBNF **)
-
-    (** QualifiedIdentifier = Identifier ['.' Identifier]. **)
-    PROCEDURE QualifiedIdentifier( ): SyntaxTree.QualifiedIdentifier;
-    VAR prefix,suffix: SyntaxTree.Identifier; qualifiedIdentifier: SyntaxTree.QualifiedIdentifier;  position: LONGINT;
-    BEGIN
-      IF Trace THEN S( "QualifiedIdentifier" ) END;
-      position:= symbol.start;
-      prefix := Identifier();
-      IF prefix # SyntaxTree.invalidIdentifier THEN
-        IF ~Optional( Scanner.Period )THEN
-          suffix := prefix;  prefix := NIL;   (* empty *)
-        ELSE
-           suffix := Identifier();
-        END;
-        qualifiedIdentifier := SyntaxTree.NewQualifiedIdentifier( position, prefix,suffix);
-      ELSE
-        qualifiedIdentifier := SyntaxTree.invalidQualifiedIdentifier;
-      END;
-      IF Trace THEN E( "QualifiedIdentifier" ) END;
-      RETURN qualifiedIdentifier
-    END QualifiedIdentifier;
-
-    (** IdentifierDefinition = Identifier [ '*' | '-' ].  **)
-    PROCEDURE IdentifierDefinition( VAR name: SyntaxTree.Identifier;  VAR access: SET; allowedReadOnly: BOOLEAN);
-    BEGIN
-      IF Trace THEN S( "IdentifierDefinition" ) END;
-      name := Identifier();
-
-      IF Optional( Scanner.Times ) THEN
-        access := SyntaxTree.Public + SyntaxTree.Protected + SyntaxTree.Internal;
-      ELSIF Optional( Scanner.Minus ) THEN
-        IF ~allowedReadOnly THEN
-          Error( symbol.start, Diagnostics.Invalid, "may not be defined read-only" )
-        ELSE
-          access :=  SyntaxTree.ReadOnly + {SyntaxTree.InternalWrite};
-        END;
-      ELSE
-        access := SyntaxTree.Internal;
-      END;
-      IF Trace THEN E( "IdentifierDefinition") END;
-    END IdentifierDefinition;
-
-    (**    Statement =
-                     [
-                     Designator [':=' Expression]
-                     | 'if' Expression 'then' StatementSequence
-                        {'elsif' Expression 'then' StatementSequence} 'end'
-                     | 'with' Identifier ':' QualifiedIdentifier 'do'
-                         StatementSequence 'end'
-                     | 'case' Expression 'of' ['|'] Case {'|' Case} ['else' StatementSequence] 'end'
-                     | 'while' Expression 'do' StatementSequence 'end'
-                     | 'repeat' StatementSequence 'until' Expression
-                     | 'for' Identifier ':=' Expression 'to' Expression ['by' Expression] 'do'
-                         StatementSequence 'end'
-                     | 'loop' StatementSequence 'end'
-                     | 'exit'
-                     | 'return' [Expression]
-                     | 'await' Expression
-                     | 'begin' StatementBlock 'end'
-                     | 'code' {any} 'end'
-                     ].
-    **)
-    PROCEDURE Statement( statements: SyntaxTree.StatementSequence; outer: SyntaxTree.Statement): BOOLEAN;
-    VAR qualifiedIdentifier: SyntaxTree.QualifiedIdentifier;  expression: SyntaxTree.Expression; designator: SyntaxTree.Designator;  statement: SyntaxTree.Statement;
-      ifStatement: SyntaxTree.IfStatement; elsifPart: SyntaxTree.IfPart;   statementSequence: SyntaxTree.StatementSequence;  withStatement: SyntaxTree.WithStatement;
-      withPart: SyntaxTree.WithPart; caller: SyntaxTree.ProcedureCallStatement;
-      caseStatement: SyntaxTree.CaseStatement;  whileStatement: SyntaxTree.WhileStatement;  repeatStatement: SyntaxTree.RepeatStatement;  forStatement: SyntaxTree.ForStatement;
-      identifier: SyntaxTree.Identifier;  loopStatement: SyntaxTree.LoopStatement;  returnStatement: SyntaxTree.ReturnStatement;  awaitStatement: SyntaxTree.AwaitStatement;
-      qualifiedType: SyntaxTree.QualifiedType; code : SyntaxTree.Code; position: LONGINT; result: BOOLEAN;
-    BEGIN
-      IF Trace THEN S( "Statement" ) END;
-      CASE symbol.token OF
-      | Scanner.Identifier, Scanner.Self, Scanner.Result:
-          designator := Designator();
-          position := symbol.start;
-          IF Optional( Scanner.Becomes ) THEN
-            expression := Expression();
-            statement := SyntaxTree.NewAssignment( position, designator, expression,outer )
-          ELSE
-            caller := SyntaxTree.NewProcedureCallStatement(designator.position, designator,outer);
-            statement := caller;
-          END;
-          statements.AddStatement( statement );
-          result := TRUE
-      | Scanner.If:
-          NextSymbol;
-          ifStatement := SyntaxTree.NewIfStatement( symbol.start ,outer);
-          expression := Expression();
-          ifStatement.ifPart.SetCondition( expression );
-          Check( Scanner.Then );
-          statementSequence := StatementSequence(ifStatement);
-          ifStatement.ifPart.SetStatements( statementSequence );
-          WHILE Optional( Scanner.Elsif ) DO
-            elsifPart := SyntaxTree.NewIfPart();
-            ifStatement.AddElsifPart( elsifPart);
-            expression := Expression();
-            elsifPart.SetCondition( expression );
-            Check( Scanner.Then );
-            statementSequence := StatementSequence(ifStatement);
-            elsifPart.SetStatements( statementSequence );
-          END;
-          IF Optional( Scanner.Else ) THEN
-            statementSequence := StatementSequence(ifStatement);
-            ifStatement.SetElsePart( statementSequence );
-          END;
-          Check( Scanner.End );  statements.AddStatement( ifStatement );
-          result := TRUE
-      | Scanner.With:
-          withStatement := SyntaxTree.NewWithStatement( symbol.start ,outer);
-          NextSymbol;
-          REPEAT
-            identifier := Identifier();
-            IF Optional(Scanner.Period) & Optional(Scanner.Identifier) THEN
-              Error(identifier.position,Diagnostics.Invalid,"forbidden qualified identifier in with statement");
-            END;
-            withPart := SyntaxTree.NewWithPart();
-            withStatement.AddWithPart(withPart);
-            designator := SyntaxTree.NewIdentifierDesignator(identifier.position,identifier);
-            withPart.SetVariable( designator );
-            Check( Scanner.Colon );
-            qualifiedIdentifier := QualifiedIdentifier();
-            qualifiedType := SyntaxTree.NewQualifiedType(qualifiedIdentifier.suffix.position, currentScope, qualifiedIdentifier);
-            withPart.SetType(qualifiedType);
-            Check( Scanner.Do );
-            statementSequence := StatementSequence(withStatement);
-            withPart.SetStatements( statementSequence );
-          UNTIL ~Optional(Scanner.Bar) OR ~CascadedWithSupport;
-          IF CascadedWithSupport & Optional(Scanner.Else) THEN
-            statementSequence := StatementSequence(withStatement);
-            withStatement.SetElsePart(statementSequence);
-          END;
-          Check( Scanner.End );
-          statements.AddStatement( withStatement );
-          result := TRUE
-      | Scanner.Case:
-          caseStatement := SyntaxTree.NewCaseStatement( symbol.start,outer );
-          NextSymbol;
-          expression := Expression();
-          Check( Scanner.Of );
-          caseStatement.SetVariable( expression );
-          IF Optional(Scanner.Bar) THEN END;
-          REPEAT
-            Case(caseStatement)
-          UNTIL ~Optional(Scanner.Bar);
-          IF Optional( Scanner.Else ) THEN
-            statementSequence := StatementSequence(caseStatement);
-            caseStatement.SetElsePart( statementSequence );
-          END;
-          Check( Scanner.End );
-          statements.AddStatement( caseStatement );
-          result := TRUE
-      | Scanner.While:
-          NextSymbol;
-          whileStatement := SyntaxTree.NewWhileStatement( symbol.start, outer );
-          expression := Expression();
-          Check( Scanner.Do );
-          whileStatement.SetCondition( expression );
-          statementSequence := StatementSequence(whileStatement);
-          whileStatement.SetStatements( statementSequence );
-          Check( Scanner.End );
-          statements.AddStatement( whileStatement );
-          result := TRUE
-      | Scanner.Repeat:
-          NextSymbol;
-          repeatStatement := SyntaxTree.NewRepeatStatement( symbol.start, outer );
-          statementSequence := StatementSequence(repeatStatement);
-          repeatStatement.SetStatements( statementSequence );
-          Check( Scanner.Until );
-          expression := Expression();
-          repeatStatement.SetCondition( expression );
-          statements.AddStatement( repeatStatement );
-          result := TRUE
-      | Scanner.For:
-          NextSymbol;
-          forStatement := SyntaxTree.NewForStatement( symbol.start, outer);
-          identifier := Identifier();
-          IF Optional(Scanner.Period) & Optional(Scanner.Identifier) THEN
-            Error(identifier.position,Diagnostics.Invalid,"forbidden non-local counter variable");
-          END;
-          designator := SyntaxTree.NewIdentifierDesignator(identifier.position,identifier);
-          forStatement.SetVariable( designator );
-          Check( Scanner.Becomes );
-          expression := Expression();
-          forStatement.SetFrom( expression );
-          Check( Scanner.To );
-          expression := Expression();
-          forStatement.SetTo( expression );
-          IF Optional( Scanner.By ) THEN
-            expression := Expression();
-            forStatement.SetBy( expression );
-          END;
-          Check( Scanner.Do );
-          statementSequence := StatementSequence(forStatement);
-          forStatement.SetStatements( statementSequence );
-          Check( Scanner.End );
-          statements.AddStatement( forStatement );
-          result := TRUE
-      | Scanner.Loop:
-          NextSymbol;
-          loopStatement := SyntaxTree.NewLoopStatement( symbol.start ,outer);
-          statementSequence := StatementSequence(loopStatement);
-          loopStatement.SetStatements( statementSequence );
-          Check( Scanner.End );
-          statements.AddStatement( loopStatement );
-          result := TRUE;
-      | Scanner.Exit:
-          NextSymbol;
-          statement := SyntaxTree.NewExitStatement( symbol.start, outer);
-          statements.AddStatement( statement );
-          result := TRUE;
-      | Scanner.Return:
-          NextSymbol;
-          returnStatement := SyntaxTree.NewReturnStatement( symbol.start, outer);
-          IF (symbol.token >= Scanner.Plus) & (symbol.token <= Scanner.Identifier) THEN
-            expression := Expression();
-            returnStatement.SetReturnValue( expression );
-          END;
-          statements.AddStatement( returnStatement );
-          result := TRUE;
-      | Scanner.Begin:
-          NextSymbol;  statement := StatementBlock(outer);  statements.AddStatement( statement );  Check( Scanner.End );
-          result := TRUE;
-      | Scanner.Await:
-          awaitStatement := SyntaxTree.NewAwaitStatement( symbol.start, outer );
-          NextSymbol;
-          expression := Expression();
-          awaitStatement.SetCondition( expression );
-          statements.AddStatement( awaitStatement );
-          result := TRUE
-      | Scanner.Code:
-        (* assemble *)
-        code := Code(outer);
-        Check(Scanner.End);
-        statements.AddStatement( code );
-        result := TRUE
-      | Scanner.End:  result := FALSE (* end of if, with, case, while, for, loop, or statement sequence *)
-      | Scanner.Until: result := FALSE  (* end of repeat *)
-      | Scanner.Else:  result := FALSE (* else of if or case *)
-      | Scanner.Elsif:  result := FALSE (* elsif of if *)
-      | Scanner.Bar:  result := FALSE (* next case *)
-      | Scanner.Finally: result := FALSE  (* end block by finally statement *)
-      | Scanner.Semicolon: result := FALSE (* allow the empty statement *)
-      (* builtin pseudo procedures are resolved by checker *)
-      ELSE Error( symbol.start, Scanner.Semicolon, "" ); result := FALSE;
-      END;
-      IF Trace THEN E( "Statement" ) END;
-      RETURN result
-    END Statement;
-
-    (** StatementSequence = Statement {';' Statement}. **)
-    PROCEDURE StatementSequence(outer: SyntaxTree.Statement ): SyntaxTree.StatementSequence;
-    VAR statements: SyntaxTree.StatementSequence; b: BOOLEAN;
-    BEGIN
-      IF Trace THEN S( "StatementSequence" ) END;
-      statements := SyntaxTree.NewStatementSequence();
-      IF Lax THEN
-        WHILE ~Peek(Scanner.Return) & Statement(statements,outer) DO Ignore(Scanner.Semicolon) END;
-        IF Peek(Scanner.Return) & Statement(statements,outer) THEN Ignore(Scanner.Semicolon) END; (* return bound to end of statement sequence *)
-      ELSE
-        REPEAT
-          b := Statement( statements,outer )
-        UNTIL ~Optional( Scanner.Semicolon );
-      END;
-      IF Trace THEN E( "StatementSequence" ) END;
-      RETURN statements
-    END StatementSequence;
-
-    (** StatementBlock = ['{' BlockModifier '}'] StatementSequence. **)
-    PROCEDURE StatementBlock(outer: SyntaxTree.Statement): SyntaxTree.StatementBlock;
-    VAR block: SyntaxTree.StatementBlock;
-    BEGIN
-      IF Trace THEN S( "StatementBlock" ) END;
-      block := SyntaxTree.NewStatementBlock( symbol.end, outer );
-      IF Optional( Scanner.LeftBrace ) THEN
-        block.SetModifier(Flags());
-      END;
-      block.SetStatementSequence( StatementSequence(block) );
-      IF Trace THEN E( "StatementBlock" ) END;
-      RETURN block
-    END StatementBlock;
-
-    (** Code = {  Any \ 'end' } . **)
-    PROCEDURE Code(outer: SyntaxTree.Statement): SyntaxTree.Code;
-    VAR startPos, endPos, i ,len: LONGINT; codeString: Scanner.SourceString; code: SyntaxTree.Code;
-    BEGIN
-      startPos := symbol.start;
-      IF scanner.SkipToNextEnd(startPos, endPos, symbol) THEN
-        codeString := symbol.source;
-        code := SyntaxTree.NewCode(startPos,outer);
-        i := 0; len := LEN(codeString);
-        code.SetSourceCode(codeString,len);
-      END;
-      RETURN code;
-    END Code;
-
-    (** wrapper for a body in records and modules *)
-    PROCEDURE BodyProcedure(parentScope: SyntaxTree.Scope): SyntaxTree.Procedure;
-    VAR procedureScope: SyntaxTree.ProcedureScope; procedure: SyntaxTree.Procedure;
-    BEGIN
-      procedureScope := SyntaxTree.NewProcedureScope(parentScope);
-      IF parentScope IS SyntaxTree.ModuleScope THEN
-        procedure := SyntaxTree.NewProcedure( symbol.start, Global.ModuleBodyName,procedureScope);
-        procedure.SetAccess(SyntaxTree.Hidden);
-      ELSE
-        procedure := SyntaxTree.NewProcedure( symbol.start, Global.RecordBodyName,procedureScope);
-        (*! todo: make this a hidden symbol. Problematic when used with paco. *)
-        procedure.SetAccess(SyntaxTree.Public + SyntaxTree.Protected + SyntaxTree.Internal);
-      END;
-      parentScope.AddProcedure(procedure);
-      procedure.SetType(SyntaxTree.NewProcedureType(-1,parentScope));
-      procedure.SetBodyProcedure(TRUE);
-      procedureScope.SetBody(Body(procedureScope));
-      RETURN procedure
-    END BodyProcedure;
-
-    (* ProcedureType = 'procedure' [Flags] [FormalParameters]. *)
-    PROCEDURE ProcedureType(position: LONGINT;  parentScope: SyntaxTree.Scope): SyntaxTree.ProcedureType;
-    VAR procedureType: SyntaxTree.ProcedureType;
-    BEGIN
-      IF Trace THEN S( "ProcedureType" ) END;
-      (* procedure symbol already consumed *)
-      procedureType := SyntaxTree.NewProcedureType( position, parentScope);
-      IF Optional(Scanner.LeftBrace) THEN
-        procedureType.SetModifiers(Flags());
-      END;
-      IF Optional(Scanner.LeftParenthesis) THEN FormalParameters( procedureType, parentScope) END;
-      IF Trace THEN E( "ProcedureType" )
-      END;
-      RETURN procedureType;
-    END ProcedureType;
-
-    (** ParameterDeclaration = ['var'|'const'] Identifier {',' Identifier}':' Type.**)
-    PROCEDURE ParameterDeclaration( procedureType: SyntaxTree.ProcedureType ; parentScope: SyntaxTree.Scope);
-    VAR
-      type: SyntaxTree.Type; name: SyntaxTree.Identifier;
-      firstParameter, parameter: SyntaxTree.Parameter;   kind: LONGINT;
-    BEGIN
-      IF Trace THEN S( "ParameterDeclaration" ) END;
-      IF Optional( Scanner.Var ) THEN (* var parameter *)
-        kind := SyntaxTree.VarParameter
-      ELSIF Optional( Scanner.Const ) THEN (* const parameter *)
-        kind := SyntaxTree.ConstParameter
-      ELSIF symbol.token # Scanner.Identifier THEN
-        Error(symbol.start,Scanner.Identifier,"");
-        RETURN
-      ELSE kind := SyntaxTree.ValueParameter
-      END;
-      firstParameter := procedureType.lastParameter;
-      REPEAT
-        name := Identifier();
-        parameter := SyntaxTree.NewParameter(name.position,procedureType,name,kind);
-        procedureType.AddParameter(parameter);
-      UNTIL ~Optional( Scanner.Comma );
-      Check( Scanner.Colon );
-      type := Type( NIL, parentScope);
-      ASSERT(type # NIL);
-      IF firstParameter # NIL THEN parameter := firstParameter.nextParameter ELSE parameter := procedureType.firstParameter END;
-      WHILE parameter # NIL DO
-        parameter.SetType( type );
-        parameter := parameter.nextParameter;
-      END;
-      IF Trace THEN E( "ParameterDeclaration" )
-      END;
-    END ParameterDeclaration;
-*)
-    PROCEDURE CommentSymbol(symbol: SyntaxTree.Symbol);
-    BEGIN
-      IF (recentComment # NIL) & (recentComment.nextSymbol = NIL) THEN
-        recentComment.SetNextSymbol(symbol);
-      END;
-      recentSymbol := symbol
-    END CommentSymbol;
-(*
-    (** OperatorDeclaration  = 'operator' String ['*'|'-'] FormalParameters ';'
-                             DeclarationSequence [Body] 'end' String.
-    **)
-    PROCEDURE OperatorDeclaration(parentScope: SyntaxTree.Scope );
-    VAR
-      string: Scanner.StringType; name: Scanner.StringType;
-      procedureScope: SyntaxTree.ProcedureScope;
-      procedureType: SyntaxTree.ProcedureType;
-      operator: SyntaxTree.Operator;
-      access: SET;
-      i: LONGINT; ch: CHAR; position: LONGINT;
-    BEGIN
-      IF Trace THEN S( "Operator" ) END;
-      (* symbol operator already consumed *)
-      position := symbol.start;
-      IF MandatoryString( string ) THEN
-        (* copy string to name and check for length. LEN(name)>0, LEN(string)>0 can be presumed  *)
-        i := 0;
-        REPEAT
-          ch := string[i];
-          name[i] := ch;
-          INC(i);
-        UNTIL (ch = 0X) OR (i=LEN(string)) OR (i=LEN(name));
-        IF ch # 0X THEN (* string too long to act as operator identifier *)
-          Error(symbol.start,Basic.StringTooLong,"");
-          name := "";
-        END;
-      ELSE
-        name := "";
-      END;
-      IF Optional( Scanner.Times ) THEN access := SyntaxTree.ReadOnly;
-      ELSIF Optional( Scanner.Minus ) THEN access := SyntaxTree.ReadOnly;
-      ELSE access := SyntaxTree.Internal;
-      END;
-      procedureScope := SyntaxTree.NewProcedureScope(parentScope);
-      operator := SyntaxTree.NewOperator( symbol.start, SyntaxTree.NewIdentifier(position,name), procedureScope);
-      CommentSymbol(operator);
-      operator.SetAccess(access * SyntaxTree.ReadOnly);
-      procedureType := SyntaxTree.NewProcedureType(symbol.start,parentScope);
-      IF Mandatory(Scanner.LeftParenthesis) THEN FormalParameters( procedureType, procedureScope ) END;
-      operator.SetType( procedureType );
-      IF Lax THEN Ignore(Scanner.Semicolon) ELSE Check( Scanner.Semicolon ) END;
-      DeclarationSequence( procedureScope );
-      IF Peek(Scanner.Begin) OR Peek(Scanner.Code) THEN
-        procedureScope.SetBody(Body(procedureScope));
-      END;
-      IF Mandatory(Scanner.End) & ExpectThisString(string) THEN END;
-      parentScope.AddProcedure(operator);
-      IF parentScope IS SyntaxTree.ModuleScope THEN
-        parentScope(SyntaxTree.ModuleScope).AddOperator(operator);
-      ELSIF parentScope IS SyntaxTree.RecordScope THEN
-        parentScope(SyntaxTree.RecordScope).AddOperator(operator);
-      ELSE
-        Error(position,Diagnostics.Invalid,"Operators only allowed in module scope");
-      END;
-      IF Trace THEN EE( "Operator", name ) END;
-    END OperatorDeclaration;
-
-    (** VariableNameList = IdentifierDefinition [Flags] {',' IdentifierDefinition [Flags]}.**)
-    PROCEDURE VariableNameList( scope: SyntaxTree.Scope );
-    VAR varname: SyntaxTree.Identifier;  position: LONGINT; variable: SyntaxTree.Variable;  flags,access: SET;
-    BEGIN
-      IF Trace THEN S( "VariableNameList" ) END;
-      REPEAT
-        flags := {};
-        position := symbol.start;
-        IdentifierDefinition( varname, access,TRUE);
-        variable := SyntaxTree.NewVariable( position, varname );
-        CommentSymbol(variable);
-        IF Optional(Scanner.LeftBrace) THEN variable.SetModifiers(Flags()) END;
-        variable.SetAccess(access);
-        scope.AddVariable(variable);
-      UNTIL ~Optional( Scanner.Comma );
-      IF Trace THEN E( "VariableNameList" ) END;
-    END VariableNameList;
-
-    (** VariableDeclaration = VariableNameList ':' Type. **)
-    PROCEDURE VariableDeclaration(parentScope: SyntaxTree.Scope );
-    VAR
-      variable, firstVariable: SyntaxTree.Variable; type: SyntaxTree.Type;
-    BEGIN
-      IF Trace THEN S( "VariableDeclaration" ) END;
-      firstVariable := parentScope.lastVariable;
-      VariableNameList( parentScope );
-      Check( Scanner.Colon );
-      type := Type( NIL, parentScope );
-
-      variable := firstVariable;
-      IF firstVariable #  NIL THEN variable := firstVariable.nextVariable ELSE variable := parentScope.firstVariable END;
-      WHILE variable # NIL  DO
-        variable.SetType( type );
-        variable := variable.nextVariable;
-      END;
-      IF Trace THEN E( "VariableDeclaration" ) END;
-    END VariableDeclaration;
-
-    (** TypeDeclaration = IdentifierDefinition '=' Type.**)
-    PROCEDURE TypeDeclaration(parentScope: SyntaxTree.Scope);
-    VAR name: SyntaxTree.Identifier;  position: LONGINT; type: SyntaxTree.Type; typeDeclaration: SyntaxTree.TypeDeclaration;   access: SET;
-    BEGIN
-      IF Trace THEN S( "TypeDeclaration" ) END;
-      position := symbol.start;
-      IdentifierDefinition( name, access,FALSE);
-      typeDeclaration := SyntaxTree.NewTypeDeclaration( position,name);
-      CommentSymbol(typeDeclaration);
-      Check( Scanner.Equal );
-      type := Type( name , parentScope);
-      type.SetTypeDeclaration(typeDeclaration);
-      typeDeclaration.SetDeclaredType(type);
-      (*
-      type.SetName(typeDeclaration.name);  (* don't do that: overwrites global names ! *)
-      *)
-      typeDeclaration.SetAccess(access * SyntaxTree.ReadOnly);
-      parentScope.AddTypeDeclaration( typeDeclaration );
-      IF Trace THEN E( "TypeDeclaration" ) END;
-    END TypeDeclaration;
-
-    (** ConstDeclaration = IdentifierDefinition '=' Expression. **)
-    PROCEDURE ConstDeclaration(parentScope: SyntaxTree.Scope );
-    VAR name: SyntaxTree.Identifier;  position: LONGINT; constant: SyntaxTree.Constant;  expression: SyntaxTree.Expression;  access: SET;
-    BEGIN
-      IF Trace THEN S( "ConstDeclaration" ) END;
-      IdentifierDefinition( name, access, FALSE);
-      position := symbol.start;
-      constant := SyntaxTree.NewConstant( position, name );
-      CommentSymbol(constant);
-      constant.SetAccess(access * SyntaxTree.ReadOnly);
-      Check( Scanner.Equal );
-      expression := Expression();
-      constant.SetValue( expression );
-      parentScope.AddConstant( constant );
-      IF Trace THEN E( "ConstDeclaration" ) END;
-    END ConstDeclaration;
-*)
-
-    PROCEDURE StmtSequence( parentScope: SyntaxTree.Scope );
-    VAR
-    BEGIN
-      IF Trace THEN S( "StmtSequence" ) END;
-      IF Trace THEN E( "StmtSequence" ) END;
-    END StmtSequence;
-
-(**
-  OpImmediate   = Symbol
-                | Int
-                | Hex
-                | Float
-                .
-**)
-    PROCEDURE OpImmediate( parentScope: SyntaxTree.Scope ):BOOLEAN;
-    VAR
-    BEGIN
-      IF Trace THEN S( "OpImmediate" ) END;
-      IF Trace THEN E( "OpImmediate" ) END;
-    END OpImmediate;
-
-(**
-  MemoryAddr    = Register [ Int ]
-                | Symbol
-                | Int
-                .
-**)
-    PROCEDURE MemoryAddr( parentScope: SyntaxTree.Scope ):BOOLEAN;
-    VAR
-    BEGIN
-      IF Trace THEN S( "MemoryAddr" ) END;
-      IF Trace THEN E( "MemoryAddr" ) END;
-    END MemoryAddr;
-
-(**
-  Register      = '$' 'SP'
-                | '$' 'FP'
-                | '$' Int
-                | '$' 'R' '#' Int
-                .
-**)
-    PROCEDURE Register( parentScope: SyntaxTree.Scope ):BOOLEAN;
-    VAR
-    BEGIN
-      IF Trace THEN S( "Register" ) END;
-      IF Trace THEN E( "Register" ) END;
-    END Register;
-
-    PROCEDURE String( parentScope: SyntaxTree.Scope ):BOOLEAN;
-    VAR
-    BEGIN
-      IF Trace THEN S( "String" ) END;
-      IF Trace THEN E( "String" ) END;
-    END String;
-
-(**
-  Operand       = Type '[' MemoryAddr ']'       ; Memory Operand
-                | Type Register [ Int ]         ; Register Operand
-                | Type OpImmediate              ; Immediate Operand
-                | Type String                   ; String Operand
-                | Int                           ; Number Operand
-                .
-**)
-    PROCEDURE Operand( parentScope: SyntaxTree.Scope );
-    VAR
-      value	: HUGEINT;
-      dummy : BOOLEAN;
-      type : Fs.StringType;
-    BEGIN
-      IF Trace THEN S( "Operand" ) END;
-      IF MandatoryIdentifier( type ) THEN
-        (* Type *)
-        IF Optional( Scanner.TK_LeftBracket ) THEN
-        
-        ELSIF Register( parentScope ) THEN
-        
-        ELSIF OpImmediate( parentScope ) THEN
-        
-        ELSIF String( parentScope ) THEN
-        
-        ELSE
-          Error( symbol.start, symbol.token, "Operand" );
-        END;
-      ELSE
-        (* Number *)
-        dummy := MandatoryInteger( value );
-	 END;
-      IF Trace THEN E( "Operand" ) END;
-    END Operand;
-
-(**
-  Const         = 'data' Operand .
-**)
-    PROCEDURE ConstSequence( parentScope: SyntaxTree.Scope );
-    VAR
-    BEGIN
-      IF Trace THEN S( "ConstSequence" ) END;
-      WHILE Optional( Scanner.TK_Data ) DO
-        Operand( parentScope );
-      END;
-      IF Trace THEN E( "ConstSequence" ) END;
-    END ConstSequence;
-
-
-(**
-  SectionOffset = 'offset' '=' Int .
-**)
-    PROCEDURE SectionOffset( parentScope: SyntaxTree.Scope);
-    VAR
-      value : HUGEINT;
-    BEGIN
-      IF Trace THEN S( "SectionOffset" ) END;
-      IF Mandatory( Scanner.TK_Offset ) THEN
-        IF Mandatory( Scanner.TK_Becomes ) THEN
-          IF MandatoryInteger( value ) THEN
-          END;
-        END;
-      END;
-      IF Trace THEN E( "SectionOffset" ) END;
-    END SectionOffset;
-
-(**
-  Section       = 'bodycode' SymbolName SectionOffset { Stmt }
-                | 'inlinecode' SymbolName SectionOffset { Stmt }
-                | 'initcode' SymbolName SectionOffset { Stmt }
-                | 'var' SymbolName SectionOffset { Var }
-                | 'const' SymbolName SectionOffset { Const }
-                | 'code' SymbolName SectionOffset { Stmt }
-                .
-**)
-    PROCEDURE Section( parentScope: SyntaxTree.Scope);
-    VAR
-      previousScope: SyntaxTree.Scope;
-      name : SyntaxTree.Identifier;
-    BEGIN
-      previousScope := currentScope;
-      currentScope := parentScope;
-      IF Trace THEN S( "Section" ) END;
-      LOOP
-        IF Optional( Scanner.TK_Bodycode ) THEN
-          name := Identifier();
-          SectionOffset( parentScope );
-          StmtSequence( parentScope );
-        ELSIF Optional( Scanner.TK_Inlinecode ) THEN
-(*          ...*)
-        ELSIF Optional( Scanner.TK_Const ) THEN
-          name := Identifier();
-          SectionOffset( parentScope );
-          ConstSequence( parentScope );
-        ELSE EXIT
-        END;
-      END;
-      currentScope := previousScope;
-      IF Trace THEN E( "Section" ) END;
-    END Section;
-
-(**
-  Import        = 'imports' SymbolName { ',' SymbolName } .
-**)
-    PROCEDURE ImportList( moduleScope: SyntaxTree.ModuleScope );
-    VAR
-      name : SyntaxTree.Identifier;
-      import        : SyntaxTree.Import;
-      position      : LONGINT;
-    BEGIN
-      IF Trace THEN S( "Import" ) END;
-      (* import symbol already consumed *)
-      REPEAT
-        position := symbol.start;
-        name := Identifier();
-        IF name # SyntaxTree.invalidIdentifier THEN
-          import := SyntaxTree.NewImport( position, name, name, TRUE );
-          CommentSymbol(import);
-          moduleScope.AddImport( import );
-        END;
-      UNTIL ~Optional( Scanner.TK_Comma );
-      IF Trace THEN E( "Import" );  END;
-    END ImportList;
-
-(**
-  Module        = 'module' SymbolName [Import] { Section } .
-**)
-    PROCEDURE Module*(): SyntaxTree.Module;
-    VAR moduleName: SyntaxTree.Identifier;  module: SyntaxTree.Module;  position: LONGINT; 
-    BEGIN
-      IF Trace THEN S( "Module" ) END;
-      position := symbol.start;
-      moduleScope := SyntaxTree.NewModuleScope(); (* needed to feed in comment already before module starts *)
-      currentScope := moduleScope;
-      IF Mandatory( Scanner.TK_Module ) THEN
-        moduleName :=  Identifier();
-        module := SyntaxTree.NewModule( scanner.source, moduleName.position, moduleName, moduleScope, 0 );
-        module.SetType(SyntaxTree.moduleType);
-        CommentSymbol(module);
-        IF Optional(Scanner.TK_Imports) THEN
-        	ImportList(moduleScope)
-        END;
-        Section( moduleScope );
-      END;
-      IF Trace THEN E( "Module" ) END;
-      RETURN module
-    END Module;
-
-    (** check if another module declaration is available after recent module parsing -> for parsing and compiling multiple modules within a single file **)
-    PROCEDURE NextModule*(): BOOLEAN;
-    BEGIN
-      NextSymbol;
-      RETURN Peek(Scanner.TK_Module);
-    END NextModule;
-
-  END Parser;
-
-  (* utilities *)
-(*  PROCEDURE AppendModifier(VAR list: SyntaxTree.Modifier; modifier: SyntaxTree.Modifier);
-  VAR this, next: SyntaxTree.Modifier;
-  BEGIN
-    IF list = NIL THEN list := modifier
-    ELSE
-      this := list;
-      next := list.nextModifier;
-      WHILE next # NIL DO
-        this := next;
-        next := this.nextModifier;
-      END;
-      this.SetNext(modifier);
-    END;
-  END AppendModifier;*)
-
-  (** parser retrieval **)
-  PROCEDURE NewParser*( scanner: Scanner.AssemblerScanner;  diagnostics: Diagnostics.Diagnostics): Parser;
-  VAR parser: Parser;
-  BEGIN
-    NEW( parser, scanner, diagnostics );  RETURN parser;
-  END NewParser;
-
-END FoxIntermediateParser.
+	MessageString= ARRAY 256 OF CHAR;
+
+	(** the intermediate code parser **)
+	IntermediateCodeParser* = OBJECT
+	CONST
+		Trace = FALSE;
+		Strict = TRUE;
+
+	VAR
+		diagnostics: Diagnostics.Diagnostics;
+		error: BOOLEAN;
+		symbol: Scanner.Symbol;
+		scanner: Scanner.AssemblerScanner;
+		system: Global.System;
+
+		PROCEDURE &Init*(diagnostics: Diagnostics.Diagnostics; s: Global.System);
+		BEGIN
+			ASSERT(s # NIL); (* a default system object is required in case there is no platform directive *)
+			SELF.diagnostics := diagnostics;
+			system := s;
+			error := FALSE
+		END Init;
+
+		PROCEDURE Error(pos: LONGINT; CONST msg: ARRAY OF CHAR);
+		BEGIN
+			error := TRUE;
+			IF diagnostics # NIL THEN
+				diagnostics.Error(scanner.source^,pos,Diagnostics.Invalid,msg);
+			END;
+
+			D.Update;
+			IF Trace THEN D.TraceBack END
+		END Error;
+
+		PROCEDURE NextSymbol;
+		BEGIN error := error OR ~scanner.GetNextSymbol(symbol)
+		END NextSymbol;
+
+		PROCEDURE ThisToken(x: LONGINT): BOOLEAN;
+		BEGIN
+			IF ~error & (symbol.token = x) THEN NextSymbol; RETURN TRUE ELSE RETURN FALSE END;
+		END ThisToken;
+
+		PROCEDURE GetIdentifier(VAR pos: LONGINT; VAR identifier: ARRAY OF CHAR): BOOLEAN;
+		BEGIN
+			pos := symbol.start;
+			IF symbol.token # Scanner.Identifier THEN RETURN FALSE
+			ELSE COPY(symbol.identifierString,identifier); NextSymbol; RETURN TRUE
+			END;
+		END GetIdentifier;
+
+		PROCEDURE ExpectToken(x: LONGINT): BOOLEAN;
+		VAR
+			s: MessageString;
+		BEGIN
+			IF ThisToken(x) THEN RETURN TRUE
+			ELSE
+				s := "expected token "; Strings.Append(s,Scanner.tokens[x]); Strings.Append(s," but got "); Strings.Append(s,Scanner.tokens[symbol.token]);
+				Error(symbol.start, s);RETURN FALSE
+			END;
+		END ExpectToken;
+
+		PROCEDURE ThisIdentifier(CONST this: ARRAY OF CHAR): BOOLEAN;
+		BEGIN
+			IF ~error & (symbol.token = Scanner.Identifier) & (this = symbol.identifierString) THEN NextSymbol; RETURN TRUE ELSE RETURN FALSE END;
+		END ThisIdentifier;
+
+		PROCEDURE ExpectAnyIdentifier(VAR pos: LONGINT; VAR identifier: ARRAY OF CHAR): BOOLEAN;
+		BEGIN
+			IF ~GetIdentifier(pos,identifier)THEN Error(pos,"identifier expected"); RETURN FALSE
+			ELSE RETURN TRUE
+			END;
+		END ExpectAnyIdentifier;
+
+		PROCEDURE ExpectIntegerWithSign(VAR integer: LONGINT): BOOLEAN;
+		VAR
+			result, isNegated: BOOLEAN;
+		BEGIN
+			isNegated := ThisToken(Scanner.Minus);
+			IF ExpectToken(Scanner.Number) & (symbol.numberType = Scanner.Integer) THEN
+				IF isNegated THEN
+					integer := -symbol.integer
+				ELSE
+					integer := symbol.integer
+				END;
+				result := TRUE
+			ELSE
+				result := FALSE
+			END;
+			RETURN result
+		END ExpectIntegerWithSign;
+
+		PROCEDURE ExpectIntegerWithoutSign(VAR integer: LONGINT): BOOLEAN;
+		VAR
+			result: BOOLEAN;
+		BEGIN
+			IF ExpectToken(Scanner.Number) & (symbol.numberType = Scanner.Integer) THEN
+				integer := symbol.integer;
+				result := TRUE
+			ELSE
+				result := FALSE
+			END;
+			RETURN result
+		END ExpectIntegerWithoutSign;
+
+		PROCEDURE IgnoreNewLines;
+		BEGIN
+			WHILE ThisToken(Scanner.Ln) DO END;
+		END IgnoreNewLines;
+
+		(* expect the newline or end-of-text symbol *)
+		PROCEDURE ExpectLineDelimiter(): BOOLEAN;
+		BEGIN
+			IF ~error & ((symbol.token = Scanner.Ln) OR (symbol.token = Scanner.EndOfText)) THEN
+				NextSymbol;
+				RETURN TRUE
+			ELSE
+				Error(symbol.start, "end of line/text expected");
+				RETURN FALSE
+			END;
+		END ExpectLineDelimiter;
+
+		(** parse an optional line number **)
+		PROCEDURE ParseLineNumber(expectedLineNumber: LONGINT);
+		VAR
+			positionOfLine, specifiedLineNumber: LONGINT;
+			message, tempString: MessageString;
+		BEGIN
+			IF Trace THEN D.String(">>> ParseLineNumber"); D.Ln END;
+
+			positionOfLine := symbol.start;
+			IF ThisToken(Scanner.Number) THEN (* note: line numbers are optional *)
+				specifiedLineNumber := symbol.integer;
+				IF ExpectToken(Scanner.Colon) THEN
+					IF Strict & (specifiedLineNumber # expectedLineNumber) THEN
+						message := "invalid code line number (";
+						Strings.IntToStr(specifiedLineNumber, tempString); Strings.Append(message, tempString);
+						Strings.Append(message, " instead of ");
+						Strings.IntToStr(expectedLineNumber, tempString); Strings.Append(message, tempString);
+						Strings.Append(message, ")");
+						Error(positionOfLine, message)
+					END
+				END
+			END
+		END ParseLineNumber;
+
+		(** parse an intermediate code operand **)
+		PROCEDURE ParseOperand(VAR operand: IntermediateCode.Operand; sectionList: Sections.SectionList);
+		VAR
+			positionOfOperand, pos, registerNumber, symbolOffset, someLongint, integer: LONGINT;
+			someHugeint: HUGEINT;
+			hasTypeDescriptor, isMemoryOperand, lastWasIdentifier, isNegated: BOOLEAN;
+			someLongreal: LONGREAL;
+			identifier: SyntaxTree.IdentifierString;
+			type: IntermediateCode.Type;
+			sectionOfSymbol: Sections.Section;
+			name: Basic.SegmentedName;
+			registerClass: IntermediateCode.RegisterClass;
+		BEGIN
+			IF Trace THEN D.String(">>> ParseOperand"); D.Ln END;
+
+			positionOfOperand := symbol.start;
+
+			(* defaults *)
+			hasTypeDescriptor := FALSE;
+			isMemoryOperand := FALSE;
+
+			(* consume optional type description *)
+			lastWasIdentifier := GetIdentifier(pos, identifier);
+			IF lastWasIdentifier & IntermediateCode.DenotesType(identifier, type) THEN
+				hasTypeDescriptor := TRUE;
+				lastWasIdentifier := GetIdentifier(pos, identifier)
+			END;
+
+			(* consume optional memory operand bracket *)
+			IF ~lastWasIdentifier THEN
+				isMemoryOperand := ThisToken(Scanner.LeftBracket);
+				lastWasIdentifier := GetIdentifier(pos, identifier)
+			END;
+
+			IF lastWasIdentifier THEN
+				IF IntermediateCode.DenotesRegister(identifier, registerClass, registerNumber) THEN
+					(* register *)
+					IntermediateCode.InitRegister(operand, type, registerClass, registerNumber);
+				ELSE
+					(* TODO: handle assembly constants *)
+
+					(* symbol name *)
+					symbolOffset := 0;
+
+					(* consume optional symbol offset *)
+					IF ThisToken(Scanner.Colon) THEN
+						IF ExpectIntegerWithSign(integer) THEN
+							symbolOffset := integer
+						ELSE
+							Error(symbol.start, "invalid symbol offset")
+						END
+					END;
+
+					IF Trace THEN D.String(">>> symbol detected"); D.Ln END;
+
+					Basic.ToSegmentedName(identifier, name);
+					IntermediateCode.InitAddress(operand, IntermediateCode.UnsignedIntegerType(system.addressSize), name, 0, symbolOffset)
+				END
+
+			ELSIF symbol.token = Scanner.String THEN
+				(* string constant *)
+				IntermediateCode.InitString(operand, symbol.string);
+				NextSymbol
+
+			ELSE
+				(* immediate values/numbers *)
+				isNegated := ThisToken(Scanner.Minus);
+				IF ThisToken(Scanner.Number) THEN
+					CASE symbol.numberType OF
+					| Scanner.Integer:
+						IF isNegated THEN someLongint := -symbol.integer ELSE someLongint := symbol.integer END;
+						IF ~hasTypeDescriptor THEN
+							(* if no type description was included: use number type *)
+							IntermediateCode.InitNumber(operand, someLongint);
+						ELSIF type.form = IntermediateCode.Float THEN
+							ASSERT(hasTypeDescriptor);
+							IntermediateCode.InitFloatImmediate(operand, type, REAL(someLongint))
+						ELSE
+							ASSERT(hasTypeDescriptor & (type.form IN IntermediateCode.Integer));
+							IntermediateCode.InitImmediate(operand, type, someLongint)
+						END
+					| Scanner.Hugeint:
+						IF isNegated THEN someHugeint := - symbol.hugeint ELSE someHugeint := symbol.hugeint END;
+						IF ~hasTypeDescriptor THEN
+							(* if no type description was included: use number type *)
+							IntermediateCode.InitNumber(operand, someHugeint)
+						ELSIF type.form = IntermediateCode.Float THEN
+							ASSERT(hasTypeDescriptor);
+							IntermediateCode.InitFloatImmediate(operand, type, REAL(someHugeint))
+						ELSE
+							ASSERT(hasTypeDescriptor & (type.form IN IntermediateCode.Integer));
+							IntermediateCode.InitImmediate(operand, type, someHugeint)
+						END
+					| Scanner.Real, Scanner.Longreal:
+						IF isNegated THEN someLongreal := -symbol.real ELSE someLongreal := symbol.real END;
+						(* if no type description was included: use float type with same amount of bits as address type *)
+						IF ~hasTypeDescriptor THEN
+							IntermediateCode.InitType(type, IntermediateCode.Float, INTEGER(system.addressSize))
+						END;
+						IF type.form IN IntermediateCode.Integer THEN
+							Error(positionOfOperand, "floating point immediate value not applicable")
+						ELSE
+							IntermediateCode.InitFloatImmediate(operand, type, someLongreal)
+						END
+					ELSE HALT(100)
+					END
+				ELSE
+					Error(positionOfOperand, "invalid operand")
+				END
+			END;
+
+			(* consume optional offset given in system units *)
+			IF ThisToken(Scanner.Plus) THEN
+				IF ExpectIntegerWithoutSign(integer) THEN
+					IntermediateCode.SetOffset(operand, integer)
+				ELSE
+					Error(symbol.start, "invalid offset")
+				END
+			ELSIF ThisToken(Scanner.Minus) THEN
+				IF ExpectIntegerWithoutSign(integer) THEN
+					IntermediateCode.SetOffset(operand, -integer)
+				ELSE
+					Error(symbol.start, "invalid offset")
+				END
+			END;
+
+			(* wrap memory operand around current operand if necessary *)
+			IF isMemoryOperand & ExpectToken(Scanner.RightBracket) THEN
+				IntermediateCode.SetType(operand, IntermediateCode.UnsignedIntegerType(system.addressSize)); (* set the type of the inner operand to the platform's address type *)
+				IF ~hasTypeDescriptor THEN
+					IntermediateCode.InitType(type, IntermediateCode.SignedInteger, INTEGER(system.addressSize)) (* default: signed integer type of address size *)
+				END;
+				IntermediateCode.InitMemory(operand, type, operand, 0) (* TODO: add offset? *)
+			END
+		END ParseOperand;
+
+		(** parse an intermediate code instruction **)
+		PROCEDURE ParseInstruction(VAR instruction: IntermediateCode.Instruction; sectionList: Sections.SectionList);
+		VAR
+			opCode: SHORTINT;
+			positionOfInstruction, positionOfOperand, operandNumber: LONGINT;
+			operand: IntermediateCode.Operand;
+			operands: ARRAY 3 OF IntermediateCode.Operand;
+			operandType: IntermediateCode.Type;
+			identifier, message, tempString: SyntaxTree.IdentifierString;
+		BEGIN
+			IF Trace THEN D.String(">>> ParseInstruction"); D.Ln END;
+
+			positionOfInstruction := symbol.start;
+			IF ExpectAnyIdentifier(positionOfInstruction, identifier) THEN
+				(* TODO: detect labels of the form << labelName: >> *)
+				opCode := IntermediateCode.FindMnemonic(identifier);
+
+				IF opCode = IntermediateCode.None THEN
+					Error(positionOfInstruction, "unknown mnemonic")
+				ELSE
+					(* consume all operands *)
+					IntermediateCode.InitType(operandType, IntermediateCode.SignedInteger, 32); (* defaults *)
+					IntermediateCode.InitOperand(operands[0]);
+					IntermediateCode.InitOperand(operands[1]);
+					IntermediateCode.InitOperand(operands[2]);
+
+					operandNumber := 0;
+					IF ~ThisToken(Scanner.Ln) & ~ThisToken(Scanner.EndOfText) THEN
+						REPEAT
+							positionOfOperand := symbol.start;
+							IF operandNumber > 2 THEN
+								Error(positionOfInstruction, "instruction has too many operands")
+							ELSE
+								ParseOperand(operand, sectionList);
+								IF ~error THEN
+									IF Strict & ~IntermediateCode.CheckOperand(operand, opCode, operandNumber, message) THEN
+										Strings.Append(message, " @ operand ");
+										Strings.IntToStr(operandNumber + 1, tempString); Strings.Append(message, tempString);
+										Error(positionOfOperand, message)
+									END;
+									operands[operandNumber] := operand;
+									INC(operandNumber)
+								END
+							END
+						UNTIL error OR ~ThisToken(Scanner.Comma);
+						IF ~error & ExpectLineDelimiter() THEN END
+					END;
+
+					IF ~error THEN
+						IntermediateCode.InitInstruction(instruction, positionOfInstruction, opCode, operands[0], operands[1], operands[2]);
+						IF Strict & ~IntermediateCode.CheckInstruction(instruction, message) THEN
+							Error(positionOfInstruction, message)
+						END
+					END
+				END;
+
+			END
+		END ParseInstruction;
+
+		(** parse the content of an intermediate code section
+		note: 'sectionList' is the list where referenced sections are found/to be created
+		**)
+		PROCEDURE ParseSectionContent*(scanner: Scanner.AssemblerScanner; section: IntermediateCode.Section; sectionList: Sections.SectionList);
+		VAR
+			instruction: IntermediateCode.Instruction;
+			lineNumber: LONGINT;
+		BEGIN
+			IF Trace THEN D.Ln; D.String(">>> ParseSectionContent"); D.Ln END;
+			SELF.scanner := scanner;
+			IgnoreNewLines;
+			lineNumber := 0;
+			WHILE ~error & (symbol.token # Scanner.Period) & (symbol.token # Scanner.EndOfText) DO
+				(* consume optional line number *)
+				ParseLineNumber(lineNumber);
+				IF ~error THEN
+					ParseInstruction(instruction, sectionList);
+					IF ~error THEN
+						IF Trace THEN IntermediateCode.DumpInstruction(D.Log, instruction); D.Ln; END;
+						section.Emit(instruction);
+						INC(lineNumber)
+					END;
+				END;
+				IgnoreNewLines
+			END
+		END ParseSectionContent;
+
+		(** parse a list of section properties **)
+		PROCEDURE ParseSectionProperties(VAR section: IntermediateCode.Section);
+		VAR
+			positionOfProperty, integer: LONGINT;
+		BEGIN
+			IF Trace THEN D.Ln; D.String(">>> ParseSectionProperties"); D.Ln END;
+
+			WHILE ~error & (symbol.token # Scanner.EndOfText) & (symbol.token # Scanner.Ln) DO
+				positionOfProperty := symbol.start;
+
+				(* fingerprint *)
+				IF ThisIdentifier("fingerprint") & ExpectToken(Scanner.Equal) THEN
+					IF ExpectIntegerWithSign(integer) THEN
+						IF (section.fingerprint # 0) & (section.fingerprint # integer) THEN
+							Error(positionOfProperty, "incompatible fingerprint");
+						ELSE
+							section.SetFingerprint(integer);
+						END
+					ELSE
+						Error(positionOfProperty, "invalid fingerprint")
+					END
+
+				(* position *)
+				ELSIF ThisIdentifier("priority") & ExpectToken(Scanner.Equal) THEN
+					IF ExpectIntegerWithSign(integer) THEN
+						section.SetPriority(SHORT(integer));
+					ELSE
+						Error(positionOfProperty," invalid priority")
+					END;
+				(* alignment *)
+				ELSIF ThisIdentifier("aligned") & ExpectToken(Scanner.Equal) THEN
+					IF ExpectIntegerWithSign(integer) THEN
+						section.SetPositionOrAlignment(FALSE, integer)
+					ELSE
+						Error(positionOfProperty, "invalid alignment")
+					END
+
+				(* fixed position *)
+				ELSIF ThisIdentifier("fixed") & ExpectToken(Scanner.Equal) THEN
+					IF ExpectIntegerWithSign(integer) THEN
+						section.SetPositionOrAlignment(TRUE, integer)
+					ELSE
+						Error(positionOfProperty, "invalid fixed postion")
+					END
+
+				(* unit size of the section in bits *)
+				ELSIF ThisIdentifier("unit") & ExpectToken(Scanner.Equal) THEN
+					IF ExpectIntegerWithSign(integer) THEN
+						section.SetBitsPerUnit(integer) (* overwrite default unit size *)
+					ELSE
+						Error(positionOfProperty, "invalid unit size")
+					END
+
+				(* total size of the section in units *)
+				ELSIF ThisIdentifier("size") & ExpectToken(Scanner.Equal) THEN
+					IF ExpectIntegerWithSign(integer) THEN
+						 (* nothing to do (this property is ignored, since the size is calculated from the actual content) *)
+					ELSE
+						Error(positionOfProperty, "invalid size")
+					END
+
+				ELSE
+					Error(positionOfProperty, "invalid property")
+				END
+			END
+		END ParseSectionProperties;
+
+		(** parse the content of an intermediate code module **)
+		PROCEDURE ParseModuleContent*(scanner: Scanner.AssemblerScanner ; module: Sections.Module (* sectionList: Sections.SectionList; VAR moduleName: SyntaxTree.IdentifierString; VAR backend: Backend.Backend; loader: ModuleLoader*) ): BOOLEAN;
+		VAR
+			pos, positionOfDirective: LONGINT;
+			identifier: Scanner.IdentifierString;
+			afterModuleDirective, afterImportsDirective, afterFirstSection, isExternalSection: BOOLEAN;
+			sectionType: SHORTINT;
+			section: IntermediateCode.Section;
+			name: Basic.SegmentedName;
+			moduleName: SyntaxTree.IdentifierString;
+		BEGIN
+			IF Trace THEN D.Ln; D.String(">>> ParseModuleContent"); D.Ln END;
+
+			moduleName := "";
+			(*NEW(imports, 128);*)
+
+			ASSERT(scanner # NIL);
+			SELF.scanner := scanner;
+			NextSymbol; (* read first symbol *)
+
+			(* go through directives *)
+			afterModuleDirective := FALSE;
+			afterImportsDirective := FALSE;
+			afterFirstSection := FALSE;
+			IgnoreNewLines;
+			WHILE ~error & (symbol.token # Scanner.EndOfText) DO
+				positionOfDirective := symbol.start;
+				IF ExpectToken(Scanner.Period) & ExpectAnyIdentifier(pos, identifier) THEN
+					(* 'module' directive *)
+					IF identifier = "module" THEN
+						IF afterModuleDirective THEN
+							Error(positionOfDirective, "multiple module directives");
+						ELSIF ExpectAnyIdentifier(pos, identifier) & ExpectLineDelimiter() THEN
+							moduleName := identifier;
+							module.SetModuleName(identifier);
+							afterModuleDirective := TRUE;
+						END
+
+					(* 'platform' directive *)
+					ELSIF identifier = "platform" THEN
+						IF ~afterModuleDirective THEN
+							Error(positionOfDirective, "platform directive must be preceeded by module directive")
+						ELSIF ExpectAnyIdentifier(pos, identifier) & ExpectLineDelimiter() THEN
+							module.SetPlatformName(identifier);
+							(*! check against used backend *)
+						ELSIF afterFirstSection THEN
+							Error(positionOfDirective, "platform directive not before all sections")
+						END
+
+					(* 'imports' directive *)
+					ELSIF identifier = "imports" THEN
+						IF ~afterModuleDirective THEN
+							Error(positionOfDirective, "import directive must be preceeded by module directive")
+						ELSIF afterImportsDirective THEN
+							Error(positionOfDirective, "multiple import directives")
+						ELSIF afterFirstSection THEN
+							Error(positionOfDirective, "import directive not before all sections")
+						ELSE
+							REPEAT
+								IF ExpectAnyIdentifier(positionOfDirective, identifier) THEN
+									module.imports.AddName(identifier);
+									(*
+									IF ~loader(identifier) THEN Error(positionOfDirective, "could not import") END;
+									*)
+								END
+							UNTIL error OR ~ThisToken(Scanner.Comma);
+							IF ExpectLineDelimiter() THEN
+								afterImportsDirective := TRUE
+							END
+						END
+
+					(* section *)
+					ELSE
+						(* determine if section is external *)
+						IF identifier = "external" THEN
+							positionOfDirective := symbol.start;
+							IF ExpectToken(Scanner.Period) & ExpectAnyIdentifier(pos, identifier) THEN END;
+							isExternalSection := TRUE
+						ELSE
+							isExternalSection := FALSE
+						END;
+
+						IF  ~error THEN
+							IF identifier = "code" THEN sectionType := Sections.CodeSection
+							ELSIF identifier = "const" THEN sectionType := Sections.ConstSection
+							ELSIF identifier = "var" THEN sectionType := Sections.VarSection
+							ELSIF identifier = "bodycode" THEN sectionType := Sections.BodyCodeSection
+							ELSIF identifier = "inlinecode" THEN sectionType := Sections.InlineCodeSection
+							ELSIF identifier = "initcode" THEN sectionType := Sections.InitCodeSection
+							ELSE Error(positionOfDirective, "invalid directive or section type")
+							END;
+
+							IF ~error & ~afterModuleDirective THEN
+								Error(positionOfDirective, "module directive expected first")
+							END;
+
+							IF ~error THEN
+								IF ExpectAnyIdentifier(pos, identifier) THEN
+									Basic.ToSegmentedName(identifier, name);
+									section := IntermediateCode.NewSection(module.allSections, sectionType, name, NIL, TRUE); (* keeps section if already present *)
+
+									(* set default unit size for the platform, which depends on the section type *)
+									IF (sectionType = Sections.VarSection) OR (sectionType = Sections.ConstSection) THEN
+										section.SetBitsPerUnit(system.dataUnit)
+									ELSE
+										section.SetBitsPerUnit(system.codeUnit)
+									END;
+									ASSERT(section.bitsPerUnit # Sections.UnknownSize);
+
+									(* consume optional section properties *)
+									ParseSectionProperties(section);
+
+									IF ~error & ExpectLineDelimiter() THEN
+										ParseSectionContent(scanner, section, module.allSections);
+										afterFirstSection := TRUE
+									END
+								END
+							END
+
+						END
+					END
+				END;
+				IgnoreNewLines;
+			END;
+			RETURN ~error
+		END ParseModuleContent;
+
+		(** parse an entire intermediate code module **)
+		PROCEDURE ParseModule*(system: Global.System): Sections.Module;
+		VAR
+			result: Sections.Module;
+		BEGIN
+			NEW(result, NIL, system); (* note: 1. there is no syntax tree module, 2. the system object to be used is not yet known *)
+			IF ParseModuleContent(scanner, result (* result.allSections, moduleName, backend, loader *)) THEN
+				IF Trace THEN
+					D.String("++++++++++ PARSED MODULE '"); D.String(result.moduleName); D.String("' ++++++++++"); D.Ln;
+					result.Dump(D.Log)
+				END
+			ELSE
+				result := NIL
+			END
+		END ParseModule;
+	END IntermediateCodeParser;
+
+	PROCEDURE ParseReader*(reader: Streams.Reader; diagnostics: Diagnostics.Diagnostics; module: Sections.Module): BOOLEAN;
+	VAR
+		assemblerScanner: Scanner.AssemblerScanner;
+		intermediateCodeParser: IntermediateCodeParser;
+	BEGIN
+		NEW(assemblerScanner, "", reader, 0, diagnostics);
+		NEW(intermediateCodeParser, diagnostics, module.system);
+		RETURN intermediateCodeParser.ParseModuleContent(assemblerScanner, module)
+	END ParseReader;
+
+	PROCEDURE ParseFile*(CONST pathName, moduleName: ARRAY OF CHAR; system: Global.System; diagnostics: Diagnostics.Diagnostics): Sections.Module;
+	VAR
+		filename: Files.FileName;
+		assemblerScanner: Scanner.AssemblerScanner;
+		intermediateCodeParser: IntermediateCodeParser;
+		reader: Streams.Reader;
+		msg: ARRAY 128 OF CHAR;
+		module: Sections.Module;
+	BEGIN
+		(* open corresponding intermediate code file *)
+		Files.JoinExtension(moduleName, IntermediateCodeExtension, filename);
+		IF pathName # "" THEN Files.JoinPath(pathName, filename, filename) END;
+		reader := Basic.GetFileReader(filename);
+		IF Trace THEN D.String("FoxIntermediateCodeParser.ParseFile "); D.String(filename); D.Ln END;
+		IF reader = NIL THEN
+			msg := "failed to open ";
+			Strings.Append(msg, filename);
+			diagnostics.Error(filename, Diagnostics.Invalid, Diagnostics.Invalid, msg);
+			RETURN NIL
+		ELSE
+			NEW(module, NIL, system);
+			IF ParseReader(reader, diagnostics, module) THEN
+				RETURN module
+			ELSE
+				RETURN NIL
+			END;
+		END;
+	END ParseFile;
 
 
+END FoxIntermediateParser.

source/FoxTRMAssembler.Mod

@@ -0,0 +1,123 @@
+MODULE FoxTRMAssembler; (** AUTHOR ""; PURPOSE ""; *)
+
+IMPORT InstructionSet := FoxTRMInstructionSet, FoxAssembler, D := Debugging, Scanner := FoxScanner, Diagnostics;
+
+CONST Trace=FoxAssembler.Trace;
+
+TYPE
+	Register* = LONGINT; (* index for InstructionSet.registers *)
+	Operand* = InstructionSet.Operand;
+
+TYPE
+	Assembler*= OBJECT (FoxAssembler.Assembler)
+	VAR capabilities-: SET;
+		  instructionSet: InstructionSet.InstructionSet;
+
+		PROCEDURE &Init2*(diagnostics: Diagnostics.Diagnostics; capabilities: SET; instructionSet: InstructionSet.InstructionSet);
+		BEGIN
+			SELF.capabilities := capabilities;
+			SELF.instructionSet:=instructionSet;
+			Init(diagnostics);
+		END Init2;
+
+		PROCEDURE Instruction*(CONST mnemonic: ARRAY OF CHAR);
+		VAR i,numberOperands,mnem,pos: LONGINT; VAR operands: ARRAY 3 OF Operand; instruction: InstructionSet.Instruction;
+
+			PROCEDURE ParseOperand;
+			(* stub, must be overwritten by implementation *)
+			VAR operand: InstructionSet.Operand;
+				result: FoxAssembler.Result;
+				register1,register2: SHORTINT;
+				stop,memory: BOOLEAN;
+			BEGIN
+				stop := FALSE;
+				register1 := InstructionSet.None;
+				register2 := InstructionSet.None;
+				result.type := -1;
+				result.value := 0;
+
+				IF numberOperands >= 2 THEN Error(errorPosition,"too many operands")
+				ELSE
+					memory := ThisToken(Scanner.LeftBracket);
+					IF (symbol.token = Scanner.Identifier) & GetRegister(symbol.identifierString,register1) THEN
+						NextSymbol;
+						stop := ~ThisToken(Scanner.Plus);
+					END;
+					IF ~stop THEN
+						IF (symbol.token = Scanner.Identifier) THEN
+							IF GetRegister(symbol.identifierString,register2) THEN
+								NextSymbol;
+							ELSIF GetNonConstant(errorPosition,symbol.identifierString, result) THEN
+								NextSymbol;
+							ELSIF Expression(result,FALSE) THEN
+							END;
+						ELSIF Expression(result,FALSE) THEN
+						END;
+					END;
+					IF memory & ExpectToken(Scanner.RightBracket) THEN
+						instructionSet.InitMemory(operand,register1,result.value);
+					ELSIF register1 # -1 THEN
+						instructionSet.InitRegister(operand,register1);
+					ELSE
+						instructionSet.InitImmediate(operand,result.sizeInBits,result.value);
+					END;
+					IF result.fixup # NIL THEN
+						instructionSet.AddFixup(operand,result.fixup);
+					END;
+					operands[numberOperands] := operand;
+				END;
+			END ParseOperand;
+
+		BEGIN
+			IF Trace THEN
+				D.String("Instruction: "); D.String(mnemonic);  D.String(" "); D.Ln;
+			END;
+			pos := errorPosition;
+			mnem := instructionSet.FindMnemonic(mnemonic);
+			IF mnem >= 0 THEN
+				FOR i := 0 TO 2 DO instructionSet.InitOperand(operands[i]) END;
+				numberOperands := 0;
+				IF symbol.token # Scanner.Ln THEN
+					REPEAT
+						ParseOperand;
+						INC(numberOperands);
+					UNTIL error OR ~ThisToken(Scanner.Comma);
+				END;
+				IF ~error THEN
+					instructionSet.MakeInstruction(instruction,mnem,operands[0],operands[1]);
+					IF instruction.format = InstructionSet.None THEN
+						ErrorSS(pos,"operand instruction format mismatch",mnemonic);
+					ELSIF instructionSet.instructionFormats[instruction.format].capabilities > capabilities THEN
+						Error(pos,"instruction not supported");
+					ELSE
+						IF pass < FoxAssembler.MaxPasses THEN
+							(* not last pass: only increment the current PC by a unit *)
+							section.resolved.SetPC(section.resolved.pc + 1)
+						ELSE
+							instructionSet.EmitInstruction(instruction, mnem, section.resolved);
+						END;
+					END;
+				END
+			ELSE
+				ErrorSS(pos,"unknown instruction ",mnemonic)
+			END
+		END Instruction;
+		
+		PROCEDURE GetRegister(CONST ident: ARRAY OF CHAR; VAR register: SHORTINT): BOOLEAN;
+		BEGIN
+			register := instructionSet.FindRegister(ident);
+			RETURN register # InstructionSet.None
+		END GetRegister;
+	END Assembler;
+
+	
+
+
+END FoxTRMAssembler.
+
+SystemTools.Free FoxTRMAssembler FoxTRMInstructionSet ~
+
+
+
+
+

source/FoxTRMBackend.Mod

@@ -0,0 +1,2523 @@
+MODULE FoxTRMBackend; (** AUTHOR "fof"; PURPOSE "backend for the tiny register machine"; *)
+
+IMPORT
+	Basic := FoxBasic, SyntaxTree := FoxSyntaxTree, Global := FoxGlobal, Backend := FoxBackend, Sections := FoxSections,
+	IntermediateCode := FoxIntermediateCode, IntermediateBackend := FoxIntermediateBackend, BinaryCode := FoxBinaryCode,
+	SemanticChecker := FoxSemanticChecker, Formats := FoxFormats, Assembler := FoxTRMAssembler, InstructionSet := FoxTRMInstructionSet,
+	SYSTEM, Diagnostics, Streams, Options, WMUtilities, Strings, ObjectFile, Scanner := FoxScanner, ObjectFileFormat := FoxIntermediateObjectFile,
+	ActiveCells := FoxActiveCells, CodeGenerators := FoxCodeGenerators, D := Debugging,
+	KernelLog;
+
+CONST
+	TraceFixups = FALSE;
+	DefaultRuntimeModuleName = "TRMRuntime";
+	HaltIRQNumber=8;
+	Registers = 8; None=-1;
+	Low=0; High=1;
+
+	opAND= InstructionSet.opAND; opBIC* = InstructionSet.opBIC;
+	opOR= InstructionSet.opOR; opXOR= InstructionSet.opXOR;
+	opADD= InstructionSet.opADD; opFADD = InstructionSet.opFADD; opSUB= InstructionSet.opSUB; opFSUB = InstructionSet.opFSUB;
+	opMUL= InstructionSet.opMUL; opFMUL = InstructionSet.opFMUL; opNOT= InstructionSet.opNOT;
+	opLDH= InstructionSet.opLDH;
+	opMOV= InstructionSet.opMOV; opROR= InstructionSet.opROR;
+	opBLR= InstructionSet.opBLR; opBR= InstructionSet.opBR;
+	opIRET* = InstructionSet.opIRET; opLD= InstructionSet.opLD;
+	opST= InstructionSet.opST; opBL= InstructionSet.opBL;
+	opBEQ= InstructionSet.opBEQ; opBNE= InstructionSet.opBNE;
+	opBAE= InstructionSet.opBAE; opBB= InstructionSet.opBB;
+	opBN= InstructionSet.opBN; opBNN= InstructionSet.opBNN;
+	opBO* = InstructionSet.opBO; opBNO* = InstructionSet.opBNO;
+	opBA= InstructionSet.opBA; opBBE= InstructionSet.opBBE;
+	opBGE= InstructionSet.opBGE; opBLT= InstructionSet.opBLT;
+	opBGT= InstructionSet.opBGT; opBLE= InstructionSet.opBLE;
+	opBT= InstructionSet.opBT; opBF* = InstructionSet.opBF;
+	opSPSR* = InstructionSet.opSPSR;
+
+	VectorSupportFlag = "vectorSupport";
+	FloatingPointSupportFlag ="floatingPoint";
+	FPSupportFlag = "supportFP";
+	PatchSpartan6 ="patchSpartan6";
+
+TYPE
+	Operand=InstructionSet.Operand;
+
+	FixupEntry=POINTER TO RECORD
+		maxPC: LONGINT;
+		fixup: BinaryCode.Fixup;
+		next: FixupEntry;
+	END;
+
+	ForwardFixupList=OBJECT
+	VAR
+		first,last: FixupEntry;
+
+		PROCEDURE &Init;
+		BEGIN
+			first := NIL; last := NIL;
+		END Init;
+
+		PROCEDURE Enter(fixup: BinaryCode.Fixup; currentPC: LONGINT; bits: LONGINT);
+		VAR entry: FixupEntry; maxPC: LONGINT;
+		BEGIN
+			maxPC := currentPC + ASH(1,bits-1) -1; (* signed *)
+			NEW(entry); entry.fixup := fixup;
+			entry.maxPC := maxPC-1; (* one instruction necessary to jump over the instruction *)
+			IF first = NIL THEN first := entry; last := entry;
+			ELSE
+				ASSERT(last.maxPC <= maxPC); (* otherwise we have to insert sorted but this does not seem necessary *)
+				last.next := entry;
+				last := entry;
+			END;
+		END Enter;
+
+		PROCEDURE Check(outPC: LONGINT): BinaryCode.Fixup;
+		VAR fixup: BinaryCode.Fixup;
+		BEGIN
+			IF (first # NIL) & (outPC >= first.maxPC) THEN
+				fixup := first.fixup;
+				IF first = last THEN first := NIL; last := NIL ELSE first := first.next END;
+				RETURN fixup;
+			ELSE
+				RETURN NIL
+			END;
+		END Check;
+
+	END ForwardFixupList;
+
+	Ticket=CodeGenerators.Ticket;
+
+	PhysicalRegisters*=OBJECT (CodeGenerators.PhysicalRegisters)
+	VAR
+		toVirtual: ARRAY Registers OF Ticket; (* registers real register -> none / reserved / split / blocked / virtual register (>0) *)
+		reserved: ARRAY Registers OF BOOLEAN;
+		unusable: Ticket;
+		hint: LONGINT;
+
+		PROCEDURE &InitPhysicalRegisters(supportFP: BOOLEAN);
+		VAR i: LONGINT;
+		BEGIN
+			FOR i := 0 TO LEN(toVirtual)-1 DO
+				toVirtual[i] := NIL;
+				reserved[i] := FALSE;
+			END;
+			(* reserve stack and base pointer registers *)
+			NEW(unusable);
+			toVirtual[InstructionSet.SP] := unusable;
+			toVirtual[InstructionSet.LR] := unusable;
+			IF supportFP THEN
+				toVirtual[InstructionSet.FP] := unusable
+			END;
+		END InitPhysicalRegisters;
+
+		PROCEDURE SupportFP(b: BOOLEAN);
+		BEGIN
+			IF b THEN toVirtual[InstructionSet.FP] := unusable ELSE toVirtual[InstructionSet.FP] := NIL END;
+		END SupportFP;
+
+		PROCEDURE NumberRegisters(): LONGINT;
+		BEGIN
+			RETURN Registers
+		END NumberRegisters;
+
+		PROCEDURE Allocate(index: LONGINT; virtualRegister: Ticket);
+		BEGIN
+			Assert(toVirtual[index]=NIL,"register already allocated");
+			toVirtual[index] := virtualRegister;
+			ASSERT(~virtualRegister.spilled);
+		END Allocate;
+
+		PROCEDURE SetReserved(index: LONGINT; res: BOOLEAN);
+		BEGIN
+			reserved[index] := res;
+		END SetReserved;
+
+		PROCEDURE Reserved(index: LONGINT): BOOLEAN;
+		BEGIN
+			RETURN (index>0) & reserved[index]
+		END Reserved;
+
+		PROCEDURE Free(index: LONGINT);
+		BEGIN
+			Assert((toVirtual[index] # NIL),"register not reserved");
+			toVirtual[index] := NIL;
+		END Free;
+
+		PROCEDURE NextFree(CONST type: IntermediateCode.Type):LONGINT;
+		VAR i: LONGINT;
+		BEGIN
+			ASSERT(type.sizeInBits=32);
+			i := 0;
+			IF (hint # None) THEN
+				IF toVirtual[hint] = NIL THEN i := hint END;
+				hint := None
+			END;
+
+			WHILE (i<Registers) & (toVirtual[i] # NIL) DO
+				INC(i);
+			END;
+			IF i=Registers THEN i := None END;
+			RETURN i;
+		END NextFree;
+
+		PROCEDURE AllocationHint(index: LONGINT);
+		BEGIN hint := index
+		END AllocationHint;
+
+		PROCEDURE Mapped(physical: LONGINT): Ticket;
+		BEGIN
+			RETURN toVirtual[physical]
+		END Mapped;
+
+		PROCEDURE Dump(w: Streams.Writer);
+		VAR i: LONGINT; virtual: Ticket;
+		BEGIN
+			w.String("---- registers ----"); w.Ln;
+			FOR i := 0 TO LEN(toVirtual)-1 DO
+				virtual := toVirtual[i];
+				IF virtual # unusable THEN
+					w.String("reg "); w.Int(i,1); w.String(": ");
+					IF virtual = NIL THEN w.String("free")
+					ELSE	w.String(" r"); w.Int(virtual.register,1);
+					END;
+					IF reserved[i] THEN w.String("reserved") END;
+					w.Ln;
+				END;
+			END;
+		END Dump;
+
+	END PhysicalRegisters;
+
+	CodeGeneratorTRM = OBJECT (CodeGenerators.GeneratorWithTickets)
+	VAR
+		opSP, opLR, opFP, null, noOperand: InstructionSet.Operand;
+		instructionSet: InstructionSet.InstructionSet;
+
+		stackSize, enterStackSize, spillStackPosition: LONGINT;
+		stackSizeKnown: BOOLEAN;
+		inStackAllocation: BOOLEAN;
+		runtimeModuleName: SyntaxTree.IdentifierString;
+
+		forwardFixups: ForwardFixupList;
+		spillStackStart: LONGINT;
+		backend: BackendTRM;
+		supportFP: BOOLEAN;
+		pushChainLength: LONGINT;
+		patchSpartan6: BOOLEAN;
+
+		PROCEDURE SetInstructionSet(instructionSet: InstructionSet.InstructionSet);
+		BEGIN
+			SELF.instructionSet:=instructionSet;
+		END SetInstructionSet;
+
+		PROCEDURE &InitGeneratorTRM(CONST runtime: SyntaxTree.IdentifierString; diagnostics: Diagnostics.Diagnostics; b: BackendTRM; instructionSet: InstructionSet.InstructionSet);
+		VAR physicalRegisters: PhysicalRegisters;
+		BEGIN
+			inStackAllocation := FALSE;
+			SELF.runtimeModuleName := runtime;
+			SELF.instructionSet:=instructionSet;
+			backend := b;
+			NEW(physicalRegisters,FALSE);
+			InitTicketGenerator(diagnostics, backend.optimize,2,physicalRegisters);
+			error := FALSE;
+			pushChainLength := 0;
+			instructionSet.InitImmediate(null, 0, 0);
+			instructionSet.InitOperand(noOperand);
+			instructionSet.InitRegister(opSP, InstructionSet.SP);
+			instructionSet.InitRegister(opLR, InstructionSet.LR);
+			instructionSet.InitRegister(opFP, InstructionSet.FP);
+
+			dump := NIL;
+			patchSpartan6 := FALSE;
+			NEW(forwardFixups);
+		END InitGeneratorTRM;
+
+		PROCEDURE CheckStackPointer(CONST dest: InstructionSet.Operand);
+		BEGIN
+			IF stackSizeKnown & ~inStackAllocation THEN
+				IF(dest.type = InstructionSet.Register) & (dest.register = InstructionSet.SP) THEN
+					IF dump # NIL THEN
+						dump.String("stack size unknown ") ;
+					END;
+					(*
+					D.String("stack size unknown ") ; Basic.WriteSegmentedName(D.Log, in.name); D.Int(inPC,1); D.Ln;
+					*)
+					stackSizeKnown := FALSE;
+					(*
+					IF ~backend.supportFP & (in.type = Sections.CodeSection) THEN
+						Error("Stack size unknown and no FP support!");
+					END;
+					*)
+				END;
+			END;
+		END CheckStackPointer;
+
+		PROCEDURE PatchSpartan6;
+		VAR i: LONGINT; opx: InstructionSet.Operand;
+		BEGIN
+			IF patchSpartan6 THEN
+				IF (out.os.fixed) & ((out.os.alignment + out.pc) MOD 1024 = 959) THEN
+					instructionSet.InitImmediate(opx,0,16);
+					instructionSet.Emit(InstructionSet.opBT, opx, emptyOperand, out);
+					FOR i := 1 TO 16 DO
+						out.PutBits(0,18);
+					END;
+				END;
+			END;
+		END PatchSpartan6;
+
+		PROCEDURE Emit(op: LONGINT; CONST op1, op2: InstructionSet.Operand);
+		VAR pc: LONGINT;
+		BEGIN
+			pc := (out.os.alignment + out.pc);
+			ASSERT(~patchSpartan6 OR ~out.os.fixed OR ((out.os.alignment + out.pc) MOD 1024 < 960) OR ((out.os.alignment + out.pc) MOD 1024 > 975) );
+			
+			instructionSet.Emit(op, op1, op2, out);
+			(* do this AFTER each instruction because otherwise presumptions on the size of the PC in the generator are wrong *)
+			(* note, in general, by the inclusion of the following code, no assumptions are true about the actual size of instructions in code emission
+				--> forward jumps do have to be patched in all cases
+			*)
+			PatchSpartan6;
+		END Emit;
+
+		PROCEDURE Emit2(op: LONGINT; CONST op1, op2: InstructionSet.Operand);
+		BEGIN
+			CheckStackPointer(op1);
+			Emit(op, op1, op2);
+		END Emit2;
+
+		PROCEDURE Emit2N(op: LONGINT; CONST op1: InstructionSet.Operand; n: LONGINT);
+		VAR op2: InstructionSet.Operand;
+		BEGIN
+			CheckStackPointer(op1);
+			instructionSet.InitImmediate(op2,0,n);
+			Emit(op, op1, op2);;
+		END Emit2N;
+
+		PROCEDURE Emit1(op: LONGINT; CONST op1: InstructionSet.Operand);
+		BEGIN
+			Emit(op, op1, emptyOperand);
+		END Emit1;
+
+		PROCEDURE Emit1N(op: LONGINT; n: LONGINT);
+		VAR op1: InstructionSet.Operand;
+		BEGIN
+			instructionSet.InitImmediate(op1,0,n);
+			Emit(op, op1, emptyOperand);
+		END Emit1N;
+
+		(*------------------- overwritten methods ----------------------*)
+		PROCEDURE Section(in: IntermediateCode.Section; out: BinaryCode.Section);
+		VAR oldSpillStackSize: LONGINT;
+
+			PROCEDURE CheckEmptySpillStack(): BOOLEAN;
+			BEGIN
+				IF spillStack.Size()#0 THEN Error(inPC,"implementation error, spill stack not cleared");
+					IF dump # NIL THEN
+						spillStack.Dump(dump);
+						tickets.Dump(dump);
+					END;
+				RETURN FALSE ELSE RETURN TRUE END;
+			END CheckEmptySpillStack;
+
+		BEGIN
+		
+		 
+			physicalRegisters(PhysicalRegisters).SupportFP(FALSE);
+			supportFP := FALSE;
+			tickets.Init;
+			spillStack.Init;
+			stackSizeKnown := TRUE;
+			forwardFixups.Init;
+			Section^(in,out);
+
+			IF stackSizeKnown = FALSE THEN
+				supportFP := TRUE;
+				tickets.Init;
+				spillStack.Init;
+				forwardFixups.Init;
+				out.Reset;
+				physicalRegisters(PhysicalRegisters).SupportFP(TRUE);
+				Section^(in,out);
+			END;
+
+			IF CheckEmptySpillStack() & (spillStack.MaxSize() >0) THEN
+				forwardFixups.Init;
+				oldSpillStackSize := spillStack.MaxSize();
+				out.Reset;
+				Section^(in,out);
+				ASSERT(spillStack.MaxSize() = oldSpillStackSize);
+			END;
+			IF CheckEmptySpillStack() THEN END;
+
+		END Section;
+
+		PROCEDURE Supported(CONST instr: IntermediateCode.Instruction; VAR moduleName, procedureName: ARRAY OF CHAR): BOOLEAN;
+		VAR sizeInBits: LONGINT; form: LONGINT; opcode: LONGINT;
+		BEGIN
+			opcode := instr.opcode;
+			form := instr.op1.type.form;
+			COPY(runtimeModuleName, moduleName);
+			IF opcode = IntermediateCode.conv THEN (* conversions between float and integer types in a library *)
+				IF form = IntermediateCode.Float THEN
+					IF instr.op2.type.form = IntermediateCode.Float THEN
+						IF (instr.op1.type.sizeInBits = 32) & (instr.op2.type.sizeInBits = 64) THEN
+							procedureName := "ConvertXR"; RETURN FALSE
+						ELSIF (instr.op1.type.sizeInBits = 64) & (instr.op2.type.sizeInBits = 32) THEN
+							procedureName := "ConvertRX"; RETURN FALSE
+						ELSE HALT(100);
+						END;
+					ELSE
+						ASSERT( instr.op2.type.form = IntermediateCode.SignedInteger);
+						IF (instr.op2.type.sizeInBits = 32) THEN
+							IF instr.op1.type.sizeInBits = 32 THEN
+								procedureName := "ConvertIR"; RETURN FALSE
+							ELSIF instr.op1.type.sizeInBits = 64 THEN
+								procedureName := "ConvertHR"; RETURN FALSE
+							ELSE HALT(100);
+							END;
+						ELSIF (instr.op2.type.sizeInBits=64) THEN
+							IF instr.op1.type.sizeInBits = 32 THEN
+								procedureName := "ConvertIX"; RETURN FALSE
+							ELSIF instr.op1.type.sizeInBits = 64 THEN
+								procedureName := "ConvertHX"; RETURN FALSE
+							ELSE HALT(100);
+							END;
+						ELSE HALT(100);
+						END
+					END;
+				ELSIF instr.op2.type.form = IntermediateCode.Float THEN
+					ASSERT(instr.op1.type.form = IntermediateCode.SignedInteger);
+					IF (instr.op2.type.sizeInBits = 32) THEN
+						IF instr.op1.type.sizeInBits = 32 THEN
+							procedureName := "ConvertRI"; RETURN FALSE
+						ELSIF instr.op1.type.sizeInBits = 64 THEN
+							procedureName := "ConvertRH"; RETURN FALSE
+						ELSE HALT(100);
+						END;
+					ELSIF (instr.op2.type.sizeInBits=64) THEN
+						IF instr.op1.type.sizeInBits = 32 THEN
+							procedureName := "ConvertXI"; RETURN FALSE
+						ELSIF instr.op1.type.sizeInBits = 64 THEN
+							procedureName := "ConvertXH"; RETURN FALSE
+						ELSE HALT(100);
+						END;
+					ELSE HALT(100);
+					END
+				END;
+			ELSIF form IN IntermediateCode.Integer THEN
+				IF instr.op1.type.sizeInBits = IntermediateCode.Bits64 THEN
+					CASE instr.opcode OF
+					IntermediateCode.div:	procedureName := "DivH"; RETURN FALSE
+					| IntermediateCode.mod: procedureName := "ModH"; RETURN FALSE
+					| IntermediateCode.abs: procedureName := "AbsH"; RETURN FALSE;
+					| IntermediateCode.shl :
+						IF instr.op1.type.form = IntermediateCode.SignedInteger THEN
+							procedureName := "AslH"; RETURN FALSE;
+						ELSE
+							procedureName := "LslH"; RETURN FALSE;
+						END;
+					| IntermediateCode.shr :
+						IF instr.op1.type.form = IntermediateCode.SignedInteger THEN
+							procedureName := "AsrH"; RETURN FALSE;
+						ELSE
+							procedureName := "LsrH"; RETURN FALSE;
+						END;
+					| IntermediateCode.ror: procedureName := "RorH"; RETURN FALSE;
+					| IntermediateCode.rol: procedureName := "RolH"; RETURN FALSE;
+					ELSE RETURN TRUE
+					END
+				ELSIF instr.op1.type.sizeInBits = IntermediateCode.Bits32 THEN
+					CASE instr.opcode OF
+					IntermediateCode.div:	procedureName := "DivL"; RETURN FALSE
+					| IntermediateCode.mod: procedureName := "ModL"; RETURN FALSE
+					| IntermediateCode.mul:
+						IF (Global.NoMulCapability IN backend.capabilities) THEN  (*mul forbidden*)
+							procedureName:="MulL"; RETURN FALSE	
+						ELSE
+							RETURN TRUE;	
+						END
+					ELSE
+					RETURN TRUE
+					END;
+				ELSE
+					sizeInBits := instr.op1.type.sizeInBits;
+					HALT(100)
+				END;
+			ELSIF (form = IntermediateCode.Float) THEN
+				IF instr.op1.type.sizeInBits = IntermediateCode.Bits64 THEN
+					CASE instr.opcode OF
+						| IntermediateCode.add: procedureName := "AddX"; RETURN FALSE;
+						| IntermediateCode.sub: procedureName := "SubX"; RETURN FALSE;
+						| IntermediateCode.mul: procedureName := "MulX"; RETURN FALSE;
+						| IntermediateCode.div: procedureName := "DivX"; RETURN FALSE
+						| IntermediateCode.abs: procedureName := "AbsX"; RETURN FALSE;
+					ELSE RETURN TRUE
+					END;
+				ELSIF instr.op1.type.sizeInBits = IntermediateCode.Bits32 THEN
+					CASE instr.opcode OF
+						| IntermediateCode.add:
+							IF Global.FloatingPointCapability IN backend.capabilities THEN RETURN TRUE
+							ELSE procedureName := "AddR"; RETURN FALSE
+							END
+						| IntermediateCode.sub:
+							IF Global.FloatingPointCapability IN backend.capabilities THEN RETURN TRUE
+							ELSE procedureName := "SubR"; RETURN FALSE
+							END
+						| IntermediateCode.mul:
+							IF Global.FloatingPointCapability IN backend.capabilities THEN RETURN TRUE
+							ELSE procedureName := "MulR"; RETURN FALSE
+							END
+						| IntermediateCode.div: procedureName := "DivR"; RETURN FALSE
+						| IntermediateCode.abs: procedureName := "AbsR"; RETURN FALSE;
+					ELSE RETURN TRUE
+					END;
+				ELSE HALT(100)
+				END;
+			ELSIF form = IntermediateCode.Undefined THEN
+				RETURN TRUE
+			ELSE HALT(100)
+			END;
+			RETURN TRUE
+		END Supported;
+
+		(* input: type (such as that of an intermediate operand), output: low and high type (such as in low and high type of an operand) *)
+		PROCEDURE GetPartType(CONST type: IntermediateCode.Type; part: LONGINT; VAR typePart: IntermediateCode.Type);
+		BEGIN
+			ASSERT(type.sizeInBits >0); ASSERT(part < 2);
+			IF (part = 0) OR (type.sizeInBits =64) THEN
+				IntermediateCode.InitType(typePart,type.form,32);
+			ELSE
+				typePart := IntermediateCode.undef
+			END;
+		END GetPartType;
+
+		PROCEDURE GetSpillOperand(ticket: Ticket; VAR mem: Operand);
+		VAR offset: LONGINT; register: LONGINT;
+		BEGIN
+			
+			D.String("spill stack used in "); Basic.WriteSegmentedName(D.Log, in.name); D.String(": "); D.Int(inPC,1); D.Ln;
+			
+			offset :=  spillStackPosition-ticket.offset; (* relative to logical frame pointer ! *)
+			register := PhysicalRegister(IntermediateCode.FP,Low,offset);
+			instructionSet.InitMemory(mem, register, offset);
+		END GetSpillOperand;
+
+		PROCEDURE ToSpillStack(ticket: Ticket);
+		VAR mem, reg:Operand;
+		BEGIN
+			IF dump # NIL THEN dump.String("spill: "); CodeGenerators.DumpTicket(dump,ticket); dump.Ln; END;
+			GetSpillOperand(ticket,mem);
+			instructionSet.InitRegister(reg,ticket.register);
+			Emit2(opST,reg,mem);
+		END ToSpillStack;
+
+		PROCEDURE AllocateSpillStack(size: LONGINT);
+		BEGIN
+		END AllocateSpillStack;
+
+		PROCEDURE ToRegister(ticket: Ticket);
+		VAR mem,reg: Operand;
+		BEGIN
+			IF dump # NIL THEN dump.String("unspill: "); CodeGenerators.DumpTicket(dump,ticket); dump.Ln END;
+			GetSpillOperand(ticket,mem);
+			instructionSet.InitRegister(reg,ticket.register);
+			Emit2(opLD,reg,mem);
+		END ToRegister;
+
+		PROCEDURE ExchangeTickets(ticket1,ticket2: Ticket);
+		VAR op1,op2,temp: Operand;
+		BEGIN
+			TicketToOperand(ticket1,op1);
+			TicketToOperand(ticket2,op2);
+			GetTemporaryRegister(temp);
+			IF op1.type = InstructionSet.Register THEN
+				ASSERT(op2.type = InstructionSet.Memory);
+				Emit2(opMOV,temp,op1);
+				Emit2(opLD,op1,op2);
+				Emit2(opST,temp,op2);
+			ELSE
+				ASSERT(op2.type = InstructionSet.Register); ASSERT(op1.type = InstructionSet.Memory);
+				Emit2(opMOV,temp,op2);
+				Emit2(opLD,op2,op1);
+				Emit2(opST,temp,op1);
+			END;
+			ReleaseHint(temp.register);
+			(* spill stack not yet supported *)		
+		END ExchangeTickets;
+
+		PROCEDURE CheckFixups;
+		VAR  fixup, forward, newFixup: BinaryCode.Fixup; fixupOp: InstructionSet.Operand; checkPC, iterCount: LONGINT;
+
+			PROCEDURE CheckPC(): LONGINT;
+			CONST safety=16; (* max number of TRM instructions to emit IR instruction *)
+			BEGIN
+				IF patchSpartan6 & out.os.fixed & ((out.pc+out.os.alignment) MOD 1024 < 960) & ((out.pc+out.os.alignment) MOD 1024 > 960-safety) THEN
+					RETURN out.pc + safety + 16
+				ELSE
+					RETURN out.pc + safety (* assuming that an IR instruction can be emitted within at most 10 instructions *)
+				END;
+			END CheckPC;
+
+		BEGIN
+			fixup := forwardFixups.Check(CheckPC());
+			iterCount:=0;
+			WHILE(fixup # NIL) DO
+				INC(iterCount);
+				IF(iterCount>30) THEN
+					D.String("too many iterations in forward fixup");D.Ln;
+					HALT(100);
+				END;
+				(*problem: sometimes causes problems when there are large backwards jumps*)
+				(*but is needed for long jumps in general*)
+				(*!TODO: sometimes leads to infinite loop in instruction sizes <= 14*)
+				(* sometimes, compiler continues to work fine without this section.*)
+				(*apparently this section resolves the multihop jumps, but fails if it's supposed to go backward?*)
+				IF fixup.symbolOffset < inPC THEN (* already resolved ok *)
+				ELSE (* must be handled *)
+					IF TraceFixups THEN
+						D.String("relative branch fixup bits: ");D.Int(instructionSet.RelativeBranchFixupBits,1);
+						D.String(" at inPC="); D.Int(inPC,1); D.String(", outPC="); D.Int(out.pc,1);
+						D.String(", symbol offset=");D.Int(fixup.symbolOffset,1);
+						D.String(", fixup from outPC = "); D.Int(fixup.offset,1); D.String(" to "); fixup.Dump(D.Log); D.String(" forwarded."); D.Ln;
+					END;
+					forward := BrForward(opBT);
+					(*
+					Emit1N(opBT, 1);
+					*)
+					newFixup := BinaryCode.NewFixup(fixup.mode, out.pc, fixup.symbol, fixup.symbolOffset, 0, 0, NIL);
+					fixup.SetSymbol(fixup.symbol.name, fixup.symbol.fingerprint, 0, fixup.displacement+out.pc);
+					ASSERT(ABS(out.pc - fixup.displacement) < 512);
+					instructionSet.InitFixup(fixupOp,0,newFixup);
+					forwardFixups.Enter(newFixup, out.pc, instructionSet.RelativeBranchFixupBits);
+					Emit1(opBT, fixupOp);
+					SetTarget(forward);
+				END;  
+				fixup := forwardFixups.Check(CheckPC());
+			END;
+		END CheckFixups;
+
+		PROCEDURE IsComplex(CONST operand: IntermediateCode.Operand): BOOLEAN;
+		BEGIN RETURN (operand.type.sizeInBits > 32)
+		END IsComplex;
+
+		PROCEDURE IsFloat(CONST operand: IntermediateCode.Operand): BOOLEAN;
+		BEGIN RETURN operand.type.form = IntermediateCode.Float
+		END IsFloat;
+
+		PROCEDURE Generate(VAR instruction: IntermediateCode.Instruction);
+		VAR opcode: SHORTINT; ticket: Ticket; hwreg, lastUse: LONGINT;
+		BEGIN
+			CheckFixups;
+
+			(*
+			IF ((instruction.opcode = IntermediateCode.mov) OR (instruction.opcode = IntermediateCode.pop)) & (instruction.op1.register <= IntermediateCode.ParameterRegister) THEN
+				hwreg := ParameterRegister(IntermediateCode.ParameterRegister-instruction.op1.register, instruction.op1.type);
+				Spill(physicalRegisters.Mapped(hwreg));
+				lastUse := inPC+1;
+				WHILE (lastUse < in.pc) &
+					((in.instructions[lastUse].opcode # IntermediateCode.push) OR (in.instructions[lastUse].op1.register # instruction.op1.register)) & (in.instructions[lastUse].opcode # IntermediateCode.call) DO
+					INC(lastUse)
+				END;
+				ticket := ReservePhysicalRegister(instruction.op1.type,hwreg,lastUse);
+			END;
+			*)
+
+			ReserveOperandRegisters(instruction.op1,TRUE); ReserveOperandRegisters(instruction.op2,TRUE);ReserveOperandRegisters(instruction.op3,TRUE);
+
+			opcode := instruction.opcode;
+			CASE opcode OF
+			IntermediateCode.nop: (* do nothing *)
+			|IntermediateCode.mov:
+				EmitMov(instruction.op1,instruction.op2,Low);
+				IF IsComplex(instruction.op1) THEN
+					EmitMov(instruction.op1,instruction.op2,High)
+				END;
+			|IntermediateCode.conv: EmitConv(instruction);
+			|IntermediateCode.call: EmitCall(instruction);
+			|IntermediateCode.enter: EmitEnter(instruction);
+			|IntermediateCode.leave: EmitLeave(instruction);
+			|IntermediateCode.exit: EmitExit(instruction);
+			|IntermediateCode.return:
+				EmitReturn(instruction,Low);
+				IF IsComplex(instruction.op1) THEN
+					EmitReturn(instruction,High)
+				END;
+			|IntermediateCode.result:
+				EmitResult(instruction,Low);
+				IF IsComplex(instruction.op1) THEN
+					EmitResult(instruction,High)
+				END;
+			|IntermediateCode.trap: EmitTrap(instruction);
+			|IntermediateCode.br .. IntermediateCode.brlt: EmitBr(instruction)
+			|IntermediateCode.pop:
+				EmitPop(instruction.op1,Low);
+				IF IsComplex(instruction.op1) THEN
+					EmitPop(instruction.op1,High);
+				END;
+			|IntermediateCode.push:
+				IF IsComplex(instruction.op1) THEN
+					EmitPush(instruction.op1,High);
+				END;
+				EmitPush(instruction.op1,Low);
+			|IntermediateCode.neg: EmitNeg(instruction);
+			|IntermediateCode.not:
+				EmitNot(instruction,Low);
+				IF IsComplex(instruction.op1) THEN
+					EmitNot(instruction,High)
+				END;
+			|IntermediateCode.abs: EmitAbs(instruction);
+			|IntermediateCode.mul:
+				IF IsFloat(instruction.op1) THEN
+					EmitFMul(instruction)
+				ELSE
+					EmitMul(instruction)
+				END
+			|IntermediateCode.div: EmitDiv(instruction);
+			|IntermediateCode.mod: EmitMod(instruction);
+			|IntermediateCode.sub:
+				IF IsFloat(instruction.op1) THEN
+					EmitFSub(instruction)
+				ELSE
+					EmitSub(instruction)
+				END
+			|IntermediateCode.add:
+				IF IsFloat(instruction.op1) THEN
+					EmitFAdd(instruction)
+				ELSE
+					EmitAdd(instruction)
+				END
+			|IntermediateCode.and:
+				EmitAnd(instruction,Low);
+				IF IsComplex(instruction.op1) THEN
+					EmitAnd(instruction,High);
+				END;
+			|IntermediateCode.or:
+				EmitOr(instruction,Low);
+				IF IsComplex(instruction.op1) THEN
+					EmitOr(instruction,High)
+				END;
+			|IntermediateCode.xor:
+				EmitXor(instruction,Low);
+				IF IsComplex(instruction.op1) THEN
+					EmitXor(instruction,High)
+				END;
+			|IntermediateCode.shl: EmitShift(instruction);
+			|IntermediateCode.shr: EmitShift(instruction);
+			|IntermediateCode.rol: EmitShift(instruction);
+			|IntermediateCode.ror: EmitShift(instruction);
+			|IntermediateCode.copy: EmitCopy(instruction);
+			|IntermediateCode.fill: EmitFill(instruction, FALSE);
+			|IntermediateCode.asm: EmitAsm(instruction);
+			END;
+
+			ReserveOperandRegisters(instruction.op3,FALSE); ReserveOperandRegisters(instruction.op2,FALSE); ReserveOperandRegisters(instruction.op1,FALSE);
+
+		END Generate;
+
+		PROCEDURE PostGenerate(CONST instruction: IntermediateCode.Instruction);
+		VAR ticket: Ticket;
+		BEGIN
+			TryUnmap(instruction.op3); TryUnmap(instruction.op2); TryUnmap(instruction.op1);
+			ticket := tickets.live;
+			WHILE (ticket # NIL) & (ticket.lastuse = inPC) DO
+				UnmapTicket(ticket);
+				ticket := tickets.live
+			END;
+		END PostGenerate;
+
+
+		PROCEDURE TicketToOperand(ticket:Ticket; VAR op: InstructionSet.Operand);
+		BEGIN
+			ASSERT(ticket # NIL);
+			IF ticket.spilled THEN
+				GetSpillOperand(ticket,op);
+			ELSE
+				instructionSet.InitRegister(op,ticket.register)
+			END;
+		END TicketToOperand;
+
+		(* updateStackSize is important as intermediate RETURNS should not change stack size *)
+		PROCEDURE AllocateStack(size: LONGINT; updateStackSize: BOOLEAN);
+		VAR  sizeOperand: InstructionSet.Operand;
+		BEGIN
+			inStackAllocation := TRUE;
+			IF size > 0 THEN
+				IF size < ASH(1,instructionSet.ImmediateFixupBits) THEN
+					instructionSet.InitImmediate(sizeOperand, 0, size)
+				ELSE
+					ImmediateToOperand(size,Low,FALSE,instructionSet.ImmediateFixupBits,sizeOperand)
+				END;
+				Emit2(opSUB, opSP, sizeOperand);
+				IF updateStackSize THEN INC(stackSize, size) END;
+			ELSIF size < 0 THEN
+				size := -size;
+				IF size < ASH(1,instructionSet.ImmediateFixupBits) THEN
+					instructionSet.InitImmediate(sizeOperand, 0, size);
+				ELSE
+					ImmediateToOperand(size,Low, FALSE, instructionSet.ImmediateFixupBits,sizeOperand);
+				END;
+				Emit2(opADD, opSP, sizeOperand);
+				IF updateStackSize THEN DEC(stackSize, size) END;
+			END;
+			inStackAllocation := FALSE;
+		END AllocateStack;
+
+		PROCEDURE EmitEnter(CONST instr: IntermediateCode.Instruction);
+		VAR cc: LONGINT; mem: InstructionSet.Operand;
+		BEGIN
+			stackSize := 0;
+			(*
+				p1
+				...
+				pm		<- SP + stackSize = FP + enterStackSize = logicalFP
+				v1
+				...
+				vn
+				spill1	<- logicalFP + spillStackPosition
+				...
+				spilln
+				LR	<- SP+1
+				FP <- SP = FP
+			*)
+			cc := SHORT(instr.op1.intValue);
+			spillStackPosition := - LONGINT(instr.op2.intValue)-1; (* relative to logical frame pointer ! *)
+			AllocateStack(LONGINT(instr.op2.intValue+2+spillStack.MaxSize()), TRUE);
+			instructionSet.InitMemory(mem, InstructionSet.SP, 1);
+			Emit2(opST, opLR, mem);
+			instructionSet.InitMemory(mem, InstructionSet.SP, 0);
+			Emit2(opST, opFP, mem);
+			enterStackSize := stackSize;
+			Emit2(opMOV, opFP, opSP);
+		END EmitEnter;
+
+		PROCEDURE EmitLeave(CONST instr: IntermediateCode.Instruction);
+		VAR cc: LONGINT; mem: InstructionSet.Operand;
+		BEGIN
+			IF supportFP THEN
+				Emit2(opMOV, opSP, opFP);
+			END;
+			instructionSet.InitMemory(mem, InstructionSet.SP, 0);
+			Emit2(opLD, opFP, mem);
+			instructionSet.InitMemory(mem, InstructionSet.SP, 1);
+			Emit2(opLD, opLR, mem);
+			IF supportFP THEN
+				AllocateStack(-enterStackSize, FALSE); (* revert stack *)
+			ELSE
+				ASSERT(enterStackSize = stackSize);
+				AllocateStack(-stackSize,FALSE);
+			END;
+		END EmitLeave;
+
+		PROCEDURE EmitExit(CONST instr: IntermediateCode.Instruction);
+		BEGIN
+			Emit1(opBR, opLR);
+		END EmitExit;
+
+		PROCEDURE ResultRegister(part: LONGINT): InstructionSet.Operand;
+		VAR register: InstructionSet.Operand;
+		BEGIN
+			IF part = Low THEN instructionSet.InitRegister(register,0)
+			ELSE instructionSet.InitRegister(register,1)
+			END;
+			RETURN register
+		END ResultRegister;
+
+		PROCEDURE EmitResult(VAR instr: IntermediateCode.Instruction; part: LONGINT);
+		VAR op,result: Operand;
+		BEGIN
+			AcquireDestinationRegister(instr.op1, part,op);
+			result := ResultRegister(part);
+			MovIfDifferent(op, result);
+			ReleaseDestinationRegister(instr.op1,part,op);
+		END EmitResult;
+
+		PROCEDURE EmitReturn(VAR instr: IntermediateCode.Instruction; part: LONGINT);
+		VAR op,result: Operand;
+		BEGIN
+			MakeRegister(instr.op1,part,op);
+			result := ResultRegister(part);
+			MovIfDifferent(result, op);
+		END EmitReturn;
+
+		PROCEDURE EmitMov(VAR vop1,vop2: IntermediateCode.Operand; part: LONGINT);
+		VAR left,right: Operand; rightTicket: Ticket; neg: BOOLEAN;
+		BEGIN
+			rightTicket := NIL;
+			IF vop2.mode = IntermediateCode.ModeMemory THEN
+				(*GetMemory(vop2,part,right,rightTicket);*) (* done in load *)
+			ELSIF ~UnsignedImmediate(vop2,part,instructionSet.ImmediateFixupBits,FALSE,neg,right) THEN
+				MakeRegister(vop2,part,right);
+				ReleaseHint(right.register);
+			END;
+			AcquireDestinationRegister(vop1,part,left);
+			IF vop2.mode = IntermediateCode.ModeMemory THEN
+				Load(vop2,part,left);
+			ELSE
+				MovIfDifferent(left, right);
+			END;
+			IF vop1.mode = IntermediateCode.ModeMemory THEN
+				Store(vop1,part,left);
+			END;
+			ReleaseHint(left.register);
+		END EmitMov;
+
+		PROCEDURE EmitConv(VAR instr: IntermediateCode.Instruction);
+		VAR left,right,temp: Operand;
+			srcSize, destSize: LONGINT;
+		BEGIN
+			srcSize := instr.op2.type.sizeInBits;
+			destSize := instr.op1.type.sizeInBits;
+
+			ASSERT( (srcSize = 32) OR (srcSize = 64));
+			ASSERT( (destSize = 32) OR (destSize = 64));
+			ASSERT(instr.op1.type.form IN IntermediateCode.Integer);
+			ASSERT(instr.op2.type.form IN IntermediateCode.Integer);
+
+			IF srcSize >= destSize THEN
+				MakeRegister(instr.op2,Low,right);
+				ReleaseHint(right.register);
+				AcquireDestinationRegister(instr.op1,Low,left);
+				MovIfDifferent(left, right);
+				ReleaseDestinationRegister(instr.op1,Low, left);
+			ELSE
+				MakeRegister(instr.op2, Low, right);
+				ReleaseHint(right.register);
+				AcquireDestinationRegister(instr.op1,Low,left);
+				MovIfDifferent(left,right);
+				ReleaseDestinationRegister(instr.op1,Low,left);
+
+				IF (instr.op2.type.form = IntermediateCode.SignedInteger) & (instr.op1.type.form = IntermediateCode.SignedInteger) THEN
+					GetTemporaryRegister(temp);
+					Emit2(opMOV, temp,left);
+					AcquireDestinationRegister(instr.op1,High,left);
+					Emit2(opMOV, left, temp);
+					Emit2N(opROR, temp, 31);
+					Emit2N(opAND, temp, 1);
+					Emit2(opNOT, left, temp);
+					Emit2N(opADD, left, 1);
+				ELSE
+					AcquireDestinationRegister(instr.op1,High,left);
+					Emit2N(opMOV, left, 0);
+				END;
+				ReleaseDestinationRegister(instr.op1,High,left);
+			END;
+
+		END EmitConv;
+
+		PROCEDURE Resolve(VAR op: IntermediateCode.Operand);
+		BEGIN
+			IF (op.symbol.name # "") & (op.resolved = NIL) THEN
+				op.resolved := module.allSections.FindByName(op.symbol.name)
+			END;
+		END Resolve;
+
+
+		PROCEDURE EmitCall(VAR instruction: IntermediateCode.Instruction);
+		VAR op: InstructionSet.Operand; section: IntermediateCode.Section; code: BinaryCode.Section; symbol: ObjectFile.Identifier;
+			fixup, newFixup: BinaryCode.Fixup; pc: LONGINT; regOp: Operand; offset,reloffset: LONGINT;
+		BEGIN
+			IF (instruction.op1.symbol.name # "") & (instruction.op1.mode # IntermediateCode.ModeMemory) THEN
+				Resolve(instruction.op1);
+				IF instruction.op1.resolved # NIL THEN
+					section :=  instruction.op1.resolved(IntermediateCode.Section);
+				END;
+				IF (section # NIL) & (section.type = Sections.InlineCodeSection) THEN
+					code := section.resolved;
+					ASSERT(code # NIL);
+					out.CopyBits(code.os.bits, 0, code.os.bits.GetSize());
+					fixup := code.fixupList.firstFixup;
+					pc := code.pc;
+					WHILE (fixup # NIL) DO
+						newFixup := BinaryCode.NewFixup(fixup.mode, fixup.offset+pc, fixup.symbol, fixup.symbolOffset, fixup.displacement, fixup.scale, fixup.pattern);
+						out.fixupList.AddFixup(newFixup);
+						fixup := fixup.nextFixup;
+					END;
+				ELSE
+					IF out.os.fixed THEN (* only if my own address is already known .. *)
+						offset := GetSymbolOffset(instruction.op1, symbol);
+					ELSE
+						offset := instruction.op1.offset;
+						Resolve(instruction.op1);
+						symbol := instruction.op1.symbol;
+					END;
+					reloffset := offset - out.pc-out.os.alignment-1;
+					IF symbol.name # "" THEN
+						fixup := BinaryCode.NewFixup(BinaryCode.Relative,out.pc,symbol, offset, 0, 0, NIL);
+						instructionSet.InitFixup(op, 32, fixup);
+						Emit1(opBL, op);
+					ELSIF (-ASH(1,instructionSet.BranchAndLinkFixupBits-1) <= reloffset) & (reloffset < ASH(1,instructionSet.BranchAndLinkFixupBits-1)) THEN
+						ImmediateToOperand(reloffset, Low, TRUE, instructionSet.BranchAndLinkFixupBits,op);
+						ASSERT(op.type = InstructionSet.Immediate);
+						Emit1(opBL, op);
+					ELSE
+						GetTemporaryRegister(op);
+						ImmediateToOperand(offset, Low, FALSE, instructionSet.ImmediateFixupBits,op);
+						ASSERT(op.type = InstructionSet.Register);
+						Emit2(opBLR, opLR, op);
+					END;
+				END;
+			ELSE
+				MakeRegister(instruction.op1,Low,regOp);
+				Emit2(opBLR, opLR, regOp);
+			END;
+			AllocateStack(-SHORT(instruction.op2.intValue), TRUE)
+		END EmitCall;
+
+		PROCEDURE GetImmediate32(val: LONGINT; CONST reg: InstructionSet.Operand; emit: BOOLEAN): LONGINT;
+		VAR ops: LONGINT; set: SET;
+
+			PROCEDURE Add(val,pos: LONGINT; VAR first: BOOLEAN): LONGINT;
+			VAR imm: InstructionSet.Operand; ops: LONGINT; op: InstructionSet.Operand;
+			BEGIN
+				instructionSet.InitImmediate(imm, 0, val);
+				IF pos # 0 THEN
+					IF first THEN
+						ops := 2;
+						IF emit THEN
+							Emit2(opMOV, reg, imm);
+							instructionSet.InitImmediate(imm, 0, 32-pos);  (*!TODO: if instruction width is <=13, immediate for ror is so small it can't express this number!*)
+							Emit2(opROR, reg, imm);
+						END;
+					ELSE
+						ops := 3;
+						IF emit THEN
+							GetTemporaryRegister(op);
+							Emit2(opMOV, op, imm);
+							instructionSet.InitImmediate(imm, 0, 32-pos);
+							Emit2(opROR, op, imm);
+							Emit2(opADD, reg, op);
+							ReleaseHint(op.register);
+						END;
+					END;
+				ELSE
+					ops := 1;
+					IF emit THEN Emit2(opADD, reg, imm) END;
+				END;
+				first := FALSE;
+				RETURN ops
+			END Add;
+
+			PROCEDURE Compute(val: SET): LONGINT;
+			VAR v,i: LONGINT; ops: LONGINT; first: BOOLEAN;
+			BEGIN
+				v := 0; ops := 0; first := TRUE;
+				FOR i := 31 TO 0 BY -1 DO
+					v := v * 2;
+					IF i IN val THEN INC(v) END;
+					IF v*2 >= ASH(1,instructionSet.ImmediateFixupBits) THEN
+						ops := ops + Add(v,i,first);
+						v := 0;
+					END;
+				END;
+				IF v # 0 THEN ops := ops + Add(v,0,first) END;
+				RETURN ops
+			END Compute;
+
+		BEGIN
+			set := SYSTEM.VAL(SET,val);
+			ops := Compute(set);
+			RETURN ops
+		END GetImmediate32;
+
+		PROCEDURE ImmediateToOperand(imm: HUGEINT; part: LONGINT; signed: BOOLEAN; bits: LONGINT; VAR op: Operand);
+		VAR immOp: InstructionSet.Operand; maxImmValue, minImmValue : LONGINT;
+
+			PROCEDURE ImmediateToOp32(imm: LONGINT; VAR op: InstructionSet.Operand);
+			VAR ops: LONGINT;
+			BEGIN
+				IF (imm>=0) & (imm < ASH(1,instructionSet.ImmediateFixupBits)) THEN
+					instructionSet.InitImmediate(immOp, 0, imm);
+					Emit2(opMOV, op, immOp);
+				ELSIF (imm <0) & (imm > MIN(LONGINT)) & (ABS(imm) < ASH(1,instructionSet.ImmediateFixupBits)) THEN
+					instructionSet.InitImmediate(immOp, 0, 0);
+					Emit2(opMOV, op, immOp);
+					instructionSet.InitImmediate(immOp, 0, ABS(imm));
+					Emit2(opSUB, op, immOp);
+				ELSE
+					ops := GetImmediate32(imm, op, TRUE);
+				END;
+			END ImmediateToOp32;
+
+		BEGIN
+			IF signed THEN
+				minImmValue := -ASH(1,bits-1); maxImmValue := ASH(1,bits-1)-1;
+			ELSE
+				minImmValue := 0; maxImmValue := ASH(1,bits)-1
+			END;
+			IF (op.type # InstructionSet.Register) & (imm >=minImmValue) & (imm <=maxImmValue) THEN (* immediate operand *)
+				IF part = Low THEN
+					instructionSet.InitImmediate(op,0,SHORT(imm));
+				ELSE
+					instructionSet.InitImmediate(op,0,0);
+				END;
+			ELSE
+				IF op.type # InstructionSet.Register THEN
+					GetTemporaryRegister(op);
+				END;
+				IF part = Low THEN
+					ImmediateToOp32(SHORT(imm), op)
+				ELSE
+					ImmediateToOp32(SHORT(imm DIV 10000H DIV 10000H),op);
+				END
+			END;
+		END ImmediateToOperand;
+
+		PROCEDURE MakeRegister(VAR vop: IntermediateCode.Operand; part: LONGINT; VAR rop: Operand);
+		VAR virtualReg: LONGINT; tmp, imm: Operand; offset: LONGINT; symbol: ObjectFile.Identifier;
+			sizeInBits: LONGINT;
+		BEGIN
+			(*InstructionSet.InitOperand(rop); *)
+			instructionSet.InitOperand(imm);
+			sizeInBits := vop.type.sizeInBits;
+			virtualReg := vop.register;
+
+			offset := GetSymbolOffset(vop,symbol);
+			CASE vop.mode OF
+			IntermediateCode.ModeMemory:
+				GetTemporaryRegister(rop);
+				Load(vop,part,rop);
+			|IntermediateCode.ModeRegister:
+				GetRegister(vop,part,rop);
+			|IntermediateCode.ModeImmediate:
+				IF symbol.name # "" THEN
+					instructionSet.InitFixup(tmp, 14, BinaryCode.NewFixup(BinaryCode.Absolute,out.pc,vop.symbol, vop.symbolOffset, vop.offset,0,NIL));
+					GetTemporaryRegister(rop);
+					Emit2(opMOV, rop, tmp);
+				ELSE
+					IF vop.type.form IN IntermediateCode.Integer THEN
+					ASSERT ((vop.intValue = 0) OR (offset = 0));
+						ImmediateToOperand(vop.intValue+offset, part, FALSE, instructionSet.ImmediateFixupBits,rop);
+					ELSE ASSERT(vop.type.form = IntermediateCode.Float); ASSERT(vop.type.sizeInBits=32);
+						ImmediateToOperand(BinaryCode.ConvertReal(SHORT(vop.floatValue)),part,FALSE,instructionSet.ImmediateFixupBits,rop);
+					END;
+
+					IF rop.type # InstructionSet.Register THEN
+						GetTemporaryRegister(tmp);
+						Emit2(opMOV, tmp, rop);
+						rop := tmp
+					END;
+				END;
+			ELSE HALT(200)
+			END;
+		END MakeRegister;
+
+		(* if the symbol has a statically known offset then return offset and set resulting section to nil, otherwise do not set resulting section to nil *)
+		PROCEDURE GetSymbolOffset(VAR vop: IntermediateCode.Operand; VAR sectionName: ObjectFile.Identifier): LONGINT;
+		VAR offset: LONGINT; section: Sections.Section;
+		BEGIN
+			sectionName := vop.symbol;
+			Resolve(vop);
+			section := vop.resolved; offset := vop.offset;
+			IF (section # NIL) & (section(IntermediateCode.Section).resolved # NIL) & (section(IntermediateCode.Section).resolved.os.fixed) THEN
+				INC(offset, section(IntermediateCode.Section).resolved.os.alignment);
+				INC(offset, section(IntermediateCode.Section).instructions[vop.symbolOffset].pc);
+				sectionName.name := "";
+			END;
+			RETURN offset
+		END GetSymbolOffset;
+
+		PROCEDURE GetMemory(VAR vop: IntermediateCode.Operand; part: LONGINT; VAR memoryOperand: InstructionSet.Operand; ticket: Ticket);
+		VAR virtualReg: LONGINT; register: LONGINT; registerOperand, temporary: InstructionSet.Operand; symbol: ObjectFile.Identifier;
+			offset: LONGINT;
+		BEGIN
+			virtualReg := vop.register;
+			ASSERT(vop.mode = IntermediateCode.ModeMemory);
+			offset := GetSymbolOffset(vop, symbol) + part;
+			register := PhysicalRegister(vop.register,Low,offset);
+
+			IF register = None THEN
+				IF symbol.name = "" THEN
+					offset := offset + SHORT(vop.intValue);
+				END;
+				register := InstructionSet.None;
+			END;
+
+			IF (0<=offset) & (offset < ASH(1,instructionSet.MemoryOffsetFixupBits)) THEN
+				instructionSet.InitMemory(memoryOperand, register, offset);
+			ELSE
+				IF ticket = NIL THEN
+					ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
+				END;
+				TicketToOperand(ticket, temporary);
+				ImmediateToOperand(offset, Low, FALSE, instructionSet.ImmediateFixupBits,temporary);
+				instructionSet.InitRegister(registerOperand,register);
+				IF register # InstructionSet.None THEN
+					Emit2(opADD,temporary,registerOperand);
+				END;
+				instructionSet.InitMemory(memoryOperand, temporary.register, 0);
+			END;
+			IF symbol.name # "" THEN
+				instructionSet.AddFixup(memoryOperand, BinaryCode.NewFixup(BinaryCode.Absolute, 0, symbol, vop.symbolOffset, offset, 0, NIL));
+			END;
+		END GetMemory;
+
+		PROCEDURE Load(VAR vop: IntermediateCode.Operand; part: LONGINT; CONST register: Operand);
+		VAR memoryOperand: Operand;
+		BEGIN
+			ASSERT(register.type = InstructionSet.Register);
+			GetMemory(vop,part,memoryOperand,physicalRegisters.Mapped(register.register));
+			Emit2(opLD,register,memoryOperand);
+		END Load;
+
+		PROCEDURE Store(VAR vop: IntermediateCode.Operand; part: LONGINT; CONST register: Operand);
+		VAR memoryOperand: Operand;
+		BEGIN
+			GetMemory(vop,part,memoryOperand,NIL);
+			Emit2(opST,register,memoryOperand);
+		END Store;
+
+		PROCEDURE UnsignedImmediate(vop: IntermediateCode.Operand; part: LONGINT; bits: LONGINT; allowNegation: BOOLEAN; VAR neg: BOOLEAN; VAR rop: Operand): BOOLEAN;
+		VAR value,offset : LONGINT; symbol: ObjectFile.Identifier;
+		BEGIN
+			IF (vop.mode = IntermediateCode.ModeImmediate) THEN
+				offset := GetSymbolOffset(vop, symbol);
+				IF part = Low THEN
+					value := SHORT(vop.intValue + offset);
+				ELSE
+					value := SHORT((vop.intValue + offset) DIV 1000H DIV 1000H);
+				END;
+				IF symbol.name # "" THEN RETURN FALSE
+				ELSIF vop.type.form = IntermediateCode.Float THEN RETURN FALSE
+				ELSIF (value >= 0) & (value < ASH(1,bits)) THEN
+					instructionSet.InitImmediate(rop, 0, value); neg := FALSE;
+					RETURN TRUE
+				ELSIF allowNegation & (value <0) & (value # MIN(LONGINT)) & (-value < ASH(1,bits)) THEN
+					instructionSet.InitImmediate(rop, 0, -value); neg := TRUE;
+					RETURN TRUE
+				END;
+			END;
+			RETURN FALSE
+		END UnsignedImmediate;
+
+
+		PROCEDURE HardwareIntegerRegister(index: LONGINT; sizeInBits: LONGINT): LONGINT;
+		BEGIN 	RETURN index
+		END HardwareIntegerRegister;
+
+		PROCEDURE HardwareFloatRegister(index: LONGINT; sizeInBits: LONGINT): LONGINT;
+		BEGIN RETURN index
+		END HardwareFloatRegister;
+
+		PROCEDURE GetTypedHardwareRegister(index: LONGINT; type: IntermediateCode.Type): LONGINT;
+		VAR size: LONGINT;
+		BEGIN
+			IF type.form IN IntermediateCode.Integer THEN
+				RETURN HardwareIntegerRegister(index, type.sizeInBits)
+			ELSIF type.form = IntermediateCode.Float THEN
+				RETURN HardwareFloatRegister(index, type.sizeInBits)
+			ELSE
+				HALT(100);
+			END;
+		END GetTypedHardwareRegister;
+
+		PROCEDURE ParameterRegister(CONST type: IntermediateCode.Type; index: LONGINT): LONGINT;
+		BEGIN
+			RETURN GetTypedHardwareRegister(index, type)
+		END ParameterRegister;
+
+		PROCEDURE PhysicalRegister(virtualReg: LONGINT; part: LONGINT; VAR offset: LONGINT): LONGINT;
+		VAR register: LONGINT; fpOffset: LONGINT; ticket: Ticket;
+		BEGIN
+			IF virtualReg = IntermediateCode.FP THEN
+				IF supportFP THEN
+					register := InstructionSet.FP;
+					INC(offset, enterStackSize);
+				ELSE
+					register := InstructionSet.SP;
+					INC(offset, stackSize);
+				END;
+			ELSIF virtualReg = IntermediateCode.SP THEN
+				register := InstructionSet.SP;
+			(*!ELSIF virtualReg <= IntermediateCode.ParameterRegister THEN
+				register := ParameterRegister(IntermediateCode.ParameterRegister-virtualReg, IntermediateCode.int32);
+			*)
+			ELSE
+				ticket := virtualRegisters.Mapped(virtualReg,part);
+				IF ticket = NIL THEN register := None
+				ELSE
+					UnSpill(ticket);
+					register := ticket.register
+				END;
+			END;
+			RETURN register
+		END PhysicalRegister;
+
+		PROCEDURE GetRegister(CONST virtual: IntermediateCode.Operand; part:LONGINT; VAR physical: Operand);
+		VAR type: IntermediateCode.Type; virtualRegister, physicalRegister: LONGINT;
+			tmp,imm: Operand; offset: LONGINT; ticket: Ticket; ops: LONGINT;
+		BEGIN
+			ASSERT(virtual.mode = IntermediateCode.ModeRegister);
+			GetPartType(virtual.type,part,type);
+
+			virtualRegister := virtual.register;
+
+			offset := virtual.offset;
+			physicalRegister := PhysicalRegister(virtual.register,part,offset);
+			instructionSet.InitRegister(physical, physicalRegister);
+
+			IF offset # 0 THEN
+				(*
+				offset := virtual.offset;
+				*)
+				Assert(type.form # IntermediateCode.Float,"forbidden offset on float");
+				ReleaseHint(physical.register);
+				GetTemporaryRegister(tmp);
+				MovIfDifferent(tmp, physical);
+				physical := tmp;
+
+
+				IF (offset >= 0) & (offset < ASH(1,instructionSet.ImmediateFixupBits)) THEN
+					instructionSet.InitImmediate(imm, 0, offset);
+					Emit2(opADD,physical,imm);
+				ELSIF  (offset <0) & (-offset < ASH(1,instructionSet.ImmediateFixupBits)) THEN
+					instructionSet.InitImmediate(imm, 0, -offset);
+					Emit2(opSUB,physical,imm);
+				ELSE
+					GetTemporaryRegister(tmp);
+					ops := GetImmediate32(offset,tmp,TRUE);
+					Emit2(opADD,physical,tmp);
+					ReleaseHint(tmp.register);
+				END;
+			END;
+		END GetRegister;
+
+		PROCEDURE IsSameRegister(CONST a, b : InstructionSet.Operand) : BOOLEAN;
+		BEGIN
+			IF (a.fixup # NIL) OR (b.fixup # NIL) OR (a.type # InstructionSet.Register) OR (b.type # InstructionSet.Register) THEN RETURN FALSE END;
+			RETURN a.register = b.register;
+		END IsSameRegister;
+
+		PROCEDURE MovIfDifferent(CONST a,b: InstructionSet.Operand);
+		BEGIN
+			IF ~IsSameRegister(a,b) THEN Emit2(opMOV, a, b) END;
+		END MovIfDifferent;
+
+
+		PROCEDURE AcquireDestinationRegister(CONST vop: IntermediateCode.Operand; part: LONGINT; VAR op: Operand);
+		VAR  type: IntermediateCode.Type;
+		BEGIN
+			GetPartType(vop.type,part,type);
+			IF vop.mode = IntermediateCode.ModeMemory THEN
+				GetTemporaryRegister(op);
+			ELSE
+				IF virtualRegisters.Mapped(vop.register,part)=NIL THEN
+					TryAllocate(vop,part);
+				END;
+				GetRegister(vop,part,op);
+			END;
+		END AcquireDestinationRegister;
+
+		PROCEDURE PrepareOp3(CONST instruction: IntermediateCode.Instruction;part: LONGINT; allowNegation: BOOLEAN; VAR negate: BOOLEAN; VAR dest, left, right: Assembler.Operand);
+		VAR vop1,vop2, vop3: IntermediateCode.Operand; op2: InstructionSet.Operand;
+			opx: Operand;
+		BEGIN
+			vop1 := instruction.op1; vop2 := instruction.op2; vop3 := instruction.op3;
+			IF (IntermediateCode.Commute23 IN IntermediateCode.instructionFormat[instruction.opcode].flags)  THEN
+				IF IntermediateCode.OperandEquals(vop1,vop3)  OR UnsignedImmediate(vop2,part,instructionSet.ImmediateFixupBits,FALSE,negate,right) THEN
+					vop3 := instruction.op2; vop2 := instruction.op3;
+				END;
+			END;
+			IF ~UnsignedImmediate(vop3, part, instructionSet.ImmediateFixupBits, allowNegation, negate,right) THEN
+				instructionSet.InitOperand(right);
+				MakeRegister(vop3,part,right);
+			END;
+			MakeRegister(vop2,part,op2);
+			ReleaseHint(op2.register);
+			AcquireDestinationRegister(vop1,part,left);
+			dest := left;
+			IF ~IsSameRegister(left,op2) THEN
+				IF IsSameRegister(left,right) THEN
+					GetTemporaryRegister(opx);
+					MovIfDifferent(opx, op2);
+					dest := left;
+					left := opx;
+				ELSE
+					MovIfDifferent(left, op2);
+				END;
+			END;
+		END PrepareOp3;
+
+
+		PROCEDURE PrepareFOp3(CONST instruction: IntermediateCode.Instruction; VAR dest, left, right: Assembler.Operand);
+		VAR vop1,vop2, vop3: IntermediateCode.Operand; op2: InstructionSet.Operand;
+			opx: Operand;
+		BEGIN
+			vop1 := instruction.op1; vop2 := instruction.op2; vop3 := instruction.op3;
+			instructionSet.InitOperand(right);
+			MakeRegister(vop3,Low,right);
+			MakeRegister(vop2,Low,op2);
+			ReleaseHint(op2.register);
+			AcquireDestinationRegister(vop1,Low,left);
+			dest := left;
+			IF ~IsSameRegister(left,op2) THEN
+				IF IsSameRegister(left,right) THEN
+					GetTemporaryRegister(opx);
+					MovIfDifferent(opx, op2);
+					dest := left;
+					left := opx;
+				ELSE
+					MovIfDifferent(left, op2);
+				END;
+			END;
+		END PrepareFOp3;
+
+		PROCEDURE PrepareOp2(CONST instruction: IntermediateCode.Instruction;part: LONGINT; allowNegation: BOOLEAN; VAR negate: BOOLEAN; VAR left, right: Assembler.Operand);
+		VAR vop1,vop2: IntermediateCode.Operand;
+		BEGIN
+			vop1 := instruction.op1; vop2 := instruction.op2;
+			IF ~UnsignedImmediate(vop2, part, instructionSet.ImmediateFixupBits, allowNegation, negate,right) THEN
+				instructionSet.InitOperand(right);
+				MakeRegister(vop2,part,right);
+			END;
+			ReleaseHint(right.register);
+			AcquireDestinationRegister(vop1,part,left);
+		END PrepareOp2;
+
+		PROCEDURE ReleaseDestinationRegister(VAR vop: IntermediateCode.Operand; part: LONGINT; left: Assembler.Operand);
+		BEGIN
+			IF vop.mode = IntermediateCode.ModeMemory THEN
+				ASSERT(left.type = InstructionSet.Register);
+				Store(vop,part,left);
+				ReleaseHint(left.register);
+			END;
+		END ReleaseDestinationRegister;
+
+		PROCEDURE FinishOp(VAR vop: IntermediateCode.Operand; part: LONGINT; dest, left: Assembler.Operand);
+		VAR op: Operand;
+		BEGIN
+			IF vop.mode = IntermediateCode.ModeMemory THEN
+				ASSERT(left.type = InstructionSet.Register);
+				Store(vop,part,left);
+				ReleaseHint(left.register);
+			ELSIF dest.register # left.register THEN
+				Emit2(opMOV, dest, left);
+			END;
+		END FinishOp;
+
+		PROCEDURE EmitAdd(VAR instruction: IntermediateCode.Instruction);
+		VAR destLow, destHigh, leftLow,rightLow,leftHigh,rightHigh: InstructionSet.Operand;negateLow,negateHigh: BOOLEAN;
+			fixup: BinaryCode.Fixup;
+		BEGIN
+			PrepareOp3(instruction,Low,TRUE,negateLow,destLow, leftLow,rightLow);
+			IF IsComplex(instruction.op1) THEN
+				PrepareOp3(instruction,High,TRUE,negateHigh,destHigh, leftHigh,rightHigh);
+			END;
+			IF negateLow THEN Emit2(opSUB,leftLow,rightLow) ELSE Emit2(opADD,leftLow,rightLow) END;
+			FinishOp(instruction.op1,Low,destLow, leftLow);
+			IF IsComplex(instruction.op1) THEN
+				fixup := BrForward(opBB);
+				(*
+				Emit1N(opBB, 1);
+				*)
+				Emit2N(opADD, leftHigh, 1);
+				SetTarget(fixup);
+				IF negateHigh THEN Emit2(opSUB,leftHigh,rightHigh) ELSE Emit2(opADD,leftHigh,rightHigh) END;
+				FinishOp(instruction.op1,High,destHigh, leftHigh);
+			END;
+		END EmitAdd;
+
+		PROCEDURE EmitFAdd(VAR instruction: IntermediateCode.Instruction);
+		VAR destLow, destHigh, leftLow, rightLow, leftHigh, rightHigh: Operand; negateLow, negateHigh: BOOLEAN;
+		BEGIN
+			PrepareFOp3(instruction,destLow, leftLow,rightLow);
+			Emit2(opFADD,leftLow,rightLow);
+			FinishOp(instruction.op1,Low,destLow, leftLow);
+		END EmitFAdd;
+
+
+		PROCEDURE EmitSub(VAR instruction: IntermediateCode.Instruction);
+		VAR destLow, destHigh, leftLow, rightLow, leftHigh, rightHigh: Operand; negateLow, negateHigh: BOOLEAN; fixup: BinaryCode.Fixup;
+		BEGIN
+			IF (instruction.op1.mode = IntermediateCode.ModeRegister) & (instruction.op1.register = IntermediateCode.SP) &
+				(instruction.op2.mode = IntermediateCode.ModeRegister) & (instruction.op2.register = IntermediateCode.SP) &
+				(instruction.op3.mode = IntermediateCode.ModeImmediate) & (instruction.op3.symbol.name = "") THEN
+					AllocateStack(SHORT(instruction.op3.intValue), TRUE); RETURN
+			END;
+
+			PrepareOp3(instruction,Low,TRUE,negateLow, destLow, leftLow,rightLow);
+			IF IsComplex(instruction.op1) THEN
+				PrepareOp3(instruction,High,TRUE,negateHigh,destHigh, leftHigh,rightHigh);
+				IF negateHigh THEN Emit2(opADD,leftHigh,rightHigh) ELSE Emit2(opSUB,leftHigh,rightHigh) END;
+			END;
+			IF negateLow THEN Emit2(opADD,leftLow,rightLow) ELSE Emit2(opSUB,leftLow,rightLow) END;
+			FinishOp(instruction.op1,Low,destLow, leftLow);
+			IF IsComplex(instruction.op1) THEN
+				fixup := BrForward(opBAE);
+				(*
+				Emit1N(opBAE, 1);
+				*)
+				Emit2N(opSUB,leftHigh, 1);
+				SetTarget(fixup);
+				FinishOp(instruction.op1,High,destHigh, leftHigh)
+			END;
+		END EmitSub;
+
+		PROCEDURE EmitFSub(VAR instruction: IntermediateCode.Instruction);
+		VAR destLow, destHigh, leftLow, rightLow, leftHigh, rightHigh: Operand; negateLow, negateHigh: BOOLEAN;
+		BEGIN
+			PrepareFOp3(instruction,destLow, leftLow,rightLow);
+			Emit2(opFSUB,leftLow,rightLow);
+			FinishOp(instruction.op1,Low,destLow, leftLow);
+		END EmitFSub;
+
+
+		PROCEDURE EmitMul(VAR instruction: IntermediateCode.Instruction);
+		VAR negate: BOOLEAN;
+			op1Low, op2Low, op3Low, op1High, op2High, op3High, destLow, destHigh: Operand;
+		BEGIN
+			IF ~IsComplex(instruction.op1) THEN
+				PrepareOp3(instruction,Low,FALSE,negate,destLow, op1Low,op2Low);
+				Emit2(opMUL,op1Low,op2Low);
+				FinishOp(instruction.op1,Low,destLow, op1Low)
+			ELSE
+				AcquireDestinationRegister(instruction.op1,Low,op1Low);
+				AcquireDestinationRegister(instruction.op1,High,op1High);
+				MakeRegister(instruction.op2,Low,op2Low);
+				MakeRegister(instruction.op2,High,op2High);
+				MakeRegister(instruction.op3,Low,op3Low);
+				MakeRegister(instruction.op3,High,op3High);
+
+				Emit2(opMOV, op1Low, op2Low);
+				Emit2(opMUL, op1Low, op3Low);
+				Emit1(opLDH, op1High);
+				Emit2(opMUL, op2High, op3Low);
+				Emit2(opADD, op1High, op2High);
+				Emit2(opMUL, op2Low, op3High);
+				Emit2(opADD, op1High, op2Low);
+
+				ReleaseDestinationRegister(instruction.op1,Low,op1Low);
+				ReleaseDestinationRegister(instruction.op1,High,op1High);
+			END;
+		END EmitMul;
+
+		PROCEDURE EmitFMul(VAR instruction: IntermediateCode.Instruction);
+		VAR destLow, destHigh, leftLow, rightLow, leftHigh, rightHigh: Operand; negateLow, negateHigh: BOOLEAN;
+		BEGIN
+			PrepareFOp3(instruction,destLow, leftLow,rightLow);
+			Emit2(opFMUL,leftLow,rightLow);
+			FinishOp(instruction.op1,Low,destLow, leftLow);
+		END EmitFMul;
+
+		PROCEDURE EmitDiv(CONST instr: IntermediateCode.Instruction);
+		BEGIN
+			HALT(100); (*! div is not supported by hardware, must be runtime call -- cf. method Supported *)
+		END EmitDiv;
+
+		(* undefined for float and huegint, huegint version as library *)
+		PROCEDURE EmitMod(CONST instr: IntermediateCode.Instruction);
+		BEGIN
+			HALT(100); (*! mod is not supported by hardware, must be runtime call -- cf. method Supported *)
+		END EmitMod;
+
+		PROCEDURE EmitAnd(VAR instruction: IntermediateCode.Instruction; part: LONGINT);
+		VAR left, right, dest: Operand; negate: BOOLEAN;
+		BEGIN
+			PrepareOp3(instruction,part,FALSE,negate,dest,left,right);
+			Emit2(opAND,left,right);
+			FinishOp(instruction.op1, part,dest, left)
+		END EmitAnd;
+
+		PROCEDURE EmitOr(VAR instruction: IntermediateCode.Instruction; part: LONGINT);
+		VAR left, right, dest: Operand; negate: BOOLEAN;
+		BEGIN
+			PrepareOp3(instruction,part,FALSE,negate,dest, left,right);
+			Emit2(opOR,left,right);
+			FinishOp(instruction.op1,part,dest, left)
+		END EmitOr;
+
+		PROCEDURE EmitXor(VAR instruction: IntermediateCode.Instruction; part: LONGINT);
+		VAR dest, left, right: Operand; negate: BOOLEAN;
+		BEGIN
+			PrepareOp3(instruction,part,FALSE,negate,dest,left,right);
+			Emit2(opXOR,left,right);
+			FinishOp(instruction.op1,part,dest,left)
+		END EmitXor;
+
+		PROCEDURE GetTemporaryRegister(VAR op: Operand);
+		VAR ticket: Ticket;
+		BEGIN
+			ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
+			TicketToOperand(ticket,op);
+		END GetTemporaryRegister;
+
+		PROCEDURE EmitShift(VAR instr: IntermediateCode.Instruction);
+		VAR op2, op3, dest, imm, one, opx, mask, opx2: Operand; shift: LONGINT; fixup, fixup2: BinaryCode.Fixup;
+		BEGIN
+			instructionSet.InitOperand(imm); instructionSet.InitOperand(one);
+
+			ASSERT(instr.op1.type.sizeInBits < 64);
+
+			AcquireDestinationRegister(instr.op1, Low, dest);
+
+			MakeRegister(instr.op2, Low, op2);
+			(*! caution: do not use dest and op2 / op3 more than once in one line: dest might be source (as in shl $1,1,$1) *)
+
+			IF instr.op3.mode = IntermediateCode.ModeImmediate THEN
+				shift := SHORT(instr.op3.intValue) MOD 32;
+				IF shift = 0 THEN
+					MovIfDifferent(dest, op2);
+					Emit2N(opROR, dest, shift);
+				ELSE
+					CASE instr.opcode OF
+					|IntermediateCode.ror:
+						MovIfDifferent(dest, op2);
+						Emit2N(opROR, dest, shift);
+					|IntermediateCode.rol:
+						MovIfDifferent(dest, op2);
+						Emit2N(opROR, dest, 32-shift);
+					|IntermediateCode.shl:
+						MovIfDifferent(dest, op2);
+						Emit2N(opROR, dest, 32-shift);
+						ImmediateToOperand(ASH(1, shift)-1, Low, FALSE, instructionSet.ImmediateFixupBits,imm);
+						Emit2(opBIC, dest, imm);
+						ReleaseHint(imm.register);
+					|IntermediateCode.shr:
+						IF instr.op1.type.form # IntermediateCode.SignedInteger THEN
+							(* logical shift right *)
+							ImmediateToOperand(ASH(1,shift)-1,Low,FALSE,instructionSet.ImmediateFixupBits,imm);
+							Emit2(opBIC, op2, imm);
+							MovIfDifferent(dest, op2);
+							Emit2N(opROR, dest, shift);
+							ReleaseHint(imm.register);
+						ELSE
+							(* arithmetic shift right *)
+							ImmediateToOperand(ASH(1,shift)-1,Low,FALSE,instructionSet.ImmediateFixupBits,imm);
+							MovIfDifferent(dest, op2);
+							Emit2(opOR,dest,dest);
+							fixup := BrForward(opBN);
+							(*
+							Emit1N(opBN, 2); (* if op2 < 0 then skip next two instructions  *)
+							*)
+							Emit2(opBIC, dest,imm);
+							fixup2 := BrForward(opBT);
+							(*
+							Emit1N(opBT, 1); (* skip next instruction *)
+							*)
+							SetTarget(fixup);
+							Emit2(opOR, dest, imm);
+							SetTarget(fixup2);
+							Emit2N(opROR, dest, shift);
+							ReleaseHint(imm.register);
+						END;
+					END;
+				END;
+			ELSE
+				MakeRegister(instr.op3, Low, op3);
+
+				CASE instr.opcode OF
+				|IntermediateCode.ror:
+					Emit2(opROR, op2, op3);
+					MovIfDifferent(dest, op2);
+				|IntermediateCode.rol:
+					GetTemporaryRegister(imm);
+					ImmediateToOperand(32, Low, FALSE, instructionSet.ImmediateFixupBits, imm);
+					Emit2(opSUB, imm, op3);
+					Emit2(opROR, op2, imm);
+					MovIfDifferent(dest, op2);
+					ReleaseHint(imm.register);
+				|IntermediateCode.shl:
+					GetTemporaryRegister(imm);
+					ImmediateToOperand(32, Low, FALSE, instructionSet.ImmediateFixupBits,imm);
+					Emit2(opSUB, imm, op3);
+					Emit2(opROR, op2, imm);
+					IF IsSameRegister(dest, op2) THEN
+						GetTemporaryRegister(op2);
+					ELSE
+						Emit2(opMOV, dest, op2);
+					END;
+					(*GetTemporaryRegister(one,32);*)
+					ImmediateToOperand(1, Low, FALSE, instructionSet.ImmediateFixupBits, op2);
+					Emit2(opROR, op2, imm);
+					Emit2N(opSUB, op2, 1);
+					Emit2(opBIC, dest, op2);
+					ReleaseHint(imm.register);
+					ReleaseHint(op2.register);
+
+				|IntermediateCode.shr:
+					IF instr.op1.type.form # IntermediateCode.SignedInteger THEN
+						GetTemporaryRegister(mask);
+						ImmediateToOperand(1, Low, FALSE, instructionSet.ImmediateFixupBits,mask);
+
+						IF IsSameRegister(dest, op3) THEN
+							GetTemporaryRegister(opx);
+							Emit2(opMOV, opx, op3);
+							Emit2(opMOV, dest, op2);
+							op3 := opx;
+						ELSE
+							MovIfDifferent(dest, op2);
+						END;
+
+						IF physicalRegisters.NextFree(IntermediateCode.int32)#None THEN
+							GetTemporaryRegister(opx2);
+						ELSE
+							EmitPush(instr.op1,Low); (* save dest *)
+							opx2 := dest;
+						END;
+
+						Emit2N(opMOV, opx2, 32);
+						Emit2(opSUB, opx2, op3);
+						Emit2(opROR, mask, opx2);
+						Emit2N(opSUB, mask, 1);
+
+						IF opx2.register = dest.register THEN
+							EmitPop(instr.op1,Low); (* restore dest *)
+						ELSE
+							ReleaseHint(opx2.register);
+						END;
+
+						Emit2(opBIC, dest, mask);
+						Emit2(opROR, dest, op3);
+
+						ReleaseHint(opx.register);
+						ReleaseHint(mask.register);
+					ELSE
+						GetTemporaryRegister(imm);
+						ImmediateToOperand(32, Low, FALSE, instructionSet.ImmediateFixupBits, imm);
+						Emit2(opSUB, imm, op3);
+						GetTemporaryRegister(one);
+						ImmediateToOperand(1, Low, FALSE, instructionSet.ImmediateFixupBits, one);
+						Emit2(opROR, one, imm);
+						Emit2N(opSUB, one, 1);
+						Emit2(opOR, op2, op2); (* if negative *)
+						fixup := BrForward(opBN);
+						(*
+						Emit1N(opBN, 2); (* then skip next two instructions  *)
+						*)
+						Emit2(opBIC, op2,one);
+						fixup2 := BrForward(opBT);
+						(*
+						Emit1N(opBT, 1); (* skip next instruction *)
+						*)
+						SetTarget(fixup);
+						Emit2(opOR, op2, one);
+						SetTarget(fixup2);
+						Emit2(opROR, op2, op3);
+						MovIfDifferent(dest, op2);
+						ReleaseHint(imm.register);
+						ReleaseHint(one.register);
+					END;
+				END;
+			END;
+
+			ReleaseDestinationRegister(instr.op1, Low, dest);
+		END EmitShift;
+
+		PROCEDURE EmitCopy(VAR instr: IntermediateCode.Instruction);
+		VAR op1, op2, op3: Operand; mem1, mem2: InstructionSet.Operand; reg: Operand;
+			prevSize, i: LONGINT; ticket: Ticket;
+		BEGIN
+			MakeRegister(instr.op1, Low, op1);
+			MakeRegister(instr.op2, Low, op2);
+			IF (instr.op3.mode = IntermediateCode.ModeImmediate) & (instr.op3.intValue < 16) THEN
+				GetTemporaryRegister(reg);
+				FOR i := 0 TO SHORT(instr.op3.intValue)-1 DO
+					instructionSet.InitMemory(mem1, op1.register, i);
+					instructionSet.InitMemory(mem2, op2.register, i);
+					Emit2(opLD, reg, mem2);
+					Emit2(opST, reg, mem1);
+				END;
+				ReleaseHint(reg.register);
+			ELSE
+				MakeRegister(instr.op3, Low, op3);
+				ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
+				TicketToOperand(ticket,reg);
+				instructionSet.InitMemory(mem1, op1.register, 0);
+				instructionSet.InitMemory(mem2, op2.register, 0);
+
+				prevSize := out.pc;
+				Emit2(opLD, reg, mem2);
+				Emit2(opST, reg, mem1);
+				Emit2N(opADD, op1, 1);
+				Emit2N(opADD, op2, 1);
+				Emit2N(opSUB, op3, 1);
+
+				Emit1N(opBGT, -(out.pc-prevSize+1));
+				UnmapTicket(ticket);
+			END;
+		END EmitCopy;
+
+		PROCEDURE EmitFill(VAR instr: IntermediateCode.Instruction; down: BOOLEAN);
+		VAR op1, op2, op3: Operand; mem1: InstructionSet.Operand;
+			prevSize: LONGINT; i: LONGINT; ticket: Ticket;
+		BEGIN
+			MakeRegister(instr.op1, Low, op1);
+			MakeRegister(instr.op2, Low, op2);
+			IF ~down & (instr.op3.mode = IntermediateCode.ModeImmediate) & (instr.op3.intValue < 16) THEN
+				FOR i := 0 TO SHORT(instr.op3.intValue)-1 DO
+					instructionSet.InitMemory(mem1, op1.register, i);
+					Emit2(opST, op2, mem1);
+				END;
+			ELSE
+				MakeRegister(instr.op3, Low, op3);
+				instructionSet.InitMemory(mem1, op1.register, 0);
+
+				prevSize := out.pc;
+				Emit2(opST, op2, mem1);
+				IF down THEN
+					Emit2N(opSUB, op1, 1);
+				ELSE
+					Emit2N(opADD, op1, 1);
+				END;
+				Emit2N(opSUB, op3, 1);
+
+				Emit1N(opBGT, -(out.pc-prevSize+1));
+				UnmapTicket(ticket);
+			END;
+		END EmitFill;
+
+		PROCEDURE BrForward(op: LONGINT): BinaryCode.Fixup;
+		VAR fixupOp: InstructionSet.Operand; fixup: BinaryCode.Fixup; identifier: ObjectFile.Identifier;
+		BEGIN
+			identifier.name := in.name;
+			identifier.fingerprint := in.fingerprint;
+			fixup := BinaryCode.NewFixup(BinaryCode.Relative, out.pc, identifier, 0,0,0,NIL);
+			fixup.resolved := in;
+			instructionSet.InitFixup(fixupOp,32,fixup);
+			Emit1(op, fixupOp);
+			RETURN fixup;
+		END BrForward;
+
+		PROCEDURE SetTarget(fixup: BinaryCode.Fixup);
+		BEGIN
+			fixup.SetSymbol(in.name, in.fingerprint, 0, out.pc+fixup.displacement (* displacement offset computed during operand emission, typically -1 *) );
+			fixup.resolved := in;
+		END SetTarget;
+
+		PROCEDURE EmitBr (VAR instr: IntermediateCode.Instruction);
+		VAR dest, destPC, offset: LONGINT; target: Operand; reverse: BOOLEAN;
+			(* jump operands *)  op2, op3: Operand; hiHit, hiFail, lowHit: LONGINT;
+				failPC: LONGINT;
+					pattern: ObjectFile.FixupPatterns; fixup, failFixup: BinaryCode.Fixup;
+					float,negate: BOOLEAN; identifier: ObjectFile.Identifier;
+
+			PROCEDURE JmpDest(brop: LONGINT);
+			VAR op1: Operand; fixupOp: InstructionSet.Operand; oldLR, thisPC: Operand; ticket1, ticket2: Ticket;
+			BEGIN
+				IF instr.op1.mode = IntermediateCode.ModeImmediate THEN
+					Assert(instr.op1.symbol.name # "", "branch without symbol destination");
+					dest := (instr.op1.symbolOffset); (* this is the offset in the in-data section (intermediate code), it is not byte-relative *)
+					destPC := in.instructions[dest].pc + instr.op1.offset;
+					offset := destPC - out.pc;
+					fixup := BinaryCode.NewFixup(BinaryCode.Relative, out.pc, instr.op1.symbol, instr.op1.symbolOffset, instr.op1.offset,0,NIL);
+					IF (fixup.symbol.name = in.name) & (fixup.symbolOffset > inPC) THEN (* forward jump *)
+						forwardFixups.Enter(fixup, out.pc, instructionSet.RelativeBranchFixupBits);
+					ELSIF (fixup.symbol.name = in.name) & (fixup.symbolOffset < inPC) THEN (* backward jump *)
+						ASSERT(offset < 0); offset := -offset;
+						IF offset >= ASH(1,instructionSet.RelativeBranchFixupBits-1)-1 THEN
+							(*D.String("fixup too far for immediate fixup, offset=");D.Int(offset,1);D.Ln;*)
+						
+							(* cannot enter fixup / use immediate jump, jump too far *)
+							fixup := BrForward(instructionSet.inverseCondition[brop]); (* jump over absolute branch (skip) *)
+							(*
+							fixup := BinaryCode.NewFixup(BinaryCode.Relative, out.pc, in, 0,0,0,NIL);
+							InstructionSet.InitFixup(fixupOp,32,fixup);
+							Emit1(InstructionSet.inverseCondition[brop], fixupOp); (* jump over absolute branch (skip) *)
+							*)
+							(* do a relative register jump, an absolute jump would require a fixup with unpredictable size
+								=> have to get program counter, misuse BL here:
+								MOV Rx, LR
+								BL 0; get PC of next line
+								MOV Ry, LR
+								MOV LR, Rx ; restore LR
+								ADD Ry, offset
+								BR R2
+							 *)
+							ticket1 := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
+							ticket2 := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
+							TicketToOperand(ticket1,oldLR);
+							TicketToOperand(ticket2,thisPC);
+							Emit2(opMOV,oldLR, opLR);
+							Emit1N(opBL,0);
+							(* exactly here we have the current PC in LR, so we compute the offset here *)
+							offset := out.pc-destPC;
+							Emit2(opMOV, thisPC, opLR);
+							Emit2(opMOV, opLR, oldLR);
+							UnmapTicket(ticket1);
+							instructionSet.InitOperand(target);
+							ImmediateToOperand(offset,Low,FALSE, instructionSet.ImmediateFixupBits,target);
+							Emit2(opSUB, thisPC, target);
+							Emit1(InstructionSet.opBR, thisPC);
+							ReleaseHint(target.register);
+							(* patch fixup for skip long jump code *)
+							SetTarget(fixup);
+							(*
+							fixup.SetSymbol(in, 0, out.pc+fixup.displacement (* displacement offset computed during operand emission, typically -1 *) );
+							*)
+							RETURN
+						END;
+					END;
+					instructionSet.InitFixup(target, 32, fixup);
+					(* fixup mask entered curing  code emission *)
+					Emit1(brop, target);
+				ELSIF brop = opBT THEN (* register jump, unconditional *)
+					MakeRegister(instr.op1,Low,op1);
+					Emit1(opBR, op1);
+				ELSE
+					HALT(100); (* no conditional jump on register implemented *)
+				END;
+			END JmpDest;
+
+			PROCEDURE Cmp(left, right: InstructionSet.Operand);
+			VAR destOp: Operand; ticket: Ticket; fixup, fixup2: BinaryCode.Fixup;
+			BEGIN
+				IF float THEN
+					ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
+					TicketToOperand(ticket,destOp);
+					Emit2(opMOV, destOp, left);
+					Emit2(opAND, destOp, right);
+					fixup := BrForward(opBN);
+					(*
+					Emit1N(opBN, 3);
+					*)
+					Emit2(opMOV, destOp, left);
+					Emit2(opSUB, destOp, right);
+					fixup2 := BrForward(opBT);
+					SetTarget(fixup);
+					(* Emit1N(opBT, 2); *)
+					Emit2(opMOV, destOp, right);
+					Emit2(opSUB, destOp, left);
+					SetTarget(fixup2);
+					UnmapTicket(ticket);
+				ELSE
+					IF (left.register >= 0) & (physicalRegisters.Mapped(left.register) = NIL) THEN
+						IF negate THEN
+							Emit2(opADD, left, right);
+						ELSE
+							Emit2(opSUB, left, right);
+						END;
+					ELSE
+						ticket := TemporaryTicket(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32);
+						TicketToOperand(ticket,destOp);
+						Emit2(opMOV, destOp, left);
+						IF negate THEN
+							Emit2(opADD, destOp, right);
+						ELSE
+							Emit2(opSUB, destOp, right);
+						END;
+						UnmapTicket(ticket);
+					END;
+				END;
+			END Cmp;
+
+		BEGIN
+			hiFail := None; hiHit := None; lowHit := None;
+
+			float := instr.op2.type.form = IntermediateCode.Float;
+			failPC := 0;
+
+			IF (instr.op1.symbol.name = in.name) & (instr.op1.symbolOffset = inPC +1) THEN (* jump to next instruction can be ignored *)
+				IF dump # NIL THEN dump.String("jump to next instruction ignored"); dump.Ln END;
+				RETURN
+			END;
+
+			IF instr.opcode = IntermediateCode.br THEN
+				JmpDest(opBT);
+			ELSE
+				(*
+					conditional branch
+
+					for 32 bit operands quite simple
+
+						cmp left right
+						brc(hit) target
+						...
+						target:
+						....
+
+					for 64 bit operands transformed to
+
+						cmp hi(left) hi(right)
+						brc(hiHit) target
+						brc(hiFail) fail
+
+						cmp low(left) low(right)
+						brc(lowHit) target
+						fail:
+						....
+						target:
+						.....
+
+				*)
+
+				IF instr.op2.type.sizeInBits # 64 THEN
+					CASE instr.opcode OF
+					IntermediateCode.breq:
+						lowHit := opBEQ;
+					|IntermediateCode.brne:
+						lowHit := opBNE;
+					|IntermediateCode.brge:
+						IF instr.op2.type.form IN {IntermediateCode.SignedInteger, IntermediateCode.Float} THEN
+							IF reverse THEN lowHit := opBLE ELSE lowHit := opBGE END;
+						ELSIF instr.op2.type.form = IntermediateCode.UnsignedInteger THEN
+							IF reverse THEN lowHit := opBBE ELSE lowHit := opBAE END;
+						END;
+					|IntermediateCode.brlt:
+						IF instr.op2.type.form IN {IntermediateCode.SignedInteger, IntermediateCode.Float}  THEN
+							IF reverse THEN lowHit := opBGT ELSE lowHit := opBLT END;
+						ELSIF instr.op2.type.form = IntermediateCode.UnsignedInteger THEN
+							IF reverse THEN lowHit := opBA  ELSE lowHit := opBB END;
+						END;
+					END;
+				ELSE
+					Assert(instr.op2.type.form # IntermediateCode.UnsignedInteger, "no unsigned integer64 branch implemented");
+					CASE instr.opcode OF
+					IntermediateCode.breq:
+						hiHit := None; hiFail := opBNE; lowHit := opBEQ
+					|IntermediateCode.brne:
+						hiHit := opBNE; hiFail := None; lowHit := opBNE
+					|IntermediateCode.brge:
+						IF reverse THEN
+							hiHit := opBLT; hiFail := opBGT; lowHit := opBBE
+						ELSE
+							hiHit := opBGT; hiFail := opBLT; lowHit := opBAE
+						END;
+					|IntermediateCode.brlt:
+						IF reverse THEN
+							hiHit := opBGT; hiFail := opBLT; lowHit := opBA
+						ELSE
+							hiHit := opBLT; hiFail := opBGT; lowHit := opBB
+						END;
+					END;
+
+					MakeRegister(instr.op2, High, op2); negate := FALSE;
+					IF float THEN
+						MakeRegister(instr.op3, High, op3)
+					ELSIF ~UnsignedImmediate(instr.op3, High, instructionSet.ImmediateFixupBits, TRUE, negate,op3) THEN
+						MakeRegister(instr.op3, High, op3)
+					END;
+
+					Cmp(op2, op3);
+					ReleaseHint(op2.register); ReleaseHint(op3.register);
+					float := FALSE; (* lower bits must always be compared as (unsigned) integers *)
+
+					IF hiHit # None THEN
+						JmpDest(hiHit);
+					END;
+					IF hiFail # None THEN
+						NEW(pattern,1);
+						pattern[0].offset := 0; pattern[0].bits := instructionSet.RelativeBranchFixupBits;
+						identifier.name := in.name;
+						identifier.fingerprint := in.fingerprint;
+						failFixup := BinaryCode.NewFixup(BinaryCode.Relative, out.pc, identifier, 0, 0, 0 , pattern);
+						failFixup.resolved := in;
+						instructionSet.InitImmediate(target,32,0);
+						instructionSet.AddFixup(target, failFixup);
+						Emit1(hiFail, target);
+					END;
+
+
+					(*ReleaseHint(op2.register);
+					ReleaseHint(op3.register);*)
+				END;
+
+				MakeRegister(instr.op2, Low, op2); negate := FALSE;
+				IF float THEN
+					MakeRegister(instr.op3, Low, op3)
+				ELSIF ~UnsignedImmediate(instr.op3, Low, instructionSet.ImmediateFixupBits, TRUE, negate,op3) THEN
+					MakeRegister(instr.op3, Low, op3)
+				END;
+				Cmp(op2, op3);
+				ReleaseHint(op2.register); ReleaseHint(op3.register);
+				ASSERT(lowHit # None);
+				JmpDest(lowHit);
+				IF hiFail # None THEN
+					failFixup.SetSymbol(in.name, in.fingerprint, 0, out.pc+failFixup.displacement (* displacement offset computed during operand emission, typically -1 *) );
+					failFixup.resolved := in;
+				END;
+			END;
+		END EmitBr;
+
+		PROCEDURE EmitPop(VAR vop: IntermediateCode.Operand; part: LONGINT);
+		VAR mem: InstructionSet.Operand; reg: Operand;
+		BEGIN
+			instructionSet.InitMemory(mem, InstructionSet.SP, 0);
+			AcquireDestinationRegister(vop, part, reg);
+			Emit2(opLD, reg, mem);
+			AllocateStack(-1, TRUE);
+			ReleaseDestinationRegister(vop, part, reg);
+		END EmitPop;
+
+		PROCEDURE EmitPush(VAR vop: IntermediateCode.Operand; part: LONGINT);
+		VAR mem: InstructionSet.Operand; reg: Operand; pc: LONGINT;
+		BEGIN
+			MakeRegister(vop, part, reg);
+			IF pushChainLength = 0 THEN (* check for chain of pushes *)
+				pc := inPC+1; pushChainLength := 1;
+				WHILE ~inEmulation & (pc < in.pc) & (in.instructions[pc].opcode = IntermediateCode.push) DO
+					INC(pc); INC(pushChainLength);
+				END;
+				AllocateStack(pushChainLength,TRUE);
+			END;
+			DEC(pushChainLength);
+			instructionSet.InitMemory(mem, InstructionSet.SP, pushChainLength);
+			Emit2(opST, reg, mem);
+		END EmitPush;
+
+		PROCEDURE EmitNeg(VAR instr: IntermediateCode.Instruction);
+		VAR  leftLow, leftHigh, rightLow, rightHigh, reg: Operand; neg: BOOLEAN; fixup: BinaryCode.Fixup;
+		BEGIN
+			IF instr.op1.type.form IN IntermediateCode.Integer THEN
+				PrepareOp2(instr,Low,FALSE,neg,leftLow, rightLow);
+				Emit2(opNOT, leftLow, rightLow);
+				IF IsComplex(instr.op1) THEN
+					PrepareOp2(instr,High,FALSE,neg,leftHigh,rightHigh);
+					Emit2(opNOT, leftHigh, rightHigh);
+				END;
+				Emit2N(opADD,leftLow,1);
+				FinishOp(instr.op1,Low,leftLow, leftLow);
+				IF IsComplex(instr.op1) THEN
+					fixup := BrForward(opBB);
+					(*
+					Emit1N(opBB, 1);
+					*)
+					Emit2N(opADD, leftHigh, 1);
+					SetTarget(fixup);
+					FinishOp(instr.op1,High,leftHigh, leftHigh);
+				END;
+			ELSIF instr.op1.type.form = IntermediateCode.Float THEN
+				PrepareOp2(instr,Low,FALSE,neg,leftLow,rightLow);
+				IF IsComplex(instr.op1) THEN
+					PrepareOp2(instr,High,FALSE,neg,leftHigh,rightHigh);
+				END;
+				Emit2(opMOV,leftLow,rightLow);
+				IF ~IsComplex(instr.op1) THEN
+					reg := leftLow
+				ELSE ASSERT(instr.op1.type.sizeInBits=64);
+					Emit2(opMOV,leftHigh,rightHigh);
+					reg := leftHigh;
+				END;
+				Emit2N(opROR,reg,31);
+				Emit2N(opXOR,reg,1);
+				Emit2N(opROR,reg,1);
+				ReleaseDestinationRegister(instr.op1, Low, leftLow);
+				IF IsComplex(instr.op1) THEN
+					ReleaseDestinationRegister(instr.op1,High,leftHigh);
+				END;
+			END;
+
+		END EmitNeg;
+
+		PROCEDURE EmitNot(VAR instr: IntermediateCode.Instruction; part: LONGINT);
+		VAR left,right: Operand; negate: BOOLEAN;
+		BEGIN
+			PrepareOp2(instr,part,FALSE,negate,left,right);
+			Emit2(opNOT, left,right);
+			FinishOp(instr.op1,part,left,left);
+		END EmitNot;
+
+		PROCEDURE EmitAbs(VAR instr: IntermediateCode.Instruction);
+		VAR left,right: Operand; neg: BOOLEAN; fixup: BinaryCode.Fixup;
+		BEGIN
+			PrepareOp2(instr,Low,FALSE,neg,left,right);
+			Emit2(opMOV, left, right);
+			fixup := BrForward(opBNN);
+			(*
+			Emit1N(opBNN, 2);
+			*)
+			Emit2(opNOT, left,right);
+			Emit2N(opADD, left, 1);
+			SetTarget(fixup);
+			FinishOp(instr.op1,Low, left,left);
+		END EmitAbs;
+
+		PROCEDURE EmitTrap(CONST instr: IntermediateCode.Instruction);
+		VAR reg: Operand; reserve: Ticket;
+		BEGIN
+			instructionSet.InitRegister(reg, 0);
+			ImmediateToOperand(instr.op1.intValue,Low, FALSE, instructionSet.ImmediateFixupBits,reg);
+
+			IF physicalRegisters.Mapped(0)=NIL THEN
+				reserve := ReservePhysicalRegister(IntermediateCode.GeneralPurposeRegister,IntermediateCode.int32,0,inPC);
+			ELSE
+				reserve := NIL
+			END;
+			GetTemporaryRegister(reg);
+			Emit2N(opMOV, reg, HaltIRQNumber);
+			Emit2(opBLR, opLR, reg);
+			ReleaseHint(reg.register);
+			IF reserve # NIL THEN UnmapTicket(reserve) END;
+		END EmitTrap;
+
+		PROCEDURE EmitAsm(CONST instr: IntermediateCode.Instruction);
+		VAR reader: Streams.StringReader; procedure: SyntaxTree.Procedure; scope: SyntaxTree.Scope;
+				len: LONGINT; symbol: SyntaxTree.Symbol; assembler: Assembler.Assembler;
+				scanner: Scanner.AssemblerScanner;
+		BEGIN
+			len := Strings.Length(instr.op1.string^);
+			NEW(reader, len);
+			reader.Set(instr.op1.string^);
+			symbol := in.symbol;
+			IF (symbol = NIL) THEN
+				scope := NIL
+			ELSE
+				procedure := symbol(SyntaxTree.Procedure);
+				scope := procedure.procedureScope;
+			END;
+
+			NEW(assembler, diagnostics, backend.capabilities,instructionSet );
+			scanner := Scanner.NewAssemblerScanner(module.moduleName(*module.module.sourceName*), reader, SHORT(instr.op1.intValue), diagnostics);
+			assembler.InlineAssemble(scanner, in, scope, module);
+			error := error OR assembler.error
+		END EmitAsm;
+
+	END CodeGeneratorTRM;
+
+	System = OBJECT (Global.System)
+
+		PROCEDURE SizeOf(type: SyntaxTree.Type): LONGINT;
+		BEGIN
+			type := type.resolved;
+			IF type IS SyntaxTree.BasicType THEN
+				IF (type.sizeInBits=64) THEN
+					RETURN 64
+				ELSE
+					RETURN 32
+				END
+			ELSE RETURN SizeOf^(type)
+			END;
+		END SizeOf;
+
+	END System;
+
+
+
+	BackendTRM = OBJECT (IntermediateBackend.IntermediateBackend)
+	VAR
+		cg: CodeGeneratorTRM;
+		patchSpartan6: BOOLEAN;
+		myInstructionSet: InstructionSet.InstructionSet;
+		
+		PROCEDURE &InitBackendTRM;
+		BEGIN
+			InitIntermediateBackend;
+			SetRuntimeModuleName(DefaultRuntimeModuleName);
+			SetNewObjectFile(TRUE,TRUE);
+			myInstructionSet:=defaultInstructionSet;
+		END InitBackendTRM;
+
+		PROCEDURE Initialize(diagnostics: Diagnostics.Diagnostics; log: Streams.Writer; flags: SET; checker: SemanticChecker.Checker; system: Global.System;
+			activeCellsSpecification: ActiveCells.Specification);
+		VAR
+		BEGIN
+			Initialize^(diagnostics, log, flags, checker, system, activeCellsSpecification); (*goes up the inheritance hierarchy all the way to Backend.Mod*)
+			
+			
+			NEW(cg, runtimeModuleName, diagnostics, SELF,myInstructionSet);
+			cg.patchSpartan6 := patchSpartan6;
+		END Initialize;
+		
+		PROCEDURE SetInstructionWidth* (instructionWidth: LONGINT);  (*override*)
+		BEGIN
+			SetInstructionWidth^(instructionWidth);
+			NEW(myInstructionSet,instructionWidth);
+			cg.SetInstructionSet(myInstructionSet);
+		END SetInstructionWidth;
+		
+		
+		
+		PROCEDURE GetSystem(): Global.System;
+		VAR system: System;
+		BEGIN
+			(*
+			IF supportFP THEN
+			NEW(system, 18, 32, 32, 32, 32, 32, 32, 64 (* parameter offset: two words, one for LR and one for FP *));
+			ELSE
+			*)
+			NEW(system, 18, 32, 32, 32, 32, 32, 32, 0(* parameter offset 0: handled locally *), 0 (* no pass of parameters in registers *) , cooperative);
+			(*
+			END;
+			*)
+			Global.SetDefaultDeclarations(system,32);
+			Global.SetDefaultOperators(system);
+			RETURN system
+		END GetSystem;
+
+		PROCEDURE SupportedInstruction(CONST instruction: IntermediateCode.Instruction; VAR moduleName, procedureName: ARRAY OF CHAR): BOOLEAN;
+		BEGIN
+			RETURN cg.Supported(instruction, moduleName, procedureName);
+		END SupportedInstruction;
+
+		PROCEDURE SupportedImmediate(CONST immediate: IntermediateCode.Operand): BOOLEAN;
+		VAR reg: InstructionSet.Operand; int: LONGINT;
+		BEGIN
+			IF immediate.type.form IN  IntermediateCode.Integer THEN
+				IF immediate.type.sizeInBits < 64 THEN
+					int := LONGINT(immediate.intValue);
+					RETURN ((ABS(int) < ASH(1,myInstructionSet.ImmediateFixupBits)) OR (cg.GetImmediate32(int, reg, FALSE) < 3))
+				ELSE
+					RETURN (ABS(immediate.intValue) < ASH(1,myInstructionSet.ImmediateFixupBits))
+				END;
+			ELSE
+				RETURN FALSE
+			END
+		END SupportedImmediate;
+
+		PROCEDURE GenerateBinary(module: Sections.Module; dump: Streams.Writer);
+		VAR
+			in: Sections.Section;
+			out: BinaryCode.Section;
+			name: Basic.SectionName;
+			procedure: SyntaxTree.Procedure;
+			i, j, initialSectionCount: LONGINT;
+
+			PROCEDURE Resolve(VAR fixup: BinaryCode.Fixup);
+			BEGIN
+				IF (fixup.symbol.name #"") & (fixup.resolved = NIL) THEN
+					fixup.resolved := module.allSections.FindByName(fixup.symbol.name)
+				END;
+			END Resolve;
+
+
+		 	(* recompute fixup positions and assign binary sections *)
+		 	PROCEDURE PatchFixups(section: BinaryCode.Section);
+			VAR resolved: BinaryCode.Section; fixup: BinaryCode.Fixup; symbolOffset: LONGINT; in: IntermediateCode.Section;
+			BEGIN
+				fixup := section.fixupList.firstFixup;
+				WHILE fixup # NIL DO
+					Resolve(fixup);
+					IF  (fixup.resolved # NIL) THEN
+						resolved := fixup.resolved(IntermediateCode.Section).resolved(BinaryCode.Section);
+						in := fixup.resolved(IntermediateCode.Section);
+						symbolOffset := fixup.symbolOffset;
+						IF (symbolOffset # 0) & (symbolOffset < in.pc) THEN
+							symbolOffset := in.instructions[symbolOffset].pc;
+						END;
+						fixup.SetSymbol(fixup.symbol.name, fixup.symbol.fingerprint, 0, symbolOffset+fixup.displacement);
+					END;
+					fixup := fixup.nextFixup;
+				END;
+			END PatchFixups;
+
+		BEGIN
+		 	cg.SetModule(module);
+		 	cg.dump := dump;
+
+		 	FOR i := 0 TO module.allSections.Length() - 1 DO
+			 	in := module.allSections.GetSection(i);
+			 	in(IntermediateCode.Section).EnableComments(trace);
+		 		IF in.type = Sections.InlineCodeSection THEN
+		 			Basic.SegmentedNameToString(in.name, name);
+			 		out := ResolvedSection(in(IntermediateCode.Section));
+			 		cg.dump := out.comments;
+			 		
+			 		SetInstructionWidth(out.os.unit);
+			 		cg.Section(in(IntermediateCode.Section), out);  (*compilation*)
+			 		IF in.symbol # NIL THEN
+				 		procedure := in.symbol(SyntaxTree.Procedure);
+				 		procedure.procedureScope.body.code.SetBinaryCode(out.os.bits);
+				 	END;
+			 	END
+		 	END;
+
+			initialSectionCount := 0;
+		 	REPEAT
+		 		j := initialSectionCount;
+		 	 	initialSectionCount := module.allSections.Length() ;
+
+			 	FOR i := j TO initialSectionCount - 1 DO
+			 		in := module.allSections.GetSection(i);
+			 		IF (in.type # Sections.InlineCodeSection) (*& (in(IntermediateCode.Section).resolved = NIL) *) THEN
+				 		out := ResolvedSection(in(IntermediateCode.Section));
+				 		SetInstructionWidth(out.os.unit);
+				 		cg.Section(in(IntermediateCode.Section),out);  
+			 		END
+			 	END
+			UNTIL initialSectionCount = module.allSections.Length(); (* process remaining sections that have been added during traversal of sections *)
+
+			(*
+		 	FOR i := 0 TO module.allSections.Length() - 1 DO
+			 	in := module.allSections.GetSection(i);
+			 	IF ~in.IsExternal() THEN
+			 		IF in.type # Sections.InlineCodeSection THEN
+				 		Basic.SegmentedNameToString(in.name, name);
+				 		out := ResolvedSection(in(IntermediateCode.Section));
+				 		cg.Section(in(IntermediateCode.Section), out);
+			 		END
+			 	END;
+		 	END;
+			*)
+
+
+
+		 	FOR i := 0 TO module.allSections.Length() - 1 DO
+			 	in := module.allSections.GetSection(i);
+		 		PatchFixups(in(IntermediateCode.Section).resolved)
+		 	END;
+
+			IF cg.error THEN Error("", Diagnostics.Invalid, Diagnostics.Invalid,  "") END;
+		END GenerateBinary;
+
+		(* genasm *)
+		PROCEDURE ProcessIntermediateCodeModule*(intermediateCodeModule: Formats.GeneratedModule): Formats.GeneratedModule;
+		VAR
+			result: Formats.GeneratedModule;
+		BEGIN
+			ASSERT(intermediateCodeModule IS Sections.Module);
+			result := ProcessIntermediateCodeModule^(intermediateCodeModule);
+
+			IF ~error THEN
+				GenerateBinary(result(Sections.Module), dump);
+				IF dump # NIL THEN
+					dump.Ln; dump.Ln;
+					dump.String("------------------ binary code -------------------"); dump.Ln;
+					IF (traceString="") OR (traceString="*") THEN
+						result.Dump(dump);
+						dump.Update
+					ELSE
+						Sections.DumpFiltered(dump, result(Sections.Module), traceString);
+						dump.Update;
+					END
+				END;
+			END;
+			RETURN result
+		FINALLY
+			IF dump # NIL THEN
+				dump.Ln; dump.Ln;
+				dump.String("------------------ rescued code (code generation trapped) -------------------"); dump.Ln;
+				IF (traceString="") OR (traceString="*") THEN
+					result.Dump(dump);
+					dump.Update
+				ELSE
+					Sections.DumpFiltered(dump,result(Sections.Module),traceString);
+					dump.Update;
+				END
+			END;
+			RETURN result
+		END ProcessIntermediateCodeModule;
+
+		PROCEDURE DefineOptions(options: Options.Options);
+		BEGIN
+			options.Add(0X,VectorSupportFlag,Options.Flag);
+			options.Add(0X,FloatingPointSupportFlag,Options.Flag);
+			options.Add(0X,PatchSpartan6, Options.Flag);
+			DefineOptions^(options);
+		END DefineOptions;
+
+		PROCEDURE GetOptions(options: Options.Options);
+		VAR capabilities: SET;
+		BEGIN
+			capabilities := SELF.capabilities;
+			IF options.GetFlag(VectorSupportFlag) THEN INCL(capabilities, Global.VectorCapability) END;
+			IF options.GetFlag(FloatingPointSupportFlag) THEN INCL(capabilities, Global.FloatingPointCapability) END;
+			IF options.GetFlag(PatchSpartan6) THEN D.String("patchSpartan6=TRUE"); D.Ln; patchSpartan6 := TRUE END;
+			SetCapabilities(capabilities);
+			GetOptions^(options);
+		END GetOptions;
+
+		PROCEDURE DefaultObjectFileFormat(): Formats.ObjectFileFormat;
+		BEGIN RETURN ObjectFileFormat.Get();
+		END DefaultObjectFileFormat;
+
+		PROCEDURE DefaultSymbolFileFormat(): Formats.SymbolFileFormat;
+		BEGIN
+			RETURN NIL
+		END DefaultSymbolFileFormat;
+
+		PROCEDURE GetDescription(VAR instructionSet: ARRAY OF CHAR);
+		BEGIN instructionSet := "TRM"
+		END GetDescription;
+
+		PROCEDURE FindPC(x: SyntaxTree.Module; CONST sectionName: ARRAY OF CHAR; sectionOffset: LONGINT);
+		VAR
+			section: Sections.Section; binarySection: BinaryCode.Section; label: BinaryCode.LabelList; module: Formats.GeneratedModule;
+			i: LONGINT; pooledName: Basic.SegmentedName;
+		BEGIN
+			module := ProcessSyntaxTreeModule(x);
+			Basic.ToSegmentedName(sectionName, pooledName);
+			i := 0;
+			REPEAT
+				section := module(Sections.Module).allSections.GetSection(i);
+				INC(i);
+			UNTIL (i = module(Sections.Module).allSections.Length()) OR (section.name = pooledName);
+
+			IF section.name # pooledName THEN
+				diagnostics.Error(module.module.sourceName,Diagnostics.Invalid,Diagnostics.Invalid," could not locate pc");
+			ELSE
+				binarySection := section(IntermediateCode.Section).resolved;
+				label := binarySection.labels;
+				WHILE (label # NIL) & (label.offset >= sectionOffset) DO
+					label := label.prev;
+				END;
+				IF label # NIL THEN
+					diagnostics.Information(module.module.sourceName,label.position,Diagnostics.Invalid," pc position");
+				ELSE
+					diagnostics.Error(module.module.sourceName,Diagnostics.Invalid,Diagnostics.Invalid," could not locate pc");
+				END;
+			END;
+		END FindPC;
+
+		PROCEDURE CheckCodeAddress(VAR adr: LONGINT);
+		BEGIN
+			IF (patchSpartan6) & (adr MOD 1024 >= 959) (* need one instruction to jump, therefore include 959 in check *) & (adr MOD 1024 <= 975) THEN
+				adr := (adr DIV 1024) * 1024 +976;
+			END;
+		END CheckCodeAddress;
+		
+		PROCEDURE ResolvedSection(in: IntermediateCode.Section): BinaryCode.Section;
+		VAR section: BinaryCode.Section; unit: LONGINT;
+		BEGIN
+		
+			(*VAR and CONST sections go to the data memory, only code sections go to code memory
+			    Note that data memory has 32 bit words while code has standard 18.
+			*)
+			IF in.bitsPerUnit # Sections.UnknownSize THEN
+				unit :=  in.bitsPerUnit;
+			ELSIF in.type IN {Sections.VarSection, Sections.ConstSection} THEN
+				unit := 32;
+			ELSE
+				IF (instructionWidth # Sections.UnknownSize) THEN
+					unit := instructionWidth;
+				ELSE
+					unit:=18;
+				END
+				
+			END;
+			
+			IF in.resolved = NIL THEN
+				NEW(section, in.type, in.priority, unit, in.name, in.comments # NIL, FALSE);
+				section.SetAlignment(in.fixed, in.positionOrAlignment);
+				in.SetResolved(section);
+			ELSE
+				section := in.resolved
+			END;
+			RETURN section
+		END ResolvedSection;
+
+	END BackendTRM;
+
+	VAR 
+	defaultInstructionSet: InstructionSet.InstructionSet;
+	emptyOperand: InstructionSet.Operand;
+
+	PROCEDURE Assert(b: BOOLEAN; CONST s: ARRAY OF CHAR);
+	BEGIN
+		ASSERT(b, 100);
+	END Assert;
+
+	PROCEDURE Halt(CONST s: ARRAY OF CHAR);
+	BEGIN
+		HALT(100);
+	END Halt;
+
+	
+
+
+	PROCEDURE Init;
+	BEGIN
+		NEW(defaultInstructionSet,18); (*TODO: maybe it's better to have all these init functions outside of instruction set object?*)
+		defaultInstructionSet.InitOperand(emptyOperand);
+		
+	END Init;
+
+	PROCEDURE Get*(): Backend.Backend;
+	VAR backend: BackendTRM;
+	BEGIN NEW(backend); RETURN backend
+	END Get;
+
+BEGIN
+	Init;
+END FoxTRMBackend.
+
+
+SystemTools.FreeDownTo FoxTRMBackend  ~

source/FoxTRMInstructionSet.Mod

@@ -0,0 +1,1149 @@
+MODULE FoxTRMInstructionSet; (** AUTHOR "fof"; PURPOSE "Tiny Register Machine Instruction Set"; *)
+
+IMPORT Commands, Options, Streams, Sections := FoxSections, BinaryCode := FoxBinaryCode, Global := FoxGlobal, Basic := FoxBasic, D := Debugging, ObjectFile, Disassembler := FoxDisassembler,
+	Files, BitSets;
+
+CONST
+	checkMnemonic=TRUE;
+	maxMnemonicNameLength=8;
+	maxNumberInstructions=100;
+
+	(* 	mnemonics , unsorted
+		FoxProgTools.Enum -e -l=8
+		opMOV opNOT
+		opADD opFADD
+		opSUB opFSUB
+		opAND opBIC opOR opXOR
+		opMUL opFMUL
+		opLDH opROR opBLR opBR opSPSR opIRET opLD opST opBL
+		opBEQ opBNE opBAE opBB opBN opBNN opBO opBNO opBA opBBE opBGE opBLT opBGT opBLE opBT opBF
+		opBZS opBZC opBCS opBCC opBNS opBNC opBVS opBVC opHADD opFHADD
+		numberMnemonics
+		~
+	*)
+
+
+	(*Variable instruction width related. All other bitcaounts derived.*)
+	(*instructionW=24;*) (*Number of bits an instruction word holds. default 18*)
+	regselW=3; (*number of bits to select a register. default 3*)
+	opcodeW=4;(*Number of bits for the opcode. default 4*)
+	conditionW=4; (*Number of bits fot the branch condition*)
+
+	opMOV*= 0; opNOT*= 1; opADD*= 2; opFADD*= 3; opSUB*= 4; opFSUB*= 5; opAND*= 6; opBIC*= 7;
+	opOR*= 8; opXOR*= 9; opMUL*= 10; opFMUL*= 11; opLDH*= 12; opROR*= 13; opBLR*= 14; opBR*= 15;
+	opSPSR*= 16; opIRET*= 17; opLD*= 18; opST*= 19; opBL*= 20; opBEQ*= 21; opBNE*= 22; opBAE*= 23;
+	opBB*= 24; opBN*= 25; opBNN*= 26; opBO*= 27; opBNO*= 28; opBA*= 29; opBBE*= 30; opBGE*= 31;
+	opBLT*= 32; opBGT*= 33; opBLE*= 34; opBT*= 35; opBF*= 36; opBZS*= 37; opBZC*= 38; opBCS*= 39;
+	opBCC*= 40; opBNS*= 41; opBNC*= 42; opBVS*= 43; opBVC*= 44; opHADD*= 45; opFHADD*= 46; numberMnemonics*= 47;
+
+	(* 	operand format types *)
+	None*=-1; (* no operand *)
+	Rd=0; (* destination register,  encoded at bits 11..13  *)
+	Rs=1; (* source register,  encoded at bits 0..2 *)
+	VRd=2; (* vector destination register,  encoded at bits 11..13 *)
+	VRs=3; (* vector source register, encoded at bits 0..2  *)
+	Imm10=4; (* 10 bit immediate, unsigned, encoded at bits 0..9 *)  (*gets wider with wider instruction word.*)
+	SignedImm10=5; (* 10 bit immediate, signed, encoded at bits 0..9 *)
+	Imm14=6; (* 14 bit signed immediate, encoded at bits 0..13  *)
+	MemRegImm7=7; (* memory operand of the form  [reg +imm] with 7 bit immediate, encoded at reg = 0..2, imm= 3..9  *)
+	VRd0=8; (* vector register, being restricted to register number 0 *)
+
+
+
+
+
+
+	ZeroRegister* = 7;
+
+	(* operand types *)
+	Register*=1;
+	Immediate*=2;
+	Memory*=3;
+
+	(* special registers *)
+	LR*=7; (* pc link register *)
+	SP*=6; (* stack pointer register *)
+	globalP*=5; (* global variable link register *)
+	FP*=4; (* frame pointer register *)
+
+	(*
+		registers 0 .. 7 : general purpose registers (integer, 32 bit)
+		registers 16..23: vector registers
+	*)
+
+TYPE
+	OperandType = INTEGER;
+	OperandFormatType = INTEGER;
+	RegisterIndex = LONGINT;
+
+	InstructionFormat* = RECORD
+		mnemonic-: LONGINT;
+		code, mask: SET;
+		capabilities-: SET; (* what kind of capabilities an architecture must have to support this instruction *)
+		op1, op2: OperandFormatType;
+	END;
+
+	Mnemonic* = RECORD
+		name-: ARRAY maxMnemonicNameLength OF CHAR;
+		number-: LONGINT;
+		firstInstructionFormat, lastInstructionFormat: LONGINT;
+	END;
+
+	NumberedName=RECORD (* for sorting mnemonics *)
+		name: ARRAY maxMnemonicNameLength OF CHAR;
+		number: LONGINT;
+	END;
+
+	Operand*=RECORD
+		type-: OperandType;
+		size: LONGINT; (* size in bits *)
+		register-: RegisterIndex; (* register index *)
+		imm-: LONGINT; (* value *)
+		fixup-: BinaryCode.Fixup;
+	END;
+
+	Instruction*=RECORD
+		format-: LONGINT;
+		op1-, op2-: Operand;
+	END;
+
+
+	InstructionSet *=OBJECT
+		VAR mnemonics-: ARRAY numberMnemonics OF Mnemonic;
+		mnemonicsSorted-: ARRAY numberMnemonics OF NumberedName;
+		instructionFormats-: ARRAY maxNumberInstructions OF InstructionFormat;
+		numberInstructionFormats-: LONGINT;
+		inverseCondition-: ARRAY numberMnemonics OF LONGINT;
+		instructionW-: LONGINT;
+
+		RelativeBranchFixupBits-: LONGINT;
+		BranchAndLinkFixupBits-: LONGINT;
+		ImmediateFixupBits-: LONGINT;
+		MemoryOffsetFixupBits-: LONGINT;
+
+
+		PROCEDURE & InitInstructionSet * (instructionWidth: LONGINT);
+		BEGIN
+			ASSERT(instructionWidth>0);
+			instructionW:=instructionWidth;
+			RelativeBranchFixupBits:=instructionW-opcodeW-regselW-1;
+			BranchAndLinkFixupBits:=instructionW-opcodeW;
+			ImmediateFixupBits:=instructionW-opcodeW-regselW-1;
+			MemoryOffsetFixupBits:=instructionW-11;  (*!todo: look up how that actually comes to pass*)
+			InitInstructions();
+		END InitInstructionSet;
+		(*
+		public functions:
+		makeinstruction
+		isvalidinstruction
+		encode
+		decode
+		emitinst
+		emit
+		findmnem
+		findreg
+		initreg
+		initimm
+		initmem
+		initfix
+		addfix
+		initop
+		dumpop
+		dumpinst
+		dumpbits
+		dumpinsformat
+		disas
+		*)
+
+	PROCEDURE FindInstructionFormat(mnem: LONGINT; op1, op2: Operand): LONGINT;
+	VAR i: LONGINT; instructionFormat: InstructionFormat;
+
+		PROCEDURE Matches(operand: Operand; operandFormatType: OperandType): BOOLEAN;
+		BEGIN
+			CASE operand.type OF
+				Register : RETURN (operandFormatType IN {Rd, Rs}) & (operand.register < 16) OR (operandFormatType IN {VRd,VRs}) & (operand.register >= 16)
+				OR (operandFormatType = VRd0) & (operand.register = 16)
+				;
+				| Immediate : RETURN operandFormatType IN {Imm10, SignedImm10, Imm14};
+				| Memory : RETURN (operandFormatType=MemRegImm7);
+				| None : RETURN operandFormatType = None;
+			END;
+		END Matches;
+
+	BEGIN
+		i := mnemonics[mnem].firstInstructionFormat;
+		WHILE i <= mnemonics[mnem].lastInstructionFormat DO
+			instructionFormat := instructionFormats[i];
+			IF Matches(op1, instructionFormat.op1) & Matches(op2, instructionFormat.op2) THEN
+				RETURN i
+			END;
+			INC(i);
+		END;
+		D.String("could not find instruction for "); D.String(mnemonics[mnem].name); D.String(" ");
+		DumpOperand(D.Log, op1); D.String(", ");
+		DumpOperand(D.Log, op2); D.String(", ");
+		D.Ln;
+
+		i := mnemonics[mnem].firstInstructionFormat;
+		D.Int(i,0);D.Ln;
+		WHILE i <= mnemonics[mnem].lastInstructionFormat DO
+		D.Int(i,0);D.Ln;
+			instructionFormat := instructionFormats[i];
+			IF ~Matches(op1, instructionFormat.op1) THEN
+				D.String("op1 doesn't match");
+			END;
+			IF ~Matches(op2, instructionFormat.op2) THEN
+				D.String("op2 doesn't match");
+			END;
+			IF Matches(op1, instructionFormat.op1) & Matches(op2, instructionFormat.op2) THEN
+				D.String("MATCH!");
+			ELSE
+				D.String("NO MATCH!");
+			END;
+			D.Log.Ln;
+			INC(i);
+		END;
+		D.Update;
+
+		RETURN None;
+	END FindInstructionFormat;
+
+	PROCEDURE MakeInstruction*(VAR instruction: Instruction; mnemonic: LONGINT; op1, op2: Operand);
+	VAR instructionFormat: LONGINT;
+	BEGIN
+		instructionFormat := FindInstructionFormat(mnemonic, op1, op2);
+		instruction.format := instructionFormat;
+		instruction.op1 := op1;
+		instruction.op2 := op2;
+	END MakeInstruction;
+
+	PROCEDURE IsValidInstruction*(CONST instruction: Instruction): BOOLEAN;
+	BEGIN RETURN instruction.format # None
+	END IsValidInstruction;
+
+	PROCEDURE Encode*(CONST instruction: Instruction): LONGINT;
+	VAR codeSet: SET; instructionFormat: InstructionFormat; error: BOOLEAN;
+
+		PROCEDURE Unsigned(val: LONGINT; from, to: LONGINT);
+		VAR i: LONGINT;
+		BEGIN
+			ASSERT ( from <= to );
+			FOR i := from TO to DO
+				IF ODD(val) THEN INCL(codeSet, i) END;
+				val := val DIV 2;
+			END;
+			IF val # 0 THEN error := TRUE END;
+			ASSERT(val = 0);
+		END Unsigned;
+
+		PROCEDURE Signed(val: LONGINT; from, to: LONGINT);
+		VAR i: LONGINT;
+		BEGIN
+			ASSERT ( from <= to );
+			FOR i := from TO to-1 DO
+				IF ODD(val) THEN INCL(codeSet, i) END;
+				val := val DIV 2;
+			END;
+
+			IF val = -1 THEN INCL(codeSet, to)
+			ELSIF val # 0 THEN HALT(100) (* overflow *)
+			END;
+		END Signed;
+
+		PROCEDURE EncodeOperand(op: Operand; type: OperandFormatType);
+		VAR imm: LONGINT;
+
+			PROCEDURE Fixup(from, to: LONGINT);
+			VAR patterns: ObjectFile.FixupPatterns; displacement: LONGINT; mode: SHORTINT;
+			BEGIN
+				NEW(patterns, 1);
+				patterns[0].offset := from; patterns[0].bits := to-from+1;
+				IF (opBL <= instructionFormat.mnemonic) & (instructionFormat.mnemonic <= opBF) THEN
+					mode := BinaryCode.Relative;
+					displacement := op.fixup.displacement-1;
+				ELSE
+					mode := BinaryCode.Absolute;
+					displacement := op.fixup.displacement;
+				END;
+				op.fixup.InitFixup(mode, 0, op.fixup.symbol, op.fixup.symbolOffset, displacement, 0, patterns);
+			END Fixup;
+
+		BEGIN
+			imm := op.imm; (* for debugging *)
+			CASE type OF
+				None: (* do nothing *)
+				|Rd: Unsigned(op.register,instructionW-opcodeW-regselW,instructionW-opcodeW-1);
+				|Rs: Unsigned(op.register, 0, regselW-1);
+				|VRd: Unsigned(op.register MOD 16,instructionW-opcodeW-regselW,instructionW-opcodeW-1);
+				|VRd0: Unsigned(0, instructionW-opcodeW-regselW,instructionW-opcodeW-1);
+				|VRs: Unsigned(op.register MOD 16,0,regselW-1);
+				|Imm10: Unsigned(op.imm, 0, instructionW-opcodeW-regselW-2);
+					IF op.fixup # NIL THEN Fixup(0, instructionW-opcodeW-regselW-2) END;
+				|SignedImm10: Signed(op.imm, 0, instructionW-opcodeW-regselW-2);
+					IF op.fixup # NIL THEN Fixup(0, instructionW-opcodeW-regselW-2) END;
+				|Imm14: Signed(op.imm, 0, BranchAndLinkFixupBits-1);
+					IF op.fixup # NIL THEN Fixup(0, BranchAndLinkFixupBits-1) END;
+				|MemRegImm7: Unsigned(op.register, 0, 2); Unsigned(op.imm, regselW, instructionW-opcodeW-regselW-2);
+					IF op.fixup # NIL THEN Fixup(regselW, instructionW-opcodeW-regselW-2) END;
+			END;
+			
+		END EncodeOperand;
+
+	BEGIN
+		ASSERT(instruction.format # None);
+		instructionFormat := instructionFormats[instruction.format];
+		codeSet := instructionFormat.code;
+		EncodeOperand(instruction.op1, instructionFormat.op1);
+		EncodeOperand(instruction.op2, instructionFormat.op2);
+		RETURN SetToNumber(codeSet);
+	END Encode;
+
+	PROCEDURE Decode*(code: LONGINT; VAR instruction: Instruction);
+	VAR instructionFormat: InstructionFormat; i: LONGINT; codeSet: SET;
+
+		PROCEDURE Unsigned(from, to: LONGINT): LONGINT;
+		VAR val, i: LONGINT;
+		BEGIN
+			val := 0;
+			FOR i := to TO from BY -1 DO
+				val := val*2;
+				IF i IN codeSet THEN INC(val) END;
+			END;
+			RETURN val
+		END Unsigned;
+
+		PROCEDURE Signed(from, to: LONGINT): LONGINT;
+		VAR val, i: LONGINT; negative:BOOLEAN;
+		BEGIN
+			val := 0;
+			negative := to IN codeSet; (* two's complement negate *)
+			FOR i := to-1 TO from BY -1 DO
+				val := val*2;
+				IF (i IN codeSet) THEN
+					IF ~negative THEN INC(val) END;
+				ELSIF negative THEN
+					INC(val)
+				END;
+			END;
+			IF negative THEN INC(val); val := -val END;
+			RETURN val
+		END Signed;
+
+		PROCEDURE Matches(CONST instructionFormat: InstructionFormat): BOOLEAN;
+		BEGIN
+			RETURN instructionFormat.mask*codeSet = instructionFormat.code * instructionFormat.mask;
+		END Matches;
+
+		PROCEDURE DecodeOperand(VAR op: Operand; type: OperandFormatType);
+		BEGIN
+			InitOperand(op);
+			CASE type OF
+				None: op.type := None;
+				|Rd: InitRegister(op,Unsigned(instructionW-opcodeW-regselW,instructionW-opcodeW-1));
+				|Rs: InitRegister(op,Unsigned(0,regselW-1));
+				|VRd: InitRegister(op,Unsigned(instructionW-opcodeW-regselW,instructionW-opcodeW-1)+16);
+				|VRs: InitRegister(op,Unsigned(0,regselW-1)+16);
+				|Imm10: InitImmediate(op,ImmediateFixupBits,Unsigned(0,ImmediateFixupBits-1));
+				|SignedImm10: InitImmediate(op,ImmediateFixupBits,Signed(0,ImmediateFixupBits-1));
+				|Imm14: InitImmediate(op,BranchAndLinkFixupBits,Signed(0,BranchAndLinkFixupBits-1));
+				|MemRegImm7: InitMemory(op,Unsigned(0,regselW-1), Unsigned(regselW, ImmediateFixupBits-1));  (*load/store offsets*)
+			END;
+		END DecodeOperand;
+
+	BEGIN
+		codeSet := NumberToSet(code);
+		i := 0;
+		WHILE ~Matches(instructionFormats[i]) DO
+			INC(i);
+		END;
+		instructionFormat := instructionFormats[i];
+		instruction.format := i;
+		DecodeOperand(instruction.op1, instructionFormat.op1);
+		DecodeOperand(instruction.op2, instructionFormat.op2);
+	END Decode;
+
+	PROCEDURE EmitInstruction*(CONST instruction: Instruction; mnem: LONGINT; code: BinaryCode.Section);
+	VAR encoding: LONGINT;
+
+		PROCEDURE PatchFixup(op: Operand; type: OperandFormatType);
+		BEGIN
+			IF op.fixup # NIL THEN
+				op.fixup.SetFixupOffset(code.pc);
+				code.fixupList.AddFixup(op.fixup);
+			END;
+		END PatchFixup;
+
+		PROCEDURE PatchFixups;
+		VAR instructionFormat: InstructionFormat;
+		BEGIN
+			instructionFormat := instructionFormats[instruction.format];
+			PatchFixup(instruction.op1, instructionFormat.op1);
+			PatchFixup(instruction.op2, instructionFormat.op2);
+		END PatchFixups;
+
+	BEGIN
+		IF (code.comments # NIL) THEN
+			DumpInstruction(code.comments, instruction);
+			code.comments.Ln;
+			code.comments.Update;
+		END;
+		encoding := Encode(instruction);
+		PatchFixups();
+		code.PutBits(encoding, instructionW);
+		(*make sure it is really a section set up to take code and not for example data.*)
+		ASSERT(code.os.unit =instructionW); ASSERT(code.os.bits.GetSize() MOD instructionW = 0);
+	END EmitInstruction;
+
+	PROCEDURE Emit*(mnem: LONGINT; CONST op1, op2: Operand; code: BinaryCode.Section);
+	VAR instruction: Instruction;
+	BEGIN
+		MakeInstruction(instruction, mnem, op1, op2);
+		EmitInstruction(instruction, mnem, code);
+	END Emit;
+
+	(* perform a binary search for the index of the specified mnemonic *)
+	PROCEDURE FindMnemonic* (CONST mnem: ARRAY OF CHAR): LONGINT;
+	VAR l, r, m: LONGINT;
+	BEGIN
+		(*
+		IF mnem = "LD" THEN
+			IF vectorSupport THEN RETURN opLD ELSE RETURN opLDS END;
+		ELSIF mnem = "ST" THEN
+			IF vectorSupport THEN RETURN opST ELSE RETURN opSTS END;
+		END;
+		*)
+
+		l := 0;
+		r := numberMnemonics;
+		WHILE l # r DO
+			m := (l + r) DIV 2;
+			IF mnem < mnemonicsSorted[m].name THEN r := m;
+			ELSIF mnem > mnemonicsSorted[m].name THEN l := m + 1;
+			ELSE RETURN mnemonicsSorted[m].number;
+			END
+		END;
+		RETURN None;
+	END FindMnemonic;
+
+	PROCEDURE FindRegister*(CONST name: ARRAY OF CHAR): SHORTINT;
+	BEGIN
+		IF name[0] = "R" THEN
+			IF name[2] = 0X THEN
+				IF ("0" <= name[1]) & (name[1] <= "9") THEN
+					RETURN SHORT(ORD(name[1])-ORD("0"));
+				ELSE RETURN None
+				END;
+			ELSIF ("0"<=name[2]) & (name[2] <= "5") THEN
+				IF name[1] = "1" THEN
+					RETURN SHORT(ORD(name[2])-ORD("0")+10);
+				ELSE RETURN None
+				END;
+			ELSE RETURN None
+			END;
+		ELSIF name[0] = "V" THEN
+			IF name[1] = "R" THEN
+				IF ("0" <= name[2]) & (name[2] <= "8") THEN
+					RETURN SHORT(ORD(name[2])-ORD("0"))+16;
+				ELSIF name[2] = 0X THEN (* VR as shortcut for VR0 *)
+					RETURN 16
+				ELSE
+					RETURN None
+				END;
+			END;
+			RETURN None;
+		ELSIF name = "SP" THEN
+			RETURN SP
+		ELSIF name = "LR" THEN
+			RETURN LR
+		ELSE
+			RETURN None
+		END;
+	END FindRegister;
+
+	PROCEDURE NumberToSet(code: LONGINT): SET;
+	VAR i: LONGINT; set: SET;
+	BEGIN
+		ASSERT(MAX(SET) >= 31);
+		set := {};
+		FOR i := 0 TO 31 DO
+			IF ODD(code) THEN INCL(set, i) END;
+			code := code DIV 2;
+		END;
+		RETURN set
+	END NumberToSet;
+
+	PROCEDURE SetToNumber(set: SET): LONGINT;
+	VAR i, num: LONGINT;
+	BEGIN
+		ASSERT(MAX(SET) >= 31);
+		num := 0;
+		FOR i := 0 TO 31 DO
+			IF i IN set THEN INC(num, ASH(1, i)) END;
+		END;
+		RETURN num
+	END SetToNumber;
+
+	(** setup instruction and mnemonic tables **)
+	PROCEDURE InitInstructions;
+	VAR curMnemonic: LONGINT;
+		checkMnemonics: ARRAY numberMnemonics OF BOOLEAN;
+		isimmP,isfloatP,isvecP: LONGINT; (*shorthands for positions iside the instruction word*)
+		isSpecialBR:LONGINT;
+		opcodeP,capabilityP,currOpCode, brModesP, brCondP:SET;
+
+		PROCEDURE SortMnemonics(lo, hi: LONGINT);
+		VAR i, j: LONGINT; x, t: NumberedName;
+		BEGIN
+			i := lo; j := hi;
+			x := mnemonicsSorted[(lo+hi) DIV 2];
+			WHILE (i <= j) DO
+				WHILE (mnemonicsSorted[i].name < x.name) DO INC(i) END;
+				WHILE (x.name <  mnemonicsSorted[j].name) DO DEC(j) END;
+				IF (i <= j) THEN
+					t := mnemonicsSorted[i]; mnemonicsSorted[i] := mnemonicsSorted[j]; mnemonicsSorted[j] := t;
+					INC(i); DEC(j)
+				END
+			END;
+			IF (lo < j) THEN SortMnemonics(lo, j) END;
+			IF (i < hi) THEN SortMnemonics(i, hi) END
+		END SortMnemonics;
+
+		PROCEDURE AddMnemonic(number: LONGINT; CONST name: ARRAY OF CHAR);
+		BEGIN
+			ASSERT(number<numberMnemonics);
+			IF checkMnemonic THEN checkMnemonics[number] := TRUE END;
+
+			curMnemonic := number;
+			COPY (name, mnemonics[number].name);
+			COPY (name, mnemonicsSorted[number].name);
+			mnemonicsSorted[number].number := number;
+			mnemonics[number].firstInstructionFormat := numberInstructionFormats;
+		END AddMnemonic;
+
+		PROCEDURE AddAlias(alias,number: LONGINT; CONST name: ARRAY OF CHAR);
+		BEGIN
+			IF checkMnemonic THEN checkMnemonics[alias] := TRUE END;
+
+			COPY(name, mnemonicsSorted[alias].name);
+			COPY(name, mnemonics[alias].name);
+			mnemonicsSorted[alias].number := alias;
+			mnemonics[alias].firstInstructionFormat := mnemonics[number].firstInstructionFormat;
+		END AddAlias;
+
+
+		PROCEDURE EndMnemonic;
+		BEGIN
+			mnemonics[curMnemonic].lastInstructionFormat := numberInstructionFormats-1;
+		END EndMnemonic;
+
+		PROCEDURE AddInstruction(code, mask: SET; op1, op2: OperandType; capabilities: SET);
+		VAR instructionFormat: InstructionFormat;
+		BEGIN
+			instructionFormat.mnemonic := curMnemonic;
+			instructionFormat.code := code;
+			instructionFormat.mask := mask;
+			instructionFormat.op1 := op1;
+			instructionFormat.op2 := op2;
+			instructionFormat.capabilities:= capabilities;
+			instructionFormats[numberInstructionFormats] := instructionFormat;
+			INC(numberInstructionFormats);
+		END AddInstruction;
+
+		PROCEDURE CheckMnemonics;
+		VAR i : LONGINT;
+		BEGIN
+			FOR i := 0 TO numberMnemonics-1 DO
+				ASSERT(checkMnemonics[i]);
+			END;
+		END CheckMnemonics;
+
+		PROCEDURE Inverse(mnem1, mnem2: LONGINT);
+		BEGIN
+			inverseCondition[mnem1] := mnem2;
+			inverseCondition[mnem2] := mnem1
+		END Inverse;
+
+		(*Turn a number into a set of bits at the start of an instruction word*)
+		PROCEDURE makeOpcode(num: LONGINT) :SET;
+		VAR shifted: LONGINT;
+		BEGIN
+			(*left shift then convert to set*)
+			shifted:=LSL(num,( instructionW-opcodeW ) );
+			RETURN NumberToSet(shifted);
+		END makeOpcode;
+
+		PROCEDURE makeCondition(num:LONGINT):SET;
+		VAR shifted: LONGINT;
+		BEGIN
+			shifted:=LSL(num,( instructionW-opcodeW-conditionW) );
+			RETURN NumberToSet(shifted);
+		END makeCondition;
+
+	BEGIN
+		FOR curMnemonic := 0 TO numberMnemonics-1 DO
+			checkMnemonics[curMnemonic] := FALSE;
+			inverseCondition[curMnemonic] := -1;
+		END;
+
+		curMnemonic := -1;
+		numberInstructionFormats := 0;
+
+		(*
+			oooo ddd 0 nnnnnnnnnn
+			oooo ddd 1 xxxxxxxsss
+		*)
+
+		
+		isimmP:=instructionW-1-opcodeW-regselW; (*18bit inW=> bit 10. If this bit is NOT set, there is an immediate.*)
+		isfloatP:=isimmP-2; (*18 bit insW => bit 8*)
+		isvecP:=isimmP-1; (*18 bit insW=> bit 9*)
+		isSpecialBR:=isimmP;
+
+		opcodeP:={(instructionW-opcodeW)..(instructionW-1)}; (*normally 14..17*)
+		capabilityP:={isfloatP-1..isimmP}; (*normally 7..10*)
+		brModesP:={(instructionW-opcodeW-regselW-3)..(instructionW-opcodeW-regselW-1)}; (*18bit=> 8..10*)
+		brCondP:={(instructionW-opcodeW-4)..(instructionW-opcodeW-1)}; (*18bit => 10..13*)
+
+		(*Note the actual opcode is the first argument in addinstruction, independent of mnemonic number *)
+
+		(*Note: mov with isimm=1 and bit 3 becomes LDH*)
+		currOpCode:=makeOpcode(0);
+		AddMnemonic(opMOV, "MOV");
+		AddInstruction({}, opcodeP+{isimmP}, Rd, Imm10,{});
+		AddInstruction({isimmP}, {3}+capabilityP+opcodeP, Rd, Rs,{});
+		AddInstruction({isvecP, isimmP}, capabilityP+opcodeP, VRd, VRs,{Global.VectorCapability}); (* TODO index *)
+		AddInstruction({isvecP, isimmP}, capabilityP+opcodeP, Rd, VRs,{Global.VectorCapability}); (* TODO index *)
+		EndMnemonic;
+
+		(* LDH: oooo = 0000 *)
+		AddMnemonic(opLDH, "LDH");
+		AddInstruction({3, isimmP}, {3}+capabilityP+opcodeP, Rd, None,{});
+		AddInstruction({3, isvecP, isimmP}, {3}+capabilityP+opcodeP, VRd, None,{Global.VectorCapability}); (* TODO index *)
+		EndMnemonic;
+
+		(* NOT: oooo = 0001 *)
+		currOpCode:=makeOpcode(1);
+		AddMnemonic(opNOT, "NOT");
+		AddInstruction(currOpCode,						{isimmP}+opcodeP, Rd, Imm10,{});
+		AddInstruction({isimmP}+currOpCode, 			capabilityP+opcodeP, Rd, Rs,{});
+		AddInstruction({isimmP,isfloatP}+currOpCode, 	capabilityP+opcodeP, VRd, VRs,{Global.VectorCapability});
+		EndMnemonic;
+
+		(* ADD: oooo = 0010 *)
+		currOpCode:=makeOpcode(2);
+		AddMnemonic(opADD, "ADD");
+		AddInstruction(currOpCode, {isimmP}+opcodeP, Rd, Imm10,{});
+		AddInstruction(currOpCode+{isimmP}, capabilityP+opcodeP, Rd, Rs,{});
+		AddInstruction(currOpCode+{isimmP,isvecP}, capabilityP+opcodeP, VRd, VRs,{Global.VectorCapability});
+		EndMnemonic;
+
+		(* bit 9 indicates a usage of vector registers, bit 8 indicates floating point instructions *)
+		AddMnemonic(opFADD, "FADD");
+		AddInstruction(currOpCode+{isimmP,isfloatP}, capabilityP+opcodeP, Rd, Rs,{Global.FloatingPointCapability});
+		AddInstruction(currOpCode+{isimmP,isfloatP,isvecP}, capabilityP+opcodeP, VRd, VRs,{Global.FloatingPointCapability,Global.VectorCapability});
+		EndMnemonic;
+
+		(*No idea what bit 7 does. Appears to be a capability that is defunct in hardware.*)
+		AddMnemonic(opHADD, "HADD");
+		AddInstruction(currOpCode+{isimmP,isfloatP,7}, capabilityP+opcodeP, Rd, VRs,{Global.VectorCapability});
+		EndMnemonic;
+
+		AddMnemonic(opFHADD, "FHADD");
+		AddInstruction(currOpCode+{isimmP,isfloatP,isvecP,7}, capabilityP+opcodeP, Rd, VRs,{Global.FloatingPointCapability, Global.VectorCapability});
+		EndMnemonic;
+
+		(* SUB: oooo = 0011 *)
+		currOpCode:=makeOpcode(3);
+		AddMnemonic(opSUB, "SUB");
+		AddInstruction(currOpCode, {isimmP}+opcodeP, Rd, Imm10,{});
+		AddInstruction(currOpCode+{isimmP}, capabilityP+opcodeP, Rd, Rs,{});
+		AddInstruction(currOpCode+{isimmP,isvecP}, capabilityP+opcodeP, VRd, VRs,{Global.VectorCapability});
+		EndMnemonic;
+
+		AddMnemonic(opFSUB, "FSUB");
+		AddInstruction(currOpCode+{isimmP,isfloatP}, capabilityP+opcodeP, Rd, Rs,{Global.FloatingPointCapability});
+		AddInstruction(currOpCode+{isimmP,isfloatP,isvecP}, capabilityP+opcodeP, VRd, VRs,{Global.FloatingPointCapability, Global.VectorCapability});
+		EndMnemonic;
+
+		(* AND: oooo = 0100 *)
+		currOpCode:=makeOpcode(4);
+		AddMnemonic(opAND, "AND");
+		AddInstruction(currOpCode, {isimmP}+opcodeP, Rd, Imm10,{});
+		AddInstruction(currOpCode+{isimmP}, capabilityP+opcodeP, Rd, Rs,{});
+		AddInstruction(currOpCode+{isimmP,isvecP}, capabilityP+opcodeP, VRd, VRs,{Global.VectorCapability});
+		EndMnemonic;
+
+		(* BIC: oooo = 0101 *)
+		currOpCode:=makeOpcode(5);
+		AddMnemonic(opBIC, "BIC");
+		AddInstruction(currOpCode, {isimmP}+opcodeP, Rd, Imm10,{});
+		AddInstruction(currOpCode+{isimmP}, capabilityP+opcodeP, Rd, Rs,{});
+		AddInstruction(currOpCode+{isvecP,isimmP}, capabilityP+opcodeP, VRd, VRs,{Global.VectorCapability});
+		EndMnemonic;
+
+		(* OR: oooo = 0110 *)
+		currOpCode:=makeOpcode(6);
+		AddMnemonic(opOR, "OR");
+		AddInstruction(currOpCode, {isimmP}+opcodeP, Rd, Imm10,{});
+		AddInstruction(currOpCode+{isimmP}, capabilityP+opcodeP, Rd, Rs,{});
+		AddInstruction(currOpCode+{isimmP,isvecP}, capabilityP+opcodeP, VRd, VRs,{Global.VectorCapability});
+		EndMnemonic;
+
+		(* XOR: oooo = 0111 *)
+		currOpCode:=makeOpcode(7);
+		AddMnemonic(opXOR, "XOR");
+		AddInstruction(currOpCode, {isimmP}+opcodeP, Rd, Imm10,{});
+		AddInstruction(currOpCode+{isimmP}, capabilityP+opcodeP, Rd, Rs,{});
+		AddInstruction(currOpCode+{isimmP,isvecP}, capabilityP+opcodeP, VRd, VRs,{Global.VectorCapability});
+		EndMnemonic;
+
+		(* MUL: oooo = 1000 *)
+		currOpCode:=makeOpcode(8);
+		AddMnemonic(opMUL, "MUL");
+		AddInstruction(currOpCode, {isimmP}+opcodeP, Rd, Imm10,{});
+		AddInstruction(currOpCode+{isimmP}, capabilityP+opcodeP, Rd, Rs,{});
+		AddInstruction(currOpCode+{isimmP,isvecP}, capabilityP+opcodeP, VRd, VRs,{Global.VectorCapability});
+		EndMnemonic;
+
+		AddMnemonic(opFMUL, "FMUL");
+		AddInstruction(currOpCode+{isimmP,isfloatP}, capabilityP+opcodeP, Rd, Rs,{Global.FloatingPointCapability});
+		AddInstruction(currOpCode+{isfloatP,isvecP,isimmP}, capabilityP+opcodeP, VRd, VRs,{Global.FloatingPointCapability,Global.VectorCapability});
+		EndMnemonic;
+
+		(*opcode 9 wuld be div, is disabled.*)
+
+          (* ROR: oooo = 1010 *)
+          currOpCode:=makeOpcode(10);
+		AddMnemonic(opROR, "ROR");
+		AddInstruction(currOpCode, {isimmP}+opcodeP, Rd, Imm10,{});
+		AddInstruction(currOpCode+{isimmP}, {isimmP}+opcodeP, Rd, Rs,{});
+		AddInstruction(currOpCode+{isimmP,isvecP}, capabilityP+opcodeP, VRd, VRs,{Global.VectorCapability});
+		AddInstruction(currOpCode+{isfloatP,isvecP,isimmP}, capabilityP+opcodeP, VRd0, Rs,{Global.VectorCapability});
+		EndMnemonic;
+
+		(* BR: oooo = 1011 *)
+		currOpCode:=makeOpcode(11);
+		AddMnemonic(opBR, "BR");
+		AddInstruction(currOpCode+{isSpecialBR}, brModesP+opcodeP, Rs, None,{});
+		EndMnemonic;
+
+		(* SPSR: oooo = 1011 *)
+		AddMnemonic(opSPSR, "SPSR");
+		AddInstruction(currOpCode, {isSpecialBR}+opcodeP, Imm10, None,{});
+		EndMnemonic;
+
+		(* BLR: oooo = 1011 *)
+		(* BLR Rd, Rs 	<--> 	Rd := PC+1; PC := Rs *)
+		AddMnemonic(opBLR, "BLR");
+		AddInstruction(currOpCode+{isSpecialBR,isSpecialBR-1}, brModesP+opcodeP, Rd, Rs,{});
+		EndMnemonic;
+
+		(* RTI: oooo = 1011 *)
+		AddMnemonic(opIRET, "IRET");
+		AddInstruction(currOpCode+{isSpecialBR,isSpecialBR-2}, brModesP+opcodeP, Rs, None,{});
+		EndMnemonic;
+
+		(* LD: 1100 ddd xnnnnnnn sss *)
+		currOpCode:=makeOpcode(12);
+		AddMnemonic(opLD, "LD");
+		AddInstruction(currOpCode, {isimmP}+opcodeP, Rd, MemRegImm7,{});
+		AddInstruction(currOpCode+{isimmP}, {isimmP}+opcodeP, VRd, MemRegImm7,{Global.VectorCapability});
+		EndMnemonic;
+
+          (* ST: 1101 ddd xnnnnnnn sss *)
+          currOpCode:=makeOpcode(13);
+		AddMnemonic(opST, "ST");
+		AddInstruction(currOpCode, {isimmP}+opcodeP, Rd, MemRegImm7,{});
+		AddInstruction(currOpCode+{isimmP}, {isimmP}+opcodeP, VRd, MemRegImm7,{Global.VectorCapability});
+		EndMnemonic;
+
+		(* BC
+			1110 cond nnnnnnnnnn
+
+			cond
+			0000	Z	Zero / equal	BEQ
+			0001	~Z	Non-zero / unequal	BNE
+			0010	C	Carry / above or equal (unsigned)	BAE
+			0011	~C	No carry / below (unsigned)	BB
+			0100	N	Negative	BN
+			0101	~N	Not negative	BNN
+			0110	V	Overflow	BO
+			0111	~V	No overflow	BNO
+			1000	~(~C | Z)	Carry and no zero / above (unsigned)	BA
+			1001	~C | Z	No carry or zero / below or equal (unsigned)	BBE
+			1010	~(N V)	N=V / greater or equal (signed)	BGE
+			1011	N V	N V / less (signed)	BLT
+			1100	~((N V) | Z)	greater or equal and ~ZF / greater (signed)	BGT
+			1101	(N V) | Z	less or Z / less or equal (signed)	BLE
+			1110	TRUE	Always	BT
+			1111	FALSE	Never	BF
+		*)
+		currOpCode:=makeOpcode(14);
+		AddMnemonic(opBEQ, "BEQ"); 	AddInstruction(currOpCode+makeCondition(0), opcodeP+brCondP, SignedImm10, None,{}); EndMnemonic;
+		AddMnemonic(opBNE, "BNE"); 	AddInstruction(currOpCode+makeCondition(1), opcodeP+brCondP, SignedImm10, None,{}); EndMnemonic;
+		
+		AddMnemonic(opBAE, "BAE");  	AddInstruction(currOpCode+makeCondition(2), opcodeP+brCondP, SignedImm10, None,{}); EndMnemonic;
+		AddMnemonic(opBB, "BB");      	AddInstruction(currOpCode+makeCondition(3), opcodeP+brCondP, SignedImm10, None,{}); EndMnemonic;
+		
+		AddMnemonic(opBN, "BN");     	AddInstruction(currOpCode+makeCondition(4), opcodeP+brCondP, SignedImm10, None,{}); EndMnemonic;
+		AddMnemonic(opBNN, "BNN"); 	AddInstruction(currOpCode+makeCondition(5), opcodeP+brCondP, SignedImm10, None,{}); EndMnemonic;
+
+		AddMnemonic(opBO, "BO");     	AddInstruction(currOpCode+makeCondition(6), opcodeP+brCondP, SignedImm10, None,{}); EndMnemonic;
+		AddMnemonic(opBNO, "BNO"); 	AddInstruction(currOpCode+makeCondition(7), opcodeP+brCondP, SignedImm10, None,{}); EndMnemonic;
+		
+		AddMnemonic(opBA, "BA"); 		AddInstruction(currOpCode+makeCondition(8), opcodeP+brCondP, SignedImm10, None,{}); EndMnemonic;
+		AddMnemonic(opBBE, "BBE"); 	AddInstruction(currOpCode+makeCondition(9), opcodeP+brCondP, SignedImm10, None,{}); EndMnemonic;
+		
+		AddMnemonic(opBGE, "BGE"); 	AddInstruction(currOpCode+makeCondition(10), opcodeP+brCondP, SignedImm10, None,{}); EndMnemonic;
+		AddMnemonic(opBLT, "BLT"); 	AddInstruction(currOpCode+makeCondition(11), opcodeP+brCondP, SignedImm10, None,{}); EndMnemonic;
+		
+		AddMnemonic(opBGT, "BGT"); 	AddInstruction(currOpCode+makeCondition(12), opcodeP+brCondP, SignedImm10, None,{}); EndMnemonic;
+		AddMnemonic(opBLE, "BLE"); 	AddInstruction(currOpCode+makeCondition(13), opcodeP+brCondP, SignedImm10, None,{}); EndMnemonic;
+		
+		AddMnemonic(opBT, "BT"); 		AddInstruction(currOpCode+makeCondition(14), opcodeP+brCondP, SignedImm10, None,{}); EndMnemonic;
+		AddMnemonic(opBF, "BF"); 		AddInstruction(currOpCode+makeCondition(15), opcodeP+brCondP, SignedImm10, None,{}); EndMnemonic;
+
+		Inverse(opBEQ, opBNE);
+		Inverse(opBAE, opBB);
+		Inverse(opBN, opBNN);
+		Inverse(opBO, opBNO);
+		Inverse(opBA, opBBE);
+		Inverse(opBGE, opBLT);
+		Inverse(opBGT, opBLE);
+		Inverse(opBT, opBF);
+
+		AddAlias(opBZS,opBEQ,"BZS");
+		AddAlias(opBZC,opBNE,"BZC");
+		AddAlias(opBCS,opBAE,"BCS");
+		AddAlias(opBCC,opBB,"BCC");
+		AddAlias(opBNS,opBN,"BNS");
+		AddAlias(opBNC,opBNN,"BNC");
+		AddAlias(opBVS,opBO,"BVS");
+		AddAlias(opBVC,opBNO,"BVC");
+
+
+
+		(* BL: 1111 nnnnnnnnnnnnnn *)
+		currOpCode:=makeOpcode(15);
+		AddMnemonic(opBL, "BL");
+		AddInstruction(currOpCode, opcodeP, Imm14, None,{});
+		EndMnemonic;
+
+
+
+		SortMnemonics(0, numberMnemonics-1);
+
+
+		IF checkMnemonic THEN CheckMnemonics END;
+	END InitInstructions;
+
+	PROCEDURE InitRegister*(VAR operand: Operand; reg: LONGINT);
+	BEGIN
+		operand.type := Register;
+		operand.register := SHORT(reg);
+	END InitRegister;
+
+	PROCEDURE InitImmediate*(VAR operand: Operand; bits: LONGINT; imm: LONGINT);
+	BEGIN
+		operand.type := Immediate;
+		operand.size := bits;
+		operand.imm := imm;
+	END InitImmediate;
+
+	PROCEDURE InitMemory*(VAR operand: Operand; reg1: RegisterIndex; imm: LONGINT);
+	BEGIN
+		operand.type := Memory;
+		operand.register := reg1;
+		operand.imm := imm;
+
+		IF reg1 < 0 THEN
+			operand.register := ZeroRegister;
+		END;
+	END InitMemory;
+
+	(* generate immediate operand with fixup *)
+	PROCEDURE InitFixup*(VAR operand: Operand; bits: SHORTINT; fixup: BinaryCode.Fixup (*symbol: Sections.Section; offset, displacement: LONGINT *));
+	BEGIN
+		operand.type := Immediate;
+		operand.imm := 0;
+		operand.size := bits;
+		operand.fixup := fixup;
+		(*
+		operand.fixup := BinaryCode.NewFixup(BinaryCode.Absolute, 0, symbol, offset, displacement, 0, NIL);
+		*)
+		(*
+		operand.symbol := symbol;
+		operand.symbolOffset := offset;
+		operand.displacement := displacement;
+		*)
+	END InitFixup;
+
+	PROCEDURE AddFixup*(VAR operand: Operand; fixup: BinaryCode.Fixup);
+	BEGIN
+		ASSERT(operand.type IN {Immediate, Memory});
+		operand.fixup := fixup
+	END AddFixup;
+
+	PROCEDURE InitOperand*(VAR operand: Operand);
+	BEGIN
+		operand.type := None;
+		operand.register := None;
+		operand.imm := 0;
+		operand.fixup := NIL;
+		(*
+		operand.symbol := NIL;
+		operand.symbolOffset := 0;
+		operand.displacement := 0;
+		*)
+	END InitOperand;
+
+	PROCEDURE DumpOperand*(w: Streams.Writer; CONST operand: Operand);
+	BEGIN
+		IF operand.type = None THEN RETURN END;
+		CASE operand.type OF
+		Register: IF operand.register >= 16 THEN w.String("V"); END; w.String("R"); w.Int(operand.register MOD 16, 1);
+		|Immediate:
+			IF operand.fixup # NIL THEN
+				operand.fixup.Dump(w);
+			ELSE
+				w.Int(operand.imm, 1);
+			END;
+		|Memory:
+			w.String("[");
+			IF operand.register # 7 THEN
+				w.String("R"); w.Int(operand.register, 1);
+				IF operand.fixup # NIL THEN w.String("+"); operand.fixup.Dump(w)
+				ELSIF operand.imm > 0 THEN w.String("+"); w.Int(operand.imm, 1)
+				ELSIF operand.imm < 0 THEN w.String("-"); w.Int(-operand.imm, 1)
+				END;
+			ELSE
+				w.Int(operand.imm, 1)
+			END;
+			w.String("]");
+		END;
+	END DumpOperand;
+
+	PROCEDURE DumpInstruction*(w: Streams.Writer; CONST instruction: Instruction);
+	VAR instructionFormat: InstructionFormat; first: BOOLEAN;
+
+		PROCEDURE DumpOp(op: Operand);
+		BEGIN
+			IF op.type = None THEN RETURN END;
+			IF first THEN w.String(" "); first := FALSE; ELSE w.String(", ") END;
+			DumpOperand(w, op);
+		END DumpOp;
+
+
+	BEGIN
+		IF instruction.format = None THEN
+			w.String(" no format")
+		ELSE
+			instructionFormat := instructionFormats[instruction.format];
+			w.String(mnemonics[instructionFormat.mnemonic].name);
+			first := TRUE;
+			DumpOp(instruction.op1);
+			DumpOp(instruction.op2);
+		END;
+	END DumpInstruction;
+
+	PROCEDURE DumpBits*(w: Streams.Writer; set: SET; numberBits: LONGINT);
+	VAR i: LONGINT;
+	BEGIN
+		FOR i := numberBits-1 TO 0 BY -1 DO
+			IF i IN set THEN w.String("1") ELSE w.String("0") END;
+		END;
+	END DumpBits;
+
+	PROCEDURE DumpInstructionFormats*(context: Commands.Context);
+	VAR i, j, k, mnemNum: LONGINT; instr: InstructionFormat; first: BOOLEAN; mnemonic: Mnemonic; options: Options.Options; sorted: BOOLEAN;
+
+		PROCEDURE DumpType(type: INTEGER);
+		BEGIN
+			IF type = None THEN RETURN END;
+			IF first THEN context.out.String(" "); first := FALSE; ELSE context.out.String(", ") END;
+			CASE type OF
+				|Rd: context.out.String("Rd")
+				|Rs: context.out.String("Rs")
+			     |Imm10: context.out.String("imm10");
+			     |SignedImm10: context.out.String("SignedImm10");
+				|Imm14: context.out.String("imm14");
+				|MemRegImm7: context.out.String("MemRegImm7");
+			ELSE
+				context.out.String("error: type not found: DumpType ("); context.out.Int(type, 0); context.out.String(")");
+				context.out.Ln;
+			END;
+		END DumpType;
+
+	BEGIN
+		NEW(options);
+		options.Add("s", "sorted", Options.Flag);
+		IF options.Parse(context.arg, context.error) THEN
+			sorted := options.GetFlag("s");
+			FOR i := 0 TO numberMnemonics-1 DO
+				IF sorted THEN
+					mnemNum := mnemonicsSorted[i].number
+				ELSE
+					mnemNum := i
+				END;
+				mnemonic := mnemonics[mnemNum];
+
+				FOR j := mnemonic.firstInstructionFormat TO mnemonic.lastInstructionFormat DO
+					instr := instructionFormats[j];
+					ASSERT(mnemNum = instr.mnemonic);
+					context.out.Int(j, 2); context.out.String(" ");
+					context.out.String(mnemonic.name);
+					k := 0; first := TRUE;
+					DumpType(instr.op1);
+					DumpType(instr.op2);
+					context.out.Ln; context.out.String(" mask = "); DumpBits(context.out, instr.mask, 18);
+					context.out.Ln; context.out.String(" code = "); DumpBits(context.out, instr.code, 18);
+					context.out.Ln;
+				END;
+			END;
+		END;
+	END DumpInstructionFormats;
+
+
+
+	END InstructionSet;
+
+
+	PROCEDURE Hex(ch: CHAR): LONGINT;
+	BEGIN
+		IF (ch <= 'F') & (ch >= 'A') THEN RETURN ORD(ch)-ORD('A')+10
+		ELSIF (ch <= 'f') & (ch >= 'a') THEN RETURN ORD(ch)-ORD('a')+10
+		ELSIF (ch>='0') & (ch <='9') THEN RETURN ORD(ch)-ORD('0')
+		ELSE HALT(100)
+		END;
+	END Hex;
+
+	PROCEDURE ReadCode(file: Files.File): BitSets.BitSet;
+	VAR r: Files.Reader;  val, val2: LONGINT;line: ARRAY 10 OF CHAR; lineNr: LONGINT; bitSet: BitSets.BitSet; i: LONGINT;
+	BEGIN
+	(*todo: probably screws up on anything but 18 bit double packed*)
+		IF file = NIL THEN RETURN NIL END;
+		lineNr := 0;
+		NEW(r, file, 0);
+		NEW(bitSet,0);
+		
+		
+		
+		WHILE r.Available()>0 DO
+			r.Ln(line);
+			val:=0;
+			i:=0;
+			WHILE ORD(line[i])>0 DO(*read entire line*)
+				val:=val*10H;
+				val:=val+Hex(line[i]);
+				INC(i);				
+			END;
+			INC(lineNr);
+			bitSet.Resize(lineNr*36);(*bitset is treated as series of 36 bit slots into which the individual words fit left aligned.*)
+			bitSet.SetBits((lineNr-1)*36,decodeInstance.instructionW,val); (*extract word*)
+		END;
+		
+		RETURN bitSet
+	END ReadCode;
+
+	PROCEDURE ReadData(file: Files.File): BitSets.BitSet;
+	VAR r: Files.Reader;  val, val2: LONGINT;line: ARRAY 10 OF CHAR; lineNr: LONGINT; bitSet: BitSets.BitSet; i: LONGINT;
+	BEGIN
+		IF file = NIL THEN RETURN NIL END;
+		lineNr := 0;
+		NEW(r, file, 0);
+		NEW(bitSet,0);
+		WHILE r.Available()>0 DO
+			r.Ln(line);
+			val := 0;
+			FOR i := 0 TO 7 DO
+				val := val*10H;
+				val := val + Hex(line[i]);
+			END;
+			INC(lineNr);
+			bitSet.Resize(lineNr*32);
+			bitSet.SetBits((lineNr-1)*32, 32, val);
+		END;
+		RETURN bitSet
+	END ReadData;
+
+	PROCEDURE Disassemble*(context: Commands.Context); 
+	TYPE
+		Disasm = OBJECT (Disassembler.Disassembler)
+
+			PROCEDURE DisassembleInstruction(bitSet: BitSets.BitSet; VAR adr: LONGINT; maxInstructionSize: LONGINT; w:Streams.Writer);
+			VAR instruction: Instruction; value: LONGINT; mnemonic: LONGINT;
+			BEGIN
+				(* maxInstructionSize can be ignored here *)
+				value := bitSet.GetBits(adr*36,decodeInstance.instructionW);    (*bitset treated as series of 36 bit slots, individual words left aligned.*)
+				decodeInstance.Decode(value, instruction);
+				decodeInstance.DumpInstruction(w, instruction);
+				IF instruction.format # None THEN
+					mnemonic := decodeInstance.instructionFormats[instruction.format].mnemonic;
+					IF (mnemonic >= opBEQ) & (mnemonic <= opBF) OR (mnemonic = opBL) THEN
+						WriteReference(instruction.op1.imm+adr+1, TRUE, w);
+					ELSIF (mnemonic = opLD) OR (mnemonic = opST) THEN
+						IF (instruction.op2.register = ZeroRegister) THEN
+							WriteReference(instruction.op2.imm, FALSE, w);
+						END;
+					END;
+				END;
+				INC(adr);
+			END DisassembleInstruction;
+
+		END Disasm;
+
+	VAR disassembler: Disasm; codeFileName, dataFileName, logFileName: Files.FileName; codeFile, dataFile, logFile: Files.File;code, data: BitSets.BitSet; options: Options.Options;
+		address: LONGINT;
+		instructionWidth: LONGINT;
+	BEGIN
+		IF context.arg.GetString(codeFileName) THEN
+			codeFile := Files.Old(codeFileName);
+			IF codeFile = NIL THEN context.out.String("file not found "); context.out.String(codeFileName); RETURN END;
+			IF context.arg.GetString(dataFileName) THEN
+				dataFile := Files.Old(dataFileName)
+			ELSE
+				dataFile := NIL;
+			END;
+			NEW(options);
+			options.Add("l","logFile", Options.String);
+			options.Add("a","address",Options.Integer);
+			options.Add("w","instructionWidth",Options.Integer);
+			IF options.Parse(context.arg, context.out) THEN
+				IF ~options.GetInteger("w",instructionWidth) THEN instructionWidth:=18 END;
+				TRACE(instructionWidth);
+				IF ~options.GetInteger("a", address) THEN address := 0 END;
+				NEW(decodeInstance,instructionWidth);
+				NEW(disassembler, context.out);
+				code := ReadCode(codeFile);
+				data := ReadData(dataFile);
+				IF options.GetString("logFile",logFileName) THEN
+					logFile := Files.Old(logFileName);
+				ELSE
+					logFile := disassembler.GetLogFile(codeFileName)
+				END;
+				disassembler.Disassemble(code, data, 36, 32, logFile, address);
+			END;
+		END;
+	END Disassemble;
+
+
+VAR
+	decodeInstance: InstructionSet;
+BEGIN
+	NEW(decodeInstance,18);
+END FoxTRMInstructionSet.
+
+SystemTools.FreeDownTo FoxTRMInstructionSet ~
+FoxTRMInstructionSet.DumpInstructionFormats -s ~
+FoxTRMInstructionSet.Test ~
+
+
+
+
+
+
+
+FoxTRMInstructionSet.Disassemble disastest.mem ~
+
+FoxTRMInstructionSet.Disassemble ins.mem ~
+