voc-version added

README.md

@@ -1,10 +1,13 @@
-Oberon → ARMv{6,7E}-M compiler ([BlackBox](http://www.oberon.ch/blackbox.html) subsystem), based on N. Wirth [Project Oberon](http://www.inf.ethz.ch/personal/wirth/ProjectOberon/index.html) Oberon → RISC compiler
+Oberon → ARMv{6,7E}-M compiler, based on N. Wirth [Project Oberon](http://www.inf.ethz.ch/personal/wirth/ProjectOberon/index.html) Oberon → RISC compiler
 
-Subsystems:
+[BlackBox](https://en.wikipedia.org/wiki/BlackBox_Component_Builder) subsystems:
 * [O7](O7): compiler, linker
 * [Micro](Micro): framework for microcontrollers
 * [Mobx](Mobx): [Micro](Micro) examples
 
+[Ѵishap Oberon](https://github.com/vishaps/voc) version:
+* [O7](voc-O7): compiler, linker
+
 [Some notes](http://obertone.ru/ob/o7) (in Russian)
 
 Alexander V. Shiryaev, 2020

voc-O7/Makefile

@@ -0,0 +1,46 @@
+aLL: O7ARMv7MPCompile O7ARMv7MToolDecObj O7ARMv7MToolDecSym O7ARMv7MToolDecBin O7ARMv7MToolDecHex O7ARMv7MLinkerLink
+
+O7ARMv7MPCompile: O7ARMv7MP.o O7ARMv7MPCompile.Mod
+	voc -OC O7ARMv7MPCompile.Mod -m
+
+O7ARMv7MToolDecObj: O7ARMv7MTool.o O7ARMv7MToolDecObj.Mod
+	voc -OC O7ARMv7MToolDecObj.Mod -m
+
+O7ARMv7MToolDecSym: O7ARMv7MTool.o O7ARMv7MToolDecSym.Mod
+	voc -OC O7ARMv7MToolDecSym.Mod -m
+
+O7ARMv7MToolDecBin: O7ARMv7MTool.o O7ARMv7MToolDecBin.Mod
+	voc -OC O7ARMv7MToolDecBin.Mod -m
+
+O7ARMv7MToolDecHex: O7ARMv7MTool.o O7ARMv7MToolDecHex.Mod
+	voc -OC O7ARMv7MToolDecHex.Mod -m
+
+O7ARMv7MLinkerLink: O7ARMv7MLinker.o O7ARMv7MLinkerLink.Mod
+	voc -OC O7ARMv7MLinkerLink.Mod -m
+
+O7S.o: O7S.Mod
+	voc -OC -c O7S.Mod
+
+O7B.o: O7S.o O7B.Mod
+	voc -OC -c O7B.Mod
+
+O7ARMv6M.o: O7ARMv6M.Mod
+	voc -OC -c O7ARMv6M.Mod
+
+O7ARMv7M.o: O7ARMv6M.o O7ARMv7M.Mod
+	voc -OC -c O7ARMv7M.Mod
+
+O7ARMv7MG.o: O7S.o O7B.o O7ARMv6M.o O7ARMv7M.o O7ARMv7MG.Mod
+	voc -OC -c O7ARMv7MG.Mod
+
+O7ARMv7MP.o: O7S.o O7B.o O7ARMv7MG.o O7ARMv7MP.Mod
+	voc -OC -c O7ARMv7MP.Mod
+
+O7ARMv7MTool.o: O7B.o O7ARMv7MG.o O7ARMv7M.o O7ARMv7MTool.Mod
+	voc -OC -c O7ARMv7MTool.Mod
+
+O7ARMv7MLinker.o: O7ARMv6M.o O7ARMv7M.o O7ARMv7MLinker.Mod
+	voc -OC -c O7ARMv7MLinker.Mod
+
+clean:
+	rm -f *.c *.o *.h *.sym O7ARMv7MPCompile O7ARMv7MToolDecObj O7ARMv7MToolDecSym O7ARMv7MToolDecBin O7ARMv7MToolDecHex O7ARMv7MLinkerLink

voc-O7/O7ARMv6M.Mod

@@ -0,0 +1,891 @@
+MODULE O7ARMv6M;
+
+	(*
+		Alexander Shiryaev, 2014.09
+
+		ARMv6-M Architecture Reference Manual
+http://ecee.colorado.edu/ecen3000/labs/lab3/files/DDI0419C_arm_architecture_v6m_reference_manual.pdf
+	*)
+
+	IMPORT SYSTEM, Strings := VT100, Out;
+
+(*
+	TYPE
+		LONGINT = INTEGER;
+*)
+
+	CONST
+		(* registers *)
+			R0* = 0; R1* = 1; R2* = 2; R3* = 3;
+			R4* = 4; R5* = 5; R6* = 6; R7* = 7;
+			R8* = 8; R9* = 9; R10* = 10; R11* = 11; R12* = 12;
+			SP* = 13; LR* = 14; PC* = 15;
+		(* conditions *)
+			EQ* = 0; NE* = 1; CS* = 2; CC* = 3;
+			MI* = 4; PL* = 5; VS* = 6; VC* = 7;
+			HI* = 8; LS* = 9; GE* = 10; LT* = 11;
+			GT* = 12; LE* = 13; AL* = 14;
+
+	PROCEDURE BITS (x: INTEGER): SET;
+	BEGIN
+		RETURN SYSTEM.VAL(SET, x)
+	END BITS;
+
+	PROCEDURE ORDSET (x: SET): INTEGER;
+	BEGIN
+		RETURN SYSTEM.VAL(INTEGER, x)
+	END ORDSET;
+
+	(* A6.7.1 *)
+	PROCEDURE EmitADCSR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; dn, m: INTEGER);
+	BEGIN
+		ASSERT(m DIV 8 = 0, 20);
+		ASSERT(dn DIV 8 = 0, 21);
+		code[pc] := 4140H + m * 8 + dn; INC(pc)
+	END EmitADCSR;
+
+	(* A6.7.2 *)
+	PROCEDURE EmitADDSIm* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; d, n, im: INTEGER);
+	BEGIN
+		ASSERT(d DIV 8 = 0, 20);
+		ASSERT(n DIV 8 = 0, 21);
+		IF im DIV 8 = 0 THEN
+			code[pc] := 1C00H + im * 40H + n * 8 + d; INC(pc)
+		ELSIF (im DIV 100H = 0) & (d = n) THEN
+			code[pc] := 3000H + d * 100H + im; INC(pc)
+		ELSE HALT(1)
+		END
+	END EmitADDSIm;
+
+	(* A6.7.3, encoding T1 *)
+	PROCEDURE EmitADDSR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; d, n, m: INTEGER);
+	BEGIN
+		ASSERT(d DIV 8 = 0, 20);
+		ASSERT(n DIV 8 = 0, 21);
+		ASSERT(m DIV 8 = 0, 22);
+		code[pc] := 1800H + m * 40H + n * 8 + d; INC(pc)
+	END EmitADDSR;
+
+	(* A6.7.3, encoding T2 *)
+	PROCEDURE EmitADDR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; dn, m: INTEGER);
+	BEGIN
+		ASSERT(dn IN {0..12,14..15}, 20);
+		ASSERT(m IN {0..12,14..15}, 21);
+		ASSERT(~((dn = PC) & (m = PC)), 22);
+		ASSERT(dn # PC, 23);
+		code[pc] := 4400H + dn DIV 8 * 80H + m * 8 + dn MOD 8; INC(pc)
+	END EmitADDR;
+
+	(* A6.7.4 *)
+	PROCEDURE EmitADDSPIm* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; d, im: INTEGER);
+	BEGIN
+		IF d = SP THEN
+			ASSERT(im DIV 80H = 0, 20);
+			code[pc] := 0B000H + im; INC(pc)
+		ELSE
+			ASSERT(d DIV 8 = 0, 21);
+			ASSERT(im DIV 100H = 0, 22);
+			code[pc] := 0A800H + d * 100H + im; INC(pc)
+		END
+	END EmitADDSPIm;
+
+	(* A6.7.5 *)
+	PROCEDURE EmitADDSPR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; d, m: INTEGER);
+	BEGIN
+		ASSERT(d DIV 10H = 0, 20);
+		ASSERT(m DIV 10H = 0, 21);
+		IF d = SP THEN
+			code[pc] := 4485H + m * 8; INC(pc)
+		ELSE
+			ASSERT(d = m, 22);
+			ASSERT(d # PC, 22);
+			code[pc] := 4468H + d DIV 8 * 80H + d MOD 8; INC(pc)
+		END
+	END EmitADDSPR;
+
+	(* A6.7.7 *)
+	PROCEDURE EmitANDSR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; dn, m: INTEGER);
+	BEGIN
+		ASSERT(dn DIV 8 = 0, 20);
+		ASSERT(m DIV 8 = 0, 21);
+		code[pc] := 4000H + m * 8 + dn; INC(pc)
+	END EmitANDSR;
+
+	(* A6.7.8 *)
+	PROCEDURE EmitASRSIm* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; d, m, im: INTEGER);
+	BEGIN
+		ASSERT(d DIV 8 = 0, 20);
+		ASSERT(m DIV 8 = 0, 21);
+		ASSERT(im DIV 32 = 0, 22);
+		code[pc] := 1000H + im * 40H + m * 8 + d; INC(pc)
+	END EmitASRSIm;
+
+	(* A6.7.9 *)
+	PROCEDURE EmitASRSR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; dn, m: INTEGER);
+	BEGIN
+		ASSERT(dn DIV 8 = 0, 20);
+		ASSERT(m DIV 8 = 0, 21);
+		code[pc] := 4100H + m * 8 + dn; INC(pc)
+	END EmitASRSR;
+
+	(* A6.7.10, encoding T1 *)
+	PROCEDURE EmitBC* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; cond, im: INTEGER);
+	BEGIN
+		ASSERT(cond IN {0..13}, 20);
+		ASSERT(im >= -128, 21);
+		ASSERT(im <= 127, 22);
+		code[pc] := 0D000H + cond * 100H + im MOD 100H; INC(pc)
+	END EmitBC;
+
+	(* A6.7.10, encoding T2 *)
+	PROCEDURE EmitB* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; im: INTEGER);
+	BEGIN
+		ASSERT(im >= -1024, 21);
+		ASSERT(im <= 1023, 22);
+		code[pc] := 0E000H + im MOD 800H; INC(pc)
+	END EmitB;
+
+	(* A6.7.11 *)
+	PROCEDURE EmitBICSR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; dn, m: INTEGER);
+	BEGIN
+		ASSERT(dn DIV 8 = 0, 20);
+		ASSERT(m DIV 8 = 0, 21);
+		code[pc] := 4380H + m * 8 + dn; INC(pc)
+	END EmitBICSR;
+
+(*
+	PROCEDURE DecodeBLabel24* (S, imm10, J1, J2, imm11: INTEGER): INTEGER;
+	BEGIN
+		RETURN ((S * 1000000H + (J1 + S + 1) MOD 2 * 800000H + (J2 + S + 1) MOD 2 * 400000H + imm10 * 1000H + imm11 * 2) * 80H) DIV 80H
+	END DecodeBLabel24;
+*)
+
+	PROCEDURE DecodeBLabel24* (S, imm10, J1, J2, imm11: INTEGER): INTEGER;
+		VAR t0, t1, t2, t3, t4, t5: INTEGER;
+	BEGIN
+		t0 := S * 1000000H;
+		t1 := ((J1 + S + 1) MOD 2) * 800000H;
+		t2 := ((J2 + S + 1) MOD 2) * 400000H;
+		t3 := imm10 * 1000H;
+		t4 := imm11 * 2;
+		t5 := (t0 + t1 + t2 + t3 + t4) * 80H;
+		RETURN t5 DIV 80H
+	END DecodeBLabel24;
+
+	PROCEDURE EncodeBLabel24* (off: INTEGER; (*OUT*)VAR S, imm10, J1, J2, imm11: INTEGER);
+		VAR test: INTEGER;
+	BEGIN
+		ASSERT(off * 2 >= -16777216, 20);
+		ASSERT(off * 2 <= 16777214, 21);
+		imm11 := off MOD 800H;
+		imm10 := off DIV 800H MOD 400H;
+		S := off DIV 800000H MOD 2;
+		J1 := (off DIV 400000H + S + 1) MOD 2;
+		J2 := (off DIV 200000H + S + 1) MOD 2;
+
+		off := off * 2;
+		test := DecodeBLabel24(S, imm10, J1, J2, imm11);
+		IF off # test THEN
+			Out.String("O7ARMv6M.EncodeBLabel24: off="); Out.Int(off, 0); Out.String(" test="); Out.Int(test, 0); Out.Ln;
+			Out.String("  S="); Out.Int(S, 0); Out.String(" imm10="); Out.Int(imm10, 0);
+				Out.String(" J1="); Out.Int(J1, 0); Out.String(" J2="); Out.Int(J2, 0);
+				Out.String(" imm11="); Out.Int(imm11, 0); Out.Ln
+		END;
+		ASSERT(off = test, 100)
+	END EncodeBLabel24;
+
+	(* A6.7.13 *)
+	PROCEDURE EmitBL* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; off: INTEGER);
+		VAR S, imm10, J1, J2, imm11: INTEGER;
+	BEGIN
+		EncodeBLabel24(off, S, imm10, J1, J2, imm11);
+		code[pc] := 0F000H + S * 400H + imm10; INC(pc);
+		code[pc] := 0D000H + J1 * 2000H + J2 * 800H + imm11; INC(pc)
+	END EmitBL;
+
+	PROCEDURE DecodeBL* (c: INTEGER): INTEGER;
+		VAR S, imm10, J1, J2, imm11: INTEGER;
+
+		PROCEDURE IsBL (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {11..15,28,30,31} = {12..15,28,30,31}
+		END IsBL;
+
+	BEGIN
+		ASSERT(IsBL(c), 20);
+		imm11 := c DIV 10000H MOD 800H;
+		J2 := c DIV 8000000H MOD 2;
+		J1 := c DIV 20000000H MOD 2;
+		imm10 := c MOD 400H;
+		S := c DIV 400H MOD 2;
+		RETURN DecodeBLabel24(S, imm10, J1, J2, imm11)
+	END DecodeBL;
+
+	(* A6.7.14 *)
+	PROCEDURE EmitBLX* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; m: INTEGER);
+	BEGIN
+		ASSERT(m IN {0..14}, 20);
+		code[pc] := 4780H + m * 8; INC(pc)
+	END EmitBLX;
+
+	(* A6.7.15 *)
+	PROCEDURE EmitBX* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; m: INTEGER);
+	BEGIN
+		ASSERT(m IN {0..14}, 20);
+		code[pc] := 4700H + m * 8; INC(pc)
+	END EmitBX;
+
+	(* A6.7.17 *)
+	PROCEDURE EmitCMPIm* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; n, im: INTEGER);
+	BEGIN
+		ASSERT(n DIV 8 = 0, 20);
+		ASSERT(im DIV 100H = 0, 21);
+		code[pc] := 2800H + n * 100H + im; INC(pc)
+	END EmitCMPIm;
+
+	(* A6.7.23 *)
+	PROCEDURE EmitEORSR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; dn, m: INTEGER);
+	BEGIN
+		ASSERT(m DIV 8 = 0, 20);
+		ASSERT(dn DIV 8 = 0, 21);
+		code[pc] := 4040H + m * 8 + dn; INC(pc)
+	END EmitEORSR;
+
+	(* A6.7.26 *)
+	PROCEDURE EmitLDRIm* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; t, n, im: INTEGER);
+	BEGIN
+		ASSERT(t DIV 8 = 0, 20);
+		IF n = SP THEN
+			ASSERT(im DIV 100H = 0, 21);
+			code[pc] := 9800H + t * 100H + im; INC(pc)
+		ELSE
+			ASSERT(n DIV 8 = 0, 22);
+			ASSERT(im DIV 32 = 0, 23);
+			code[pc] := 6800H + im * 40H + n * 8 + t; INC(pc)
+		END
+	END EmitLDRIm;
+
+	(* A6.7.28 *)
+	PROCEDURE EmitLDRR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; t, n, m: INTEGER);
+	BEGIN
+		ASSERT(t DIV 8 = 0, 20);
+		ASSERT(n DIV 8 = 0, 21);
+		ASSERT(m DIV 8 = 0, 22);
+		code[pc] := 5800H + m * 40H + n * 8 + t; INC(pc)
+	END EmitLDRR;
+
+	(* A6.7.29 *)
+	PROCEDURE EmitLDRBIm* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; t, n, im: INTEGER);
+	BEGIN
+		ASSERT(t DIV 8 = 0, 20);
+		ASSERT(n DIV 8 = 0, 21);
+		ASSERT(im DIV 32 = 0, 22);
+		code[pc] := 7800H + im * 40H + n * 8 + t; INC(pc)
+	END EmitLDRBIm;
+
+	(* A6.7.30 *)
+	PROCEDURE EmitLDRBR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; t, n, m: INTEGER);
+	BEGIN
+		ASSERT(t DIV 8 = 0, 20);
+		ASSERT(n DIV 8 = 0, 21);
+		ASSERT(m DIV 8 = 0, 22);
+		code[pc] := 5C00H + m * 40H + n * 8 + t; INC(pc)
+	END EmitLDRBR;
+
+	(* A6.7.35 *)
+	PROCEDURE EmitLSLSIm* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; d, m, im: INTEGER);
+	BEGIN
+		ASSERT(d DIV 8 = 0, 20);
+		ASSERT(m DIV 8 = 0, 21);
+		ASSERT(im IN {1..31}, 22);
+		code[pc] := im * 40H + m * 8 + d; INC(pc)
+	END EmitLSLSIm;
+
+	(* A6.7.36 *)
+	PROCEDURE EmitLSLSR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; dn, m: INTEGER);
+	BEGIN
+		ASSERT(dn DIV 8 = 0, 20);
+		ASSERT(m DIV 8 = 0, 21);
+		code[pc] := 4080H + m * 8 + dn; INC(pc)
+	END EmitLSLSR;
+
+	(* A6.7.37 *)
+	PROCEDURE EmitLSRSIm* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; d, m, im: INTEGER);
+	BEGIN
+		ASSERT(d DIV 8 = 0, 20);
+		ASSERT(m DIV 8 = 0, 21);
+		ASSERT(im DIV 32 = 0, 22);
+		code[pc] := 800H + im * 40H + m * 8 + d; INC(pc)
+	END EmitLSRSIm;
+
+	(* A6.7.38 *)
+	PROCEDURE EmitLSRSR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; dn, m: INTEGER);
+	BEGIN
+		ASSERT(dn DIV 8 = 0, 20);
+		ASSERT(m DIV 8 = 0, 21);
+		code[pc] := 40C0H + m * 8 + dn; INC(pc)
+	END EmitLSRSR;
+
+	(* A6.7.39 *)
+	PROCEDURE EmitMOVSIm* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; d, im: INTEGER);
+	BEGIN
+		ASSERT(d DIV 8 = 0, 20);
+		ASSERT(im DIV 100H = 0, 21);
+		code[pc] := 2000H + d * 100H + im; INC(pc)
+	END EmitMOVSIm;
+
+	(* A6.7.40, encoding T2 *)
+	PROCEDURE EmitMOVSR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; d, m: INTEGER);
+	BEGIN
+		ASSERT(d DIV 8 = 0, 20);
+		ASSERT(m DIV 8 = 0, 21);
+		code[pc] := m * 8 + d; INC(pc)
+	END EmitMOVSR;
+
+	(* A6.7.44 *)
+	PROCEDURE EmitMULSR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; dm, n: INTEGER);
+	BEGIN
+		ASSERT(dm DIV 8 = 0, 20);
+		ASSERT(n DIV 8 = 0, 21);
+		code[pc] := 4340H + n * 8 + dm; INC(pc)
+	END EmitMULSR;
+
+	(* A6.7.45 *)
+	PROCEDURE EmitMVNSR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; d, m: INTEGER);
+	BEGIN
+		ASSERT(d DIV 8 = 0, 20);
+		ASSERT(m DIV 8 = 0, 21);
+		code[pc] := 43C0H + m * 8 + d; INC(pc)
+	END EmitMVNSR;
+
+	(* A6.7.47 *)
+	PROCEDURE EmitNOP* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER);
+	BEGIN
+		code[pc] := 0BF00H; INC(pc)
+	END EmitNOP;
+
+	(* A6.7.48 *)
+	PROCEDURE EmitORRSR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; dn, m: INTEGER);
+	BEGIN
+		ASSERT(dn DIV 8 = 0, 20);
+		ASSERT(m DIV 8 = 0, 21);
+		code[pc] := 4300H + m * 8 + dn; INC(pc)
+	END EmitORRSR;
+
+	(* A6.7.49 *)
+	PROCEDURE EmitPOP* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; regs: SET);
+		VAR P: INTEGER;
+	BEGIN
+		ASSERT(regs * {8..14,16..31} = {}, 20);
+		ASSERT(regs # {}, 21);
+		IF PC IN regs THEN EXCL(regs, PC); P := 1 ELSE P := 0 END;
+		code[pc] := 0BC00H + P * 100H + ORDSET(regs); INC(pc)
+	END EmitPOP;
+
+	(* A6.7.50 *)
+	PROCEDURE EmitPUSH* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; regs: SET);
+		VAR M: INTEGER;
+	BEGIN
+		ASSERT(regs * {8..13,15..31} = {}, 20);
+		ASSERT(regs # {}, 21);
+		IF LR IN regs THEN EXCL(regs, LR); M := 1 ELSE M := 0 END;
+		code[pc] := 0B400H + M * 100H + ORDSET(regs); INC(pc)
+	END EmitPUSH;
+
+	(* A6.7.54 *)
+	PROCEDURE EmitRORSR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; dn, m: INTEGER);
+	BEGIN
+		ASSERT(dn DIV 8 = 0, 20);
+		ASSERT(m DIV 8 = 0, 21);
+		code[pc] := 41C0H + m * 8 + dn; INC(pc)
+	END EmitRORSR;
+
+	(* A6.7.55 *)
+	PROCEDURE EmitRSBS0* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; d, n: INTEGER);
+	BEGIN
+		ASSERT(d DIV 8 = 0, 20);
+		ASSERT(n DIV 8 = 0, 21);
+		code[pc] := 4240H + n * 8 + d; INC(pc)
+	END EmitRSBS0;
+
+	(* A6.7.56 *)
+	PROCEDURE EmitSBCSR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; dn, m: INTEGER);
+	BEGIN
+		ASSERT(dn DIV 8 = 0, 20);
+		ASSERT(m DIV 8 = 0, 21);
+		code[pc] := 4180H + m * 8 + dn; INC(pc)
+	END EmitSBCSR;
+
+	(* A6.7.59 *)
+	PROCEDURE EmitSTRIm* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; t, n, im: INTEGER);
+	BEGIN
+		ASSERT(t DIV 8 = 0, 20);
+		IF n = SP THEN
+			ASSERT(im DIV 100H = 0, 21);
+			code[pc] := 9000H + t * 100H + im; INC(pc)
+		ELSE
+			ASSERT(n DIV 8 = 0, 22);
+			ASSERT(im DIV 32 = 0, 23);
+			code[pc] := 6000H + im * 40H + n * 8 + t; INC(pc)
+		END
+	END EmitSTRIm;
+
+	(* A6.7.60 *)
+	PROCEDURE EmitSTRR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; t, n, m: INTEGER);
+	BEGIN
+		ASSERT(t DIV 8 = 0, 20);
+		ASSERT(n DIV 8 = 0, 21);
+		ASSERT(m DIV 8 = 0, 22);
+		code[pc] := 5000H + m * 40H + n * 8 + t; INC(pc)
+	END EmitSTRR;
+
+	(* A6.7.61 *)
+	PROCEDURE EmitSTRBIm* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; t, n, im: INTEGER);
+	BEGIN
+		ASSERT(t DIV 8 = 0, 20);
+		ASSERT(n DIV 8 = 0, 21);
+		ASSERT(im DIV 32 = 0, 22);
+		code[pc] := 7000H + im * 40H + n * 8 + t; INC(pc)
+	END EmitSTRBIm;
+
+	(* A6.7.62 *)
+	PROCEDURE EmitSTRBR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; t, n, m: INTEGER);
+	BEGIN
+		ASSERT(t DIV 8 = 0, 20);
+		ASSERT(n DIV 8 = 0, 21);
+		ASSERT(m DIV 8 = 0, 22);
+		code[pc] := 5400H + m * 40H + n * 8 + t; INC(pc)
+	END EmitSTRBR;
+
+	(* A6.7.65 *)
+	PROCEDURE EmitSUBSIm* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; d, n, im: INTEGER);
+	BEGIN
+		ASSERT(d DIV 8 = 0, 20);
+		ASSERT(n DIV 8 = 0, 21);
+		IF im DIV 8 = 0 THEN
+			code[pc] := 1E00H + im * 40H + n * 8 + d; INC(pc)
+		ELSIF (im DIV 100H = 0) & (d = n) THEN
+			code[pc] := 3800H + d * 100H + im; INC(pc)
+		ELSE HALT(1)
+		END
+	END EmitSUBSIm;
+
+	(* A6.7.66 *)
+	PROCEDURE EmitSUBSR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; d, n, m: INTEGER);
+	BEGIN
+		ASSERT(d DIV 8 = 0, 20);
+		ASSERT(n DIV 8 = 0, 21);
+		ASSERT(m DIV 8 = 0, 22);
+		code[pc] := 1A00H + m * 40H + n * 8 + d; INC(pc)
+	END EmitSUBSR;
+
+	(* A6.7.67 *)
+	PROCEDURE EmitSUBSPIm* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; imm7: INTEGER);
+	BEGIN
+		ASSERT(imm7 DIV 80H = 0, 20);
+		code[pc] := 0B080H + imm7; INC(pc)
+	END EmitSUBSPIm;
+
+	(* A6.7.68 *)
+	PROCEDURE EmitSVC* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; im: INTEGER);
+	BEGIN
+		ASSERT(im DIV 100H = 0, 20);
+		code[pc] := 0DF00H + im; INC(pc)
+	END EmitSVC;
+
+	(* A6.7.76 *)
+	PROCEDURE EmitWFI* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER);
+	BEGIN
+		code[pc] := 0BF30H; INC(pc)
+	END EmitWFI;
+
+	PROCEDURE RegRepr* (r: INTEGER; (*OUT*)VAR s: ARRAY OF CHAR);
+	BEGIN
+		CASE r OF R0: COPY("r0", s)
+		| R1: COPY("r1", s)
+		| R2: COPY("r2", s)
+		| R3: COPY("r3", s)
+		| R4: COPY("r4", s)
+		| R5: COPY("r5", s)
+		| R6: COPY("r6", s)
+		| R7: COPY("r7", s)
+		| R8: COPY("r8", s)
+		| R9: COPY("r9", s)
+		| R10: COPY("r10", s)
+		| R11: COPY("r11", s)
+		| R12: COPY("r12", s)
+		| SP: COPY("SP", s)
+		| LR: COPY("LR", s)
+		| PC: COPY("PC", s)
+		END
+	END RegRepr;
+
+	PROCEDURE CondRepr* (cond: INTEGER; (*OUT*)VAR s: ARRAY OF CHAR);
+	BEGIN
+		CASE cond OF EQ: COPY("EQ", s)
+		| NE: COPY("NE", s)
+		| CS: COPY("CS", s)
+		| CC: COPY("CC", s)
+		| MI: COPY("MI", s)
+		| PL: COPY("PL", s)
+		| VS: COPY("VS", s)
+		| VC: COPY("VC", s)
+		| HI: COPY("HI", s)
+		| LS: COPY("LS", s)
+		| GE: COPY("GE", s)
+		| LT: COPY("LT", s)
+		| GT: COPY("GT", s)
+		| LE: COPY("LE", s)
+		ELSE COPY("?", s)
+		END
+	END CondRepr;
+
+	PROCEDURE IsLThumb32* (c: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN (c DIV 2000H = 7) & (c DIV 800H MOD 4 # 0)
+	END IsLThumb32;
+
+	(* d: decoder state *)
+	PROCEDURE OpcodeRepr* (VAR d: INTEGER; c: INTEGER; (*OUT*)VAR s: ARRAY OF CHAR);
+		VAR w: INTEGER;
+			s0: ARRAY 3 OF CHAR;
+			a, b: INTEGER;
+
+		PROCEDURE WStr ((*IN*) s0: ARRAY OF CHAR);
+			VAR i: INTEGER;
+		BEGIN
+			i := 0;
+			WHILE (i < LEN(s0(*$*))) & (s0[i] # 0X) DO
+				s[w] := s0[i]; INC(w);
+				INC(i)
+			END
+		END WStr;
+
+		PROCEDURE WReg (r: INTEGER);
+			VAR s0: ARRAY 4 OF CHAR;
+		BEGIN
+			RegRepr(r, s0);
+			WStr(s0)
+		END WReg;
+
+		PROCEDURE WInt (x: INTEGER);
+			VAR s0: ARRAY 12 OF CHAR;
+		BEGIN
+			Strings.IntToStr(x, s0);
+			WStr(s0)
+		END WInt;
+
+	BEGIN
+		ASSERT(c DIV 10000H = 0, 20);
+		w := 0;
+		IF d = 0 THEN
+			IF c DIV 4000H = 0 THEN
+					(* shift (immediate), add, substract, move, and compare *)
+				IF c DIV 800H = 0 THEN (* MOVSR | LSLSIm *)
+					IF c DIV 40H = 0 THEN (* MOVSR *)
+						WStr("MOVS "); WReg(c MOD 8);
+						WStr(", "); WReg(c DIV 8 MOD 8)
+					ELSE (* LSLSIm *)
+						WStr("LSLS "); WReg(c MOD 8);
+						WStr(", "); WReg(c DIV 8 MOD 8);
+						WStr(", #"); WInt(c DIV 40H)
+					END
+				ELSIF c DIV 800H = 1 THEN (* LSRSIm *)
+					WStr("LSRS "); WReg(c MOD 8); WStr(", "); WReg(c DIV 8 MOD 8);
+					WStr(", #"); WInt(c DIV 40H MOD 32)
+				ELSIF c DIV 800H = 2 THEN (* ASRSIm *)
+					WStr("ASRS "); WReg(c MOD 8); WStr(", "); WReg(c DIV 8 MOD 8);
+					WStr(", #"); WInt(c DIV 40H MOD 32)
+				ELSIF c DIV 200H = 12 THEN (* ADDSR *)
+					WStr("ADDS "); WReg(c MOD 8); WStr(", "); WReg(c DIV 8 MOD 8);
+					WStr(", "); WReg(c DIV 40H MOD 8)
+				ELSIF c DIV 200H = 13 THEN (* SUBSR *)
+					WStr("SUBS "); WReg(c MOD 8); WStr(", "); WReg(c DIV 8 MOD 8);
+					WStr(", "); WReg(c DIV 40H MOD 8)
+				ELSIF c DIV 200H = 14 THEN (* ADDSIm (3-bit) *)
+					WStr("ADDS "); WReg(c MOD 8); WStr(", "); WReg(c DIV 8 MOD 8);
+					WStr(", #"); WInt(c DIV 40H MOD 8)
+				ELSIF c DIV 200H = 15 THEN (* SUBSIm (3-bit) *)
+					WStr("SUBS "); WReg(c MOD 8); WStr(", "); WReg(c DIV 8 MOD 8);
+					WStr(", #"); WInt(c DIV 40H MOD 8)
+				ELSIF c DIV 800H = 4 THEN (* MOVSIm *)
+					WStr("MOVS "); WReg(c DIV 100H MOD 8);
+					WStr(", #"); WInt(c MOD 100H)
+				ELSIF c DIV 800H = 5 THEN (* CMPIm *)
+					WStr("CMP "); WReg(c DIV 100H MOD 8);
+					WStr(", #"); WInt(c MOD 100H)
+				ELSIF c DIV 800H = 6 THEN (* ADDSIm (8-bit) *)
+					WStr("ADDS "); WReg(c DIV 100H MOD 8);
+					WStr(", #"); WInt(c MOD 100H)
+				ELSIF c DIV 800H = 7 THEN (* SUBSIm (8-bit) *)
+					WStr("SUBS "); WReg(c DIV 100H MOD 8);
+					WStr(", #"); WInt(c MOD 100H)
+				END
+			ELSIF c DIV 400H = 16 THEN (* data processing *)
+				CASE c DIV 40H MOD 16 OF 0: WStr("ANDS")
+				| 1: WStr("EORS")
+				| 2: WStr("LSLS")
+				| 3: WStr("LSRS")
+				| 4: WStr("ASRS")
+				| 5: WStr("ADCS")
+				| 6: WStr("SBCS")
+				| 7: WStr("RORS")
+				| 8: WStr("TST")
+				| 9: WStr("RSBS")
+				| 10: WStr("CMP")
+				| 11: WStr("CMN")
+				| 12: WStr("ORRS")
+				| 13: WStr("MULS")
+				| 14: WStr("BICS")
+				| 15: WStr("MVNS")
+				END; s[w] := ' '; INC(w);
+				WReg(c MOD 8); WStr(", "); WReg(c DIV 8 MOD 8);
+				IF c DIV 40H MOD 16 = 9 THEN (* RSBS *)
+					WStr(", #0")
+				ELSIF c DIV 40H MOD 16 = 13 THEN (* MULS *)
+					WStr(", "); WReg(c MOD 8)
+				END
+			ELSIF c DIV 400H = 17 THEN
+					(* special data instructions and branch and exchange *)
+				IF c DIV 100H MOD 4 = 0 THEN (* ADDR *)
+					a := c DIV 80H MOD 2 * 8 + c MOD 8;
+					b := c DIV 8 MOD 10H;
+					IF b = SP THEN (* A6.7.5: ADD (SP plus register), encoding T1 *)
+						WStr("ADD "); WReg(a); WStr(", SP, "); WReg(a)
+					ELSIF a = SP THEN
+							(* A6.7.5: ADD (SP plus register), encoding T2 *)
+						WStr("ADD SP, "); WReg(b)
+					ELSE
+						WStr("ADD "); WReg(a); WStr(", "); WReg(b);
+						IF (a = PC) & (b = PC) THEN WStr(" (UNPREDICTABLE)") END
+					END
+				ELSIF c DIV 40H MOD 10H = 0 THEN
+					WStr("UNPREDICTABLE")
+				ELSIF (c DIV 40H MOD 10H = 5) OR (c DIV 80H MOD 8H = 3) THEN
+						(* CMPR, encoding T2 *)
+
+				ELSIF c DIV 100H MOD 4 = 2 THEN (* MOVR *)
+
+				ELSIF c DIV 80H MOD 8 = 6 THEN (* BX *)
+					IF c MOD 8 = 0 THEN
+						WStr("BX "); WReg(c DIV 8 MOD 10H);
+						IF c DIV 8 MOD 10H = 15 THEN
+							WStr(" (UNPREDICTABLE)")
+						END
+					END
+				ELSIF c DIV 80H MOD 8 = 7 THEN (* BLX *)
+					IF c MOD 8 = 0 THEN
+						WStr("BLX "); WReg(c DIV 8 MOD 10H);
+						IF c DIV 8 MOD 10H = 15 THEN
+							WStr(" (UNPREDICTABLE)")
+						END
+					END
+				END
+			ELSIF c DIV 800H = 9 THEN (* load from literal pool *)
+				WStr("LDR "); WReg(c DIV 100H MOD 8); WStr(", [PC, #");
+				WInt(c MOD 100H * 4); WStr("] ; "); WInt(c MOD 100H * 2)
+			ELSIF (c DIV 1000H = 5) OR (c DIV 2000H IN {3,4}) THEN
+					(* load/store single data item *)
+				IF c DIV 200H = 28H THEN (* STRR *)
+					WStr("STR "); WReg(c MOD 8); WStr(", ["); WReg(c DIV 8 MOD 8);
+					WStr(", "); WReg(c DIV 40H MOD 8); s[w] := ']'; INC(w)
+				ELSIF c DIV 200H = 29H THEN (* STRHR *)
+					WStr("STRH "); WReg(c MOD 8); WStr(", [");
+					WReg(c DIV 8 MOD 8);
+					WStr(", "); WReg(c DIV 40H MOD 8); s[w] := ']'; INC(w)
+				ELSIF c DIV 200H = 2AH THEN (* STRBR *)
+					WStr("STRB "); WReg(c MOD 8); WStr(", [");
+					WReg(c DIV 8 MOD 8);
+					WStr(", "); WReg(c DIV 40H MOD 8); s[w] := ']'; INC(w)
+				ELSIF c DIV 200H = 2BH THEN (* LDRSBR *)
+					WStr("LDRSB "); WReg(c MOD 8); WStr(", [");
+					WReg(c DIV 8 MOD 8);
+					WStr(", "); WReg(c DIV 40H MOD 8); s[w] := ']'; INC(w)
+				ELSIF c DIV 200H = 2CH THEN (* LDRR *)
+					WStr("LDR "); WReg(c MOD 8); WStr(", ["); WReg(c DIV 8 MOD 8);
+					WStr(", "); WReg(c DIV 40H MOD 8); s[w] := ']'; INC(w)
+				ELSIF c DIV 200H = 2DH THEN (* LDRHR *)
+					WStr("LDRH "); WReg(c MOD 8); WStr(", [");
+					WReg(c DIV 8 MOD 8);
+					WStr(", "); WReg(c DIV 40H MOD 8); s[w] := ']'; INC(w)
+				ELSIF c DIV 200H = 2EH THEN (* LDRBR *)
+					WStr("LDRB "); WReg(c MOD 8); WStr(", [");
+					WReg(c DIV 8 MOD 8);
+					WStr(", "); WReg(c DIV 40H MOD 8); s[w] := ']'; INC(w)
+				ELSIF c DIV 200H = 2FH THEN (* LDRSHR *)
+					WStr("LDRSH "); WReg(c MOD 8); WStr(", [");
+					WReg(c DIV 8 MOD 8);
+					WStr(", "); WReg(c DIV 40H MOD 8); s[w] := ']'; INC(w)
+				ELSIF c DIV 800H = 0CH THEN (* STRIm *)
+					WStr("STR "); WReg(c MOD 8); WStr(", ["); WReg(c DIV 8 MOD 8);
+					IF c DIV 40H MOD 32 # 0 THEN
+						WStr(", #"); WInt(c DIV 40H MOD 32); WStr("] ; ");
+						WInt(c DIV 40H MOD 32 * 4)
+					ELSE s[w] := ']'; INC(w)
+					END
+				ELSIF c DIV 800H = 0DH THEN (* LDRIm *)
+					WStr("LDR "); WReg(c MOD 8); WStr(", ["); WReg(c DIV 8 MOD 8);
+					IF c DIV 40H MOD 32 # 0 THEN
+						WStr(", #"); WInt(c DIV 40H MOD 32); WStr("] ; ");
+						WInt(c DIV 40H MOD 32 * 4)
+					ELSE s[w] := ']'; INC(w)
+					END
+				ELSIF c DIV 800H = 0EH THEN (* STRBIm *)
+					WStr("STRB "); WReg(c MOD 8);
+					WStr(", ["); WReg(c DIV 8 MOD 8);
+					IF c DIV 40H MOD 32 # 0 THEN
+						WStr(", #"); WInt(c DIV 40H MOD 32)
+					END; s[w] := ']'; INC(w)
+				ELSIF c DIV 800H = 0FH THEN (* LDRBIm *)
+					WStr("LDRB "); WReg(c MOD 8);
+					WStr(", ["); WReg(c DIV 8 MOD 8);
+					IF c DIV 40H MOD 32 # 0 THEN
+						WStr(", #"); WInt(c DIV 40H MOD 32)
+					END; s[w] := ']'; INC(w)
+				ELSIF c DIV 800H = 10H THEN (* STRHIm *)
+
+				ELSIF c DIV 800H = 11H THEN (* LDRHIm *)
+
+				ELSIF c DIV 800H = 12H THEN (* STRIm, SP *)
+					WStr("STR "); WReg(c DIV 100H MOD 8); WStr(", [SP");
+					IF c MOD 100H # 0 THEN WStr(", #");
+						WInt(c MOD 100H); WStr("] ; "); WInt(c MOD 100H * 4)
+					ELSE s[w] := ']'; INC(w)
+					END
+				ELSIF c DIV 800H = 13H THEN (* LDRIm, SP *)
+					WStr("LDR "); WReg(c DIV 100H MOD 8); WStr(", [SP");
+					IF c MOD 100H # 0 THEN WStr(", #");
+						WInt(c MOD 100H); WStr("] ; "); WInt(c MOD 100H * 4)
+					ELSE s[w] := ']'; INC(w)
+					END
+				END
+			ELSIF c DIV 800H = 16 + 4 THEN (* ADR *)
+
+			ELSIF c DIV 800H = 16 + 5 THEN (* ADDSPIm, encoding T1 *)
+				WStr("ADD "); WReg(c DIV 100H MOD 8); WStr(", SP, #");
+				WInt(c MOD 100H);
+				IF c MOD 100H # 0 THEN
+					WStr(" ; "); WInt(c MOD 100H * 4)
+				END
+			ELSIF c DIV 1000H = 0BH THEN (* miscellaneous 16-bit instructions *)
+				c := c MOD 1000H;
+				IF c DIV 80H = 0 THEN (* ADDSPIm, encoding T2 *)
+					WStr("ADD SP, SP, #"); WInt(c MOD 80H);
+					IF c MOD 80H # 0 THEN
+						WStr(" ; "); WInt(c MOD 80H * 4)
+					END
+				ELSIF c DIV 80H = 1 THEN (* SUBSPIm *)
+					WStr("SUB SP, SP, #"); WInt(c MOD 80H);
+					IF c MOD 80H # 0 THEN
+						WStr(" ; "); WInt(c MOD 80H * 4)
+					END
+				ELSIF c DIV 40H = 8 THEN (* SXTH *)
+
+				ELSIF c DIV 40H = 9 THEN (* SXTB *)
+
+				ELSIF c DIV 40H = 10 THEN (* UXTH *)
+
+				ELSIF c DIV 40H = 11 THEN (* UXTB *)
+
+				ELSIF c DIV 200H = 2 THEN (* PUSH *)
+					WStr("PUSH {");
+					a := 0; b := 0;
+					WHILE a < 8 DO
+						IF a IN BITS(c MOD 100H) THEN
+							IF b # 0 THEN WStr(", ") END;
+							WReg(a);
+							INC(b)
+						END;
+						INC(a)
+					END;
+					IF ODD(c DIV 100H) THEN
+						IF b # 0 THEN WStr(", ") END;
+						WReg(LR);
+						INC(b)
+					END;
+					s[w] := '}'; INC(w);
+					IF b < 1 THEN
+						WStr(" (UNPREDICTABLE)")
+					END
+				ELSIF c DIV 20H = 32 + 16 + 3 THEN (* CPS *)
+
+				ELSIF c DIV 40H = 40 THEN (* REV *)
+
+				ELSIF c DIV 40H = 41 THEN (* REV16 *)
+
+				ELSIF c DIV 40H = 43 THEN (* REVSH *)
+
+				ELSIF c DIV 200H = 6 THEN (* POP *)
+					WStr("POP {");
+					a := 0; b := 0;
+					WHILE a < 8 DO
+						IF a IN BITS(c MOD 100H) THEN
+							IF b # 0 THEN WStr(", ") END;
+							WReg(a);
+							INC(b)
+						END;
+						INC(a)
+					END;
+					IF ODD(c DIV 100H) THEN
+						IF b # 0 THEN WStr(", ") END;
+						WReg(PC);
+						INC(b)
+					END;
+					s[w] := '}'; INC(w);
+					IF b < 1 THEN
+						WStr(" (UNPREDICTABLE)")
+					END
+				ELSIF c DIV 100H = 14 THEN (* BKPT *)
+
+				ELSIF c DIV 100H = 15 THEN (* hint instructions *)
+					IF c MOD 10H # 0 THEN WStr("UNDEFINED")
+					ELSE
+						CASE c DIV 10H MOD 10H OF 0: WStr("NOP")
+						| 1: WStr("YIELD")
+						| 2: WStr("WFE")
+						| 3: WStr("WFI")
+						| 4: WStr("SEV")
+						ELSE
+						END
+					END
+				END
+			ELSIF c DIV 800H = 16 + 8 THEN (* store multiple registers *)
+
+			ELSIF c DIV 800H = 16 + 9 THEN (* load multiple registers *)
+
+			ELSIF c DIV 1000H = 0DH THEN (* conditional branch, and SVC *)
+				IF c DIV 100H MOD 10H = 15 THEN
+					WStr("SVC #"); WInt(c MOD 100H)
+				ELSIF c DIV 100H MOD 10H = 14 THEN
+					WStr("UNDEFINED")
+				ELSE s[w] := 'B'; INC(w);
+					CondRepr(c DIV 100H MOD 10H, s0);
+					WStr(s0); s[w] := ' '; INC(w);
+					WInt((c * 1000000H) DIV 1000000H); WStr(" ; ");
+					WInt((c * 1000000H) DIV 1000000H + 1)
+				END
+			ELSIF c DIV 800H = 16 + 12 THEN (* unconditional branch *)
+				WStr("B "); WInt((c * 200000H) DIV 200000H);
+				WStr(" ; "); WInt((c * 200000H) DIV 200000H + 1)
+			ELSIF IsLThumb32(c) THEN (* 32-bit Thumb instruction *)
+				d := 10000H + c;
+				WStr("...")
+			END
+		ELSIF d DIV 10000H = 1 THEN
+			c := 10000H * c + d MOD 10000H; d := 0;
+			IF c DIV 800H MOD 2 = 1 THEN
+				WStr("UNDEFINED")
+			ELSIF 31 IN BITS(c) THEN (* branch and miscellaneous control *)
+				a := DecodeBL(c);
+				ASSERT(a MOD 2 = 0, 102);
+				WStr("BL "); WInt(a);
+				IF a # 0 THEN WStr(" ; "); WInt(a DIV 2) END
+			ELSE
+				WStr("UNDEFINED")
+			END
+		ELSE HALT(1)
+		END;
+		s[w] := 0X
+	END OpcodeRepr;
+
+END O7ARMv6M.

voc-O7/O7ARMv7M.Mod

@@ -0,0 +1,2057 @@
+MODULE O7ARMv7M;
+
+	(*
+		Alexander Shiryaev, 2015.01, 2019.11, 2020.08
+
+		ARMv7-M Architecture Reference Manual
+			https://web.eecs.umich.edu/~prabal/teaching/eecs373-f10/readings/ARMv7-M_ARM.pdf
+	*)
+
+	IMPORT SYSTEM, Strings := VT100, ARMv6M := O7ARMv6M;
+
+	CONST
+		(* registers *)
+			R0* = 0; R1* = 1; R2* = 2; R3* = 3;
+			R4* = 4; R5* = 5; R6* = 6; R7* = 7;
+			R8* = 8; R9* = 9; R10* = 10; R11* = 11; R12* = 12;
+			SP* = 13; LR* = 14; PC* = 15;
+		(* conditions *)
+			EQ* = 0; NE* = 1; CS* = 2; CC* = 3;
+			MI* = 4; PL* = 5; VS* = 6; VC* = 7;
+			HI* = 8; LS* = 9; GE* = 10; LT* = 11;
+			GT* = 12; LE* = 13; AL* = 14;
+
+	PROCEDURE LSL (x, n: INTEGER): INTEGER;
+	BEGIN
+		RETURN SYSTEM.LSH(x, n)
+	END LSL;
+
+	PROCEDURE BITS (x: INTEGER): SET;
+	BEGIN
+		RETURN SYSTEM.VAL(SET, x)
+	END BITS;
+
+	PROCEDURE ORDSET (x: SET): INTEGER;
+	BEGIN
+		RETURN SYSTEM.VAL(INTEGER, x)
+	END ORDSET;
+
+	PROCEDURE Emit2 (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; c: INTEGER);
+	BEGIN
+		code[pc] := c MOD 10000H; INC(pc);
+		code[pc] := c DIV 10000H MOD 10000H; INC(pc)
+	END Emit2;
+
+	(* A5.3: emit 32-bit Thumb instruction *)
+	(* 111 op1:2 op2:7 x0:4	op:1 x1:15 *)
+	PROCEDURE EmitThumb2 (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; op1, op2, x0, op, x1: INTEGER);
+	BEGIN
+		ASSERT(op1 IN {1,2,3}, 20);
+		ASSERT(op2 >= 0, 21);
+		ASSERT(op2 < 80H, 22);
+		ASSERT(x0 IN {0..15}, 23);
+		ASSERT(op IN {0,1}, 24);
+		ASSERT(x1 >= 0, 25);
+		ASSERT(x1 < 8000H, 26);
+		Emit2(code, pc, LSL(op, 31) + x1 * 10000H + 0E000H + op1 * 800H + op2 * 10H + x0)
+	END EmitThumb2;
+
+	(* A5.3.5: emit Thumb-2 Load Multiple and Store Multiple instruction *)
+	(* 111 0100 op:2 0 W:1 L:1 Rn:4	x0:16 *)
+	PROCEDURE EmitLMASM (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; op, W, L, Rn, x0: INTEGER);
+	BEGIN
+		ASSERT(op IN {1,2}, 20);
+		ASSERT(W IN {0,1}, 21);
+		ASSERT(L IN {0,1}, 22);
+		ASSERT(Rn IN {0..15}, 23);
+		ASSERT(x0 DIV 10000H = 0, 24);
+		EmitThumb2(code, pc, 1, op * 8 + W * 2 + L, Rn, x0 DIV 8000H, x0 MOD 8000H)
+	END EmitLMASM;
+
+	(* A5.3.11: emit Thumb-2 data processing (shifted register) instruction *)
+	(* 111 0101 op:4 S:1 Rn:4	x0:4 Rd:4 x1:8 *)
+	PROCEDURE EmitDPSR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; op, S, Rn, x0, Rd, x1: INTEGER);
+	BEGIN
+		ASSERT(op IN {0..15}, 20);
+		ASSERT(S IN {0,1}, 21);
+		ASSERT(Rn IN {0..15}, 22);
+		ASSERT(x0 IN {0..15}, 23);
+		ASSERT(Rd IN {0..15}, 24);
+		ASSERT(x1 >= 0, 25);
+		ASSERT(x1 < 100H, 26);
+		EmitThumb2(code, pc, 1, 20H + op * 2 + S, Rn, x0 DIV 8, x0 MOD 8 * 1000H + Rd * 100H + x1)
+	END EmitDPSR;
+
+		(* A7.7.114: ROR (immediate); encoding T1 ARMv7-M *)
+		PROCEDURE EmitRORIm* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; S, Rd, Rm, im: INTEGER);
+		BEGIN
+			ASSERT(S DIV 2 = 0, 20);
+			ASSERT(Rd IN {0..12,14}, 21);
+			ASSERT(Rm IN {0..12,14}, 22);
+			ASSERT(im IN {1..31}, 23);
+			EmitDPSR(code, pc, 2, S, 0FH, im DIV 4, Rd, (im MOD 4) * 40H + 30H + Rm)
+		END EmitRORIm;
+
+	(* A5.3.1: emit Thumb-2 data processing (modified immediate) instruction *)
+	(* 111 10 x0:1 0 op:5 Rn:4	0 x1:3 Rd:4 x2:8 *)
+	PROCEDURE EmitDPMI* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; x0, op, Rn, x1, Rd, x2: INTEGER);
+	BEGIN
+		ASSERT(x0 IN {0,1}, 20);
+		ASSERT(op IN {0..31}, 21);
+		ASSERT(Rn IN {0..15}, 22);
+		ASSERT(x1 IN {0..7}, 23);
+		ASSERT(Rd IN {0..15}, 24);
+		ASSERT(x2 >= 0, 25);
+		ASSERT(x2 < 100H, 26);
+		EmitThumb2(code, pc, 2, x0 * 40H + op, Rn, 0, x1 * 1000H + Rd * 100H + x2)
+	END EmitDPMI;
+
+		(* A7.7.185: TST (immediate); encoding T1 ARMv7-M *)
+		PROCEDURE EmitTSTIm* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Rn, i, imm3, imm8: INTEGER);
+		BEGIN
+			ASSERT(Rn IN {0..12,14}, 20);
+			EmitDPMI(code, pc, i, 1, Rn, imm3, 0FH, imm8)
+		END EmitTSTIm;
+
+		(* A7.7.27: CMP (immediate); encoding T2 ARMv7-M *)
+		PROCEDURE EmitCMPImW* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Rn, i, imm3, imm8: INTEGER);
+		BEGIN
+			ASSERT(Rn IN {0..14}, 20);
+			EmitDPMI(code, pc, i, 16 + 8 + 2 + 1, Rn, imm3, 0FH, imm8)
+		END EmitCMPImW;
+
+		(* A7.7.117: RSB (immediate); encoding T2 ARMv7-M *)
+		PROCEDURE EmitRSBImW* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; S, Rd, Rn, i, imm3, imm8: INTEGER);
+		BEGIN
+			ASSERT(Rd IN {0..12,14}, 20);
+			ASSERT(Rn IN {0..12,14}, 20);
+			EmitDPMI(code, pc, i, 28 + S, Rn, imm3, Rd, imm8)
+		END EmitRSBImW;
+
+	(* A5.3.3: emit Thumb-2 data processing (plain binary immediate) instruction *)
+	(* 111 10 x0:1 1 op:5 Rn:4	0 x1:15 *)
+	PROCEDURE EmitDPPBI* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; x0, op, Rn, x1: INTEGER);
+	BEGIN
+		ASSERT(x0 IN {0,1}, 20);
+		ASSERT(op IN {0..31}, 21);
+		ASSERT(Rn IN {0..15}, 22);
+		ASSERT(x1 >= 0, 23);
+		ASSERT(x1 < 8000H, 24);
+		EmitThumb2(code, pc, 2, x0 * 40H + 20H + op, Rn, 0, x1)
+	END EmitDPPBI;
+
+	(* A5.3.12: emit Thumb-2 data processing (register) instruction *)
+	(* 111 1101 0 op1:4 Rn:4	1111 x0:4 op2:4 x1:4 *)
+	PROCEDURE EmitDPR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; op1, Rn, x0, op2, x1: INTEGER);
+	BEGIN
+		ASSERT(op1 IN {0..15}, 20);
+		ASSERT(Rn IN {0..15}, 21);
+		ASSERT(x0 IN {0..15}, 22);
+		ASSERT(op2 IN {0..15}, 23);
+		ASSERT(x1 IN {0..15}, 24);
+		EmitThumb2(code, pc, 3, 20H + op1, Rn, 1, 7000H + x0 * 100H + op2 * 10H + x1)
+	END EmitDPR;
+
+	(* A5.3.16: Multiply, multiply accumulate, and absolute difference *)
+	PROCEDURE EmitMMAAAD* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; op1, x0, Ra, x1, op2, x2: INTEGER);
+	BEGIN
+		ASSERT(op1 IN {0..7}, 20);
+		ASSERT(x0 IN {0..15}, 21);
+		ASSERT(Ra IN {0..15}, 22);
+		ASSERT(x1 IN {0..15}, 23);
+		ASSERT(op2 IN {0..3}, 24);
+		ASSERT(x2 IN {0..15}, 25);
+		EmitThumb2(code, pc, 3, 30H + op1, x0, Ra DIV 8, Ra MOD 8 * 1000H + x1 * 100H + op2 * 10H + x2)
+	END EmitMMAAAD;
+
+		(* A7.7.73: MLA; encoding T1 ARMv7-M *)
+		PROCEDURE EmitMLA* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Rd, Rn, Rm, Ra: INTEGER);
+		BEGIN
+			ASSERT(Rd IN {0..12,14}, 20);
+			ASSERT(Rn IN {0..12,14}, 21);
+			ASSERT(Rm IN {0..12,14}, 22);
+			ASSERT(Ra IN {0..12,14}, 23);
+			EmitMMAAAD(code, pc, 0, Rn, Ra, Rd, 0, Rm)
+		END EmitMLA;
+
+		(* A7.7.74: MLS; encoding T1 ARMv7-M *)
+		PROCEDURE EmitMLS* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Rd, Rn, Rm, Ra: INTEGER);
+		BEGIN
+			ASSERT(Rd IN {0..12,14}, 20);
+			ASSERT(Rn IN {0..12,14}, 21);
+			ASSERT(Rm IN {0..12,14}, 22);
+			ASSERT(Ra IN {0..12,14}, 23);
+			EmitMMAAAD(code, pc, 0, Rn, Ra, Rd, 1, Rm)
+		END EmitMLS;
+
+		(* A7.7.83: MUL; encoding T2 ARMv7-M *)
+		PROCEDURE EmitMUL* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Rd, Rn, Rm: INTEGER);
+		BEGIN
+			ASSERT(Rd IN {0..12,14}, 20);
+			ASSERT(Rn IN {0..12,14}, 21);
+			ASSERT(Rm IN {0..12,14}, 22);
+			EmitMMAAAD(code, pc, 0, Rn, 0FH, Rd, 0, Rm)
+		END EmitMUL;
+
+	(* A5.3.15: Long multiply, long multiply accumulate, and divide *)
+	PROCEDURE EmitLMLMAAD* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; op1, x0, x1, op2, x2: INTEGER);
+	BEGIN
+		ASSERT(op1 IN {0..7}, 20);
+		ASSERT(x0 IN {0..15}, 21);
+		ASSERT(x1 >= 0, 22);
+		ASSERT(x1 < 100H, 23);
+		ASSERT(op2 IN {0..15}, 24);
+		ASSERT(x2 IN {0..15}, 25);
+		EmitThumb2(code, pc, 3, 38H + op1, x0, x1 DIV 80H, x1 MOD 80H * 100H + op2 * 10H + x2)
+	END EmitLMLMAAD;
+
+	(* A5.3.7: emit Thumb-2 load word instruction *)
+	(* 111 1100 op1:2 10 1 Rn:4  x0:4 op2:6 x1:6 *)
+	PROCEDURE EmitLW (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; op1, Rn, x0, op2, x1: INTEGER);
+	BEGIN
+		ASSERT(op1 IN {0..3}, 20);
+		ASSERT(Rn IN {0..15}, 21);
+		ASSERT(x0 IN {0..15}, 22);
+		ASSERT(op2 >= 0, 23);
+		ASSERT(op2 < 40H, 24);
+		ASSERT(x1 >= 0, 25);
+		ASSERT(x1 < 40H, 26);
+		EmitThumb2(code, pc, 3, op1 * 8 + 5, Rn, x0 DIV 8, x0 MOD 8 * 1000H + op2 * 40H + x1)
+	END EmitLW;
+
+		(* A7.7.42: LDR (immediate); encoding T3 ARMv7-M *)
+		PROCEDURE EmitLWImW* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Rt, Rn, imm12: INTEGER);
+		BEGIN
+			ASSERT(Rn IN {0..14}, 20);
+			ASSERT(Rt IN {0..14}, 21);
+			ASSERT(imm12 >= 0, 22);
+			ASSERT(imm12 < 1000H, 23);
+			EmitLW(code, pc, 1, Rn, Rt, imm12 DIV 40H, imm12 MOD 40H)
+		END EmitLWImW;
+
+		(* A7.7.42: LDR (immediate); encoding T4 ARMv7-M *)
+		PROCEDURE EmitLWImWT4 (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Rt, Rn, imm8, P, U, W: INTEGER);
+		BEGIN
+			ASSERT(Rn IN {0..14}, 20);
+			ASSERT(Rt IN {0..15}, 21);
+			ASSERT(imm8 DIV 100H = 0, 22);
+			ASSERT(P DIV 2 = 0, 23);
+			ASSERT(U DIV 2 = 0, 24);
+			ASSERT(W DIV 2 = 0, 25);
+			ASSERT(~((P = 1) & (U = 1) & (W = 0)), 26);
+			ASSERT(~((Rn = 13) & (P = 0) & (U = 1) & (W = 1) & (imm8 = 4)), 27);
+			ASSERT(~((P = 0) & (W = 0)), 28);
+			EmitLW(code, pc, 0, Rn, Rt, imm8 DIV 40H + W * 4 + U * 8 + P * 16 + 32, imm8 MOD 40H)
+		END EmitLWImWT4;
+
+		PROCEDURE EmitLWImWNeg* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Rt, Rn, imm8: INTEGER);
+		BEGIN
+			EmitLWImWT4(code, pc, Rt, Rn, imm8, 1, 0, 0)
+		END EmitLWImWNeg;
+
+		(* A7.7.44: LDR (register); encoding T2 ARMv7-M *)
+		PROCEDURE EmitLWRW* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Rt, Rn, Rm, imm2: INTEGER);
+		BEGIN
+			ASSERT(Rt IN {0..15}, 20);
+			ASSERT(Rn IN {0..14}, 21);
+			ASSERT(Rm IN {0..12,14}, 22);
+			ASSERT(imm2 DIV 4 = 0, 23);
+			EmitLW(code, pc, 0, Rn, Rt, 0, imm2 * 10H + Rm)
+		END EmitLWRW;
+
+	(* A5.3.: emit Thumb-2 load byte, memory hints instruction *)
+	(* 111 1100 op1:2 00 1 Rn:4  Rt:4 op2:6 x0:6 *)
+	PROCEDURE EmitLBMH (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; op1, Rn, Rt, op2, x0: INTEGER);
+	BEGIN
+		ASSERT(op1 IN {0..3}, 20);
+		ASSERT(Rn IN {0..15}, 21);
+		ASSERT(Rt IN {0..15}, 22);
+		ASSERT(op2 >= 0, 23);
+		ASSERT(op2 < 40H, 24);
+		ASSERT(x0 >= 0, 25);
+		ASSERT(x0 < 40H, 26);
+		EmitThumb2(code, pc, 3, op1 * 8 + 1, Rn, Rt DIV 8, Rt MOD 8 * 1000H + op2 * 40H + x0)
+	END EmitLBMH;
+
+		(* A7.7.45: LDRB (immediate); encoding T2 ARMv7-M *)
+		PROCEDURE EmitLBImW* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Rt, Rn, imm12: INTEGER);
+		BEGIN
+			ASSERT(Rt IN {0..12,14}, 20);
+			ASSERT(Rn IN {0..14}, 21);
+			ASSERT(imm12 >= 0, 22);
+			ASSERT(imm12 < 1000H, 23);
+			EmitLBMH(code, pc, 1, Rn, Rt, imm12 DIV 40H, imm12 MOD 40H)
+		END EmitLBImW;
+
+		(* A7.7.47: LDRB (register); encoding T2 ARMv7-M *)
+		PROCEDURE EmitLBRW* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Rt, Rn, Rm, imm2: INTEGER);
+		BEGIN
+			ASSERT(Rt IN {0..12,14}, 20);
+			ASSERT(Rn IN {0..14}, 21);
+			ASSERT(Rm IN {0..12,14}, 22);
+			ASSERT(imm2 DIV 4 = 0, 23);
+			EmitLBMH(code, pc, 0, Rn, Rt, 0, imm2 * 10H + Rm)
+		END EmitLBRW;
+
+	(* A5.3.10: emit Thumb-2 store single data item instruction *)
+	(* 111 1100 0 op1:3 0 x0:4  x1:4 op2:6 x2:6 *)
+	PROCEDURE EmitSSDI (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; op1, x0, x1, op2, x2: INTEGER);
+	BEGIN
+		ASSERT(op1 IN {0..7}, 20);
+		ASSERT(x0 IN {0..15}, 21);
+		ASSERT(x1 IN {0..15}, 22);
+		ASSERT(op2 >= 0, 23);
+		ASSERT(op2 < 40H, 24);
+		ASSERT(x2 >= 0, 25);
+		ASSERT(x2 < 40H, 26);
+		EmitThumb2(code, pc, 3, op1 * 2, x0, x1 DIV 8, x1 MOD 8 * 1000H + op2 * 40H + x2)
+	END EmitSSDI;
+
+		(* A7.7.160: STRB (immediate); encoding T2 ARMv7-M *)
+		PROCEDURE EmitSBImW* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Rt, Rn, imm12: INTEGER);
+		BEGIN
+			ASSERT(Rt IN {0..12,14}, 20);
+			ASSERT(Rn IN {0..14}, 21);
+			ASSERT(imm12 >= 0, 110);
+			ASSERT(imm12 < 1000H, 111);
+			EmitSSDI(code, pc, 4, Rn, Rt, imm12 DIV 40H, imm12 MOD 40H)
+		END EmitSBImW;
+
+		(* A7.7.161: STRB (register); encoding T2 ARMv7-M *)
+		PROCEDURE EmitSBRW* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Rt, Rn, Rm, imm2: INTEGER);
+		BEGIN
+			ASSERT(Rt IN {0..12,14}, 20);
+			ASSERT(Rn IN {0..14}, 21);
+			ASSERT(Rm IN {0..12,14}, 22);
+			ASSERT(imm2 IN {0..3}, 23);
+			EmitSSDI(code, pc, 0, Rn, Rt, 0, imm2 * 10H + Rm)
+		END EmitSBRW;
+
+		(* A7.7.158: STR (immediate); encoding T3 ARMv7-M *)
+		PROCEDURE EmitSWImW* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Rt, Rn, imm12: INTEGER);
+		BEGIN
+			ASSERT(Rt IN {0..14}, 20);
+			ASSERT(Rn IN {0..14}, 21);
+			ASSERT(imm12 >= 0, 110);
+			ASSERT(imm12 < 1000H, 111);
+			EmitSSDI(code, pc, 6, Rn, Rt, imm12 DIV 40H, imm12 MOD 40H)
+		END EmitSWImW;
+
+		(* A7.7.159: STR (register); encoding T2 ARMv7-M *)
+		PROCEDURE EmitSWRW* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Rt, Rn, Rm, imm2: INTEGER);
+		BEGIN
+			ASSERT(Rt IN {0..14}, 20);
+			ASSERT(Rn IN {0..14}, 21);
+			ASSERT(Rm IN {0..12,14}, 22);
+			ASSERT(imm2 IN {0..3}, 23);
+			EmitSSDI(code, pc, 2, Rn, Rt, 0, imm2 * 10H + Rm)
+		END EmitSWRW;
+
+	(* A7.7.79: PUSH *)
+	PROCEDURE EmitPUSHW* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; regs: SET);
+		VAR i, n, r: INTEGER;
+	BEGIN
+		ASSERT(regs * {13,15..31} = {}, 20);
+		ASSERT(regs # {}, 21);
+		i := 16; n := 0;
+		REPEAT DEC(i); IF i IN regs THEN INC(n); r := i END UNTIL i = 0;
+		IF n = 1 THEN (* encoding T3 ARMv7-M *)
+			EmitSSDI(code, pc, 2, 13, r, 32 + 16 + 4, 4)
+		ELSE (* encoding T2 ARMv7-M *)
+			EmitLMASM(code, pc, 2, 1, 0, 13, ORDSET(regs))
+		END
+	END EmitPUSHW;
+
+	(* A7.7.98: POP *)
+	PROCEDURE EmitPOPW* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; regs: SET);
+		VAR i, n, r: INTEGER;
+	BEGIN
+		ASSERT(regs * {13,16..31} = {}, 20);
+		ASSERT(regs # {}, 21);
+		i := 16; n := 0;
+		REPEAT DEC(i); IF i IN regs THEN INC(n); r := i END UNTIL i = 0;
+		IF n = 1 THEN (* encoding T3 ARMv7-M *)
+			EmitLW(code, pc, 0, 13, r, 32 + 8 + 4, 4)
+		ELSE (* encoding T2 ARMv7-M *)
+			EmitLMASM(code, pc, 1, 1, 1, 13, ORDSET(regs))
+		END
+	END EmitPOPW;
+
+	PROCEDURE DecodeBLabel20 (S, imm6, J1, J2, imm11: INTEGER): INTEGER;
+	BEGIN
+		RETURN ((S * 100000H + J2 * 80000H + J1 * 40000H + imm6 * 1000H + imm11 * 2) * 800H) DIV 800H
+	END DecodeBLabel20;
+
+	PROCEDURE EncodeBLabel20* (off: INTEGER; (*OUT*)VAR S, imm6, J1, J2, imm11: INTEGER);
+		VAR test: INTEGER;
+	BEGIN
+		ASSERT(off * 2 >= -1048576, 21);
+		ASSERT(off * 2 <= 1048574, 22);
+		imm11 := off MOD 800H;
+		imm6 := off DIV 800H MOD 40H;
+		S := off DIV 80000H MOD 2;
+		J2 := off DIV 40000H MOD 2;
+		J1 := off DIV 20000H MOD 2;
+
+		off := off * 2;
+		test := DecodeBLabel20(S, imm6, J1, J2, imm11);
+		ASSERT(off = test, 100)
+	END EncodeBLabel20;
+
+	(* A5.3.4: emit Thumb-2 branch and miscellaneous control instruction *)
+	(* 111 10 op:7 x0:4  1 op1:3 x1:12 *)
+	PROCEDURE EmitBAMC* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; op, x0, op1, x1: INTEGER);
+	BEGIN
+		ASSERT(op >= 0, 20);
+		ASSERT(op < 80H, 21);
+		ASSERT(x0 IN {0..15}, 22);
+		ASSERT(op1 IN {0..7}, 23);
+		ASSERT(x1 >= 0, 24);
+		ASSERT(x1 < 1000H, 25);
+		EmitThumb2(code, pc, 2, op, x0, 1, op1 * 1000H + x1)
+	END EmitBAMC;
+
+	(* A7.7.236: emit VMOV (between ARM core register and single-precision register) instruction; encoding T1 FPv4-SP *)
+	PROCEDURE EmitVMOVSPR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; op, n, t: INTEGER);
+	BEGIN
+		ASSERT(op IN {0,1}, 20);
+		ASSERT(n IN {0..31}, 21);
+		ASSERT(t IN {0..12,14}, 22);
+		Emit2(code, pc, 0A10EE00H + op * 10H + n DIV 2 + n MOD 2 * 800000H + t * 10000000H)
+	END EmitVMOVSPR;
+
+	(* A7.7.239: emit VMRS instruction; encoding T1 FPv4-SP *)
+	PROCEDURE EmitVMRS* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Rt: INTEGER);
+	BEGIN
+		ASSERT(Rt IN {0..12,14,15}, 20);
+		Emit2(code, pc, 0A10EEF1H + Rt * 10000000H)
+	END EmitVMRS;
+
+	(* A7.7.240: emit VMSR instruction; encoding T1 FPv4-SP *)
+	PROCEDURE EmitVMSR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Rt: INTEGER);
+	BEGIN
+		ASSERT(Rt IN {0..12,14}, 20);
+		Emit2(code, pc, 0A10EEE1H + Rt * 10000000H)
+	END EmitVMSR;
+
+	(* A6.4: emit Floating-point data-processing instruction *)
+	(* 111 0 1110 opc1:4 opc2:4	x0:4 101 0 opc3:2 x1:1 0 opc4:4 *)
+	PROCEDURE EmitFPDP (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; opc1, opc2, x0, opc3, x1, opc4: INTEGER);
+	BEGIN
+		ASSERT(opc1 IN {0..15}, 20);
+		ASSERT(opc2 IN {0..15}, 21);
+		ASSERT(x0 IN {0..15}, 22);
+		ASSERT(opc3 IN {0..3}, 23);
+		ASSERT(x1 IN {0,1}, 24);
+		ASSERT(opc4 IN {0..15}, 25);
+		Emit2(code, pc, 0A00EE00H + opc1 * 10H + opc2 + x0 * 10000000H + opc3 * 400000H + x1 * 200000H + opc4 * 10000H)
+	END EmitFPDP;
+
+		(* A7.7.241: emit VMUL instruction; encoding T1 FPv4-SP *)
+		PROCEDURE EmitVMUL* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Sd, Sn, Sm: INTEGER);
+		BEGIN
+			ASSERT(Sd IN {0..31}, 20);
+			ASSERT(Sn IN {0..31}, 21);
+			ASSERT(Sm IN {0..31}, 22);
+			EmitFPDP(code, pc, 2 + Sd MOD 2 * 4, Sn DIV 2, Sd DIV 2, Sn MOD 2 * 2, Sm MOD 2, Sm DIV 2)
+		END EmitVMUL;
+
+		(* A7.7.221: emit VADD instruction; encoding T1 FPv4-SP *)
+		PROCEDURE EmitVADD* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Sd, Sn, Sm: INTEGER);
+		BEGIN
+			ASSERT(Sd IN {0..31}, 20);
+			ASSERT(Sn IN {0..31}, 21);
+			ASSERT(Sm IN {0..31}, 22);
+			EmitFPDP(code, pc, 3 + Sd MOD 2 * 4, Sn DIV 2, Sd DIV 2, Sn MOD 2 * 2, Sm MOD 2, Sm DIV 2)
+		END EmitVADD;
+
+		(* A7.7.249: emit VSUB instruction; encoding T1 FPv4-SP *)
+		PROCEDURE EmitVSUB* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Sd, Sn, Sm: INTEGER);
+		BEGIN
+			ASSERT(Sd IN {0..31}, 20);
+			ASSERT(Sn IN {0..31}, 21);
+			ASSERT(Sm IN {0..31}, 22);
+			EmitFPDP(code, pc, 3 + Sd MOD 2 * 4, Sn DIV 2, Sd DIV 2, Sn MOD 2 * 2 + 1, Sm MOD 2, Sm DIV 2)
+		END EmitVSUB;
+
+		(* A7.7.226: emit VDIV instruction; encoding T1 FPv4-SP *)
+		PROCEDURE EmitVDIV* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Sd, Sn, Sm: INTEGER);
+		BEGIN
+			ASSERT(Sd IN {0..31}, 20);
+			ASSERT(Sn IN {0..31}, 21);
+			ASSERT(Sm IN {0..31}, 22);
+			EmitFPDP(code, pc, 8 + Sd MOD 2 * 4, Sn DIV 2, Sd DIV 2, Sn MOD 2 * 2, Sm MOD 2, Sm DIV 2)
+		END EmitVDIV;
+
+		(* A7.7.220: emit VABS instruction; encoding T1 FPv4-SP *)
+		PROCEDURE EmitVABS* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Sd, Sm: INTEGER);
+		BEGIN
+			ASSERT(Sd IN {0..31}, 20);
+			ASSERT(Sm IN {0..31}, 21);
+			EmitFPDP(code, pc, 11 + Sd MOD 2 * 4, 0, Sd DIV 2, 3, Sm MOD 2, Sm DIV 2)
+		END EmitVABS;
+
+		(* A7.7.242: emit VNEG instruction; encoding T1 FPv4-SP *)
+		PROCEDURE EmitVNEG* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Sd, Sm: INTEGER);
+		BEGIN
+			ASSERT(Sd IN {0..31}, 20);
+			ASSERT(Sm IN {0..31}, 21);
+			EmitFPDP(code, pc, 11 + Sd MOD 2 * 4, 1, Sd DIV 2, 1, Sm MOD 2, Sm DIV 2)
+		END EmitVNEG;
+
+		(* A7.7.246: emit VSQRT instruction; encoding T1 FPv4-SP *)
+		PROCEDURE EmitVSQRT* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Sd, Sm: INTEGER);
+		BEGIN
+			ASSERT(Sd IN {0..31}, 20);
+			ASSERT(Sm IN {0..31}, 21);
+			EmitFPDP(code, pc, 11 + Sd MOD 2 * 4, 1, Sd DIV 2, 3, Sm MOD 2, Sm DIV 2)
+		END EmitVSQRT;
+
+		(* A7.7.222: emit VCMP{E} instruction; encoding T1 FPv4-SP *)
+		PROCEDURE EmitVCMPER* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; E, Sd, Sm: INTEGER);
+		BEGIN
+			ASSERT(E IN {0,1}, 20);
+			ASSERT(Sd IN {0..31}, 21);
+			ASSERT(Sm IN {0..31}, 22);
+			EmitFPDP(code, pc, 11 + Sd MOD 2 * 4, 4, Sd DIV 2, E * 2 + 1, Sm MOD 2, Sm DIV 2)
+		END EmitVCMPER;
+
+		(* A7.7.222: emit VCMP{E} instruction; encoding T2 FPv4-SP *)
+		PROCEDURE EmitVCMPE0* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; E, Sd: INTEGER);
+		BEGIN
+			ASSERT(E IN {0,1}, 20);
+			ASSERT(Sd IN {0..31}, 21);
+			EmitFPDP(code, pc, 11 + Sd MOD 2 * 4, 5, Sd DIV 2, E * 2 + 1, 0, 0)
+		END EmitVCMPE0;
+
+		(* A7.7.223: emit VCVT, VCVTR (between floating-point and integer) instruction; encoding T1 FPv4-SP *)
+		PROCEDURE EmitVCVTRInt* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; toInteger, R, signed: BOOLEAN; Sd, Sm: INTEGER);
+			VAR opc2, op: INTEGER;
+		BEGIN
+			ASSERT(Sd IN {0..31}, 20);
+			ASSERT(Sm IN {0..31}, 21);
+			IF toInteger THEN
+				IF signed THEN opc2 := 5 ELSE opc2 := 4 END;
+				IF R THEN op := 0 ELSE op := 1 END
+			ELSE
+				ASSERT(~R, 22);
+				opc2 := 0;
+				IF signed THEN op := 1 ELSE op := 0 END
+			END;
+			EmitFPDP(code, pc, 11 + Sd MOD 2 * 4, 8 + opc2, Sd DIV 2, op * 2 + 1, Sm MOD 2, Sm DIV 2)
+		END EmitVCVTRInt;
+
+	(* A6.5: emit Floating-point extension register load and store instruction *)
+	(* 111 0 110 opcode:5 Rn:4	x0:4 101 x1:9 *)
+	PROCEDURE EmitFPERLOS (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; opcode, Rn, x0, x1: INTEGER);
+	BEGIN
+		ASSERT(opcode DIV 32 = 0, 20);
+		ASSERT(Rn DIV 16 = 0, 21);
+		ASSERT(x0 DIV 16 = 0, 22);
+		ASSERT(x1 DIV 200H = 0, 23);
+		Emit2(code, pc, 0A00EC00H + Rn + opcode * 10H + x1 * 10000H + x0 * 10000000H)
+	END EmitFPERLOS;
+
+		(* A7.7.248: emit VSTR instruction; encoding T2 FPv4-SP *)
+		PROCEDURE EmitVSTR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Sd, Rn, U, imm8: INTEGER);
+		BEGIN
+			ASSERT(Sd IN {0..31}, 20);
+			ASSERT(Rn IN {0..14}, 21);
+			ASSERT(U IN {0,1}, 22);
+			ASSERT(imm8 DIV 100H = 0, 23);
+			EmitFPERLOS(code, pc, 16 + U * 8 + Sd MOD 2 * 4, Rn, Sd DIV 2, imm8)
+		END EmitVSTR;
+
+		(* A7.7.230: emit VLDR instruction; encoding T2 FPv4-SP *)
+		PROCEDURE EmitVLDR* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; Sd, Rn, U, imm8: INTEGER);
+		BEGIN
+			ASSERT(Sd IN {0..31}, 20);
+			ASSERT(Rn IN {0..15}, 21);
+			ASSERT(U IN {0,1}, 22);
+			ASSERT(imm8 DIV 100H = 0, 23);
+			EmitFPERLOS(code, pc, 16 + U * 8 + Sd MOD 2 * 4 + 1, Rn, Sd DIV 2, imm8)
+		END EmitVLDR;
+
+	(* try to encode to 12-bit modified immediate *)
+	PROCEDURE EncodeMI12* (x: INTEGER; (*OUT*)VAR i, imm3, imm8: INTEGER; (*OUT*)VAR ok: BOOLEAN);
+		VAR j, y: INTEGER; imm12: INTEGER;
+	BEGIN
+		IF x DIV 100H = 0 THEN
+			imm12 := x;
+			ok := TRUE
+		ELSIF (x MOD 10000H DIV 100H = 0) & (x DIV 10000H MOD 10000H = x MOD 10000H) THEN
+			imm12 := 100H + x MOD 100H;
+			ok := TRUE
+		ELSIF (x MOD 100H = 0) & (x DIV 10000H MOD 10000H = x MOD 10000H) THEN
+			imm12 := 200H + x DIV 100H MOD 100H;
+			ok := TRUE
+		ELSIF (x MOD 100H = x DIV 100H MOD 100H) & (x MOD 100H = x DIV 10000H MOD 100H) & (x MOD 100H = x DIV 1000000H MOD 100H) THEN
+			imm12 := 300H + x MOD 100H;
+			ok := TRUE
+		ELSE
+			j := 0; y := x;
+			WHILE (j < 24) & ~((31 IN BITS(y)) & (y MOD 1000000H = 0)) DO
+				INC(j); y := SYSTEM.ROT(x, j)
+			END;
+			IF j < 24 THEN
+				imm12 := (j + 8) * 80H + y DIV 1000000H MOD 80H;
+				ok := TRUE
+			ELSE
+				ok := FALSE
+			END
+		END;
+		IF ok THEN
+			i := imm12 DIV 800H;
+			imm3 := imm12 DIV 100H MOD 8;
+			imm8 := imm12 MOD 100H
+		END
+	END EncodeMI12;
+
+	(* A5.4.2 *)
+	PROCEDURE DecodeMI12 (i, imm3, imm8: INTEGER; (*OUT*)VAR im: INTEGER; (*OUT*)VAR ok: BOOLEAN);
+		VAR imm12: INTEGER;
+	BEGIN
+		ASSERT(i IN {0,1}, 20);
+		ASSERT(imm3 IN {0..7}, 21);
+		ASSERT(imm8 >= 0, 22);
+		ASSERT(imm8 < 100H, 23);
+		imm12 := i * 800H + imm3 * 100H + imm8;
+		IF imm12 DIV 400H = 0 THEN
+			CASE imm12 DIV 100H MOD 4 OF 0:
+				im := imm8; ok := TRUE
+			| 1:
+				IF imm8 = 0 THEN ok := FALSE
+				ELSE im := imm8 * 10000H + imm8; ok := TRUE
+				END
+			| 2:
+				IF imm8 = 0 THEN ok := FALSE
+				ELSE im := imm8 * 1000000H + imm8 * 100H; ok := TRUE
+				END
+			| 3:
+				IF imm8 = 0 THEN ok := FALSE
+				ELSE im := imm8 * 1000000H + imm8 * 10000H + imm8 * 100H + imm8; ok := TRUE
+				END
+			END
+		ELSE
+			im := 80H + imm8 MOD 80H;
+			im := SYSTEM.ROT(im, -(imm12 DIV 80H));
+			ok := TRUE
+		END
+	END DecodeMI12;
+
+	(* A5.3 *)
+	PROCEDURE IsLMASM (c: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN BITS(c) * {6,9..15} = {11,13..15}
+	END IsLMASM;
+
+		(* A7.7.79: PUSH; encoding T2 *)
+		PROCEDURE IsPUSHMany (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {0..15,29,31} = {0,2,3,5,8,11,13..15}
+		END IsPUSHMany;
+
+		(* A7.7.98: POP; encoding T2 *)
+		PROCEDURE IsPOPMany (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {0..15,29} = {0,2..5,7,11,13..15}
+		END IsPOPMany;
+
+	(* A7.7.79: PUSH; encoding T3 *)
+	PROCEDURE IsPUSHOne (c: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN BITS(c) * {0..27} = {0,2,3,6,11..15,18,24,26,27}
+	END IsPUSHOne;
+
+	(* A7.7.98: POP; encoding T3 *)
+	PROCEDURE IsPOPOne (c: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN BITS(c) * {0..27} = {0,2..4,6,11..15,18,24,25,27}
+	END IsPOPOne;
+
+	(* A5.3 *)
+	PROCEDURE IsDPSR (c: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN BITS(c) * {9..15} = {9,11,13..15}
+	END IsDPSR;
+
+		(* A7.7.85: MVN (register); encoding T2 *)
+		PROCEDURE IsMVNR (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {0..3,5..15,31} = {0..3,5,6,9,11,13..15}
+		END IsMVNR;
+
+		(* A7.7.76: MOVR (register); encoding T3 *)
+		PROCEDURE IsMOVR (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {0..3,5..15,20..23,28..31} = {0..3,6,9,11,13..15}
+		END IsMOVR;
+
+		(* A7.7.9: AND (register); encoding T2 *)
+		PROCEDURE IsANDR (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {5..15,31} = {9,11,13..15}) & ~((BITS(c) * {24..27} = {24..27}) & (4 IN BITS(c)))
+		END IsANDR;
+
+		(* A7.7.16: BIC (register); encoding T2 *)
+		PROCEDURE IsBICR (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {5..15,31} = {5,9,11,13..15}
+		END IsBICR;
+
+		(* A7.7.91: ORR (register); encoding T2 *)
+		PROCEDURE IsORRR (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {5..15,31} = {6,9,11,13..15}) & (BITS(c) * {0..3} # {0..3})
+		END IsORRR;
+
+		(* A7.7.25: EOR (register); encoding T2 *)
+		PROCEDURE IsEORR (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {5..15,31} = {7,9,11,13..15}) & ~((BITS(c) * {24..27} = {24..27}) & (4 IN BITS(c)))
+		END IsEORR;
+
+		(* A7.7.4: ADD (register); encoding T3 *)
+		PROCEDURE IsADDR (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {5..15,31} = {8,9,11,13..15}) & ~((BITS(c) * {24..27} = {24..27}) & (4 IN BITS(c))) & (BITS(c) * {0,2,3} # {0,2,3})
+		END IsADDR;
+
+		(* A7.7.6: ADD (SP plus register); encoding T3 *)
+		PROCEDURE IsADDSPR (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {0..3,5..15,31} = {0,2,3,8,9,11,13..15}
+		END IsADDSPR;
+
+		(* A7.7.2: ADC (register); encoding T2 *)
+		PROCEDURE IsADCR (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {5..15,31} = {6,8,9,11,13..15}
+		END IsADCR;
+
+		(* A7.7.172: SUB (register); encoding T2 *)
+		PROCEDURE IsSUBR (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {5..15,31} = {5,7..9,11,13..15}) & ~((BITS(c) * {24..27} = {24..27}) & (4 IN BITS(c))) & (BITS(c) * {0,2,3} # {0,2,3})
+		END IsSUBR;
+
+		(* A7.7.174: SUB (SP minus register); encoding T1 *)
+		PROCEDURE IsSUBSPR (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {0..3,5..15,31} = {0,2,3,5,7..9,11,13..15}
+		END IsSUBSPR;
+
+		(* A7.7.123: SBC (register); encoding T2 *)
+		PROCEDURE IsSBCR (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {5..15,31} = {5,6,8,9,11,13..15}
+		END IsSBCR;
+
+		(* A7.7.67: LSL (immediate); encoding T2 *)
+		PROCEDURE IsLSLIm (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {0..3,5..15,20,21,31} = {0..3,6,9,11,13..15}) & (BITS(c) * {22,23,28..30} # {})
+		END IsLSLIm;
+
+		(* A7.7.10: ASR (immediate); encoding T2 *)
+		PROCEDURE IsASRIm (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {0..3,5..15,20,21,31} = {0..3,6,9,11,13..15,21}
+		END IsASRIm;
+
+		(* A7.7.114: ROR (immediate); encoding T1 *)
+		PROCEDURE IsRORIm (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {0..3,5..15,20,21,31} = {0..3,6,9,11,13..15,20,21}) & (BITS(c) * {22,23,28..30} # {})
+		END IsRORIm;
+
+	(* A5.3 *)
+	PROCEDURE IsDPMI (c: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN BITS(c) * {9,11..15,31} = {12..15}
+	END IsDPMI;
+
+		(* A7.7.185: TST (immediate), encoding T1 *)
+		PROCEDURE IsTSTIm (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {4..9,11..15,24..27,31} = {4,12..15,24..27}
+		END IsTSTIm;
+
+		(* A7.7.75: MOV (immediate), encoding T2 *)
+		PROCEDURE IsMOVMI (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {0..3,5..9,11..15,31} = {0..3,6,12..15}
+		END IsMOVMI;
+
+		(* A7.7.84: MVN (immediate), encoding T1 *)
+		PROCEDURE IsMVNIm (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {0..3,5..9,11..15,31} = {0..3,5,6,12..15}
+		END IsMVNIm;
+
+		(* A7.7.8: AND (immediate), encoding T1 *)
+		PROCEDURE IsANDIm (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {5..9,11..15,31} = {12..15}
+		END IsANDIm;
+
+		(* A7.7.90: ORR (immediate), encoding T1 *)
+		PROCEDURE IsORRIm (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {5..9,11..15,31} = {6,12..15}) & (BITS(c) * {0..3} # {0..3})
+		END IsORRIm;
+
+		(* A7.7.15: BIC (immediate), encoding T1 *)
+		PROCEDURE IsBICIm (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {5..9,11..15,31} = {5,12..15}
+		END IsBICIm;
+
+		(* A7.7.88: ORN (immediate), encoding T1 *)
+		PROCEDURE IsORNIm (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {5..9,11..15,31} = {5,6,12..15}) & (BITS(c) * {0..3} # {0..3})
+		END IsORNIm;
+
+		(* A7.7.34: EOR (immediate), encoding T1 *)
+		PROCEDURE IsEORIm (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {5..9,11..15,31} = {7,12..15}) & ~((BITS(c) * {24..27} = {24..27}) & (4 IN BITS(c)))
+		END IsEORIm;
+
+		(* A7.7.3: ADD (immediate), encoding T3 *)
+		PROCEDURE IsADDMI (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {5..9,11..15,31} = {8,12..15}) & ~((BITS(c) * {24..27} = {24..27}) & (4 IN BITS(c))) & (BITS(c) * {0..3} # {0,2,3})
+		END IsADDMI;
+
+		(* A7.7.5: ADD (SP plus immediate), encoding T3 *)
+		PROCEDURE IsADDSPMI (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {0..3,5..9,11..15,31} = {0,2,3,8,12..15}) & ~((BITS(c) * {24..27} = {24..27}) & (4 IN BITS(c)))
+		END IsADDSPMI;
+
+		(* A7.7.171: SUB (immediate), encoding T3 *)
+		PROCEDURE IsSUBMI (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {5..9,11..15,31} = {5,7,8,12..15}) & ~((BITS(c) * {24..27} = {24..27}) & (4 IN BITS(c))) & (BITS(c) * {0..3} # {0,2,3})
+		END IsSUBMI;
+
+		(* A7.7.173: SUB (SP minus immediate), encoding T2 *)
+		PROCEDURE IsSUBSPMI (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {0..3,5..9,11..15,31} = {0,2,3,5,7,8,12..15}) & ~((BITS(c) * {24..27} = {24..27}) & (4 IN BITS(c)))
+		END IsSUBSPMI;
+
+		(* A7.7.27: CMP (immediate), encoding T2 *)
+		PROCEDURE IsCMPImW* (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {4..9,11..15,24..27,31} = {4,5,7,8,12..15,24..27}
+		END IsCMPImW;
+
+		(* A7.7.117: RSB (immediate), encoding T2 *)
+		PROCEDURE IsRSBImW (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {5..9,11..15,31} = {6..8,12..15}
+		END IsRSBImW;
+
+	(* A5.3 *)
+	PROCEDURE IsDPPBI (c: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN BITS(c) * {9,11..15,31} = {9,12..15}
+	END IsDPPBI;
+
+		(* A7.7.75: MOV (immediate), encoding T3 *)
+		PROCEDURE IsMOVPBI (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {4..9,11..15,31} = {6,9,12..15}
+		END IsMOVPBI;
+
+		(* A7.7.75: MOVT, encoding T1 *)
+		PROCEDURE IsMOVT (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {4..9,11..15,31} = {6,7,9,12..15}
+		END IsMOVT;
+
+		(* A7.7.3: ADD (immediate), encoding T4 *)
+		PROCEDURE IsADDPBI (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {4..9,11..15,31} = {9,12..15}) & (BITS(c) * {0..3} # {0..3}) & (BITS(c) * {0..3} # {0,2,3})
+		END IsADDPBI;
+
+		(* A7.7.5: ADD (SP plus immediate), encoding T4 *)
+		PROCEDURE IsADDSPPBI (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {0..9,11..15,31} = {0,2,3,9,12..15}
+		END IsADDSPPBI;
+
+		(* A7.7.171: SUB (immediate), encoding T4 *)
+		PROCEDURE IsSUBPBI (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {4..9,11..15,31} = {5,7,9,12..15}) & (BITS(c) * {0..3} # {0..3}) & (BITS(c) * {0..3} # {0,2,3})
+		END IsSUBPBI;
+
+		(* A7.7.173: SUB (SP minus immediate), encoding T3 *)
+		PROCEDURE IsSUBSPPBI (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {0..9,11..15,31} = {0,2,3,5,7,9,12..15}
+		END IsSUBSPPBI;
+
+	(* A5.3 *)
+	PROCEDURE IsBAMC (c: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN BITS(c) * {11..15,31} = {12..15,31}
+	END IsBAMC;
+
+		(* A7.7.12, encoding T3 *)
+		PROCEDURE IsBC (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {11..15,28,30,31} = {12..15,31}
+		END IsBC;
+
+		(* A7.7.12, encoding T4 *)
+		PROCEDURE IsB (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {11..15,28,30,31} = {12..15,28,31}
+		END IsB;
+
+		(* A7.7.18: BL, encoding T1 *)
+		PROCEDURE IsBL (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {11..15,28,30,31} = {12..15,28,30,31}
+		END IsBL;
+
+	(* A5.3 *)
+	PROCEDURE IsSSDI (c: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN BITS(c) * {4,8..15} = {11..15}
+	END IsSSDI;
+
+		(* A7.7.158: STR (immediate), encoding T3 *)
+		PROCEDURE IsSWImW (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {4..15} = {6,7,11..15}) & (BITS(c) * {0..3} # {0..3})
+		END IsSWImW;
+
+		(* A7.7.159: STR (register), encoding T2 *)
+		PROCEDURE IsSWRW (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {4..15,22..27} = {6,11..15}) & (BITS(c) * {0..3} # {0..3})
+		END IsSWRW;
+
+		(* A7.7.160: STRB (immediate), encoding T2 *)
+		PROCEDURE IsSBImW (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {4..15} = {7,11..15}) & (BITS(c) * {0..3} # {0..3})
+		END IsSBImW;
+
+		(* A7.7.161: STRB (register), encoding T2 *)
+		PROCEDURE IsSBRW (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {4..15,22..27} = {11..15}) & (BITS(c) * {0..3} # {0..3})
+		END IsSBRW;
+
+	(* A5.3 *)
+	PROCEDURE IsLBMH (c: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN BITS(c) * {4..6,9..15} = {4,11..15}
+	END IsLBMH;
+
+		(* A7.7.45: LDRB (immediate), encoding T2 *)
+		PROCEDURE IsLBImW (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {4..15} = {4,7,11..15}) & (BITS(c) * {28..31} # {28..31}) & (BITS(c) * {0..3} # {0..3})
+		END IsLBImW;
+
+		(* A7.7.47: LDRB (register), encoding T2 *)
+		PROCEDURE IsLBRW (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {4..15,22..27} = {4,11..15}) & (BITS(c) * {28..31} # {28..31}) & (BITS(c) * {0..3} # {0..3})
+		END IsLBRW;
+
+	(* A5.3 *)
+	PROCEDURE IsLW (c: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN BITS(c) * {4..6,9..15} = {4,6,11..15}
+	END IsLW;
+
+		(* A7.7.42: LDR (immediate), encoding T3 *)
+		PROCEDURE IsLWImW (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {4..15} = {4,6,7,11..15}) & (BITS(c) * {0..3} # {0..3})
+		END IsLWImW;
+
+		(* A7.7.42: LDR (immediate), encoding T4, P = 1, U = 0, W = 0 *)
+		PROCEDURE IsLWImWNeg (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {4..15,24..27} = {4,6,11..15,26,27}) & (BITS(c) * {0..3} # {0..3})
+		END IsLWImWNeg;
+
+		(* A7.7.43: LDR (literal); encoding T2 *)
+		PROCEDURE IsLWLt (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {0..6,8..15} = {0..4,6,11..15}
+		END IsLWLt;
+
+		(* A7.7.44: LDR (register); encoding T2 *)
+		PROCEDURE IsLWRW (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {4..15,22..27} = {4,6,11..15}) & (BITS(c) * {0..3} # {0..3})
+		END IsLWRW;
+
+	(* A5.3 *)
+	PROCEDURE IsDPR (c: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN BITS(c) * {8..15} = {9,11..15}
+	END IsDPR;
+
+		(* A7.7.68: LSL (register); encoding T2 *)
+		PROCEDURE IsLSLR (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {5..15,20..23,28..31} = {9,11..15,28..31}
+		END IsLSLR;
+
+		(* A7.7.11: ASR (register); encoding T2 *)
+		PROCEDURE IsASRR (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {5..15,20..23,28..31} = {6,9,11..15,28..31}
+		END IsASRR;
+
+		(* A7.7.115: ROR (register); encoding T2 *)
+		PROCEDURE IsRORR (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {5..15,20..23,28..31} = {5,6,9,11..15,28..31}
+		END IsRORR;
+
+	(* A5.3 *)
+	PROCEDURE IsMMAAAD (c: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN BITS(c) * {7..15} = {8,9,11..15}
+	END IsMMAAAD;
+
+		(* A7.7.73: MLA; encoding T1 *)
+		PROCEDURE IsMLA (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN (BITS(c) * {4..15,20..23} = {8,9,11..15}) & (BITS(c) * {28..31} # {28..31})
+		END IsMLA;
+
+		(* A7.7.74: MLS; encoding T1 *)
+		PROCEDURE IsMLS (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {4..15,20..23} = {8,9,11..15,20}
+		END IsMLS;
+
+		(* A7.7.83: MUL; encoding T2 *)
+		PROCEDURE IsMUL (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {4..15,20..23,28..31} = {8,9,11..15,28..31}
+		END IsMUL;
+
+	(* A5.3 *)
+	PROCEDURE IsLMLMAAD (c: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN BITS(c) * {7..15} = {7..9,11..15}
+	END IsLMLMAAD;
+
+		(* A7.7.125: SDIV; encoding T1 *)
+		PROCEDURE IsSDIV (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {4..15,20..23,28..31} = {4,7..9,11..15,20..23,28..31}
+		END IsSDIV;
+
+	(* A6.4: Floating-point data-processing instructions *)
+	PROCEDURE IsFPDP (c: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN BITS(c) * {8..11,13..15,20,25..27} = {9..11,13..15,25,27}
+	END IsFPDP;
+
+		(* A7.7.227: VFMA: encoding T1 *)
+		PROCEDURE IsVFMA (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {4,5,7..15,20,22,24..27}  = {5,7,9..11,13..15,25,27}
+		END IsVFMA;
+
+		(* A7.7.227: VFMS: encoding T1 *)
+		PROCEDURE IsVFMS (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {4,5,7..15,20,22,24..27}  = {5,7,9..11,13..15,22,25,27}
+		END IsVFMS;
+
+		(* A7.7.228: VFNMA: encoding T1 *)
+		PROCEDURE IsVFNMA (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {4,5,7..15,20,22,24..27}  = {4,7,9..11,13..15,25,27}
+		END IsVFNMA;
+
+		(* A7.7.228: VFNMS: encoding T1 *)
+		PROCEDURE IsVFNMS (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {4,5,7..15,20,22,24..27}  = {4,7,9..11,13..15,22,25,27}
+		END IsVFNMS;
+
+		(* A7.7.241: VMUL; encoding T1 *)
+		PROCEDURE IsVMUL (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {4,5,7..15,20,22,24..27} = {5,9..11,13..15,25,27}
+		END IsVMUL;
+
+		(* A7.7.243: VNMUL; encoding T2 *)
+		PROCEDURE IsVNMUL (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {4,5,7..15,20,22,24..27} = {5,9..11,13..15,22,25,27}
+		END IsVNMUL;
+
+		(* A7.7.221: VADD; encoding T1 *)
+		PROCEDURE IsVADD (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {4,5,7..15,20,22,24..27} = {4,5,9..11,13..15,25,27}
+		END IsVADD;
+
+		(* A7.7.249: VSUB; encoding T1 *)
+		PROCEDURE IsVSUB (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {4,5,7..15,20,22,24..27} = {4,5,9..11,13..15,22,25,27}
+		END IsVSUB;
+
+		(* A7.7.226: VDIV; encoding T1 *)
+		PROCEDURE IsVDIV (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {4,5,7..15,20,22,24..27} = {7,9..11,13..15,25,27}
+		END IsVDIV;
+
+		(* A7.7.220: VABS; encoding T1 *)
+		PROCEDURE IsVABS (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {0..5,7..15,20,22..27} = {4,5,7,9..11,13..15,22,23,25,27}
+		END IsVABS;
+
+		(* A7.7.242: VNEG; encoding T1 *)
+		PROCEDURE IsVNEG (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {0..5,7..15,20,22..27} = {0,4,5,7,9..11,13..15,22,25,27}
+		END IsVNEG;
+
+		(* A7.7.246: VSQRT; encoding T1 *)
+		PROCEDURE IsVSQRT (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {0..5,7..15,20,22..27} = {0,4,5,7,9..11,13..15,22,23,25,27}
+		END IsVSQRT;
+
+		(* A7.7.222: VCMP{E}; encoding T1 *)
+		PROCEDURE IsVCMPER (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {0..5,7..15,20,22,24..27} = {2,4,5,7,9..11,13..15,22,25,27}
+		END IsVCMPER;
+
+		(* A7.7.222: VCMP{E}; encoding T2 *)
+		PROCEDURE IsVCMPE0 (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {0..5,7..15,16..22,24..27} = {0,2,4,5,7,9..11,13..15,22,25,27}
+		END IsVCMPE0;
+
+		(* A7.7.223: VCVT, VCVTR (between floating-point and integer); encoding T1 *)
+		PROCEDURE IsVCVTRInt (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {1,3..5,7..15,20,22,24..27} = {3..5,7,9..11,13..15,22,25,27}
+		END IsVCVTRInt;
+
+	(* A6.5: (Floating-point) Extension register load or store instructions *)
+	PROCEDURE IsFPERLOS (c: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN BITS(c) * {9..11,13..15,25..27} = {10,11,13..15,25,27}
+	END IsFPERLOS;
+
+		(* A7.7.248: VSTR; encoding T2 *)
+		PROCEDURE IsVSTR (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {4,5,8..15,24..27} = {8,10,11,13..15,25,27}
+		END IsVSTR;
+
+		(* A7.7.230: VLDR; encoding T2 *)
+		PROCEDURE IsVLDR (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {4,5,8..15,24..27} = {4,8,10,11,13..15,25,27}
+		END IsVLDR;
+
+	(* A6.6: (Floating-point) 32-bit transfer between ARM core and extension registers *)
+	PROCEDURE IsFP32TBACAER (c: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN BITS(c) * {8..11,13..15,20,25..27} = {9..11,13..15,20,25,27}
+	END IsFP32TBACAER;
+
+		(* A7.7.236: VMOV (between ARM core register and single-precision register); encoding T1 *)
+		PROCEDURE IsVMOVSPR (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {5..22,24..27} = {9..11,13..15,20,25,27}
+		END IsVMOVSPR;
+
+		(* A7.7.239: VMRS; encoding T1 *)
+		PROCEDURE IsVMRS (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {0..27} = {0,4..7,9..11,13..15,20,25,27}
+		END IsVMRS;
+
+		(* A7.7.240: VMSR; encoding T1 *)
+		PROCEDURE IsVMSR (c: INTEGER): BOOLEAN;
+		BEGIN
+			RETURN BITS(c) * {0..27} = {0,5..7,9..11,13..15,20,25,27}
+		END IsVMSR;
+
+	PROCEDURE IsWFIW (c: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN c = 8003F3AFH
+	END IsWFIW;
+
+	PROCEDURE EmitWFIW* (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER);
+	BEGIN
+		Emit2(code, pc, -2147224657 (*8003F3AFH*))
+	END EmitWFIW;
+
+	(* A7.7.12, encoding T3 *)
+	PROCEDURE DecodeBC (c: INTEGER; (*OUT*)VAR cond, label: INTEGER);
+		VAR S, imm6, J1, J2, imm11: INTEGER;
+	BEGIN
+		ASSERT(IsBC(c), 20);
+		imm11 := c DIV 10000H MOD 800H;
+		J2 := c DIV 8000000H MOD 2;
+		J1 := c DIV 20000000H MOD 2;
+		imm6 := c MOD 40H;
+		cond := c DIV 40H MOD 10H;
+		S := c DIV 400H MOD 2;
+		label := DecodeBLabel20(S, imm6, J1, J2, imm11)
+	END DecodeBC;
+
+	(* A7.7.12, encoding T4 *)
+	PROCEDURE DecodeB (c: INTEGER): INTEGER;
+		VAR S, imm10, J1, J2, imm11: INTEGER;
+	BEGIN
+		ASSERT(IsB(c), 20);
+		imm11 := c DIV 10000H MOD 800H;
+		J2 := c DIV 8000000H MOD 2;
+		J1 := c DIV 20000000H MOD 2;
+		imm10 := c MOD 400H;
+		S := c DIV 400H MOD 2;
+		RETURN ARMv6M.DecodeBLabel24(S, imm10, J1, J2, imm11)
+	END DecodeB;
+
+	PROCEDURE OpcodeRepr2 (c: INTEGER; (*OUT*)VAR s: ARRAY OF CHAR);
+		VAR w: INTEGER;
+
+		PROCEDURE WStr ((*OUT*)VAR s: ARRAY OF CHAR; VAR w: INTEGER; (*IN*) s0: ARRAY OF CHAR);
+			VAR i: INTEGER;
+		BEGIN
+			i := 0;
+			WHILE (i < LEN(s0(*$*))) & (s0[i] # 0X) DO
+				s[w] := s0[i]; INC(w);
+				INC(i)
+			END
+		END WStr;
+
+		PROCEDURE WReg ((*OUT*)VAR s: ARRAY OF CHAR; VAR w: INTEGER; r: INTEGER);
+			VAR s0: ARRAY 4 OF CHAR;
+		BEGIN
+			ARMv6M.RegRepr(r, s0);
+			WStr(s, w, s0)
+		END WReg;
+
+		PROCEDURE WInt ((*OUT*)VAR s: ARRAY OF CHAR; VAR w: INTEGER; x: INTEGER);
+			VAR s0: ARRAY 12 OF CHAR;
+		BEGIN
+			Strings.IntToStr(x, s0);
+			WStr(s, w, s0)
+		END WInt;
+
+		PROCEDURE WHex32 ((*OUT*)VAR s: ARRAY OF CHAR; VAR w: INTEGER; x: INTEGER);
+			VAR i, a: INTEGER;
+		BEGIN i := 8;
+			REPEAT
+				a := x DIV 10000000H MOD 10H; x := x * 10H;
+				IF a < 10 THEN s[w] := CHR(ORD('0') + a)
+				ELSE s[w] := CHR(ORD('A') - 10 + a)
+				END; INC(w);
+				DEC(i)
+			UNTIL i = 0
+		END WHex32;
+
+		PROCEDURE WHex16L ((*OUT*)VAR s: ARRAY OF CHAR; VAR w: INTEGER; x: INTEGER);
+			VAR i, a: INTEGER;
+		BEGIN i := 4;
+			REPEAT
+				a := x DIV 1000H MOD 10H; x := x * 10H;
+				IF a < 10 THEN s[w] := CHR(ORD('0') + a)
+				ELSE s[w] := CHR(ORD('A') - 10 + a)
+				END; INC(w);
+				DEC(i)
+			UNTIL i = 0
+		END WHex16L;
+
+		PROCEDURE WHex12L ((*OUT*)VAR s: ARRAY OF CHAR; VAR w: INTEGER; x: INTEGER);
+			VAR i, a: INTEGER;
+		BEGIN i := 3;
+			REPEAT
+				a := x DIV 100H MOD 10H; x := x * 10H;
+				IF a < 10 THEN s[w] := CHR(ORD('0') + a)
+				ELSE s[w] := CHR(ORD('A') - 10 + a)
+				END; INC(w);
+				DEC(i)
+			UNTIL i = 0
+		END WHex12L;
+
+		PROCEDURE LMASM;
+
+			PROCEDURE Op0 ((*IN*) op: ARRAY OF CHAR; unpr: BOOLEAN);
+				VAR i, j: INTEGER;
+			BEGIN
+				WStr(s, w, op); WStr(s, w, ".W {");
+				i := 0; j := 0;
+				WHILE i < 16 DO
+					IF (16 + i) IN BITS(c) THEN
+						IF j # 0 THEN WStr(s, w, ", ") END;
+						WReg(s, w, i);
+						INC(j)
+					END;
+					INC(i)
+				END;
+				s[w] := '}'; INC(w);
+				IF (j < 2) OR unpr THEN
+					WStr(s, w, " (UNPREDICTABLE)")
+				END
+			END Op0;
+
+		BEGIN
+			IF IsPUSHMany(c) THEN
+				Op0("PUSH", FALSE)
+			ELSIF IsPOPMany(c) THEN
+				Op0("POP", c DIV 40000000H = -1)
+			END
+		END LMASM;
+
+		PROCEDURE PUSHPOPOne;
+			VAR Rt: INTEGER;
+
+			PROCEDURE Op1 ((*IN*) op: ARRAY OF CHAR; unpr: BOOLEAN);
+			BEGIN
+				WStr(s, w, op); WStr(s, w, ".W {"); WReg(s, w, Rt);
+				s[w] := '}'; INC(w);
+				IF unpr THEN
+					WStr(s, w, " (UNPREDICTABLE)")
+				END
+			END Op1;
+
+		BEGIN
+			IF IsPUSHOne(c) THEN (* SSDI *)
+				Rt := c DIV 10000000H MOD 10H;
+				Op1("PUSH", Rt IN {SP,PC})
+			ELSIF IsPOPOne(c) THEN (* LW *)
+				Rt := c DIV 10000000H MOD 10H;
+				Op1("POP", Rt = SP)
+			END
+		END PUSHPOPOne;
+
+		PROCEDURE DPSR;
+			VAR S, Rd, Rn, Rm, shift: INTEGER;
+
+			PROCEDURE WDPSR0 ((*IN*) op: ARRAY OF CHAR; W: BOOLEAN; shift: INTEGER; unpr: BOOLEAN);
+			BEGIN
+				ASSERT(S IN {0,1}, 20);
+				WStr(s, w, op);
+				IF S = 1 THEN s[w] := 'S'; INC(w) END;
+				IF W THEN WStr(s, w, ".W") END;
+				s[w] := ' '; INC(w);
+				WReg(s, w, Rd); WStr(s, w, ", "); WReg(s, w, Rm);
+				IF shift # 0 THEN
+					WStr(s, w, ", #");
+					WInt(s, w, shift)
+				END;
+				IF unpr THEN WStr(s, w, " (UNPREDICTABLE)") END
+			END WDPSR0;
+
+			PROCEDURE WDPSR1 ((*IN*) op: ARRAY OF CHAR; W: BOOLEAN; shift: INTEGER; unpr: BOOLEAN);
+			BEGIN
+				ASSERT(S IN {0,1}, 20);
+				WStr(s, w, op);
+				IF S = 1 THEN s[w] := 'S'; INC(w) END;
+				IF W THEN WStr(s, w, ".W") END;
+				s[w] := ' '; INC(w);
+				WReg(s, w, Rd); WStr(s, w, ", ");
+				WReg(s, w, Rn); WStr(s, w, ", "); WReg(s, w, Rm);
+				IF shift # 0 THEN
+					WStr(s, w, ", #");
+					WInt(s, w, shift)
+				END;
+				IF unpr THEN WStr(s, w, " (UNPREDICTABLE)") END
+			END WDPSR1;
+
+		BEGIN
+			S := c DIV 10H MOD 2;
+			Rd := c DIV 1000000H MOD 10H;
+			Rn := c MOD 10H;
+			Rm := c DIV 10000H MOD 10H;
+			IF IsMVNR(c) THEN
+				(* TODO: DecodeImmShift *)
+				IF (c DIV 100000H MOD 10H = 0) & (c DIV 10000000H MOD 8 = 0) THEN
+					WDPSR0("MVN", TRUE, 0, (Rd IN {SP,PC}) OR (Rm IN {SP,PC}))
+				END
+			ELSIF IsMOVR(c) THEN
+				WDPSR0("MOV", TRUE, 0, ((S = 1) & ((Rd IN {SP,PC}) OR (Rm IN {SP,PC}))) OR ((S = 0) & ((Rd = PC) OR (Rm = PC) OR (Rd = SP) & (Rm = SP))))
+			ELSIF IsANDR(c) THEN ASSERT(~((Rd = PC) & (S = 1)), 100);
+				(* TODO: DecodeImmShift *)
+				IF (c DIV 100000H MOD 10H = 0) & (c DIV 10000000H MOD 8 = 0) THEN
+					WDPSR1("AND", TRUE, 0, (Rd = SP) OR (Rd = PC) & (S = 0) OR (Rn IN {SP,PC}) OR (Rm IN {SP,PC}))
+				END
+			ELSIF IsBICR(c) THEN
+				(* TODO: DecodeImmShift *)
+				IF (c DIV 100000H MOD 10H = 0) & (c DIV 10000000H MOD 8 = 0) THEN
+					WDPSR1("BIC", TRUE, 0, (Rd IN {SP,PC}) OR (Rn IN {SP,PC}) OR (Rm IN {SP,PC}))
+				END
+			ELSIF IsORRR(c) THEN ASSERT(Rn # PC, 101);
+				(* TODO: DecodeImmShift *)
+				IF (c DIV 100000H MOD 10H = 0) & (c DIV 10000000H MOD 8 = 0) THEN
+					WDPSR1("ORR", TRUE, 0, (Rd IN {SP,PC}) OR (Rn = SP) OR (Rm IN {SP,PC}))
+				END
+			ELSIF IsEORR(c) THEN ASSERT(~((Rd = PC) & (S = 1)), 102);
+				(* TODO: DecodeImmShift *)
+				IF (c DIV 100000H MOD 10H = 0) & (c DIV 10000000H MOD 8 = 0) THEN
+					WDPSR1("EOR", TRUE, 0, (Rd = SP) OR (Rd = PC) & (S = 0) OR (Rn IN {SP,PC}) OR (Rm IN {SP,PC}))
+				END
+			ELSIF IsADDR(c) THEN
+				ASSERT(~((Rd = PC) & (S = 1)), 103); ASSERT(Rn # SP, 104);
+				(* TODO: DecodeImmShift *)
+				IF (c DIV 100000H MOD 10H = 0) & (c DIV 10000000H MOD 8 = 0) THEN
+					WDPSR1("ADD", TRUE, 0, (Rd = SP) OR (Rd = PC) & (S = 0) OR (Rn = PC) OR (Rm IN {SP,PC}))
+				END
+			ELSIF IsADDSPR(c) THEN
+				(* TODO: DecodeImmShift *)
+				IF (c DIV 100000H MOD 10H = 0) & (c DIV 10000000H MOD 8 = 0) THEN
+					WDPSR1("ADD", TRUE, 0, (Rd = PC) OR (Rm IN {SP,PC})) (* TODO: unpr depend on shift *)
+				END
+			ELSIF IsADCR(c) THEN
+				(* TODO: DecodeImmShift *)
+				IF (c DIV 100000H MOD 10H = 0) & (c DIV 10000000H MOD 8 = 0) THEN
+					WDPSR1("ADC", TRUE, 0, (Rd IN {SP,PC}) OR (Rn IN {SP,PC}) OR (Rm IN {SP,PC}))
+				END
+			ELSIF IsSUBR(c) THEN
+				ASSERT(~((Rd = PC) & (S = 1)), 105); ASSERT(Rn # SP, 106);
+				(* TODO: DecodeImmShift *)
+				IF (c DIV 100000H MOD 10H = 0) & (c DIV 10000000H MOD 8 = 0) THEN
+					WDPSR1("SUB", TRUE, 0, (Rd = SP) OR (Rd = PC) & (S = 0) OR (Rn = PC) OR (Rm IN {SP,PC}))
+				END
+			ELSIF IsSUBSPR(c) THEN
+				(* TODO: DecodeImmShift *)
+				IF (c DIV 100000H MOD 10H = 0) & (c DIV 10000000H MOD 8 = 0) THEN
+					WDPSR1("SUB", FALSE, 0, (Rd = PC) OR (Rm IN {SP,PC})) (* TODO: unpr depend on shift *)
+				END
+			ELSIF IsSBCR(c) THEN
+				(* TODO: DecodeImmShift *)
+				IF (c DIV 100000H MOD 10H = 0) & (c DIV 10000000H MOD 8 = 0) THEN
+					WDPSR1("SBC", TRUE, 0, (Rd IN {SP,PC}) OR (Rn IN {SP,PC}) OR (Rm IN {SP,PC}))
+				END
+			ELSIF IsLSLIm(c) THEN
+				shift := c DIV 10000000H MOD 8 * 4 + c DIV 400000H MOD 4;
+				ASSERT(shift # 0, 107);
+				WDPSR0("LSL", TRUE, shift, (Rd IN {SP,PC}) OR (Rm IN {SP,PC}))
+			ELSIF IsASRIm(c) THEN
+				shift := c DIV 10000000H MOD 8 * 4 + c DIV 400000H MOD 4;
+				WDPSR0("ASR", TRUE, shift, (Rd IN {SP,PC}) OR (Rm IN {SP,PC}))
+			ELSIF IsRORIm(c) THEN
+				shift := c DIV 10000000H MOD 8 * 4 + c DIV 400000H MOD 4;
+				ASSERT(shift # 0, 108);
+				WDPSR0("ROR", FALSE, shift, (Rd IN {SP,PC}) OR (Rm IN {SP,PC}))
+			END
+		END DPSR;
+
+		PROCEDURE DPMI;
+			VAR i, imm3, imm8, im, S, Rn, Rd: INTEGER;
+				ok: BOOLEAN;
+
+			PROCEDURE WOp0 ((*IN*) op: ARRAY OF CHAR; unpr: BOOLEAN);
+			BEGIN
+				WStr(s, w, op);
+				s[w] := ' '; INC(w);
+				WReg(s, w, Rn); WStr(s, w, ", #");
+				IF ok THEN
+					IF (im >= -1) & (im <= 255) THEN
+						WInt(s, w, im)
+					ELSE
+						WStr(s, w, "0x"); WHex32(s, w, im)
+					END
+				ELSE WStr(s, w, "(UNPREDICTABLE)")
+				END;
+				IF unpr THEN
+					WStr(s, w, " (UNPREDICTABLE)")
+				END
+			END WOp0;
+
+			PROCEDURE WOp1 ((*IN*) op: ARRAY OF CHAR; W: BOOLEAN; unpr: BOOLEAN);
+			BEGIN
+				WStr(s, w, op);
+				IF S = 1 THEN s[w] := 'S'; INC(w) END;
+				IF W THEN WStr(s, w, ".W") END;
+				s[w] := ' '; INC(w);
+				WReg(s, w, Rd); WStr(s, w, ", #");
+				IF ok THEN
+					IF (im >= -1) & (im <= 255) THEN
+						WInt(s, w, im)
+					ELSE
+						WStr(s, w, "0x"); WHex32(s, w, im)
+					END
+				ELSE WStr(s, w, "(UNPREDICTABLE)")
+				END;
+				IF unpr THEN
+					WStr(s, w, " (UNPREDICTABLE)")
+				END
+			END WOp1;
+
+			PROCEDURE WOp2 ((*IN*) op: ARRAY OF CHAR; W: BOOLEAN; unpr: BOOLEAN);
+			BEGIN
+				WStr(s, w, op);
+				IF S = 1 THEN s[w] := 'S'; INC(w) END;
+				IF W THEN WStr(s, w, ".W") END;
+				s[w] := ' '; INC(w);
+				WReg(s, w, Rd); WStr(s, w, ", ");
+				WReg(s, w, Rn); WStr(s, w, ", #");
+				IF ok THEN
+					IF (im >= -1) & (im <= 255) THEN
+						WInt(s, w, im)
+					ELSE
+						WStr(s, w, "0x"); WHex32(s, w, im)
+					END
+				ELSE WStr(s, w, "(UNPREDICTABLE)")
+				END;
+				IF unpr THEN
+					WStr(s, w, " (UNPREDICTABLE)")
+				END
+			END WOp2;
+
+		BEGIN
+			i := c DIV 400H MOD 2;
+			S := c DIV 10H MOD 2;
+			Rn := c MOD 10H;
+			imm3 := c DIV 10000000H MOD 8;
+			Rd := c DIV 1000000H MOD 10H;
+			imm8 := c DIV 10000H MOD 100H;
+			DecodeMI12(i, imm3, imm8, im, ok);
+			IF IsTSTIm(c) THEN
+				WOp0("TST", Rn IN {SP,PC})
+			ELSIF IsCMPImW(c) THEN
+				WOp0("CMP.W", Rn = PC)
+			ELSIF IsMOVMI(c) THEN
+				WOp1("MOV", TRUE, Rd IN {SP,PC})
+			ELSIF IsMVNIm(c) THEN
+				WOp1("MVN", FALSE, Rd IN {SP,PC})
+			ELSIF IsANDIm(c) THEN
+				ASSERT(~((Rd = PC) & (S = 1)), 100);
+				WOp2("AND", FALSE, (Rd = SP) OR (Rd = PC) & (S = 0) OR (Rn IN {SP,PC}))
+			ELSIF IsORRIm(c) THEN
+				ASSERT(Rn # PC, 101);
+				WOp2("ORR", FALSE, (Rd IN {SP,PC}) OR (Rn = SP))
+			ELSIF IsORNIm(c) THEN
+				ASSERT(Rn # PC, 102);
+				WOp2("ORN", FALSE, (Rd IN {SP,PC}) OR (Rn = SP))
+			ELSIF IsBICIm(c) THEN
+				WOp2("BIC", FALSE, (Rd IN {SP,PC}) OR (Rn IN {SP,PC}))
+			ELSIF IsEORIm(c) THEN
+				ASSERT(~((Rd = PC) & (S = 1)), 103);
+				WOp2("EOR", FALSE, (Rd = SP) OR (Rd = PC) & (S = 0) OR (Rn IN {SP,PC}))
+			ELSIF IsADDMI(c) THEN
+				ASSERT(~((Rd = PC) & (S = 1)), 104);
+				ASSERT(Rn # SP, 105);
+				WOp2("ADD", TRUE, (Rd = SP) OR (Rd = PC) & (S = 0) OR (Rn = PC))
+			ELSIF IsADDSPMI(c) THEN
+				ASSERT(~((Rd = PC) & (S = 1)), 106);
+				WOp2("ADD", TRUE, (Rd = PC) & (S = 0))
+			ELSIF IsSUBMI(c) THEN
+				ASSERT(~((Rd = PC) & (S = 1)), 107);
+				ASSERT(Rn # SP, 108);
+				WOp2("SUB", TRUE, (Rd = SP) OR (Rd = PC) & (S = 0) OR (Rn = PC))
+			ELSIF IsSUBSPMI(c) THEN
+				ASSERT(~((Rd = PC) & (S = 1)), 109);
+				WOp2("SUB", TRUE, (Rd = PC) & (S = 0))
+			ELSIF IsRSBImW(c) THEN
+				WOp2("RSB", TRUE, (Rd IN {SP,PC}) OR (Rn IN {SP,PC}))
+			END
+		END DPMI;
+
+		PROCEDURE DPPBI;
+			VAR Rd, Rn: INTEGER;
+
+			PROCEDURE OpMovx ((*IN*) op: ARRAY OF CHAR);
+				VAR im: INTEGER;
+			BEGIN
+				im := c MOD 10H * 1000H + c DIV 400H MOD 2 * 800H + c DIV 10000000H MOD 8 * 100H + c DIV 10000H MOD 100H;
+				WStr(s, w, op); s[w] := ' '; INC(w);
+				WReg(s, w, Rd);
+				WStr(s, w, ", #"); WInt(s, w, im);
+				WStr(s, w, " ; 0x"); WHex16L(s, w, im);
+				IF Rd IN {SP,PC} THEN
+					WStr(s, w, " (UNPREDICTABLE)")
+				END
+			END OpMovx;
+
+			PROCEDURE Op0 ((*IN*) op: ARRAY OF CHAR; unpr: BOOLEAN);
+				VAR im: INTEGER;
+			BEGIN
+				im := c DIV 400H MOD 2 * 800H + c DIV 10000000H MOD 8 * 100H + c DIV 10000H MOD 100H;
+				WStr(s, w, op); s[w] := ' '; INC(w);
+				WReg(s, w, Rd); WStr(s, w, ", ");
+				WReg(s, w, Rn); WStr(s, w, ", #");
+				WInt(s, w, im);
+				WStr(s, w, " ; 0x"); WHex12L(s, w, im);
+				IF unpr THEN
+					WStr(s, w, " (UNPREDICTABLE)")
+				END
+			END Op0;
+
+		BEGIN
+			Rd := c DIV 1000000H MOD 10H;
+			Rn := c MOD 10H;
+			IF IsMOVPBI(c) THEN
+				OpMovx("MOVW")
+			ELSIF IsMOVT(c) THEN
+				OpMovx("MOVT")
+			ELSIF IsADDPBI(c) THEN
+				ASSERT(~(Rn IN {SP,PC}), 100);
+				Op0("ADDW", Rd IN {SP,PC})
+			ELSIF IsADDSPPBI(c) THEN
+				Op0("ADDW", Rd = PC)
+			ELSIF IsSUBPBI(c) THEN
+				ASSERT(~(Rn IN {SP,PC}), 101);
+				Op0("SUBW", Rd IN {SP,PC})
+			ELSIF IsSUBSPPBI(c) THEN
+				Op0("SUBW", Rd = PC)
+			END
+		END DPPBI;
+
+		PROCEDURE B (L: BOOLEAN);
+			VAR label: INTEGER;
+		BEGIN
+			IF L THEN label := ARMv6M.DecodeBL(c)
+			ELSE label := DecodeB(c)
+			END;
+			ASSERT(label MOD 2 = 0, 100);
+			IF L THEN
+				WStr(s, w, "BL ")
+			ELSE
+				WStr(s, w, "B.W ")
+			END;
+			WInt(s, w, label);
+			IF label # 0 THEN
+				WStr(s, w, " ; "); WInt(s, w, label DIV 2)
+			END
+		END B;
+
+		PROCEDURE BC;
+			VAR cond, label: INTEGER;
+				s0: ARRAY 3 OF CHAR;
+		BEGIN
+			DecodeBC(c, cond, label);
+			ASSERT(label MOD 2 = 0, 100);
+			ARMv6M.CondRepr(cond, s0);
+			s[w] := 'B'; INC(w);
+			WStr(s, w, s0); WStr(s, w, ".W "); WInt(s, w, label);
+			IF label # 0 THEN
+				WStr(s, w, " ; "); WInt(s, w, label DIV 2)
+			END
+		END BC;
+
+		PROCEDURE LSWBImW (S, B: BOOLEAN);
+			VAR imm12: INTEGER;
+				Rt: INTEGER;
+		BEGIN
+			IF S THEN
+				WStr(s, w, "STR")
+			ELSE
+				WStr(s, w, "LDR")
+			END;
+			IF B THEN s[w] := 'B'; INC(w) END;
+			WStr(s, w, ".W ");
+			Rt := c DIV 10000000H MOD 10H;
+			WReg(s, w, Rt);
+			WStr(s, w, ", [");
+			WReg(s, w, c MOD 10H);
+			imm12 := c DIV 10000H MOD 1000H;
+			IF imm12 # 0 THEN
+				WStr(s, w, ", #");
+				WInt(s, w, imm12)
+			END;
+			s[w] := ']'; INC(w);
+			IF (~S & ~B & (Rt = PC))
+			OR (~S & B & (Rt = SP))
+			OR (S & ~B & (Rt = PC))
+			OR (S & B & (Rt IN {SP,PC})) THEN
+				WStr(s, w, " (UNPREDICTABLE)")
+			END
+		END LSWBImW;
+
+		PROCEDURE LSWBImWNeg (S, B: BOOLEAN);
+			VAR imm8: INTEGER;
+				Rt: INTEGER;
+		BEGIN
+			IF S THEN
+				WStr(s, w, "STR")
+			ELSE
+				WStr(s, w, "LDR")
+			END;
+			IF B THEN s[w] := 'B'; INC(w) END;
+			WStr(s, w, ".W ");
+			Rt := c DIV 10000000H MOD 10H;
+			WReg(s, w, Rt);
+			WStr(s, w, ", [");
+			WReg(s, w, c MOD 10H);
+			imm8 := c DIV 10000H MOD 100H;
+			IF imm8 # 0 THEN
+				WStr(s, w, ", #-");
+				WInt(s, w, imm8)
+			END;
+			s[w] := ']'; INC(w);
+(*
+			IF (~S & ~B & (Rt = PC))
+			OR (~S & B & (Rt = SP))
+			OR (S & ~B & (Rt = PC))
+			OR (S & B & (Rt IN {SP,PC})) THEN
+				WStr(s, w, " (UNPREDICTABLE)")
+			END
+*)
+		END LSWBImWNeg;
+
+		PROCEDURE LSWBRW (S, B: BOOLEAN);
+			VAR Rt, Rm, imm2: INTEGER;
+		BEGIN
+			IF S THEN
+				WStr(s, w, "STR")
+			ELSE
+				WStr(s, w, "LDR")
+			END;
+			IF B THEN s[w] := 'B'; INC(w) END;
+			WStr(s, w, ".W ");
+			Rt := c DIV 10000000H MOD 10H;
+			WReg(s, w, Rt);
+			WStr(s, w, ", [");
+			WReg(s, w, c MOD 10H);
+			imm2 := c DIV 100000H MOD 4;
+			Rm := c DIV 10000H MOD 10H;
+			WStr(s, w, ", "); WReg(s, w, Rm);
+			IF imm2 # 0 THEN
+				WStr(s, w, ", LSL #");
+				WInt(s, w, imm2)
+			END;
+			s[w] := ']'; INC(w);
+			IF (Rm IN {SP,PC})
+			OR (~S & ~B & (Rt = PC))
+			OR (~S & B & (Rt = SP))
+			OR (S & ~B & (Rt = PC))
+			OR (S & B & (Rt IN {SP,PC})) THEN
+				WStr(s, w, " (UNPREDICTABLE)")
+			END
+		END LSWBRW;
+
+		PROCEDURE LW;
+			VAR Rt, U, imm12, label: INTEGER;
+		BEGIN
+			IF IsLWImW(c) THEN
+				LSWBImW(FALSE, FALSE)
+			ELSIF IsLWImWNeg(c) THEN
+				LSWBImWNeg(FALSE, FALSE)
+			ELSIF IsLWRW(c) THEN
+				LSWBRW(FALSE, FALSE)
+			ELSIF IsLWLt(c) THEN
+				Rt := c DIV 10000000H MOD 10H;
+				U := c DIV 80H MOD 2;
+				imm12 := c DIV 10000H MOD 1000H;
+				IF U = 1 THEN label := imm12 ELSE label := -imm12 END;
+				WStr(s, w, "LDR.W "); WReg(s, w, Rt); WStr(s, w, ", ");
+				(* WInt(s, w, label); *)
+					WStr(s, w, "[PC, #"); WInt(s, w, label); s[w] := ']'; INC(w);
+				IF label MOD 4 = 0 THEN
+					WStr(s, w, " ; "); WInt(s, w, label DIV 4)
+				END
+			END
+		END LW;
+
+		PROCEDURE DPR;
+			VAR S, Rd, Rn, Rm: INTEGER;
+
+			PROCEDURE WDPRW ((*IN*) op: ARRAY OF CHAR; unpr: BOOLEAN);
+			BEGIN
+				WStr(s, w, op);
+				IF S = 1 THEN s[w] := 'S'; INC(w) END;
+				WStr(s, w, ".W ");
+				WReg(s, w, Rd); WStr(s, w, ", ");
+				WReg(s, w, Rn); WStr(s, w, ", ");
+				WReg(s, w, Rm);
+				IF unpr THEN WStr(s, w, " (UNPREDICTABLE)") END
+			END WDPRW;
+
+		BEGIN
+			S := c DIV 10H MOD 2;
+			Rd := c DIV 1000000H MOD 10H;
+			Rn := c MOD 10H;
+			Rm := c DIV 10000H MOD 10H;
+			IF IsLSLR(c) THEN
+				WDPRW("LSL", (Rd IN {SP,PC}) OR (Rn IN {SP,PC}) OR (Rm IN {SP,PC}))
+			ELSIF IsASRR(c) THEN
+				WDPRW("ASR", (Rd IN {SP,PC}) OR (Rn IN {SP,PC}) OR (Rm IN {SP,PC}))
+			ELSIF IsRORR(c) THEN
+				WDPRW("ROR", (Rd IN {SP,PC}) OR (Rn IN {SP,PC}) OR (Rm IN {SP,PC}))
+			END
+		END DPR;
+
+		PROCEDURE MMAAAD;
+			VAR Rd, Rn, Rm, Ra: INTEGER;
+		BEGIN
+			Rn := c MOD 10H;
+			Ra := c DIV 10000000H MOD 10H;
+			Rd := c DIV 1000000H MOD 10H;
+			Rm := c DIV 10000H MOD 10H;
+			IF IsMUL(c) THEN
+				WStr(s, w, "MUL "); WReg(s, w, Rd); WStr(s, w, ", ");
+				WReg(s, w, Rn); WStr(s, w, ", ");
+				WReg(s, w, Rm);
+				IF (Rd IN {SP,PC}) OR (Rn IN {SP,PC}) OR (Rm IN {SP,PC}) THEN
+					WStr(s, w, " (UNPREDICTABLE)")
+				END
+			ELSIF IsMLS(c) THEN
+				WStr(s, w, "MLS "); WReg(s, w, Rd); WStr(s, w, ", ");
+				WReg(s, w, Rn); WStr(s, w, ", ");
+				WReg(s, w, Rm); WStr(s, w, ", ");
+				WReg(s, w, Ra);
+				IF (Rd IN {SP,PC}) OR (Rn IN {SP,PC}) OR (Rm IN {SP,PC}) OR (Ra IN {SP,PC}) THEN
+					WStr(s, w, " (UNPREDICTABLE)")
+				END
+			ELSIF IsMLA(c) THEN
+				WStr(s, w, "MLA "); WReg(s, w, Rd); WStr(s, w, ", ");
+				WReg(s, w, Rn); WStr(s, w, ", ");
+				WReg(s, w, Rm); WStr(s, w, ", ");
+				WReg(s, w, Ra);
+				IF (Rd IN {SP,PC}) OR (Rn IN {SP,PC}) OR (Rm IN {SP,PC}) OR (Ra = SP) THEN
+					WStr(s, w, " (UNPREDICTABLE)")
+				END
+			END
+		END MMAAAD;
+
+		PROCEDURE LMLMAAD;
+			VAR Rd, Rn, Rm: INTEGER;
+		BEGIN
+			IF IsSDIV(c) THEN
+				Rn := c MOD 10H;
+				Rd := c DIV 1000000H MOD 10H;
+				Rm := c DIV 10000H MOD 10H;
+				WStr(s, w, "SDIV "); WReg(s, w, Rd); WStr(s, w, ", ");
+				WReg(s, w, Rn); WStr(s, w, ", ");
+				WReg(s, w, Rm);
+				IF (Rd IN {SP,PC}) OR (Rn IN {SP,PC}) OR (Rm IN {SP,PC}) THEN
+					WStr(s, w, " (UNPREDICTABLE)")
+				END
+			END
+		END LMLMAAD;
+
+		PROCEDURE FPDP;
+			VAR d, n, m: INTEGER;
+				T, sz: INTEGER;
+
+			PROCEDURE Op0 ((*IN*) op: ARRAY OF CHAR);
+			BEGIN
+				WStr(s, w, op); WStr(s, w, ".F32 S"); WInt(s, w, d);
+				WStr(s, w, ", S"); WInt(s, w, n); WStr(s, w, ", S");
+				WInt(s, w, m)
+			END Op0;
+
+			PROCEDURE Op1 ((*IN*) op: ARRAY OF CHAR);
+			BEGIN
+				WStr(s, w, op); WStr(s, w, ".F32 S"); WInt(s, w, d);
+				WStr(s, w, ", S"); WInt(s, w, m)
+			END Op1;
+
+		BEGIN
+			d := c DIV 10000000H MOD 10H * 2 + c DIV 40H MOD 2;
+			n := c MOD 10H * 2 + c DIV 800000H MOD 2;
+			m := c DIV 10000H MOD 10H * 2 + c DIV 200000H MOD 2;
+			IF IsVMUL(c) THEN
+				Op0("VMUL")
+			ELSIF IsVADD(c) THEN
+				Op0("VADD")
+			ELSIF IsVSUB(c) THEN
+				Op0("VSUB")
+			ELSIF IsVDIV(c) THEN
+				Op0("VDIV")
+			ELSIF IsVFMA(c) THEN
+				Op0("VFMA")
+			ELSIF IsVFMS(c) THEN
+				Op0("VFMS")
+			ELSIF IsVFNMA(c) THEN
+				Op0("VFNMA")
+			ELSIF IsVFNMS(c) THEN
+				Op0("VFNMS")
+			ELSIF IsVNMUL(c) THEN
+				Op0("VNMUL")
+			ELSIF IsVABS(c) THEN
+				Op1("VABS")
+			ELSIF IsVNEG(c) THEN
+				Op1("VNEG")
+			ELSIF IsVSQRT(c) THEN
+				Op1("VSQRT")
+			ELSIF IsVCMPER(c) THEN
+				WStr(s, w, "VCMP");
+				IF 23 IN BITS(c) THEN s[w] := 'E'; INC(w) END;
+				WStr(s, w, ".F32 S"); WInt(s, w, d);
+				WStr(s, w, ", S"); WInt(s, w, m)
+			ELSIF IsVCMPE0(c) THEN
+				WStr(s, w, "VCMP");
+				IF 23 IN BITS(c) THEN s[w] := 'E'; INC(w) END;
+				WStr(s, w, ".F32 S"); WInt(s, w, d); WStr(s, w, ", #0.0")
+			ELSIF IsVCVTRInt(c) THEN ASSERT(~ODD(c DIV 2), 100);
+				WStr(s, w, "VCVT");
+				IF ODD(c DIV 4) THEN (* to integer *)
+					IF ~(23 IN BITS(c)) THEN s[w] := 'R'; INC(w) END;
+					s[w] := '.'; INC(w);
+					IF ODD(c) THEN s[w] := 'S' ELSE s[w] := 'U' END;
+					INC(w); WStr(s, w, "32.F32 S")
+				ELSE
+					WStr(s, w, ".F32.");
+					IF 23 IN BITS(c) THEN s[w] := 'S' ELSE s[w] := 'U' END;
+					INC(w); WStr(s, w, "32 S")
+				END;
+				WInt(s, w, d); WStr(s, w, ", S"); WInt(s, w, m);
+				IF c MOD 8 = 1 THEN
+					WStr(s, w, " ; opc2 = 1")
+				END
+			ELSE
+				T := c DIV 1000H MOD 2;
+				sz := c DIV 1000000H MOD 2;
+				IF (T = 1) OR (sz = 1) THEN
+					WStr(s, w, "FP UNDEFINED")
+				END
+			END
+		END FPDP;
+
+		PROCEDURE FPERLOS;
+			VAR T: INTEGER;
+				Rn: INTEGER;
+
+			PROCEDURE Op0 ((*IN*) op: ARRAY OF CHAR);
+				VAR Sd, imm32: INTEGER;
+			BEGIN
+				Sd := c DIV 10000000H MOD 10H * 2 + c DIV 40H MOD 2;
+				imm32 := c DIV 10000H MOD 100H * 4;
+				WStr(s, w, op); WStr(s, w, " S"); WInt(s, w, Sd); WStr(s, w, ", [");
+				WReg(s, w, Rn); WStr(s, w, ", #");
+				IF 7 IN BITS(c) THEN s[w] := '+' ELSE s[w] := '-' END; INC(w);
+				WInt(s, w, imm32); s[w] := ']'; INC(w)
+			END Op0;
+
+		BEGIN
+			Rn := c MOD 10H;
+			IF IsVSTR(c) THEN
+				Op0("VSTR")
+			ELSIF IsVLDR(c) THEN
+				Op0("VLDR")
+			ELSE
+				T := c DIV 1000H MOD 2;
+				IF T = 1 THEN
+					WStr(s, w, "FP UNDEFINED")
+				END
+			END
+		END FPERLOS;
+
+		PROCEDURE FP32TBACAER;
+			VAR n, Rt, op: INTEGER;
+				T: INTEGER;
+		BEGIN
+			Rt := c DIV 10000000H MOD 10H;
+			IF IsVMOVSPR(c) THEN
+				n := c MOD 10H * 2 + c DIV 800000H MOD 2;
+				op := c DIV 10H MOD 2;
+				IF op = 1 THEN (* to ARM register *)
+					WStr(s, w, "VMOV "); WReg(s, w, Rt); WStr(s, w, ", S");
+					WInt(s, w, n)
+				ELSE
+					WStr(s, w, "VMOV S"); WInt(s, w, n); WStr(s, w, ", ");
+					WReg(s, w, Rt)
+				END;
+				IF Rt IN {SP,PC} THEN
+					WStr(s, w, " (UNPREDICTABLE)")
+				END
+			ELSIF IsVMRS(c) THEN
+				WStr(s, w, "VMRS ");
+				IF Rt = 15 THEN WStr(s, w, "APSR_nzcv") ELSE WReg(s, w, Rt) END;
+				WStr(s, w, ", FPSCR")
+			ELSIF IsVMSR(c) THEN
+				WStr(s, w, "VMSR FPSCR, ");
+				WReg(s, w, Rt)
+			ELSE
+				T := c DIV 1000H MOD 2;
+				IF T = 1 THEN
+					WStr(s, w, "FP UNDEFINED")
+				END
+			END
+		END FP32TBACAER;
+
+	BEGIN
+		w := 0;
+		PUSHPOPOne;
+		IF IsWFIW(c) THEN
+			WStr(s, w, "WFI")
+		ELSIF IsLMASM(c) THEN
+			LMASM
+		ELSIF IsDPSR(c) THEN
+			DPSR
+		ELSIF IsDPMI(c) THEN
+			DPMI
+		ELSIF IsDPPBI(c) THEN
+			DPPBI
+		ELSIF IsBAMC(c) THEN
+			IF IsB(c) THEN
+				B(FALSE)
+			ELSIF IsBC(c) THEN
+				BC
+			ELSIF IsBL(c) THEN
+				B(TRUE)
+			END
+		ELSIF IsSSDI(c) THEN
+			IF IsSWImW(c) THEN
+				LSWBImW(TRUE, FALSE)
+			ELSIF IsSBImW(c) THEN
+				LSWBImW(TRUE, TRUE)
+			ELSIF IsSWRW(c) THEN
+				LSWBRW(TRUE, FALSE)
+			ELSIF IsSBRW(c) THEN
+				LSWBRW(TRUE, TRUE)
+			END
+		ELSIF IsLBMH(c) THEN
+			IF IsLBImW(c) THEN
+				LSWBImW(FALSE, TRUE)
+			ELSIF IsLBRW(c) THEN
+				LSWBRW(FALSE, TRUE)
+			END
+		ELSIF IsLW(c) THEN
+			LW
+		ELSIF IsDPR(c) THEN
+			DPR
+		ELSIF IsMMAAAD(c) THEN
+			MMAAAD
+		ELSIF IsLMLMAAD(c) THEN
+			LMLMAAD
+		ELSIF IsFPDP(c) THEN
+			FPDP
+		ELSIF IsFPERLOS(c) THEN
+			FPERLOS
+		ELSIF IsFP32TBACAER(c) THEN
+			FP32TBACAER
+		END;
+		s[w] := 0X
+	END OpcodeRepr2;
+
+	(* d: decoder state *)
+	PROCEDURE OpcodeRepr* (VAR d: INTEGER; c: INTEGER; (*OUT*)VAR s: ARRAY OF CHAR);
+	BEGIN
+		ASSERT(c DIV 10000H = 0, 20);
+		IF d = 0 THEN
+			ARMv6M.OpcodeRepr(d, c, s)
+		ELSIF d DIV 10000H = 1 THEN
+			c := 10000H * c + d MOD 10000H; d := 0;
+			OpcodeRepr2(c, s)
+		ELSE HALT(1)
+		END
+	END OpcodeRepr;
+
+END O7ARMv7M.

voc-O7/O7ARMv7MG.Mod

@@ -0,0 +1,2756 @@
+MODULE O7ARMv7MG; (* NW  18.4.2016 / 31.5.2019  code generator in Oberon-07 for RISC*)
+
+	(* Modified for ARMv7-M by A. V. Shiryaev, 2018.05.25, 2019.10.21 *)
+
+	(*
+http://www.inf.ethz.ch/personal/wirth/FPGA-relatedWork/RISC-Arch.pdf
+
+http://infocenter.arm.com/help/topic/com.arm.doc.ddi0439d/DDI0439D_cortex_m4_processor_r0p1_trm.pdf
+
+		ARMv7-M Architecture Reference Manual
+			https://web.eecs.umich.edu/~prabal/teaching/eecs373-f10/readings/ARMv7-M_ARM.pdf
+	*)
+
+	(*
+		TODO:
+			LEN(record.arrayOfChar):
+				Reg Stack
+				invalid code generated when no Reg Stack compile-time error
+			implement "special feautures" (see RISC-Arch.pdf, section 4):
+				implement MOV+U F0, c = 1 feature? save flags to register
+					when it's required?
+					MRS instruction
+			check loadCond (IsFlagsUp0 related)
+			implement LDPSR
+			see PO.Applications.pdf, p. 47
+			shifts...
+			implementation limits:
+				use long B and BC branches:
+					use short B and BC where possible (see Put3orig(BC...)),
+						else use long B and BC..
+			optimizations:
+				arrays assignment (see PO.Applications.pdf, 45):
+					use special command instead of loop
+				bits:
+					SYSTEM.BIT(adr, bit)
+					...
+				register procedures
+				MovIm...	https://github.com/aixp/ProjectOberon2013/commit/873fe7ef74a2c41592f9904ad7c3893e4a368d58
+		NOTE:
+			do not try to optimize CMP, BC -> CB[N]Z:
+				fixups:
+					fixup problems
+				else:
+					there is no places where to use
+			do not remove redundant cmps in Put3 (fixup problems)
+	*)
+
+	IMPORT SYSTEM, Files, ORS := O7S, ORB := O7B, ARMv6M := O7ARMv6M, ARMv7M := O7ARMv7M;
+	(*Code generator for Oberon compiler for RISC processor.
+		 Procedural interface to Parser OSAP; result in array "code".
+		 Procedure Close writes code-files*)
+
+	TYPE
+		LONGINT = INTEGER;
+		(* REAL = SHORTREAL; *)
+		LONGREAL = REAL;
+		(* CHAR = SHORTCHAR; *)
+		(* BYTE = SHORTCHAR; *)
+		BYTE = CHAR;
+
+	CONST WordSize* = 4;
+
+		parblksize0Proc* = 0; parblksize0Int* = 0;
+
+		(* MT = 12; SB = 13; SP = 14; LNK = 15;	 (*dedicated registers*) *)
+
+		MT = 11; SB = 12; SP = ARMv6M.SP; LNK = ARMv6M.LR;
+
+		maxCode = 16000; maxStrx = 2400; maxTD = 160; C24 = 1000000H;
+		Reg = 10; RegI = 11; Cond = 12;	(*internal item modes*)
+
+	(*frequently used opcodes*)	U = 2000H; V = 1000H;
+		Mov = 0; Lsl = 1; Asr = 2; Ror= 3; And = 4; Ann = 5; Ior = 6; Xor = 7;
+		Add = 8; Sub = 9; Cmp = 9; Mul = 10; Div = 11;
+		Ldr = 8; Str = 10;
+		BR = 0; BLR = 1; BC = 2; BL = 3;
+		MI = 0; PL = 8; EQ = 1; NE = 9; LT = 5; GE = 13; LE = 6; GT = 14;
+
+		TYPE Item* = RECORD
+			mode*: INTEGER;
+			type*: ORB.Type;
+			a-, b-, r: LONGINT;
+			rdo-: BOOLEAN	(*read only*)
+		END ;
+
+	(* Item forms and meaning of fields:
+		mode		r			a			 b
+		--------------------------------
+		Const	 -		 value (proc adr)	 (immediate value)
+		Var		 base	 off		 -							 (direct adr)
+		Par			-		 off0		 off1				 (indirect adr)
+		Reg		regno											(regno >= 100H: FPU register)
+		RegI	 regno	 off		 -
+		Cond	cond	 Fchain	Tchain	*)
+
+	VAR pc-, varsize: LONGINT;	 (*program counter, data index*)
+		tdx, strx: LONGINT;
+		entry: LONGINT;	 (*main entry point*)
+		RH: LONGINT;	(*available registers R[0] ... R[H-1]*)
+		curSB: LONGINT;	(*current static base in SB*)
+		frame: LONGINT;	(*frame offset changed in SaveRegs and RestoreRegs*)
+		fixorgP, fixorgD, fixorgT: LONGINT;	 (*origins of lists of locations to be fixed up by loader*)
+		check: BOOLEAN;	(*emit run-time checks*)
+		version: INTEGER;	(* 0 = RISC-0, 1 = RISC-5 *)
+
+		relmap: ARRAY 6 OF INTEGER;	(*condition codes for relations*)
+		armcode: ARRAY maxCode OF LONGINT;
+		data: ARRAY maxTD OF LONGINT;	(*type descriptors*)
+		str: ARRAY maxStrx OF CHAR;
+
+		RM: SET; (* registers modified *)
+		enterPushFixup: INTEGER;
+
+		FR: SET; (* for SaveRegs/RestoreRegs *)
+
+		updateCarry: BOOLEAN;
+
+	PROCEDURE BITS (x: INTEGER): SET;
+	BEGIN
+		RETURN SYSTEM.VAL(SET, x)
+	END BITS;
+
+	PROCEDURE ORDSET (x: SET): INTEGER;
+	BEGIN
+		RETURN SYSTEM.VAL(INTEGER, x)
+	END ORDSET;
+
+	PROCEDURE LSL (x, n: INTEGER): INTEGER;
+	BEGIN RETURN SYSTEM.LSH(x, n)
+	END LSL;
+
+	(*instruction assemblers according to formats*)
+
+	(* for fixups only *)
+		PROCEDURE Put1orig (op, a, b, im: LONGINT);
+		BEGIN (*emit format-1 instruction,	-10000H <= im < 10000H*)
+			IF im < 0 THEN INC(op, V) END;
+			armcode[pc] := (((a+40H) * 10H + b) * 10H + op) * 10000H + (im MOD 10000H); INC(pc)
+		END Put1orig;
+
+		PROCEDURE Put2orig (op, a, b, off: LONGINT);
+		BEGIN (*emit load/store instruction*)
+			ASSERT(op DIV 10H = 0);
+			ASSERT(a DIV 10H = 0);
+			ASSERT(b DIV 10H = 0);
+			armcode[pc] := ((op * 10H + a) * 10H + b) * 100000H + (off MOD 100000H); INC(pc)
+		END Put2orig;
+
+		PROCEDURE Put3orig (op, cond, off: LONGINT);
+		BEGIN (*emit branch instruction*)
+			armcode[pc] := ((op+12) * 10H + cond) * 1000000H + (off MOD 1000000H); INC(pc);
+			IF op = BC THEN (* armcode[pc] := 00FFFFFEH; INC(pc) *)
+			ELSIF op = BL THEN armcode[pc] := 00FFFFFFH; INC(pc)
+			ELSE HALT(1)
+			END
+		END Put3orig;
+
+	(*
+		encode register
+		NOTE:
+			R0-R3, R12, LR: not need to save on interrupts
+			R0-R7: best for Thumb-16 instructions
+	*)
+	PROCEDURE ER (a: INTEGER): INTEGER;
+	BEGIN
+		CASE a OF 0: RETURN ARMv6M.R0
+		| 1: RETURN ARMv6M.R1
+		| 2: RETURN ARMv6M.R2
+		| 3: RETURN ARMv6M.R4
+		| 4: RETURN ARMv6M.R5
+		| 5: RETURN ARMv6M.R7
+		| 6: RETURN ARMv6M.R12
+		| 7: RETURN ARMv6M.R8
+		| 8: RETURN ARMv6M.R9
+		| 9: RETURN ARMv6M.R10
+		| 10: RETURN ARMv6M.R11
+		| MT: RETURN ARMv6M.R6
+		| SB: RETURN ARMv6M.R3
+		| SP: RETURN ARMv6M.SP
+		| LNK: RETURN ARMv6M.LR
+		| 15: RETURN ARMv6M.PC
+		END
+	END ER;
+
+	PROCEDURE ERs (s: SET): SET;
+		VAR r: SET; i: INTEGER;
+	BEGIN
+		r := {}; i := 0;
+		WHILE i < 10H DO
+			IF i IN s THEN INCL(r, ER(i)) END;
+			INC(i)
+		END;
+		RETURN r
+	END ERs;
+
+	(* decode register *)
+	PROCEDURE DR (a: INTEGER): INTEGER;
+	BEGIN
+		CASE a OF ARMv6M.R0: RETURN 0
+		| ARMv6M.R1: RETURN 1
+		| ARMv6M.R2: RETURN 2
+		| ARMv6M.R3: RETURN SB
+		| ARMv6M.R4: RETURN 3
+		| ARMv6M.R5: RETURN 4
+		| ARMv6M.R6: RETURN MT
+		| ARMv6M.R7: RETURN 5
+		| ARMv6M.R8: RETURN 7
+		| ARMv6M.R9: RETURN 8
+		| ARMv6M.R10: RETURN 9
+		| ARMv6M.R11: RETURN 10
+		| ARMv6M.R12: RETURN 6
+		| ARMv6M.SP: RETURN SP
+		| ARMv6M.LR: RETURN LNK
+		| ARMv6M.PC: RETURN 15
+		END
+	END DR;
+
+	PROCEDURE UpdateFlags (a: INTEGER);
+		VAR isMI: BOOLEAN; i, imm3, imm8: INTEGER;
+	BEGIN
+		a := ER(a);
+		IF a DIV 8 = 0 THEN
+			ARMv6M.EmitCMPIm(armcode, pc, a, 0)
+		ELSE
+			ARMv7M.EncodeMI12(0, i, imm3, imm8, isMI);
+			ASSERT(isMI, 100);
+			ARMv7M.EmitCMPImW(armcode, pc, a, i, imm3, imm8)
+		END
+	END UpdateFlags;
+
+	(* A6.7.17 *)
+	PROCEDURE IsCMPIm (c: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN c DIV 800H = 5
+	END IsCMPIm;
+
+	PROCEDURE RemoveRedundantCmp;
+		VAR c: INTEGER;
+	BEGIN
+		IF (pc >= 2) & (armcode[pc - 1] DIV 10000H = 0) THEN
+			IF ARMv6M.IsLThumb32(armcode[pc - 2]) THEN
+				c := armcode[pc - 1] * 10000H + armcode[pc - 2];
+				IF ARMv7M.IsCMPImW(c) & (c MOD 10H # 0FH) THEN
+					DEC(pc, 2)
+				END
+			ELSIF IsCMPIm(armcode[pc - 1]) THEN
+				DEC(pc)
+			END
+		END
+	END RemoveRedundantCmp;
+
+	(* emit RSBS a, a, #0 *)
+	PROCEDURE RSBS0 (a: INTEGER);
+		CONST S = 1;
+		VAR i, imm3, imm8: INTEGER; isMI: BOOLEAN;
+	BEGIN
+		INCL(RM, a);
+		a := ER(a);
+		IF a DIV 8 = 0 THEN
+			ARMv6M.EmitRSBS0(armcode, pc, a, a)
+		ELSE
+			ARMv7M.EncodeMI12(0, i, imm3, imm8, isMI); ASSERT(isMI, 100);
+			ARMv7M.EmitRSBImW(armcode, pc, S, a, a, i, imm3, imm8)
+		END
+	END RSBS0;
+
+	PROCEDURE Div0PosB (S: INTEGER; a, b, c: INTEGER);
+	BEGIN
+		ASSERT(S DIV 2 = 0, 20);
+		(* A7.7.125: SDIV; encoding T1 ARMv7-M *)
+			ASSERT(a IN {0..12,14}, 21);
+			ASSERT(b IN {0..12,14}, 22);
+			ASSERT(c IN {0..12,14}, 23);
+			ARMv7M.EmitLMLMAAD(armcode, pc, 1, ER(b), 0F0H + ER(a), 0FH, ER(c));
+			(* NOTE: overflow: 80000000H / 0FFFFFFFFH = 80000000H *)
+		IF S = 1 THEN
+			UpdateFlags(a)
+		END
+	END Div0PosB;
+
+	PROCEDURE ^ Put10 (S: INTEGER; op, a, b, im: LONGINT);
+
+	PROCEDURE ^ fix (at, with: LONGINT);
+
+	PROCEDURE Div0NegB (S: INTEGER; a, b, c: INTEGER);
+		VAR r: INTEGER;
+	BEGIN
+		IF a = c THEN
+			r := RH;
+			IF (a < MT) & (r <= a) THEN r := a + 1 END;
+			IF (b < MT) & (r <= b) THEN r := b + 1 END;
+			ASSERT(r < MT, 100)
+		ELSE r := a
+		END;
+		Put10(0, Add, r, b, 1);
+		Div0PosB(0, a, r, c);
+		Put10(S, Sub, a, a, 1)
+	END Div0NegB;
+
+	PROCEDURE Div0 (S: INTEGER; a, b, c: INTEGER);
+		VAR pc0, pc1: LONGINT;
+	BEGIN
+		Put10(1, Cmp, b, b, 0);
+		pc0 := pc; Put3orig(BC, GE, 0);
+		Div0NegB(S, a, b, c);
+		pc1 := pc; Put3orig(BC, 7, 0);
+		fix(pc0, pc - pc0 - 1);
+		Div0PosB(S, a, b, c);
+		fix(pc1, pc - pc1 - 1)
+	END Div0;
+
+	(* op # Mov: R.a := R.b op R.c; op = Mov: R.a := R.c *)
+	(* S=1: change NZCV according R.a after *)
+	PROCEDURE Put00 (S: INTEGER; op, a, b, c: LONGINT);
+		VAR u, v: BOOLEAN;
+			r: INTEGER;
+	BEGIN (*emit format-0 instruction
+		code[pc] := ((a*10H + b) * 10H + op) * 10000H + c; *)
+
+		ASSERT(S IN {0,1}, 20);
+
+		IF ORS.errcnt = 0 THEN
+
+			u := 13 IN BITS(op);
+			IF u THEN DEC(op, U) END;
+			v := 12 IN BITS(op);
+			IF v THEN DEC(op, V) END;
+
+			ASSERT(op DIV 10H = 0, 21);
+			ASSERT(a DIV 10H = 0, 22);
+			ASSERT(b DIV 10H = 0, 23);
+			ASSERT(c DIV 10H = 0, 24);
+
+			INCL(RM, a);
+
+			IF ~((op IN {Add,Sub}) & u) THEN RemoveRedundantCmp END;
+
+			CASE op MOD 10H OF Mov: (* R.a := R.c *)
+				ASSERT(~v, 100);
+				IF ~u THEN
+					IF (ER(a) DIV 8 = 0) & ((ER(c) DIV 8 = 0) OR ((c = SP) & (S = 0))) THEN
+						IF c = SP THEN
+							ARMv6M.EmitADDSPIm(armcode, pc, ER(a), 0)
+						ELSE
+							ARMv6M.EmitMOVSR(armcode, pc, ER(a), ER(c))
+						END
+					ELSIF c = SP THEN
+						(* A7.7.5: ADD (SP plus immediate); encoding T3 ARMv7-M *)
+							ASSERT(a # 15, 103);
+							ARMv7M.EmitDPMI(armcode, pc, 0, 16 + S, ER(c), 0, ER(a), 0)
+							(* S = 1: N, Z, C, V will be updated *) (* NOTE: C *)
+					ELSE
+						(* A7.7.76: MOV (register); encoding T3 ARMv7-M *)
+							ASSERT(~((S = 1) & ((a IN {13,15}) OR (c IN {13,15}))), 101);
+							ASSERT(~((S = 0) & ((a = 15) OR (c = 15) OR (a = 13) & (c = 13))), 102);
+							ARMv7M.EmitDPSR(armcode, pc, 2, S, 0FH, 0, ER(a), ER(c))
+							(* S = 1: N, Z will be updated *)
+					END
+				ELSE
+					ASSERT(b = 0, 101);
+					ASSERT(c IN {0,1}, 102);
+					IF c = 0 THEN
+						HALT(103)
+					ELSE (* c = 1 *)
+						HALT(126) (* TODO *)
+					END
+				END
+			| Lsl: (* R.a := R.b <- R.c *)
+				ASSERT(~u, 104);
+				ASSERT(~v, 105);
+				IF (ER(a) DIV 8 = 0) & (a = b) & (ER(c) DIV 8 = 0) THEN
+					ARMv6M.EmitLSLSR(armcode, pc, ER(a), ER(c))
+				ELSE
+					(* A7.7.68: LSL (register); encoding T2 ARMv7-M *)
+						ASSERT(~(a IN {13,15}), 106);
+						ASSERT(~(b IN {13,15}), 107);
+						ASSERT(~(c IN {13,15}), 108);
+						ARMv7M.EmitDPR(armcode, pc, 0 + S, ER(b), ER(a), 0, ER(c))
+						(* S=1: N, Z, C will be updated *)
+				END
+			| Asr: (* R.a := R.b -> R.c *)
+				ASSERT(~u, 109);
+				ASSERT(~v, 110);
+				IF (ER(a) DIV 8 = 0) & (a = b) & (ER(c) DIV 8 = 0) THEN
+					ARMv6M.EmitASRSR(armcode, pc, ER(a), ER(c))
+				ELSE
+					(* A7.7.11: ASR (register); encoding T2 ARMv7-M *)
+						ASSERT(~(a IN {13,15}), 111);
+						ASSERT(~(b IN {13,15}), 112);
+						ASSERT(~(c IN {13,15}), 113);
+						ARMv7M.EmitDPR(armcode, pc, 4 + S, ER(b), ER(a), 0, ER(c))
+						(* S=1: N, Z, C will be updated *)
+				END
+			| Ror: (* R.a := R.b rot R.c *)
+				ASSERT(~u, 114);
+				ASSERT(~v, 115);
+				IF (ER(a) DIV 8 = 0) & (a = b) & (ER(c) DIV 8 = 0) THEN
+					ARMv6M.EmitRORSR(armcode, pc, ER(a), ER(c))
+				ELSE
+					(* A7.7.115: ROR (register); encoding T2 ARMv7-M *)
+						ASSERT(~(a IN {13,15}), 116);
+						ASSERT(~(b IN {13,15}), 117);
+						ASSERT(~(c IN {13,15}), 118);
+						ARMv7M.EmitDPR(armcode, pc, 6 + S, ER(b), ER(a), 0, ER(c))
+						(* S=1: N, Z, C will be updated *)
+				END
+			| And: (* R.a := R.b & R.c *)
+				ASSERT(~u, 119);
+				ASSERT(~v, 120);
+				IF (ER(a) DIV 8 = 0) & (a = b) & (ER(c) DIV 8 = 0) THEN
+					ARMv6M.EmitANDSR(armcode, pc, ER(a), ER(c))
+				ELSIF (ER(a) DIV 8 = 0) & (a = c) & (ER(b) DIV 8 = 0) THEN
+					ARMv6M.EmitANDSR(armcode, pc, ER(a), ER(b))
+				ELSIF b = c THEN HALT(1) (* R.a := R.b *)
+				ELSE
+					(* A7.7.9: AND (register); encoding T2 ARMv7-M *)
+						ASSERT(~(a IN {13,15}), 121);
+						ASSERT(~(b IN {13,15}), 122);
+						ASSERT(~(c IN {13,15}), 123);
+						ARMv7M.EmitDPSR(armcode, pc, 0, S, ER(b), 0, ER(a), ER(c)) (* shift = 0 *)
+						(* S=1: N, Z, C will be updated *)
+				END
+			| Ann: (* R.a := R.b & ~R.c *)
+				ASSERT(~u, 124);
+				ASSERT(~v, 125);
+				ASSERT(b # c, 100); (* in this case, emit R.a := 0 *)
+				IF (ER(a) DIV 8 = 0) & (a = b) & (ER(c) DIV 8 = 0) THEN (* R.a := R.a & ~R.c *)
+					ARMv6M.EmitBICSR(armcode, pc, ER(a), ER(c))
+				ELSE
+					(* A7.7.16: BIC (register); encoding T2 ARMv7-M *)
+						ASSERT(~(a IN {13,15}), 106);
+						ASSERT(~(b IN {13,15}), 107);
+						ASSERT(~(c IN {13,15}), 108);
+						ARMv7M.EmitDPSR(armcode, pc, 1, S, ER(b), 0, ER(a), ER(c)) (* shift = 0 *)
+						(* S=1: N, Z, C will be updated *)
+				END
+			| Ior: (* R.a := R.b or R.c *)
+				ASSERT(~u, 104);
+				ASSERT(~v, 105);
+				IF (ER(a) DIV 8 = 0) & (a = b) & (ER(c) DIV 8 = 0) THEN
+					ARMv6M.EmitORRSR(armcode, pc, ER(a), ER(c))
+				ELSIF (ER(a) DIV 8 = 0) & (a = c) & (ER(b) DIV 8 = 0) THEN
+					ARMv6M.EmitORRSR(armcode, pc, ER(a), ER(b))
+				ELSIF b = c THEN HALT(1) (* R.a := R.b *)
+				ELSE
+					(* A7.7.91: ORR (register); encoding T2 ARMv7-M *)
+						ASSERT(~(a IN {13,15}), 111);
+						ASSERT(~(b IN {13,15}), 112);
+						ASSERT(~(c IN {13,15}), 113);
+						ARMv7M.EmitDPSR(armcode, pc, 2, S, ER(b), 0, ER(a), ER(c)) (* shift = 0 *)
+						(* S=1: N, Z, C will be updated *)
+				END
+			| Xor: (* R.a := R.b xor R.c *)
+				ASSERT(~u, 109);
+				ASSERT(~v, 110);
+				IF (ER(a) DIV 8 = 0) & (a = b) & (ER(c) DIV 8 = 0) THEN
+					ARMv6M.EmitEORSR(armcode, pc, ER(a), ER(c))
+				ELSIF (ER(a) DIV 8 = 0) & (a = c) & (ER(b) DIV 8 = 0) THEN
+					ARMv6M.EmitEORSR(armcode, pc, ER(a), ER(b))
+				ELSIF b = c THEN HALT(1)
+				ELSE
+					(* A7.7.35: EOR (register); encoding T2 ARMv7-M *)
+						ASSERT(~(a IN {13,15}), 116);
+						ASSERT(~(b IN {13,15}), 117);
+						ASSERT(~(c IN {13,15}), 118);
+						ARMv7M.EmitDPSR(armcode, pc, 4, S, ER(b), 0, ER(a), ER(c)) (* shift = 0 *)
+						(* S=1: N, Z, C will be updated *)
+				END
+			| Add: (* R.a := R.b + R.c *)
+				ASSERT(~v, 114);
+				ASSERT(a # 15, 120);
+				ASSERT(~(c IN {13,15}), 121);
+				IF ~u THEN
+					IF (ER(a) IN {0..7}) & (ER(b) IN {0..7}) & (ER(c) IN {0..7}) THEN
+						ARMv6M.EmitADDSR(armcode, pc, ER(a), ER(b), ER(c))
+					ELSIF (b = SP) & (S = 0) THEN
+						ARMv6M.EmitADDSPR(armcode, pc, ER(a), ER(c))
+					ELSIF ((a = b) OR (a = c)) & (S = 0) THEN
+						IF a = b THEN
+							ARMv6M.EmitADDR(armcode, pc, ER(a), ER(c))
+						ELSE (* a = c *)
+							ARMv6M.EmitADDR(armcode, pc, ER(a), ER(b))
+						END
+					ELSE
+						ASSERT(b # 15, 122);
+						ASSERT((b = 13) OR (a # 13), 123);
+						(* A7.7.4: ADD (register); encoding T3 ARMv7-M *)
+						(* A7.7.6: ADD (SP plus register); encoding T3 ARMv7-M *)
+							ARMv7M.EmitDPSR(armcode, pc, 8, S, ER(b), 0, ER(a), ER(c)) (* shift = 0 *)
+							(* S=1: N, Z, C, V will be updated *)
+					END
+				ELSE (* with carry *)
+					IF (ER(a) DIV 8 = 0) & (a = b) & (ER(c) DIV 8 = 0) THEN
+						ARMv6M.EmitADCSR(armcode, pc, ER(a), ER(c))
+					ELSIF (ER(a) DIV 8 = 0) & (a = c) & (ER(b) DIV 8 = 0) THEN
+						ARMv6M.EmitADCSR(armcode, pc, ER(a), ER(b))
+					ELSE
+						ASSERT(~(b IN {13,15}), 124);
+						(* A7.7.2: ADC(register); encoding T2 ARMv7-M *)
+							ARMv7M.EmitDPSR(armcode, pc, 10, S, ER(b), 0, ER(a), ER(c))
+							(* S=1: N, Z, C, V will be updated *)
+					END
+				END
+			| Sub: (* R.a := R.b - R.c *)
+				ASSERT(~v, 119);
+				ASSERT(a # 15, 100);
+				ASSERT(~(c IN {13,15}), 101);
+				IF ~u THEN
+					IF (ER(a) DIV 8 = 0) & (ER(b) DIV 8 = 0) & (ER(c) DIV 8 = 0) THEN
+						ARMv6M.EmitSUBSR(armcode, pc, ER(a), ER(b), ER(c))
+					ELSE
+						ASSERT(b # 15, 122);
+						ASSERT((b = 13) OR (a # 13), 123);
+						(* A7.7.172: SUB (register); encoding T2 ARMv7-M *)
+						(* A7.7.174: SUB (SP minus register); encoding T1 *)
+							ARMv7M.EmitDPSR(armcode, pc, 13, S, ER(b), 0, ER(a), ER(c))
+							(* S=1: N, Z, C, V will be updated *)
+					END
+				ELSE (* with carry *)
+					IF (ER(a) DIV 8 = 0) & (a = b) & (ER(c) DIV 8 = 0) THEN
+						ARMv6M.EmitSBCSR(armcode, pc, ER(a), ER(c))
+					ELSE
+						ASSERT(~(b IN {13,15}), 123);
+						(* A7.7.123: SBC (register); encoding T2 ARMv7-M *)
+							ARMv7M.EmitDPSR(armcode, pc, 11, S, ER(b), 0, ER(a), ER(c))
+							(* S=1: N, Z, C, V will be updated *)
+					END
+				END
+			| Mul: (* R.a := R.b * R.c *)
+				ASSERT(~v, 124);
+				IF ~u THEN
+					IF (a # b) & (a = c) THEN r := b; b := c; c := r END;
+					IF (a = b) & (ER(a) DIV 8 = 0) & (ER(c) DIV 8 = 0) THEN
+						(* NOTE:
+							low word of result does not depend on sign of operands *)
+						ARMv6M.EmitMULSR(armcode, pc, ER(a), ER(c))
+					ELSE
+						(* NOTE:
+							low word of result does not depend on sign of operands *)
+						ARMv7M.EmitMUL(armcode, pc, ER(a), ER(b), ER(c));
+						IF S = 1 THEN
+							UpdateFlags(a)
+						END
+					END
+				ELSE
+					HALT(126)
+				END
+			| Div: (* R.a := R.b div R.c *)
+				ASSERT(~u, 103);
+				ASSERT(~v, 104);
+				Div0(S, a, b, c)
+			END
+
+		END
+	END Put00;
+
+	PROCEDURE Put0 (op, a, b, c: INTEGER);
+	BEGIN
+		Put00(1, op, a, b, c)
+	END Put0;
+
+	(* R.a := im *)
+	(* NOTE: ARMv7MLinker.MovIm0 *)
+	PROCEDURE MovIm (S: INTEGER; a: INTEGER; im: INTEGER);
+		VAR shift: INTEGER;
+			isLR: BOOLEAN;
+			imInv: INTEGER; isMI: BOOLEAN; i, imm3, imm8, imm4: INTEGER;
+	BEGIN
+		ASSERT(S IN {0,1}, 20);
+		ASSERT(a IN {0..14}, 21);
+
+		INCL(RM, a);
+
+		IF a # SP THEN
+			isLR := ER(a) DIV 8 = 0;
+			IF isLR & (im DIV 100H = 0) THEN
+				ARMv6M.EmitMOVSIm(armcode, pc, ER(a), im)
+			ELSE
+				ARMv7M.EncodeMI12(im, i, imm3, imm8, isMI);
+				IF isMI THEN
+					(* A7.7.75: MOV (immediate); encoding T2 ARMv7-M *)
+						ARMv7M.EmitDPMI(armcode, pc, i, 4 + S, 0FH, imm3, ER(a), imm8)
+					(* S=1: N, Z, C will be updated *) (* NOTE: C *)
+				ELSE
+					imInv := ORDSET(BITS(im) / {0..31});
+					ARMv7M.EncodeMI12(imInv, i, imm3, imm8, isMI);
+					IF isMI THEN
+						(* A7.7.84: MVN (immediate); encoding T1 ARMv7-M *)
+							ARMv7M.EmitDPMI(armcode, pc, i, 6 + S, 0FH, imm3, ER(a), imm8)
+							(* S=1: N, Z, C will be updated *) (* NOTE: C *)
+					ELSIF isLR & (im > 255) & (im <= 255 + 255) THEN
+						ARMv6M.EmitMOVSIm(armcode, pc, ER(a), 255);
+						ARMv6M.EmitADDSIm(armcode, pc, ER(a), ER(a), im - 255)
+					ELSE
+						shift := 8;
+						WHILE (shift < 32) & (SYSTEM.ROT(im DIV 100H * 100H, -shift) DIV 100H # 0) DO INC(shift) END;
+						IF isLR & (shift < 32) THEN
+							ASSERT(im =
+								SYSTEM.LSH(SYSTEM.ROT(im DIV 100H * 100H, -shift), shift)
+								+ im MOD 100H);
+							ARMv6M.EmitMOVSIm(armcode, pc, ER(a), SYSTEM.ROT(im DIV 100H * 100H, -shift));
+							ARMv6M.EmitLSLSIm(armcode, pc, ER(a), ER(a), shift);
+							ARMv6M.EmitADDSIm(armcode, pc, ER(a), ER(a), im MOD 100H)
+						ELSE
+							(* TODO: 3 ops: mov; (add, lsl), (lsl, sub), (lsl, sub) | MI12; add, lsl, sub *)
+							IF isLR & (im MOD 10000H DIV 100H = 0) THEN
+								ARMv6M.EmitMOVSIm(armcode, pc, ER(a), im MOD 10000H)
+							ELSE
+								(* A7.7.75: MOV (immediate); encoding T3 ARMv7-M *)
+									imm4 := im DIV 1000H MOD 10H;
+									i := im DIV 800H MOD 2;
+									imm3 := im DIV 100H MOD 8;
+									imm8 := im MOD 100H;
+									ARMv7M.EmitDPPBI(armcode, pc, i, 4, imm4, imm3 * 1000H + ER(a) * 100H + imm8)
+							END;
+							im := im DIV 10000H;
+							IF im # 0 THEN
+								(* A7.7.78: MOVT; encoding T1 ARMv7 *)
+									imm4 := im DIV 1000H MOD 10H;
+									i := im DIV 800H MOD 2;
+									imm3 := im DIV 100H MOD 8;
+									imm8 := im MOD 100H;
+									ARMv7M.EmitDPPBI(armcode, pc, i, 12, imm4, imm3 * 1000H + ER(a) * 100H + imm8)
+							END;
+							IF S = 1 THEN
+								UpdateFlags(a)
+							END
+						END
+					END
+				END
+			END
+		ELSE (* a = SP *)
+			ASSERT(RH < MT, 100);
+			ASSERT(RH # SP, 101);
+			MovIm(S, RH, im);
+			Put00(S, Mov, SP, 0, RH)
+		END
+	END MovIm;
+
+	(* op # Mov: R.a := R.b op im; op = Mov: R.a := im *)
+	(* change NZCV according R.a after *)
+	PROCEDURE Put10 (S: INTEGER; op, a, b, im: LONGINT);
+		VAR u, v: BOOLEAN;
+			isMI: BOOLEAN; i, imm3, imm8: INTEGER;
+			imm2: INTEGER;
+			imInv: INTEGER;
+			r: INTEGER;
+	BEGIN (*emit format-1 instruction,	-10000H <= im < 10000H
+		IF im < 0 THEN INC(op, V) END ;
+		code[pc] := (((a+40H) * 10H + b) * 10H + op) * 10000H + (im MOD 10000H); INC(pc) *)
+
+		ASSERT(S IN {0,1}, 20);
+
+		IF ORS.errcnt = 0 THEN
+
+			v := 12 IN BITS(op);
+			IF v THEN DEC(op, V) END;
+			ASSERT(~v, 100);
+
+			u := 13 IN BITS(op);
+			IF u THEN
+				ASSERT(im DIV 10000H = 0, 21);
+				DEC(op, U);
+				ASSERT(op = Mov, 100);
+				im := im * 10000H
+			END;
+
+			IF op MOD 10H = Ann THEN
+				op := (op DIV 10H) * 10H + And;
+				im := ORDSET(BITS(im) / {0..31}) (* im := ~im *)
+			END;
+
+			(* im: any const *)
+
+			ASSERT(op DIV 10H = 0, 22);
+			ASSERT(a DIV 10H = 0, 23);
+			ASSERT(b DIV 10H = 0, 24);
+
+			IF ~((op = Cmp) & (a = b) & (im = 0)) THEN (* ~Cmp *)
+				INCL(RM, a)
+			END;
+
+			RemoveRedundantCmp;
+
+			op := op MOD 10H;
+			IF op IN {Lsl,Asr,Ror} THEN
+				IF im = 0 THEN
+					Put00(S, Mov, a, 0, b)
+				ELSIF (im = 32) & (op = Ror) & (S = 1) THEN
+					IF a = b THEN
+						r := RH; IF (a < MT) & (r <= a) THEN r := a + 1 END;
+						ASSERT(r < MT, 100);
+						MovIm(0, r, im);
+						Put00(S, op, a, b, r)
+					ELSE
+						MovIm(0, a, im);
+						Put00(S, op, a, b, a)
+					END
+				ELSE
+					ASSERT(~(a IN {13,15}), 100);
+					ASSERT(~(b IN {13,15}), 101);
+					ASSERT(im DIV 32 = 0, 126);
+					imm3 := im DIV 4; imm2 := im MOD 4;
+					CASE op OF Lsl: (* R.a := R.b <- im *)
+						IF (ER(a) DIV 8 = 0) & (ER(b) DIV 8 = 0) THEN
+							ARMv6M.EmitLSLSIm(armcode, pc, ER(a), ER(b), im)
+						ELSE
+							(* A7.7.67: LSL (immediate); encoding T2 ARMv7-M *)
+								ARMv7M.EmitDPSR(armcode, pc, 2, S, 0FH, imm3, ER(a), imm2 * 40H + ER(b))
+								(* S=1: N, Z, C will be updated *)
+						END
+					| Asr: (* R.a := R.b -> im *)
+						IF (ER(a) DIV 8 = 0) & (ER(b) DIV 8 = 0) THEN
+							ARMv6M.EmitASRSIm(armcode, pc, ER(a), ER(b), im)
+						ELSE
+							(* A7.7.10: ASR (immediate); encoding T2 ARMv7-M *)
+								ARMv7M.EmitDPSR(armcode, pc, 2, S, 0FH, imm3, ER(a), imm2 * 40H + 20H + ER(b))
+								(* S=1: N, Z, C will be updated *)
+						END
+					| Ror: (* R.a := R.b rot im *)
+						ARMv7M.EmitRORIm(armcode, pc, S, ER(a), ER(b), im)
+						(* S=1: N, Z, C will be updated *)
+					END
+				END
+			ELSIF op = Mov THEN
+				MovIm(S, a, im)
+			ELSE
+				ARMv7M.EncodeMI12(im, i, imm3, imm8, isMI);
+				CASE op OF And: (* R.a := R.b & im *)
+					IF isMI THEN
+						(* A7.7.8: AND (immediate); encoding T1 ARMv7-M *)
+							ASSERT(~(a IN {13,15}), 100);
+							ASSERT(~(b IN {13,15}), 101);
+							ARMv7M.EmitDPMI(armcode, pc, i, S, ER(b), imm3, ER(a), imm8)
+							(* S=1: N, Z, C will be updated *) (* NOTE: C *)
+					ELSE
+						imInv := ORDSET(BITS(im) / {0..31});
+						ARMv7M.EncodeMI12(imInv, i, imm3, imm8, isMI);
+						IF isMI THEN
+							(* A7.7.15: BIC (immediate); encoding T1 ARMv7-M *)
+								ASSERT(~(a IN {13,15}), 100);
+								ASSERT(~(b IN {13,15}), 102);
+								ARMv7M.EmitDPMI(armcode, pc, i, 2 + S, ER(b), imm3, ER(a), imm8)
+								(* S=1: N, Z, C will be updated *) (* NOTE: C *)
+						ELSE
+							(* TODO: MOV, ORN optimization(s) possible?... *)
+							IF a = b THEN
+								r := RH; IF (a < MT) & (r <= a) THEN r := a + 1 END;
+								ASSERT(r < MT, 102);
+								MovIm(0, r, im);
+								Put00(S, op, a, b, r)
+							ELSE
+								MovIm(0, a, im);
+								Put00(S, op, a, b, a)
+							END
+						END
+					END
+				| Ior: (* R.a := R.b or im *)
+					IF isMI THEN
+						(* A7.7.90: ORR (immediate); encoding T1 ARMv7-M *)
+							ASSERT(~(a IN {13,15}), 100);
+							ASSERT(~(b IN {13,15}), 102);
+							ARMv7M.EmitDPMI(armcode, pc, i, 4 + S, ER(b), imm3, ER(a), imm8)
+							(* S=1: N, Z, C will be updated *) (* NOTE: C *)
+					ELSE (* try R.a := R.b or~ ~im *)
+						imInv := ORDSET(BITS(im) / {0..31});
+						ARMv7M.EncodeMI12(imInv, i, imm3, imm8, isMI);
+						IF isMI THEN
+							(* A7.7.88: ORN (immediate); encoding T1 ARMv7-M *)
+								ASSERT(~(a IN {13,15}), 100);
+								ASSERT(~(b IN {13,15}), 102);
+								ARMv7M.EmitDPMI(armcode, pc, i, 6 + S, ER(b), imm3, ER(a), imm8)
+								(* S=1: N, Z, C will be updated *) (* NOTE: C *)
+						ELSE
+							(* TODO: MOV, ORN optimization(s) possible?... *)
+							IF a = b THEN
+								r := RH; IF (a < MT) & (r <= a) THEN r := a + 1 END;
+								ASSERT(r < MT, 102);
+								MovIm(0, r, im);
+								Put00(S, op, a, b, r)
+							ELSE
+								MovIm(0, a, im);
+								Put00(S, op, a, b, a)
+							END
+						END
+					END
+				| Xor: (* R.a := R.b xor im *)
+					IF isMI THEN
+						(* A7.7.34: EOR (immediate); encoding T1 ARMv7-M *)
+							ASSERT(~(a IN {13,15}), 100);
+							ASSERT(~(b IN {13,15}), 103);
+							ARMv7M.EmitDPMI(armcode, pc, i, 8 + S, ER(b), imm3, ER(a), imm8)
+							(* S=1: N, Z, C will be updated *) (* NOTE: C *)
+					ELSIF a = b THEN
+						r := RH; IF (a < MT) & (r <= a) THEN r := a + 1 END;
+						ASSERT(r < MT, 102);
+						MovIm(0, r, im);
+						Put00(S, op, a, b, r)
+					ELSE
+						MovIm(0, a, im);
+						Put00(S, op, a, b, a)
+					END
+				| Add: (* R.a := R.b + im *)
+					ASSERT(a # 15, 104);
+					IF (ER(a) DIV 8 = 0) & (ER(b) DIV 8 = 0) & ((im DIV 8 = 0) OR (im DIV 100H = 0) & (a = b)) THEN
+						ARMv6M.EmitADDSIm(armcode, pc, ER(a), ER(b), im)
+					ELSIF (b = SP) & (im MOD 4 = 0) & (S = 0) & (((a = SP) & (im DIV 200H = 0)) OR ((ER(a) DIV 8 = 0) & (im DIV 400H = 0))) THEN
+						ARMv6M.EmitADDSPIm(armcode, pc, ER(a), im DIV 4)
+					ELSIF isMI THEN
+						ASSERT(b # 15, 105);
+						ASSERT((b = 13) OR (a # 13), 106);
+						(* A7.7.3: ADD (immediate); encoding T3 ARMv7-M *)
+						(* A7.7.5: ADD (SP plus immediate); encoding T3 ARMv7-M *)
+							ARMv7M.EmitDPMI(armcode, pc, i, 16 + S, ER(b), imm3, ER(a), imm8)
+							(* S = 1: N, Z, C, V will be updated *) (* NOTE: C *)
+					ELSIF im DIV 1000H = 0 THEN
+						ASSERT((b = 13) OR ((b # 15) & (a # 13)), 107);
+						(* A7.7.3: ADD (immediate); encoding T4 ARMv7-M *)
+						(* A7.7.5: ADD (SP plus immediate); encoding T4 ARMv7-M *)
+							i := im DIV 800H;
+							imm3 := im DIV 100H MOD 8;
+							imm8 := im MOD 100H;
+							ARMv7M.EmitDPPBI(armcode, pc, i, 0, ER(b), imm3 * 1000H + ER(a) * 100H + imm8);
+							IF S = 1 THEN
+								UpdateFlags(a)
+							END
+					ELSIF a = b THEN
+						r := RH; IF (a < MT) & (r <= a) THEN r := a + 1 END;
+						ASSERT(r < MT, 108);
+						MovIm(0, r, im);
+						Put00(S, op, a, b, r)
+					ELSE
+						MovIm(0, a, im);
+						Put00(S, op, a, b, a)
+					END
+				| Sub: (* R.a := R.b - im *)
+					ASSERT(a # 15, 107);
+					IF (a = b) & (im = 0) THEN (* Cmp *)
+						ASSERT(S = 1, 100);
+						UpdateFlags(a)
+					ELSIF (ER(a) DIV 8 = 0) & (ER(b) DIV 8 = 0) & ((im DIV 8 = 0) OR (im DIV 100H = 0) & (a = b)) THEN
+						ARMv6M.EmitSUBSIm(armcode, pc, ER(a), ER(b), im)
+					ELSIF (a = SP) & (b = SP) & (im MOD 4 = 0) & (S = 0) & (im DIV 200H = 0) THEN
+						ARMv6M.EmitSUBSPIm(armcode, pc, im DIV 4)
+					ELSIF isMI THEN
+						ASSERT(b # 15, 108);
+						ASSERT((b = 13) OR (a # 13), 109);
+						(* A7.7.171: SUB (immediate); encoding T3 ARMv7-M *)
+						(* A7.7.173: SUB (SP minus immediate); encoding T2 ARMv7-M *)
+							ARMv7M.EmitDPMI(armcode, pc, i, 1AH + S, ER(b), imm3, ER(a), imm8)
+							(* S=1: N, Z, C, V will be updated *) (* NOTE: C *)
+					ELSIF (im DIV 1000H = 0) & ((S = 0) OR ~updateCarry) THEN
+						ASSERT((b = 13) OR ((b # 15) & (a # 13)), 110);
+						(* A7.7.171: SUB (immediate); encoding T4 ARMv7-M *)
+						(* A7.7.173: SUB (SP minus immediate); encoding T3 ARMv7-M *)
+							i := im DIV 800H;
+							imm3 := im DIV 100H MOD 8;
+							imm8 := im MOD 100H;
+							ARMv7M.EmitDPPBI(armcode, pc, i, 10, ER(b), imm3 * 1000H + ER(a) * 100H + imm8);
+							IF S = 1 THEN
+								ASSERT(~updateCarry);
+								UpdateFlags(a)
+									(* NOTE: in this case C flag updated incorrectly *)
+							END
+					ELSIF a = b THEN
+						r := RH; IF (a < MT) & (r <= a) THEN r := a + 1 END;
+						ASSERT(r < MT, 111);
+						MovIm(0, r, im);
+						Put00(S, op, a, b, r)
+					ELSE
+						MovIm(0, a, im);
+						Put00(S, op, a, b, a)
+					END
+				| Mul: (* R.a := R.b * im *)
+					IF a = b THEN
+						r := RH; IF (a < MT) & (r <= a) THEN r := a + 1 END;
+						ASSERT(r < MT, 112);
+						MovIm(0, r, im);
+						Put00(S, op, a, b, r)
+					ELSE
+						MovIm(0, a, im);
+						Put00(S, op, a, b, a)
+					END
+				| Div: (* R.a := R.b div im *)
+					IF a = b THEN
+						r := RH; IF (a < MT) & (r <= a) THEN r := a + 1 END;
+						ASSERT(r < MT, 113);
+						MovIm(0, r, im);
+						Put00(S, op, a, b, r)
+					ELSE
+						MovIm(0, a, im);
+						Put00(S, op, a, b, a)
+					END
+				END
+			END
+
+		END
+	END Put10;
+
+	PROCEDURE Put1 (op, a, b, im: INTEGER);
+	BEGIN
+		Put10(1, op, a, b, im)
+	END Put1;
+
+	PROCEDURE Put1a (op, a, b, im: LONGINT);
+	BEGIN (*same as Put1, but with range test	-10000H <= im < 10000H
+		IF (im >= -10000H) & (im <= 0FFFFH) THEN Put1(op, a, b, im)
+		ELSE Put1(Mov+U, RH, 0, im DIV 10000H);
+			IF im MOD 10000H # 0 THEN Put1(Ior, RH, RH, im MOD 10000H) END ;
+			Put0(op, a, b, RH)
+		END *)
+
+		ASSERT(op DIV 10H = 0, 20);
+
+		Put1(op, a, b, im)
+	END Put1a;
+
+	PROCEDURE Put20 (S: INTEGER; op, a, b, off: LONGINT);
+		VAR v: BOOLEAN;
+			r: INTEGER;
+	BEGIN (*emit load/store instruction
+		code[pc] := ((op * 10H + a) * 10H + b) * 100000H + (off MOD 100000H); INC(pc) *)
+
+		ASSERT(S IN {0,1}, 20);
+
+		IF ORS.errcnt = 0 THEN
+
+			ASSERT(b DIV 10H = 0, 21);
+
+(*
+			ASSERT(off >= 0, 22);
+			ASSERT(off < 100000H, 23);
+*)
+			ASSERT(off >= -80000H, 22);
+			ASSERT(off < 80000H, 23);
+
+			v := ODD(op); IF v THEN DEC(op) END;
+
+			RemoveRedundantCmp;
+
+			IF op = Ldr THEN (* R.a := Mem[R.b + off] *)
+				ASSERT(a DIV 10H = 0, 24);
+				(* http://www.st.com/web/en/resource/technical/document/errata_sheet/DM00037591.pdf, section 1.1 *)
+					ASSERT(ER(a) # SP);
+				INCL(RM, a);
+				IF ~v THEN (* load word *)
+					ASSERT(off MOD 4 = 0, 100);
+					IF off < 0 THEN
+						ARMv7M.EmitLWImWNeg(armcode, pc, ER(a), ER(b), -off)
+					ELSIF (ER(a) DIV 8 = 0) & (((b = SP) & (off DIV 400H = 0)) OR ((ER(b) DIV 8 = 0) & (off DIV 4 DIV 32 = 0))) THEN
+						ARMv6M.EmitLDRIm(armcode, pc, ER(a), ER(b), off DIV 4)
+					ELSIF off < 1000H THEN
+						ARMv7M.EmitLWImW(armcode, pc, ER(a), ER(b), off)
+					ELSE
+						IF a = b THEN
+							r := RH;
+							IF (a < MT) & (r <= a) THEN r := a + 1 END;
+							ASSERT(r < MT, 101)
+						ELSE
+							r := a
+						END;
+						IF (ER(a) DIV 8 = 0) & (ER(b) DIV 8 = 0) & (ER(r) DIV 8 = 0) THEN
+							MovIm(0, r, off);
+							ARMv6M.EmitLDRR(armcode, pc, ER(a), ER(b), ER(r))
+						ELSIF off MOD 8 = 0 THEN
+							MovIm(0, r, off DIV 8);
+							ARMv7M.EmitLWRW(armcode, pc, ER(a), ER(b), ER(r), 3)
+						ELSE
+							MovIm(0, r, off DIV 4);
+							ARMv7M.EmitLWRW(armcode, pc, ER(a), ER(b), ER(r), 2)
+						END
+					END
+				ELSE (* load byte *)
+					IF off < 0 THEN
+						HALT(126)
+					ELSIF (ER(a) DIV 8 = 0) & (ER(b) DIV 8 = 0) & (off DIV 32 = 0) THEN
+						ARMv6M.EmitLDRBIm(armcode, pc, ER(a), ER(b), off)
+					ELSIF off < 1000H THEN
+						ARMv7M.EmitLBImW(armcode, pc, ER(a), ER(b), off)
+					ELSE
+						IF a = b THEN
+							r := RH;
+							IF (a < MT) & (r <= a) THEN r := a + 1 END;
+							ASSERT(r < MT, 101)
+						ELSE
+							r := a
+						END;
+						IF (ER(a) DIV 8 = 0) & (ER(b) DIV 8 = 0) & (ER(r) DIV 8 = 0) THEN
+							MovIm(0, r, off);
+							ARMv6M.EmitLDRBR(armcode, pc, ER(a), ER(b), ER(r))
+						ELSIF off MOD 8 = 0 THEN
+							MovIm(0, r, off DIV 8);
+							ARMv7M.EmitLBRW(armcode, pc, ER(a), ER(b), ER(r), 3)
+						ELSIF off MOD 4 = 0 THEN
+							MovIm(0, r, off DIV 4);
+							ARMv7M.EmitLBRW(armcode, pc, ER(a), ER(b), ER(r), 2)
+						ELSIF off MOD 2 = 0 THEN
+							MovIm(0, r, off DIV 2);
+							ARMv7M.EmitLBRW(armcode, pc, ER(a), ER(b), ER(r), 1)
+						ELSE
+							MovIm(0, r, off);
+							ARMv7M.EmitLBRW(armcode, pc, ER(a), ER(b), ER(r), 0)
+						END
+					END
+				END;
+				IF S = 1 THEN UpdateFlags(a) END
+			ELSIF op = Str THEN (* Mem[R.b + off] := R.a *)
+				ASSERT(off >= 0, 126);
+				IF ~v THEN (* store word *)
+					ASSERT(off MOD 4 = 0, 102);
+					IF a >= 100H THEN (* FPU register *)
+						DEC(a, 100H);
+						ARMv7M.EmitVSTR(armcode, pc, ER(a), ER(b), 1, off DIV 4)
+					ELSIF (ER(a) DIV 8 = 0) & (((b = SP) & (off DIV 400H = 0)) OR ((ER(b) DIV 8 = 0) & (off DIV 4 DIV 32 = 0))) THEN
+						ARMv6M.EmitSTRIm(armcode, pc, ER(a), ER(b), off DIV 4)
+					ELSIF off < 1000H THEN
+						ARMv7M.EmitSWImW(armcode, pc, ER(a), ER(b), off)
+					ELSE
+						r := RH;
+						IF (a < MT) & (r <= a) THEN r := a + 1 END;
+						IF (b < MT) & (r <= b) THEN r := b + 1 END;
+						ASSERT(r < MT, 101);
+						IF (ER(a) DIV 8 = 0) & (ER(b) DIV 8 = 0) & (ER(r) DIV 8 = 0) THEN
+							MovIm(0, r, off);
+							ARMv6M.EmitSTRR(armcode, pc, ER(a), ER(b), ER(r))
+						ELSIF off MOD 8 = 0 THEN
+							MovIm(0, r, off DIV 8);
+							ARMv7M.EmitSWRW(armcode, pc, ER(a), ER(b), ER(r), 3)
+						ELSE
+							MovIm(0, r, off DIV 4);
+							ARMv7M.EmitSWRW(armcode, pc, ER(a), ER(b), ER(r), 2)
+						END
+					END
+				ELSE (* store byte *)
+					ASSERT(a DIV 10H = 0, 100);
+					IF (ER(a) DIV 8 = 0) & (ER(b) DIV 8 = 0) & (off DIV 32 = 0) THEN
+						ARMv6M.EmitSTRBIm(armcode, pc, ER(a), ER(b), off)
+					ELSIF off < 1000H THEN
+						ARMv7M.EmitSBImW(armcode, pc, ER(a), ER(b), off)
+					ELSE
+						r := RH;
+						IF (a < MT) & (r <= a) THEN r := a + 1 END;
+						IF (b < MT) & (r <= b) THEN r := b + 1 END;
+						ASSERT(r < MT, 101);
+						IF (ER(a) DIV 8 = 0) & (ER(b) DIV 8 = 0) & (ER(r) DIV 8 = 0) THEN
+							MovIm(0, r, off);
+							ARMv6M.EmitSTRBR(armcode, pc, ER(a), ER(b), ER(r))
+						ELSIF off MOD 8 = 0 THEN
+							MovIm(0, r, off DIV 8);
+							ARMv7M.EmitSBRW(armcode, pc, ER(a), ER(b), ER(r), 3)
+						ELSIF off MOD 4 = 0 THEN
+							MovIm(0, r, off DIV 4);
+							ARMv7M.EmitSBRW(armcode, pc, ER(a), ER(b), ER(r), 2)
+						ELSIF off MOD 2 = 0 THEN
+							MovIm(0, r, off DIV 2);
+							ARMv7M.EmitSBRW(armcode, pc, ER(a), ER(b), ER(r), 1)
+						ELSE
+							MovIm(0, r, off);
+							ARMv7M.EmitSBRW(armcode, pc, ER(a), ER(b), ER(r), 0)
+						END
+					END
+				END
+			ELSE HALT(1) (* invalid operation *)
+			END
+
+		END
+	END Put20;
+
+	PROCEDURE Put2 (op, a, b, off: INTEGER);
+	BEGIN
+		Put20(1, op, a, b, off)
+	END Put2;
+
+	PROCEDURE CondRISCToARM (cond: INTEGER): INTEGER;
+	BEGIN
+		CASE cond OF MI: RETURN ARMv6M.MI
+		| EQ: RETURN ARMv6M.EQ
+		| 2: RETURN ARMv6M.CC
+		| LT: RETURN ARMv6M.LT
+		| LE: RETURN ARMv6M.LE
+		| 7: RETURN ARMv6M.AL
+		| PL: RETURN ARMv6M.PL
+		| NE: RETURN ARMv6M.NE
+		| 10: RETURN ARMv6M.CS
+		| GE: RETURN ARMv6M.GE
+		| GT: RETURN ARMv6M.GT
+		(* | 15: RETURN 15 *)
+		END
+	END CondRISCToARM;
+
+(*
+	PROCEDURE CondARMToRISC (armcond: INTEGER): INTEGER;
+	BEGIN
+		CASE armcond OF ARMv6M.EQ: RETURN EQ
+		| ARMv6M.NE: RETURN NE
+		| ARMv6M.CS: RETURN 10
+		| ARMv6M.CC: RETURN 2
+		| ARMv6M.MI: RETURN MI
+		| ARMv6M.PL: RETURN PL
+		| ARMv6M.GE: RETURN GE
+		| ARMv6M.LT: RETURN LT
+		| ARMv6M.GT: RETURN GT
+		| ARMv6M.LE: RETURN LE
+		| ARMv6M.AL: RETURN 7
+		(* | 15: RETURN 15 *)
+		END
+	END CondARMToRISC;
+*)
+
+	PROCEDURE ^ negated(cond: LONGINT): LONGINT;
+
+	PROCEDURE Put3 (op, cond, off: LONGINT);
+		VAR S, imm10, J1, J2, imm11, imm6: INTEGER;
+			pc0, pc1: INTEGER;
+	BEGIN (*emit branch instruction
+		code[pc] := ((op+12) * 10H + cond) * 1000000H + (off MOD 1000000H); INC(pc) *)
+
+		IF ORS.errcnt = 0 THEN
+
+			ASSERT(op DIV 4 = 0, 20);
+			ASSERT(cond DIV 10H = 0, 21);
+
+			CASE op OF BR: (* if cond, then PC := R.c *)
+				IF off IN {0..15} THEN
+					ASSERT(cond = 7, 102);
+					ARMv6M.EmitBX(armcode, pc, ER(off))
+				ELSIF off = 10H THEN
+					(* return from interrupt *)
+					HALT(126)
+				ELSE HALT(1)
+				END
+			| BLR:
+				IF off MOD 10H = MT THEN (* Trap or New *)
+					off := off DIV 10H MOD 10000000H;
+					(* see Kernel.Trap, System.Trap *)
+					IF off MOD 10H = 0 THEN (* New *)
+						ASSERT(cond = 7, 100);
+						(* NOTE: New() arguments in R0, R1 *)
+						ARMv6M.EmitSVC(armcode, pc, off MOD 10H)
+					ELSIF cond = 7 THEN
+						MovIm(0, 1, off DIV 10H); (* R1 := ORS.Pos *)
+						ARMv6M.EmitSVC(armcode, pc, off MOD 10H)
+					ELSE
+						pc0 := pc; Put3(BC, 0, 0);
+						MovIm(0, 1, off DIV 10H); (* R1 := ORS.Pos *)
+						ARMv6M.EmitSVC(armcode, pc, off MOD 10H);
+						pc1 := pc;
+						pc := pc0;
+						Put3(BC, negated(cond), pc1 - pc0 - 1);
+						pc := pc1
+					END
+				ELSE (* if cond, then LNK := PC+1; PC := R.c *)
+					ASSERT(off DIV 10H = 0, 101);
+					ASSERT(cond = 7, 102);
+					ASSERT(off # 15, 103);
+					INCL(RM, LNK);
+					ARMv6M.EmitBLX(armcode, pc, ER(off))
+				END
+			| BC: (* if cond, then PC := PC+1+offset *)
+				ASSERT(off >= -800000H, 102);
+				ASSERT(off < 800000H, 103);
+
+					DEC(off);
+
+				IF cond = 7 THEN
+					IF (off >= -1024) & (off <= 1023) THEN
+						ARMv6M.EmitB(armcode, pc, off)
+					ELSE
+						(*
+						(* A7.7.12: B; encoding T4 ARMv7-M *)
+							ARMv6M.EncodeBLabel24(off, S, imm10, J1, J2, imm11);
+							ARMv7M.EmitBAMC(armcode, pc, S * 40H + imm10 DIV 10H, imm10 MOD 10H, J1 * 2 + 1, J2 * 800H + imm11)
+						*)
+						ORS.Mark("unconditional branch is too long")
+					END
+				ELSIF cond = 15 THEN
+					ARMv6M.EmitNOP(armcode, pc)
+				ELSE
+					cond := CondRISCToARM(cond);
+					IF (off >= -128) & (off <= 127) THEN
+						ARMv6M.EmitBC(armcode, pc, cond, off)
+					ELSE
+						(*
+						(* A7.7.12: B; encoding T3 ARMv7-M *)
+							ARMv7M.EncodeBLabel20(off, S, imm6, J1, J2, imm11);
+							ARMv7M.EmitBAMC(armcode, pc, S * 40H + cond * 4 + imm6 DIV 10H, imm6 MOD 10H, J1 * 2, J2 * 800H + imm11)
+						*)
+						ORS.Mark("conditional branch is too long")
+					END
+				END
+
+			| BL: (* if cond, then LNK := PC+1; PC := PC+1+offset *)
+				ASSERT(off >= -800000H, 104);
+				ASSERT(off < 800000H, 105);
+
+				INCL(RM, LNK);
+
+				IF cond # 7 THEN
+					HALT(126)
+				ELSE
+						IF off # 0 THEN DEC(off) END;
+					ARMv6M.EmitBL(armcode, pc, off)
+				END
+			END
+
+		END
+	END Put3;
+
+	PROCEDURE incR;
+	BEGIN
+		EXCL(FR, RH);
+		IF RH < MT-1 THEN INC(RH) ELSE ORS.Mark("register stack overflow") END
+	END incR;
+
+	PROCEDURE CheckRegs*;
+	BEGIN
+		IF RH # 0 THEN ORS.Mark("Reg Stack"); RH := 0 END ;
+		IF pc >= maxCode - 40 THEN ORS.Mark("program too long") END;
+		IF frame # 0 THEN ORS.Mark("frame error"); frame := 0 END
+	END CheckRegs;
+
+	PROCEDURE SetCC(VAR x: Item; n: LONGINT);
+	BEGIN x.mode := Cond; x.a := 0; x.b := 0; x.r := n
+	END SetCC;
+
+	PROCEDURE Trap(cond, num: LONGINT);
+	BEGIN Put3(BLR, cond, ORS.Pos()*100H + num*10H + MT)
+	END Trap;
+
+	(*handling of forward reference, fixups of branch addresses and constant tables*)
+
+	PROCEDURE negated(cond: LONGINT): LONGINT;
+	BEGIN
+		IF cond < 8 THEN cond := cond+8 ELSE cond := cond-8 END ;
+		RETURN cond
+	END negated;
+
+	PROCEDURE invalSB;
+	BEGIN curSB := 1
+	END invalSB;
+
+(*
+	PROCEDURE fix(at, with: LONGINT);
+	BEGIN
+		IF armcode[at] DIV 10000000H MOD 10H = 0EH (* BC *) THEN
+			HALT(1);
+			ASSERT(armcode[at+1] = 00FFFFFEH, 100);
+			armcode[at] := armcode[at] DIV C24 * C24 + (with MOD C24)
+		ELSE
+			ASSERT(armcode[at] = 00FFFFFEH, 101);
+			ASSERT(armcode[at-1] DIV 10000000H MOD 10H = 0EH, 102); (* BC *)
+			armcode[at-1] := armcode[at-1] DIV C24 * C24 + (with MOD C24)
+		END
+	END fix;
+
+	PROCEDURE FixLink*(L: LONGINT);
+		VAR L1: LONGINT;
+	BEGIN invalSB;
+		WHILE L # 0 DO
+			IF armcode[L] DIV 10000000H MOD 10H = 0EH (* BC *) THEN
+				HALT(1);
+				ASSERT(armcode[L+1] = 00FFFFFEH, 100);
+				L1 := armcode[L] MOD 40000H;
+				fix(L, pc-L-1)
+			ELSE
+				ASSERT(armcode[L] = 00FFFFFEH, 101);
+				ASSERT(armcode[L-1] DIV 10000000H MOD 10H = 0EH, 102); (* BC *)
+				L1 := armcode[L-1] MOD 40000H;
+				fix(L, pc-L-1+1)
+			END;
+			L := L1
+		END
+	END FixLink;
+
+	PROCEDURE FixLinkWith (L0, dst: LONGINT);
+		VAR L1: LONGINT;
+	BEGIN
+		WHILE L0 # 0 DO
+			IF armcode[L0] DIV 10000000H MOD 10H = 0EH THEN (* BC *)
+				ASSERT(armcode[L0+1] = 00FFFFFEH, 101);
+				L1 := armcode[L0] MOD C24;
+				armcode[L0] := armcode[L0] DIV C24 * C24 + ((dst - L0 - 1) MOD C24)
+			ELSE
+				ASSERT(armcode[L0] = 00FFFFFEH, 101);
+				ASSERT(armcode[L0-1] DIV 10000000H MOD 10H = 0EH, 102); (* BC *)
+				L1 := armcode[L0-1] MOD C24;
+				armcode[L0-1] := armcode[L0-1] DIV C24 * C24 + ((dst - L0 - 1 + 1) MOD C24)
+			END;
+			L0 := L1
+		END
+	END FixLinkWith;
+
+	PROCEDURE merged (L0, L1: LONGINT): LONGINT;
+		VAR L2, L3: LONGINT;
+	BEGIN
+		IF L0 # 0 THEN L3 := L0;
+			HALT(126);
+			REPEAT L2 := L3;
+			ASSERT(armcode[L2] DIV 10000000H MOD 10H = 0EH, 100); (* BC *)
+			ASSERT(armcode[L2+1] = 00FFFFFEH, 101);
+			L3 := armcode[L2] MOD 40000H UNTIL L3 = 0;
+			ASSERT(armcode[L2] DIV 10000000H MOD 10H = 0EH, 102); (* BC *)
+			ASSERT(armcode[L2+1] = 00FFFFFEH, 103);
+			armcode[L2] := armcode[L2] + L1; L1 := L0
+		END;
+		RETURN L1
+	END merged;
+*)
+
+	PROCEDURE fix (at, with: LONGINT);
+	BEGIN
+		IF ORS.errcnt = 0 THEN
+			ASSERT(armcode[at] DIV 10000000H MOD 10H = 0EH, 100) (* BC *)
+		END;
+		armcode[at] := armcode[at] DIV C24 * C24 + (with MOD C24)
+	END fix;
+
+	PROCEDURE FixOne*(at: LONGINT);
+	BEGIN fix(at, pc-at-1)
+	END FixOne;
+
+	PROCEDURE FixLink*(L: LONGINT);
+		VAR L1: LONGINT;
+	BEGIN invalSB;
+		WHILE L # 0 DO L1 := armcode[L] MOD 40000H; fix(L, pc-L-1); L := L1 END
+	END FixLink;
+
+	PROCEDURE FixLinkWith (L0, dst: LONGINT);
+		VAR L1: LONGINT;
+	BEGIN
+		WHILE L0 # 0 DO
+			L1 := armcode[L0] MOD C24;
+			armcode[L0] := armcode[L0] DIV C24 * C24 + ((dst - L0 - 1) MOD C24); L0 := L1
+		END
+	END FixLinkWith;
+
+	PROCEDURE merged (L0, L1: LONGINT): LONGINT;
+		VAR L2, L3: LONGINT;
+	BEGIN
+		IF L0 # 0 THEN L3 := L0;
+			REPEAT L2 := L3; L3 := armcode[L2] MOD 40000H UNTIL L3 = 0;
+			armcode[L2] := armcode[L2] + L1; L1 := L0
+		END;
+		RETURN L1
+	END merged;
+
+	(* loading of operands and addresses into registers *)
+
+	PROCEDURE GetSB (base: LONGINT);
+	BEGIN
+		IF (version # 0) & ((base # curSB) OR (base # 0)) THEN
+			(* will be fixed up by linker/loader *)
+				INCL(RM, SB);
+				Put2orig(Ldr, ER(SB), -base, pc-fixorgD); fixorgD := pc-1; curSB := base;
+				armcode[pc] := 00FFFFFDH; INC(pc)
+		END
+	END GetSB;
+
+	PROCEDURE NilCheck;
+	BEGIN IF check THEN Trap(EQ, 4) END
+	END NilCheck;
+
+	PROCEDURE load0 (S: INTEGER; VAR x: Item);
+		VAR op, pc0, pc1: LONGINT;
+	BEGIN
+		ASSERT(S IN {0,1}, 20);
+		IF x.type.size = 1 THEN op := Ldr+1 ELSE op := Ldr END ;
+		IF x.mode # Reg THEN
+			IF x.mode = ORB.Const THEN
+				IF x.type.form = ORB.Proc THEN
+					IF x.r > 0 THEN ORS.Mark("not allowed")
+					ELSIF x.r = 0 THEN Put3(BL, 7, 0);
+						ASSERT(x.a MOD 2 = 0, 100);
+						Put10(S, Sub, RH, LNK, (pc*4 - x.a) DIV 2)
+					ELSE GetSB(x.r);
+						INCL(RM, RH);
+						Put1orig(Add, ER(RH), ER(SB), x.a + 100H); (*mark as progbase-relative*)
+						armcode[pc] := 00FFFFFFH; INC(pc)
+					END
+				(*
+				ELSIF (x.a <= 0FFFFH) & (x.a >= -10000H) THEN Put1(Mov, RH, 0, x.a)
+				ELSE Put1(Mov+U, RH, 0, x.a DIV 10000H MOD 10000H);
+					IF x.a MOD 10000H # 0 THEN Put1(Ior, RH, RH, x.a MOD 10000H) END
+				*)
+				ELSE Put10(S, Mov, RH, 0, x.a)
+				END;
+				x.r := RH; incR
+			ELSIF x.mode = ORB.Var THEN
+				IF x.r > 0 THEN (*local*) Put20(S, op, RH, SP, x.a + frame)
+				ELSE GetSB(x.r);
+					IF x.r # 0 THEN
+						INCL(RM, RH);
+						Put2orig(op, ER(RH), ER(SB), x.a);
+						armcode[pc] := 00FFFFFFH; INC(pc);
+						IF S = 1 THEN UpdateFlags(RH) END
+					ELSE Put20(S, op, RH, SB, x.a)
+					END
+				END;
+				x.r := RH; incR
+			ELSIF x.mode = ORB.Par THEN Put20(0, Ldr, RH, SP, x.a + frame); Put20(S, op, RH, RH, x.b); x.r := RH; incR
+			ELSIF x.mode = RegI THEN Put20(S, op, x.r, x.r, x.a)
+			ELSIF x.mode = Cond THEN
+				pc0 := pc; Put3orig(BC, negated(x.r), 0);
+				FixLink(x.b); Put10(S, Mov, RH, 0, 1);
+				pc1 := pc; Put3orig(BC, 7, 0);
+				fix(pc0, pc - pc0 - 1);
+				FixLink(x.a); Put10(S, Mov, RH, 0, 0);
+				fix(pc1, pc - pc1 - 1);
+				x.r := RH; incR
+			END;
+			x.mode := Reg
+		END
+	END load0;
+
+	PROCEDURE load (VAR x: Item);
+	BEGIN
+		load0(1, x)
+	END load;
+
+	PROCEDURE loadReal (VAR x: Item);
+		VAR im: INTEGER;
+	BEGIN
+		RemoveRedundantCmp;
+		IF x.mode = ORB.Var THEN
+			IF x.r > 0 (* local *) THEN
+				im := x.a + frame; ASSERT(im MOD 4 = 0, 100);
+				ARMv7M.EmitVLDR(armcode, pc, ER(RH), ER(SP), 1, im DIV 4)
+			ELSE GetSB(x.r);
+				IF x.r # 0 THEN
+					INCL(RM, RH);
+					ASSERT(x.type.size = 4, 101);
+					Put2orig(Ldr, ER(RH), ER(SB), x.a);
+					armcode[pc] := 00FFFFFCH (* VLDR *); INC(pc)
+				ELSE
+					ASSERT(x.a MOD 4 = 0, 102);
+					ARMv7M.EmitVLDR(armcode, pc, ER(RH), ER(SB), 1, x.a DIV 4)
+				END
+			END;
+			x.r := RH + 100H; incR; INCL(FR, x.r - 100H); x.mode := Reg
+		ELSIF x.mode = ORB.Par THEN
+			Put20(0, Ldr, RH, SP, x.a + frame);
+			ASSERT(x.b MOD 4 = 0, 103);
+			ARMv7M.EmitVLDR(armcode, pc, ER(RH), ER(RH), 1, x.b DIV 4);
+			x.r := RH + 100H; incR; INCL(FR, x.r - 100H); x.mode := Reg
+		ELSE
+			load0(0, x)
+		END;
+		IF (x.mode = Reg) & (x.r < 100H) THEN
+			ARMv7M.EmitVMOVSPR(armcode, pc, 0, ER(x.r), ER(x.r));
+			INCL(FR, x.r); x.r := x.r + 100H
+		END
+	END loadReal;
+
+	PROCEDURE loadAdr0 (S: INTEGER; VAR x: Item);
+	BEGIN
+		IF x.mode = ORB.Var THEN
+			IF x.r > 0 THEN (*local*) Put10(S, Add, RH, SP, x.a + frame)
+			ELSE GetSB(x.r);
+				IF x.r # 0 THEN
+					INCL(RM, RH);
+					Put1orig(Add, ER(RH), ER(SB), x.a);
+					armcode[pc] := 00FFFFFFH; INC(pc)
+				ELSE Put10(S, Add, RH, SB, x.a)
+				END
+			END;
+			x.r := RH; incR
+		ELSIF x.mode = ORB.Par THEN
+			IF x.b # 0 THEN Put20(0, Ldr, RH, SP, x.a + frame);
+				Put10(S, Add, RH, RH, x.b)
+			ELSE Put20(S, Ldr, RH, SP, x.a + frame)
+			END;
+			x.r := RH; incR
+		ELSIF x.mode = RegI THEN
+			IF x.a # 0 THEN Put10(S, Add, x.r, x.r, x.a) END
+		ELSE ORS.Mark("address error")
+		END;
+		x.mode := Reg
+	END loadAdr0;
+
+	PROCEDURE loadAdr (VAR x: Item);
+	BEGIN
+		loadAdr0(1, x)
+	END loadAdr;
+
+	PROCEDURE IsFlagsUp0 (r: INTEGER): BOOLEAN;
+		VAR res: BOOLEAN; c: INTEGER;
+	BEGIN
+		r := ER(r); ASSERT(r # 15, 100);
+		IF r DIV 8 = 0 THEN
+			res := ~ARMv6M.IsLThumb32(armcode[pc - 2]) & IsCMPIm(armcode[pc - 1]);
+			ASSERT(~res OR (armcode[pc - 1] DIV 100H MOD 8 = r), 101)
+		ELSIF ARMv6M.IsLThumb32(armcode[pc - 2]) THEN
+			ASSERT(armcode[pc - 1] DIV 10000H = 0, 102);
+			c := 10000H * armcode[pc - 1] + armcode[pc - 2];
+			res := ARMv7M.IsCMPImW(c);
+			ASSERT(~res OR (c MOD 10H = r), 103)
+		ELSE
+			res := FALSE
+		END;
+		RETURN res
+	END IsFlagsUp0;
+
+	PROCEDURE loadCond (VAR x: Item);
+	BEGIN
+		IF x.type.form = ORB.Bool THEN
+			IF x.mode = ORB.Const THEN x.r := 15 - x.a*8
+			ELSE load(x);
+				IF ~IsFlagsUp0(x.r) THEN
+					Put1(Cmp, x.r, x.r, 0)
+				(* ELSE HALT(1) *)
+				END;
+				x.r := NE; DEC(RH)
+			END ;
+			x.mode := Cond; x.a := 0; x.b := 0
+		ELSE ORS.Mark("not Boolean?")
+		END
+	END loadCond;
+
+	PROCEDURE loadTypTagAdr0 (S: INTEGER; T: ORB.Type);
+		VAR x: Item;
+	BEGIN x.mode := ORB.Var; x.a := T.len; x.r := -T.mno; loadAdr0(S, x)
+	END loadTypTagAdr0;
+
+	PROCEDURE loadTypTagAdr (T: ORB.Type);
+	BEGIN
+		loadTypTagAdr0(1, T)
+	END loadTypTagAdr;
+
+	PROCEDURE loadStringAdr0 (S: INTEGER; VAR x: Item);
+	BEGIN GetSB(0); Put10(S, Add, RH, SB, varsize+x.a); x.mode := Reg; x.r := RH; incR
+	END loadStringAdr0;
+
+	PROCEDURE loadStringAdr (VAR x: Item);
+	BEGIN
+		loadStringAdr0(1, x)
+	END loadStringAdr;
+
+	(* Items: Conversion from constants or from Objects on the Heap to Items on the Stack*)
+
+	PROCEDURE MakeConstItem*(VAR x: Item; typ: ORB.Type; val: LONGINT);
+	BEGIN x.mode := ORB.Const; x.type := typ; x.a := val
+	END MakeConstItem;
+
+	PROCEDURE MakeRealItem*(VAR x: Item; val: REAL);
+	BEGIN x.mode := ORB.Const; x.type := ORB.realType; x.a := SYSTEM.VAL(LONGINT, val)
+	END MakeRealItem;
+
+	PROCEDURE MakeStringItem*(VAR x: Item; len: LONGINT); (*copies string from ORS-buffer to ORG-string array*)
+		VAR i: LONGINT;
+	BEGIN x.mode := ORB.Const; x.type := ORB.strType; x.a := strx; x.b := len; i := 0;
+		IF strx + len + 4 < maxStrx THEN
+			WHILE len > 0 DO str[strx] := ORS.str[i]; INC(strx); INC(i); DEC(len) END ;
+			WHILE strx MOD 4 # 0 DO str[strx] := 0X; INC(strx) END
+		ELSE ORS.Mark("too many strings")
+		END
+	END MakeStringItem;
+
+	PROCEDURE MakeItem*(VAR x: Item; y: ORB.Object; curlev: LONGINT);
+	BEGIN x.mode := y.class; x.type := y.type; x.a := y.val; x.rdo := y.rdo;
+		IF y.class = ORB.Par THEN x.b := 0
+		(* ELSIF y.class = ORB.Typ THEN x.a := y.type.len; x.r := -y.lev *)
+		ELSIF (y.class = ORB.Const) & (y.type.form = ORB.String) THEN x.b := y.lev	(*len*)
+		ELSE x.r := y.lev
+		END ;
+		IF (y.lev > 0) & (y.lev # curlev) & (y.class # ORB.Const) THEN ORS.Mark("not accessible") END
+	END MakeItem;
+
+	(* Code generation for Selectors, Variables, Constants *)
+
+	PROCEDURE Field*(VAR x: Item; y: ORB.Object);	 (* x := x.y *)
+	BEGIN;
+		IF x.mode = ORB.Var THEN
+			IF x.r >= 0 THEN x.a := x.a + y.val
+			ELSE loadAdr(x); x.mode := RegI; x.a := y.val
+			END
+		ELSIF x.mode = RegI THEN x.a := x.a + y.val
+		ELSIF x.mode = ORB.Par THEN x.b := x.b + y.val
+		END
+	END Field;
+
+	PROCEDURE Index*(VAR x, y: Item);	 (* x := x[y] *)
+		VAR s, lim: LONGINT;
+	BEGIN s := x.type.base.size; lim := x.type.len;
+		IF (y.mode = ORB.Const) & (lim >= 0) THEN
+			IF (y.a < 0) OR (y.a >= lim) THEN ORS.Mark("bad index") END ;
+			IF x.mode IN {ORB.Var, RegI} THEN
+				(*
+				x.a := y.a * s + x.a
+				*)
+					IF x.mode = ORB.Var THEN
+						IF x.r >= 0 THEN x.a := y.a * s + x.a
+						ELSE loadAdr(x); x.mode := RegI; x.a := y.a * s
+						END
+					ELSE (* x.mode = RegI *) x.a := y.a * s + x.a
+					END
+			ELSIF x.mode = ORB.Par THEN x.b := y.a * s + x.b
+			END
+		ELSE load0(0, y);
+			IF check THEN	(*check array bounds*)
+				updateCarry := TRUE;
+				IF lim >= 0 THEN Put1a(Cmp, RH, y.r, lim)
+				ELSE (*open array*)
+					IF x.mode IN {ORB.Var, ORB.Par} THEN Put20(0, Ldr, RH, SP, x.a+4+frame); Put0(Cmp, RH, y.r, RH)
+					ELSE ORS.Mark("error in Index")
+					END
+				END;
+				updateCarry := FALSE;
+				Trap(10, 1)	(*BCC*)
+			END ;
+			IF s = 4 THEN Put10(0, Lsl, y.r, y.r, 2) ELSIF s > 1 THEN Put10(0, Mul, y.r, y.r, s) END ;
+			IF x.mode = ORB.Var THEN
+				IF x.r > 0 THEN Put0(Add, y.r, SP, y.r); INC(x.a, frame)
+				ELSE GetSB(x.r);
+					IF x.r = 0 THEN Put0(Add, y.r, SB, y.r)
+					ELSE
+						INCL(RM, RH); Put1orig(Add, ER(RH), ER(SB), x.a);
+						armcode[pc] := 00FFFFFFH; INC(pc);
+						Put0(Add, y.r, RH, y.r); x.a := 0
+					END
+				END;
+				x.r := y.r; x.mode := RegI
+			ELSIF x.mode = ORB.Par THEN
+				Put20(0, Ldr, RH, SP, x.a + frame);
+				Put0(Add, y.r, RH, y.r); x.mode := RegI; x.r := y.r; x.a := x.b
+			ELSIF x.mode = RegI THEN Put0(Add, x.r, x.r, y.r); DEC(RH)
+			ELSE HALT(100)
+				(* if reached, then restore back:
+					load0(0,y) -> load(y)
+					IF s = 4...: Put10(0 -> Put1( ; Put10(0->Put1a
+				*)
+			END
+		END
+	END Index;
+
+	PROCEDURE DeRef*(VAR x: Item);
+	BEGIN
+		IF x.mode = ORB.Var THEN
+			IF x.r > 0 THEN (*local*) Put2(Ldr, RH, SP, x.a + frame) ELSE GetSB(x.r);
+				IF x.r # 0 THEN
+					INCL(RM, RH);
+					Put2orig(Ldr, ER(RH), ER(SB), x.a);
+					armcode[pc] := 00FFFFFFH; INC(pc);
+					UpdateFlags(RH)
+				ELSE Put2(Ldr, RH, SB, x.a)
+				END
+			END;
+			NilCheck; x.r := RH; incR
+		ELSIF x.mode = ORB.Par THEN
+			Put20(0, Ldr, RH, SP, x.a + frame); Put2(Ldr, RH, RH, x.b); NilCheck; x.r := RH; incR
+		ELSIF x.mode = RegI THEN Put2(Ldr, x.r, x.r, x.a); NilCheck
+		ELSIF x.mode # Reg THEN ORS.Mark("bad mode in DeRef")
+		END ;
+		x.mode := RegI; x.a := 0; x.b := 0
+	END DeRef;
+
+	PROCEDURE Q(T: ORB.Type; VAR dcw: LONGINT);
+	BEGIN (*one entry of type descriptor extension table*)
+		IF T.base # NIL THEN
+			Q(T.base, dcw); data[dcw] := (T.mno*1000H + T.len) * 1000H + dcw - fixorgT;
+			fixorgT := dcw; INC(dcw)
+		END
+	END Q;
+
+	PROCEDURE FindPtrFlds(typ: ORB.Type; off: LONGINT; VAR dcw: LONGINT);
+		VAR fld: ORB.Object; i, s: LONGINT;
+	BEGIN
+		IF (typ.form = ORB.Pointer) OR (typ.form = ORB.NilTyp) THEN data[dcw] := off; INC(dcw)
+		ELSIF typ.form = ORB.Record THEN
+			fld := typ.dsc;
+			WHILE fld # NIL DO FindPtrFlds(fld.type, fld.val + off, dcw); fld := fld.next END
+		ELSIF typ.form = ORB.Array THEN
+			s := typ.base.size;
+			FOR i := 0 TO typ.len-1 DO FindPtrFlds(typ.base, i*s + off, dcw) END
+		END
+	END FindPtrFlds;
+
+	PROCEDURE BuildTD*(T: ORB.Type; VAR dc: LONGINT);
+		VAR dcw, k, s: LONGINT;	(*dcw = word address*)
+	BEGIN dcw := dc DIV 4; s := T.size; (*convert size for heap allocation*)
+		IF s <= 24 THEN s := 32 ELSIF s <= 56 THEN s := 64 ELSIF s <= 120 THEN s := 128
+		ELSE s := (s+263) DIV 256 * 256
+		END ;
+		T.len := dc; data[dcw] := s; INC(dcw); (*len used as address*)
+		k := T.nofpar; (*extension level!*)
+		IF k > 3 THEN ORS.Mark("ext level too large")
+		ELSE Q(T, dcw);
+			WHILE k < 3 DO data[dcw] := -1; INC(dcw); INC(k) END
+		END ;
+		FindPtrFlds(T, 0, dcw); data[dcw] := -1; INC(dcw); tdx := dcw; dc := dcw*4;
+		IF tdx >= maxTD THEN ORS.Mark("too many record types"); tdx := 0 END
+	END BuildTD;
+
+	PROCEDURE TypeTest* (VAR x: Item; T: ORB.Type; varpar, isguard: BOOLEAN);
+		VAR pc0: LONGINT;
+	BEGIN
+		IF T = NIL THEN
+			IF x.mode >= Reg THEN DEC(RH) END;
+			SetCC(x, 7)
+		ELSE (*fetch tag into RH*)
+			IF varpar THEN Put20(0, Ldr, RH, SP, x.a+4+frame)
+			ELSE load(x);
+				pc0 := pc; Put3orig(BC, EQ, 0);	(*NIL belongs to every pointer type*)
+				Put20(0, Ldr, RH, x.r, -8)
+			END ;
+			Put20(0, Ldr, RH, RH, T.nofpar*4); incR;
+			loadTypTagAdr0(0, T);	(*tag of T*)
+			Put0(Cmp, RH-1, RH-1, RH-2); DEC(RH, 2);
+			IF ~varpar THEN fix(pc0, pc - pc0 - 1) END;
+			IF isguard THEN
+				IF check THEN Trap(NE, 2) END
+			ELSE SetCC(x, EQ);
+				IF ~varpar THEN DEC(RH) END
+			END
+		END
+	END TypeTest;
+
+	(* Code generation for Boolean operators *)
+
+	PROCEDURE Not*(VAR x: Item);	 (* x := ~x *)
+		VAR t: LONGINT;
+	BEGIN
+		IF x.mode # Cond THEN loadCond(x) END ;
+		x.r := negated(x.r); t := x.a; x.a := x.b; x.b := t
+	END Not;
+
+	PROCEDURE And1*(VAR x: Item);	 (* x := x & *)
+	BEGIN
+		IF x.mode # Cond THEN loadCond(x) END ;
+		Put3orig(BC, negated(x.r), x.a); x.a := pc-1; FixLink(x.b); x.b := 0
+	END And1;
+
+	PROCEDURE And2*(VAR x, y: Item);
+	BEGIN
+		IF y.mode # Cond THEN loadCond(y) END ;
+		x.a := merged(y.a, x.a); x.b := y.b; x.r := y.r
+	END And2;
+
+	PROCEDURE Or1*(VAR x: Item);	 (* x := x OR *)
+	BEGIN
+		IF x.mode # Cond THEN loadCond(x) END ;
+		Put3orig(BC, x.r, x.b);	x.b := pc-1; FixLink(x.a); x.a := 0
+	END Or1;
+
+	PROCEDURE Or2*(VAR x, y: Item);
+	BEGIN
+		IF y.mode # Cond THEN loadCond(y) END ;
+		x.a := y.a; x.b := merged(y.b, x.b); x.r := y.r
+	END Or2;
+
+	(* Code generation for arithmetic operators *)
+
+	PROCEDURE Neg*(VAR x: Item);	 (* x := -x *)
+	BEGIN
+		IF x.type.form = ORB.Int THEN
+			IF x.mode = ORB.Const THEN x.a := -x.a
+			ELSE load0(0, x);
+				(* Put10(0, Mov, RH, 0, 0); Put0(Sub, x.r, RH, x.r) *)
+					RSBS0(x.r)
+			END
+		ELSIF x.type.form = ORB.Real THEN
+			IF x.mode = ORB.Const THEN x.a := x.a + 7FFFFFFFH + 1
+			ELSE
+				(* load0(0, x); Put10(0, Mov, RH, 0, 0); Put0(Fsb, x.r, RH, x.r) *)
+					loadReal(x);
+					ARMv7M.EmitVNEG(armcode, pc, ER(x.r - 100H), ER(x.r - 100H))
+			END
+		ELSE (*form = Set*)
+			IF x.mode = ORB.Const THEN x.a := -x.a-1
+			ELSE load0(0, x); Put1(Xor, x.r, x.r, -1)
+			END
+		END
+	END Neg;
+
+	PROCEDURE AddOp*(op: LONGINT; VAR x, y: Item);	 (* x := x +- y *)
+	BEGIN
+		IF op = ORS.plus THEN
+			IF (x.mode = ORB.Const) & (y.mode = ORB.Const) THEN x.a := x.a + y.a
+			ELSIF y.mode = ORB.Const THEN
+				IF y.a # 0 THEN load0(0, x); Put1a(Add, x.r, x.r, y.a)
+				ELSE load(x)
+				END
+			ELSE load0(0, x); load0(0, y); Put0(Add, RH-2, x.r, y.r); DEC(RH); x.r := RH-1
+			END
+		ELSE (*op = ORS.minus*)
+			IF (x.mode = ORB.Const) & (y.mode = ORB.Const) THEN x.a := x.a - y.a
+			ELSIF y.mode = ORB.Const THEN
+				IF y.a # 0 THEN load0(0, x); Put1a(Sub, x.r, x.r, y.a)
+				ELSE load(x)
+				END
+			ELSE load0(0, x); load0(0, y); Put0(Sub, RH-2, x.r, y.r); DEC(RH); x.r := RH-1
+			END
+		END
+	END AddOp;
+
+	PROCEDURE log2(m: LONGINT; VAR e: LONGINT): LONGINT;
+	BEGIN e := 0;
+		WHILE ~ODD(m) DO m := m DIV 2; INC(e) END ;
+		RETURN m
+	END log2;
+
+	PROCEDURE MulOp*(VAR x, y: Item);	 (* x := x * y *)
+		VAR e: LONGINT;
+	BEGIN
+		IF (x.mode = ORB.Const) & (y.mode = ORB.Const) THEN x.a := x.a * y.a
+		ELSIF (y.mode = ORB.Const) & (y.a >= 2) & (log2(y.a, e) = 1) THEN load0(0, x); Put1(Lsl, x.r, x.r, e)
+		ELSIF y.mode = ORB.Const THEN load0(0, x); Put1a(Mul, x.r, x.r, y.a)
+		ELSIF (x.mode = ORB.Const) & (x.a >= 2) & (log2(x.a, e) = 1) THEN load0(0, y); Put1(Lsl, y.r, y.r, e); x.mode := Reg; x.r := y.r
+		ELSIF x.mode = ORB.Const THEN load0(0, y); Put1a(Mul, y.r, y.r, x.a); x.mode := Reg; x.r := y.r
+		ELSE load0(0, x); load0(0, y); Put0(Mul, RH-2, x.r, y.r); DEC(RH); x.r := RH-1
+		END
+	END MulOp;
+
+	(* R.d := R.a - R.n * R.m *)
+	PROCEDURE MLS (S: INTEGER; d, n, m, a: INTEGER);
+	BEGIN
+		ASSERT(S DIV 2 = 0, 20);
+		INCL(RM, d);
+		ARMv7M.EmitMLS(armcode, pc, ER(d), ER(n), ER(m), ER(a));
+		IF S = 1 THEN UpdateFlags(d) END
+	END MLS;
+
+	PROCEDURE DivOp*(op: LONGINT; VAR x, y: Item);	 (* x := x op y *)
+		VAR e: LONGINT;
+	BEGIN
+		IF op = ORS.div THEN
+			IF (x.mode = ORB.Const) & (y.mode = ORB.Const) THEN
+				IF y.a > 0 THEN x.a := x.a DIV y.a ELSE ORS.Mark("bad divisor") END
+			ELSIF (y.mode = ORB.Const) & (y.a >= 2) & (log2(y.a, e) = 1) THEN load0(0, x); Put1(Asr, x.r, x.r, e)
+			ELSIF y.mode = ORB.Const THEN
+				IF y.a > 0 THEN load0(0, x); Put1a(Div, x.r, x.r, y.a) ELSE ORS.Mark("bad divisor") END
+			ELSE load(y);
+				IF check THEN Trap(LE, 6) END ;
+				load0(0, x); Put0(Div, RH-2, x.r, y.r); DEC(RH); x.r := RH-1
+			END
+		ELSE (*op = ORS.mod*)
+			IF (x.mode = ORB.Const) & (y.mode = ORB.Const) THEN
+				IF y.a > 0 THEN x.a := x.a MOD y.a ELSE ORS.Mark("bad modulus") END
+			ELSIF (y.mode = ORB.Const) & (y.a >= 2) & (log2(y.a, e) = 1) THEN load0(0, x);
+				IF e <= 16 THEN Put1(And, x.r, x.r, y.a-1) ELSE Put10(0, Lsl, x.r, x.r, 32-e); Put1(Ror, x.r, x.r, 32-e) END
+			ELSIF y.mode = ORB.Const THEN
+				IF y.a > 0 THEN
+					load0(0, x);
+					(*
+					Put1a(Div, x.r, x.r, y.a);
+					Put0(Mov+U, x.r, 0, 0)
+					*)
+					incR; incR;
+						Put10(0, Mov, RH-2, 0, y.a);
+						Put00(0, Div, RH-1, x.r, RH-2);
+						(*
+						Put00(0, Mul, RH-2, RH-2, RH-1);
+						Put0(Sub, x.r, x.r, RH-2);
+						*)
+							MLS(1, x.r, RH-2, RH-1, x.r);
+					DEC(RH, 2)
+				ELSE ORS.Mark("bad modulus")
+				END
+			ELSE load(y);
+				IF check THEN Trap(LE, 6) END;
+				load0(0, x);
+				(*
+				Put0(Div, RH-2, x.r, y.r);
+				Put0(Mov+U, RH-2, 0, 0);
+				*)
+				incR;
+					Put00(0, Div, RH-1, x.r, y.r);
+					(*
+					Put00(0, Mul, RH-1, RH-1, y.r);
+					Put0(Sub, RH-2-1, x.r, RH-1);
+					*)
+						MLS(1, RH-2-1, RH-1, y.r, x.r);
+				DEC(RH);
+				DEC(RH); x.r := RH-1
+			END
+		END
+	END DivOp;
+
+	(* Code generation for REAL operators *)
+
+	PROCEDURE RealOp*(op: INTEGER; VAR x, y: Item);	 (* x := x op y *)
+	BEGIN
+		(*
+		load0(0, x); load0(0, y);
+		IF op = ORS.plus THEN Put0(Fad, RH-2, x.r, y.r)
+		ELSIF op = ORS.minus THEN Put0(Fsb, RH-2, x.r, y.r)
+		ELSIF op = ORS.times THEN Put0(Fml, RH-2, x.r, y.r)
+		ELSIF op = ORS.rdiv THEN Put0(Fdv, RH-2, x.r, y.r)
+		END;
+		DEC(RH); x.r := RH-1
+		*)
+			loadReal(x); loadReal(y);
+			IF op = ORS.plus THEN
+				ARMv7M.EmitVADD(armcode, pc,
+					ER(RH-2), ER(x.r - 100H), ER(y.r - 100H))
+			ELSIF op = ORS.minus THEN
+				ARMv7M.EmitVSUB(armcode, pc,
+					ER(RH-2), ER(x.r - 100H), ER(y.r - 100H))
+			ELSIF op = ORS.times THEN
+				ARMv7M.EmitVMUL(armcode, pc,
+					ER(RH-2), ER(x.r - 100H), ER(y.r - 100H))
+			ELSIF op = ORS.rdiv THEN
+				ARMv7M.EmitVDIV(armcode, pc,
+					ER(RH-2), ER(x.r - 100H), ER(y.r - 100H))
+			END;
+			DEC(RH); x.r := RH-1+100H; INCL(FR, RH-1)
+	END RealOp;
+
+	(* Code generation for set operators *)
+
+	PROCEDURE Singleton*(VAR x: Item);	(* x := {x} *)
+	BEGIN
+		IF x.mode = ORB.Const THEN x.a := LSL(1, x.a)
+		ELSE load0(0, x); Put10(0, Mov, RH, 0, 1); Put0(Lsl, x.r, RH,	x.r)
+		END
+	END Singleton;
+
+	PROCEDURE Set*(VAR x, y: Item);	 (* x := {x .. y} *)
+	BEGIN
+		IF (x.mode = ORB.Const) & ( y.mode = ORB.Const) THEN
+			IF x.a <= y.a THEN x.a := LSL(2, y.a) - LSL(1, x.a) ELSE x.a := 0 END
+		ELSE
+			IF (x.mode = ORB.Const) & (x.a <= 16) THEN x.a := LSL(-1, x.a)
+			ELSE load0(0, x); Put10(0, Mov, RH, 0, -1); Put0(Lsl, x.r, RH, x.r)
+			END ;
+			IF (y.mode = ORB.Const) & (y.a < 16) THEN Put1(Mov, RH, 0, LSL(-2, y.a)); y.mode := Reg; y.r := RH; incR
+			ELSE load0(0, y); Put10(0, Mov, RH, 0, -2); Put0(Lsl, y.r, RH, y.r)
+			END ;
+			IF x.mode = ORB.Const THEN
+				IF x.a # 0 THEN Put10(0, Xor, y.r, y.r, -1); Put1a(And, RH-1, y.r, x.a) END ;
+				x.mode := Reg; x.r := RH-1
+			ELSE DEC(RH); Put0(Ann, RH-1, x.r, y.r);
+				ASSERT(x.mode = Reg); x.r := RH-1
+			END
+		END
+	END Set;
+
+	PROCEDURE In*(VAR x, y: Item);	(* x := x IN y *)
+	BEGIN load0(0, y);
+		IF x.mode = ORB.Const THEN Put1(Ror, y.r, y.r, (x.a + 1) MOD 20H); DEC(RH)
+		ELSE load0(0, x); Put10(0, Add, x.r, x.r, 1); Put0(Ror, y.r, y.r, x.r); DEC(RH, 2)
+		END ;
+		SetCC(x, MI)
+	END In;
+
+	PROCEDURE SetOp*(op: LONGINT; VAR x, y: Item);	 (* x := x op y *)
+		VAR xset, yset: SET; (*x.type.form = Set*)
+	BEGIN
+		IF (x.mode = ORB.Const) & (y.mode = ORB.Const) THEN
+			xset := SYSTEM.VAL(SET, x.a); yset := SYSTEM.VAL(SET, y.a);
+			IF op = ORS.plus THEN xset := xset + yset
+			ELSIF op = ORS.minus THEN xset := xset - yset
+			ELSIF op = ORS.times THEN xset := xset * yset
+			ELSIF op = ORS.rdiv THEN xset := xset / yset
+			END ;
+			x.a := SYSTEM.VAL(LONGINT, xset)
+		ELSIF y.mode = ORB.Const THEN
+			load0(0, x);
+			IF op = ORS.plus THEN Put1a(Ior, x.r, x.r, y.a)
+			ELSIF op = ORS.minus THEN Put1a(Ann, x.r, x.r, y.a)
+			ELSIF op = ORS.times THEN Put1a(And, x.r, x.r, y.a)
+			ELSIF op = ORS.rdiv THEN Put1a(Xor, x.r, x.r, y.a)
+			END ;
+		ELSE load0(0, x); load0(0, y);
+			IF op = ORS.plus THEN Put0(Ior, RH-2, x.r, y.r)
+			ELSIF op = ORS.minus THEN Put0(Ann, RH-2, x.r, y.r)
+			ELSIF op = ORS.times THEN Put0(And, RH-2, x.r, y.r)
+			ELSIF op = ORS.rdiv THEN Put0(Xor, RH-2, x.r, y.r)
+			END ;
+			DEC(RH); x.r := RH-1
+		END
+	END SetOp;
+
+	(* Code generation for relations *)
+
+	PROCEDURE IntRelation*(op: INTEGER; VAR x, y: Item); (* x := x < y *)
+	BEGIN
+		IF (y.mode = ORB.Const) & (y.type.form # ORB.Proc) THEN
+			load(x);
+			Put1a(Cmp, x.r, x.r, y.a);
+			DEC(RH)
+		ELSE
+			IF (x.mode = Cond) OR (y.mode = Cond) THEN ORS.Mark("not implemented") END;
+			load0(0, x); load0(0, y); Put0(Cmp, x.r, x.r, y.r); DEC(RH, 2)
+		END;
+		SetCC(x, relmap[op - ORS.eql])
+	END IntRelation;
+
+(*
+	PROCEDURE SetRelation*(op: INTEGER; VAR x, y: Item); (* x := x < y *)
+	BEGIN load0(0, x);
+		IF (op = ORS.eql) OR (op = ORS.neq) THEN
+			IF y.mode = ORB.Const THEN Put1a(Cmp, x.r, x.r, y.a); DEC(RH)
+			ELSE load0(0, y); Put0(Cmp, x.r, x.r, y.r); DEC(RH, 2)
+			END;
+			SetCC(x, relmap[op - ORS.eql])
+		ELSE ORS.Mark("illegal relation")
+		END
+	END SetRelation;
+*)
+
+	PROCEDURE FPUToARMReg (VAR x: Item);
+	BEGIN
+		IF (x.mode = Reg) & (x.r >= 100H) THEN
+			x.r := x.r - 100H;
+			EXCL(FR, x.r);
+			INCL(RM, x.r);
+			ARMv7M.EmitVMOVSPR(armcode, pc, 1, ER(x.r), ER(x.r))
+		END
+	END FPUToARMReg;
+
+	PROCEDURE RealRelation*(op: INTEGER; VAR x, y: Item); (* x := x < y *)
+	BEGIN
+		IF (y.mode = ORB.Const) & (y.a = 0) THEN
+			IF (x.mode = Reg) & (x.r >= 100H) THEN
+				FPUToARMReg(x);
+				UpdateFlags(x.r)
+			ELSE load(x); Put1a(Cmp, x.r, x.r, y.a)
+			END;
+			DEC(RH)
+		ELSE
+			loadReal(x); loadReal(y);
+			ARMv7M.EmitVCMPER(armcode, pc, 1, ER(x.r - 100H), ER(y.r - 100H));
+			ARMv7M.EmitVMRS(armcode, pc, 15 (* APSR_nzcv *));
+			DEC(RH, 2)
+		END;
+		SetCC(x, relmap[op - ORS.eql])
+	END RealRelation;
+
+	PROCEDURE StringRelation*(op: INTEGER; VAR x, y: Item); (* x := x < y *)
+		(*x, y are char arrays or strings*)
+		VAR pc0, pc1: LONGINT;
+	BEGIN
+		IF x.type.form = ORB.String THEN loadStringAdr0(0, x) ELSE loadAdr0(0, x) END;
+		IF y.type.form = ORB.String THEN loadStringAdr0(0, y) ELSE loadAdr0(0, y) END;
+		pc0 := pc;
+		Put20(0, Ldr+1, RH, x.r, 0); Put10(0, Add, x.r, x.r, 1);
+		Put20(0, Ldr+1, RH+1, y.r, 0); Put10(0, Add, y.r, y.r, 1);
+		Put0(Cmp, RH+2, RH, RH+1); pc1 := pc; Put3orig(BC, NE, 0);
+		Put1(Cmp, RH+2, RH, 0); Put3orig(BC, NE, pc0 - pc - 1);
+		fix(pc1, pc - pc1 - 1);
+		DEC(RH, 2); SetCC(x, relmap[op - ORS.eql])
+	END StringRelation;
+
+	(* Code generation of Assignments *)
+
+	PROCEDURE StrToChar*(VAR x: Item);
+	BEGIN x.type := ORB.charType; DEC(strx, 4); x.a := ORD(str[x.a])
+	END StrToChar;
+
+	PROCEDURE Store*(VAR x, y: Item); (* x := y *)
+		VAR op: LONGINT;
+	BEGIN load0(0, y);
+		IF x.type.size = 1 THEN op := Str+1 ELSE op := Str END ;
+		IF x.mode = ORB.Var THEN
+			IF x.r > 0 THEN (*local*) Put2(op, y.r, SP, x.a + frame)
+			ELSE
+				IF x.r # 0 THEN FPUToARMReg(y) END;
+				GetSB(x.r);
+				IF x.r # 0 THEN
+					Put2orig(op, ER(y.r), ER(SB), x.a);
+					armcode[pc] := 00FFFFFFH; INC(pc)
+				ELSE Put2(op, y.r, SB, x.a)
+				END
+			END
+		ELSIF x.mode = ORB.Par THEN Put20(0, Ldr, RH, SP, x.a + frame); Put2(op, y.r, RH, x.b);
+		ELSIF x.mode = RegI THEN Put2(op, y.r, x.r, x.a); DEC(RH);
+		ELSE ORS.Mark("bad mode in Store")
+		END;
+		DEC(RH)
+	END Store;
+
+	PROCEDURE StoreStruct* (VAR x, y: Item); (* x := y, frame = 0 *)
+		VAR s, pc0, pc1: LONGINT;
+	BEGIN
+		IF y.type.size # 0 THEN
+			loadAdr0(0, x); loadAdr0(0, y);
+			pc0 := -1;
+			IF (x.type.form = ORB.Array) & (x.type.len > 0) THEN
+				IF y.type.len >= 0 THEN
+					IF x.type.size = y.type.size THEN Put10(0, Mov, RH, 0, (y.type.size+3) DIV 4)
+					ELSE ORS.Mark("different length/size, not implemented")
+					END
+				ELSE (*y is open array*) Put2(Ldr, RH, SP, y.a+4); s := y.type.base.size; (*element size*)
+					pc0 := pc; Put3orig(BC, EQ, 0);
+					IF s = 1 THEN Put10(0, Add, RH, RH, 3); Put10(0, Asr, RH, RH, 2)
+					ELSIF s # 4 THEN Put10(0, Mul, RH, RH, s DIV 4)
+					END;
+					IF check THEN
+						ASSERT(x.type.len >= 0);
+						Put10(0, Mov, RH+1, 0, (x.type.size+3) DIV 4); Put0(Cmp, RH+1, RH, RH+1); Trap(GT, 3)
+					END
+				END
+			ELSIF x.type.form = ORB.Record THEN Put10(0, Mov, RH, 0, x.type.size DIV 4)
+			ELSE ORS.Mark("inadmissible assignment")
+			END;
+			pc1 := pc;
+			Put20(0, Ldr, RH+1, y.r, 0); Put10(0, Add, y.r, y.r, 4);
+			Put2(Str, RH+1, x.r, 0); Put10(0, Add, x.r, x.r, 4);
+			Put1(Sub, RH, RH, 1); Put3orig(BC, NE, pc1 - pc - 1);
+				DEC(RH, 2); ASSERT(RH = 0);
+			IF pc0 # -1 THEN fix(pc0, pc - pc0 - 1) END
+		END;
+		RH := 0
+	END StoreStruct;
+
+	PROCEDURE CopyString* (VAR x, y: Item); (* x := y *)
+		 VAR len, pc0: LONGINT;
+	BEGIN loadAdr0(0, x); len := x.type.len;
+		IF len >= 0 THEN
+			IF len < y.b THEN ORS.Mark("string too long") END
+		ELSIF check THEN Put20(0, Ldr, RH, SP, x.a+4); (*open array len, frame = 0*)
+			Put1(Cmp, RH, RH, y.b); Trap(LT, 3)
+		END;
+		loadStringAdr0(0, y);
+		pc0 := pc;
+		Put20(0, Ldr, RH, y.r, 0); Put10(0, Add, y.r, y.r, 4);
+		Put2(Str, RH, x.r, 0); Put10(0, Add, x.r, x.r, 4);
+		Put1(Asr, RH, RH, 24); Put3orig(BC, NE, pc0 - pc - 1); RH := 0
+	END CopyString;
+
+	(* Code generation for parameters *)
+
+	PROCEDURE OpenArrayParam*(VAR x: Item);
+	BEGIN loadAdr0(0, x);
+		IF x.type.len >= 0 THEN Put10(0, Mov, RH, 0, x.type.len) ELSE Put20(0, Ldr, RH, SP, x.a+4+frame) END;
+		incR
+	END OpenArrayParam;
+
+	PROCEDURE VarParam*(VAR x: Item; ftype: ORB.Type);
+		VAR xmd: INTEGER;
+	BEGIN xmd := x.mode; loadAdr0(0, x);
+		IF (ftype.form = ORB.Array) & (ftype.len < 0) THEN (*open array*)
+			IF x.type.len >= 0 THEN Put10(0, Mov, RH, 0, x.type.len) ELSE	Put20(0, Ldr, RH, SP, x.a+4+frame) END;
+			incR
+		ELSIF ftype.form = ORB.Record THEN
+			IF xmd = ORB.Par THEN Put20(0, Ldr, RH, SP, x.a+4+frame); incR ELSE loadTypTagAdr0(0, x.type) END
+		END
+	END VarParam;
+
+	PROCEDURE ValueParam*(VAR x: Item);
+	BEGIN load0(0, x); FPUToARMReg(x)
+	END ValueParam;
+
+	PROCEDURE StringParam*(VAR x: Item);
+	BEGIN loadStringAdr0(0, x); Put10(0, Mov, RH, 0, x.b); incR	(*len*)
+	END StringParam;
+
+	(*For Statements*)
+
+	PROCEDURE For0*(VAR x, y: Item);
+	BEGIN load(y)
+	END For0;
+
+	PROCEDURE For1*(VAR x, y, z, w: Item; VAR L: LONGINT);
+	BEGIN
+		IF z.mode = ORB.Const THEN Put1a(Cmp, RH, y.r, z.a)
+		ELSE load0(0, z); Put0(Cmp, RH-1, y.r, z.r); DEC(RH)
+		END ;
+		L := pc;
+		IF w.a > 0 THEN Put3orig(BC, GT, 0)
+		ELSIF w.a < 0 THEN Put3orig(BC, LT, 0)
+		ELSE ORS.Mark("zero increment"); Put3orig(BC, MI, 0)
+		END;
+		Store(x, y)
+	END For1;
+
+	PROCEDURE For2*(VAR x, y, w: Item);
+	BEGIN load0(0, x); DEC(RH); Put1a(Add, x.r, x.r, w.a)
+	END For2;
+
+	(* Branches, procedure calls, procedure prolog and epilog *)
+
+	PROCEDURE Here*(): LONGINT;
+	BEGIN invalSB; RETURN pc
+	END Here;
+
+	PROCEDURE FJump*(VAR L: LONGINT);
+	BEGIN Put3orig(BC, 7, L); L := pc-1
+	END FJump;
+
+	PROCEDURE CFJump*(VAR x: Item);
+	BEGIN
+		IF x.mode # Cond THEN loadCond(x) END ;
+		Put3orig(BC, negated(x.r), x.a); FixLink(x.b); x.a := pc-1
+	END CFJump;
+
+	PROCEDURE BJump*(L: LONGINT);
+	BEGIN Put3orig(BC, 7, L-pc-1)
+	END BJump;
+
+	PROCEDURE CBJump*(VAR x: Item; L: LONGINT);
+	BEGIN
+		IF x.mode # Cond THEN loadCond(x) END ;
+		Put3orig(BC, negated(x.r), L-pc-1); FixLink(x.b); FixLinkWith(x.a, L)
+	END CBJump;
+
+	PROCEDURE Fixup*(VAR x: Item);
+	BEGIN FixLink(x.a)
+	END Fixup;
+
+	PROCEDURE SaveRegs(r: LONGINT);	(* R[0 .. r-1]*)
+		VAR r0: LONGINT;
+	BEGIN (*r > 0*) r0 := 0;
+		Put10(0, Sub, SP, SP, r*4); INC(frame, 4*r);
+		REPEAT
+			IF r0 IN FR THEN Put2(Str, r0 + 100H, SP, (r-r0-1)*4)
+			ELSE Put2(Str, r0, SP, (r-r0-1)*4)
+			END;
+			INC(r0)
+		UNTIL r0 = r
+	END SaveRegs;
+
+	PROCEDURE RestoreRegs(r: LONGINT); (*R[0 .. r-1]*)
+		VAR r0: LONGINT;
+	BEGIN (*r > 0*) r0 := r;
+		REPEAT DEC(r0);
+			IF r0 IN FR THEN
+				ARMv7M.EmitVLDR(armcode, pc, ER(r0), ER(SP), 1, r-r0-1)
+			ELSE Put20(0, Ldr, r0, SP, (r-r0-1)*4)
+			END
+		UNTIL r0 = 0;
+		Put10(0, Add, SP, SP, r*4); DEC(frame, 4*r)
+	END RestoreRegs;
+
+	PROCEDURE PrepCall*(VAR x: Item; VAR r: LONGINT);
+	BEGIN (*x.type.form = ORB.Proc*)
+		IF x.mode > ORB.Par THEN load(x) END;
+		ASSERT(RH < 16); ASSERT(FR * {16..31} = {});
+			IF RH = 0 THEN r := 0
+			ELSE r := RH + 16 * ORDSET(FR * {0..RH-1})
+			END;
+		IF RH > 0 THEN SaveRegs(RH); RH := 0 END
+	END PrepCall;
+
+	PROCEDURE Call*(VAR x: Item; r: LONGINT);
+	BEGIN (*x.type.form = ORB.Proc*)
+		IF x.mode = ORB.Const THEN
+			IF x.r >= 0 THEN Put3(BL, 7, (x.a DIV 4)-pc-1)
+			ELSE (*imported*)
+				IF pc - fixorgP < 1000H THEN
+					(* will be fixed up by linker/loader *)
+					Put3orig(BL, 7, ((-x.r) * 100H + x.a) * 1000H + pc-fixorgP);
+					fixorgP := pc-1
+				ELSE ORS.Mark("fixup impossible")
+				END
+			END
+		ELSE
+			IF x.mode <= ORB.Par THEN load(x); DEC(RH)
+			ELSE
+				Put20(0, Ldr, RH, SP, 0); Put10(0, Add, SP, SP, 4);
+				Put1(Cmp, RH, RH, 0);
+				DEC(r); DEC(frame, 4)
+			END;
+			IF check THEN Trap(EQ, 5) END;
+			Put3(BLR, 7, RH)
+		END;
+		IF x.type.base.form = ORB.NoTyp THEN (*procedure*) RH := 0
+		ELSE (*function*)
+			FR := BITS(r DIV 16); ASSERT(FR * {16..31} = {}); r := r MOD 16;
+			RH := MT;
+			IF r > 0 THEN Put00(0, Mov, r, 0, 0); RestoreRegs(r) END;
+			x.mode := Reg; x.r := r; RH := r+1
+		END;
+		invalSB; RM := {0..31}
+	END Call;
+
+	PROCEDURE Enter* (parblksize, locblksize: LONGINT; int: BOOLEAN);
+		VAR a, r: LONGINT;
+	BEGIN invalSB; frame := 0;
+		enterPushFixup := pc;
+		IF ~int THEN (*procedure prolog*)
+			(* IF locblksize >= 10000H THEN ORS.Mark("too many locals") END; *)
+			ARMv6M.EmitPUSH(armcode, pc, {LNK});
+			a := parblksize0Proc; r := 0;
+			IF locblksize # parblksize0Proc THEN Put10(0, Sub, SP, SP, locblksize) END;
+			WHILE a < parblksize DO Put2(Str, r, SP, a); INC(r); INC(a, 4) END
+		ELSE (*interrupt procedure*)
+			(* IF locblksize > 0H THEN ORS.Mark("locals not allowed") END; *)
+			ARMv7M.EmitPUSHW(armcode, pc, {LNK});
+			a := parblksize0Int; r := 0;
+			IF locblksize # parblksize0Int THEN Put10(0, Sub, SP, SP, locblksize) END;
+			WHILE a < parblksize DO Put2(Str, r, SP, a); INC(r); INC(a, 4) END
+		END;
+		RM := {}
+	END Enter;
+
+(*
+		PROCEDURE Fix (VAR code: ARRAY OF INTEGER; i: INTEGER);
+			VAR cond, off, pc0: INTEGER;
+		BEGIN
+			IF ORS.errcnt = 0 THEN
+				IF code[i] DIV 10000000H MOD 10H = 0EH THEN (* BC *)
+					ASSERT(code[i+1] = 00FFFFFEH, 100);
+					cond := code[i] DIV 1000000H MOD 10H;
+					off := (code[i] MOD 1000000H * 100H) DIV 100H;
+					pc0 := pc; pc := i;
+					Put3(BC, cond, off);
+					IF pc - i = 1 THEN ARMv6M.EmitNOP(armcode, pc) END;
+					IF ORS.errcnt = 0 THEN
+						ASSERT(pc - i = 2, 101)
+					END;
+					pc := pc0
+				END
+			END
+		END Fix;
+*)
+
+		PROCEDURE Fix (VAR code: ARRAY OF INTEGER; i: INTEGER);
+			VAR cond, off, pc0: INTEGER;
+		BEGIN
+			IF ORS.errcnt = 0 THEN
+				IF code[i] DIV 10000000H MOD 10H = 0EH THEN (* BC *)
+					cond := code[i] DIV 1000000H MOD 10H;
+					off := (code[i] MOD 1000000H * 100H) DIV 100H;
+					pc0 := pc; pc := i;
+					Put3(BC, cond, off);
+					IF ORS.errcnt = 0 THEN
+						ASSERT(pc - i = 1, 100)
+					END;
+					pc := pc0
+				END
+			END
+		END Fix;
+
+		PROCEDURE FixRng (from, to: INTEGER);
+		BEGIN
+			WHILE from < to DO
+				Fix(armcode, from); INC(from)
+			END
+		END FixRng;
+
+	PROCEDURE Return* (form: INTEGER; VAR x: Item; size: LONGINT; int: BOOLEAN);
+		VAR pc0: INTEGER;
+	BEGIN
+		IF form # ORB.NoTyp THEN load(x); FPUToARMReg(x) END ;
+		IF ~int THEN (*procedure epilog*)
+			IF size # parblksize0Proc THEN Put10(0, Add, SP, SP, size) END;
+			IF LNK IN RM THEN
+				ARMv6M.EmitPOP(armcode, pc, {ARMv6M.PC})
+			ELSE
+				Put3(BR, 7, LNK);
+				pc0 := pc; pc := enterPushFixup;
+				ARMv6M.EmitNOP(armcode, pc);
+				pc := pc0
+			END
+		ELSE (*interrupt return*)
+			IF size # parblksize0Int THEN Put10(0, Add, SP, SP, size) END;
+			ARMv7M.EmitPOPW(armcode, pc, ERs(RM) * {4..11} - {ER(MT)} + {ARMv6M.PC});
+			pc0 := pc; pc := enterPushFixup;
+			ARMv7M.EmitPUSHW(armcode, pc, ERs(RM) * {4..11} - {ER(MT)} + {LNK});
+			pc := pc0
+		END;
+		RH := 0;
+		FixRng(enterPushFixup, pc)
+	END Return;
+
+	(* In-line code procedures*)
+
+	PROCEDURE Increment*(upordown: LONGINT; VAR x, y: Item);
+		VAR op, zr, v: LONGINT;
+	BEGIN (*frame = 0*)
+		IF upordown = 0 THEN op := Add ELSE op := Sub END ;
+		IF x.type = ORB.byteType THEN v := 1 ELSE v := 0 END ;
+		IF y.type.form = ORB.NoTyp THEN y.mode := ORB.Const; y.a := 1 END ;
+		IF (x.mode = ORB.Var) & (x.r > 0) THEN
+			zr := RH; Put20(0, Ldr+v, zr, SP, x.a); incR;
+			IF y.mode = ORB.Const THEN Put10(0, op, zr, zr, y.a) ELSE load0(0, y); Put00(0, op, zr, zr, y.r); DEC(RH) END ;
+			Put2(Str+v, zr, SP, x.a); DEC(RH)
+		ELSE loadAdr0(0, x); zr := RH; Put20(0, Ldr+v, RH, x.r, 0); incR;
+			IF y.mode = ORB.Const THEN Put10(0, op, zr, zr, y.a) ELSE load0(0, y); Put00(0, op, zr, zr, y.r); DEC(RH) END ;
+			Put2(Str+v, zr, x.r, 0); DEC(RH, 2)
+		END
+	END Increment;
+
+	PROCEDURE Include*(inorex: LONGINT; VAR x, y: Item);
+		VAR op, zr: LONGINT;
+	BEGIN loadAdr0(0, x); zr := RH; Put20(0, Ldr, RH, x.r, 0); incR;
+		IF inorex = 0 THEN op := Ior ELSE op := Ann END ;
+		IF y.mode = ORB.Const THEN Put10(0, op, zr, zr, LSL(1, y.a))
+		ELSE load0(0, y); Put10(0, Mov, RH, 0, 1); Put00(0, Lsl, y.r, RH, y.r); Put00(0, op, zr, zr, y.r); DEC(RH)
+		END ;
+		Put2(Str, zr, x.r, 0); DEC(RH, 2)
+	END Include;
+
+	PROCEDURE Assert*(VAR x: Item);
+		VAR cond: LONGINT;
+	BEGIN
+		IF x.mode # Cond THEN loadCond(x) END ;
+		IF x.a = 0 THEN cond := negated(x.r)
+		ELSE Put3orig(BC, x.r, x.b); FixLink(x.a); x.b := pc-1; cond := 7
+		END;
+		Trap(cond, 7); FixLink(x.b)
+	END Assert;
+
+	PROCEDURE New*(VAR x: Item);
+	BEGIN loadAdr0(0, x); loadTypTagAdr0(0, x.type.base); Trap(7, 0); RH := 0; invalSB
+	END New;
+
+	PROCEDURE Pack*(VAR x, y: Item);
+		VAR z: Item;
+	BEGIN z := x; load0(0, x); load0(0, y);
+		Put10(0, Lsl, y.r, y.r, 23); Put00(0, Add, x.r, x.r, y.r); DEC(RH); Store(z, x)
+	END Pack;
+
+	PROCEDURE Unpk*(VAR x, y: Item);
+		VAR z, e0: Item;
+	BEGIN	z := x; load0(0, x); e0.mode := Reg; e0.r := RH; e0.type := ORB.intType;
+		Put10(0, Asr, RH, x.r, 23); Put10(0, Sub, RH, RH, 127); Store(y, e0); incR;
+		Put10(0, Lsl, RH, RH, 23); Put00(0, Sub, x.r, x.r, RH); Store(z, x)
+	END Unpk;
+
+	PROCEDURE Led*(VAR x: Item);
+	BEGIN (* load0(0, x); Put10(0, Mov, RH, 0, -60); Put2(Str, x.r, RH, 0); DEC(RH) *)
+		ORS.Mark("not supported")
+	END Led;
+
+	PROCEDURE Get*(VAR x, y: Item);
+	BEGIN load0(0, x); x.type := y.type; x.mode := RegI; x.a := 0; Store(y, x)
+	END Get;
+
+	PROCEDURE Put*(VAR x, y: Item);
+	BEGIN load0(0, x); x.type := y.type; x.mode := RegI; x.a := 0; Store(x, y)
+	END Put;
+
+	PROCEDURE Copy*(VAR x, y, z: Item);
+		VAR pc0, pc1: LONGINT;
+	BEGIN load0(0, x); load0(0, y);
+		pc0 := -1;
+		IF z.mode = ORB.Const THEN
+			IF z.a > 0 THEN load0(0, z) ELSE ORS.Mark("bad count") END
+		ELSE load(z);
+			IF check THEN Trap(LT, 3) END ;
+			pc0 := pc; Put3orig(BC, EQ, 0)
+		END;
+		pc1 := pc;
+		Put20(0, Ldr, RH, x.r, 0); Put10(0, Add, x.r, x.r, 4);
+		Put2(Str, RH, y.r, 0); Put10(0, Add, y.r, y.r, 4);
+		Put1(Sub, z.r, z.r, 1); Put3orig(BC, NE, pc1 - pc - 1); DEC(RH, 3);
+		IF pc0 # -1 THEN fix(pc0, pc - pc0 - 1) END
+	END Copy;
+
+	PROCEDURE LDPSR*(VAR x: Item);
+	BEGIN (*x.mode = Const*)	Put3(0, 15, x.a + 20H)
+	END LDPSR;
+
+	PROCEDURE LDREG* (VAR x, y: Item);
+	BEGIN
+		IF x.mode = ORB.Const THEN
+			IF x.a IN {0..15} THEN
+				IF y.mode = ORB.Const THEN Put10(0, Mov, DR(x.a), 0, y.a)
+				ELSE load0(0, y); Put00(0, Mov, DR(x.a), 0, y.r); DEC(RH)
+				END
+			ELSE ORS.Mark("invalid register")
+			END
+		ELSE ORS.Mark("not supported")
+		END
+	END LDREG;
+
+	(*In-line code functions*)
+
+	PROCEDURE Abs*(VAR x: Item);
+		VAR pc0: LONGINT;
+	BEGIN
+		IF x.mode = ORB.Const THEN x.a := ABS(x.a)
+		ELSIF x.type.form = ORB.Real THEN
+			(* load0(0, x); Put10(0, Lsl, x.r, x.r, 1); Put1(Ror, x.r, x.r, 1) *)
+				loadReal(x);
+				ARMv7M.EmitVABS(armcode, pc, ER(x.r - 100H), ER(x.r - 100H))
+		ELSE
+			load0(0, x);
+			Put1(Cmp, x.r, x.r, 0);
+			pc0 := pc; Put3orig(BC, GE, 0);
+			(* Put10(0, Mov, RH, 0, 0); Put0(Sub, x.r, RH, x.r) *)
+				RSBS0(x.r);
+			fix(pc0, pc - pc0 - 1)
+		END
+	END Abs;
+
+	PROCEDURE Odd*(VAR x: Item);
+	BEGIN load0(0, x); Put1(And, x.r, x.r, 1); SetCC(x, NE); DEC(RH)
+	END Odd;
+
+(* this is Trunc
+	PROCEDURE Floor*(VAR x: Item);
+	BEGIN
+		(*
+		load0(0, x); Put10(0, Mov+U, RH, 0, 4B00H); Put0(Fad+V, x.r, x.r, RH)
+		*)
+			loadReal(x);
+			ARMv7M.EmitVCVTRInt(armcode, pc,
+				TRUE, FALSE, TRUE, ER(x.r - 100H), ER(x.r - 100H));
+			FPUToARMReg(x)
+	END Floor;
+*)
+
+	PROCEDURE Floor*(VAR x: Item);
+		CONST S = 0;
+		VAR i, imm3, imm8: INTEGER;
+			ok: BOOLEAN;
+	BEGIN
+		(*
+		load0(0, x); Put10(0, Mov+U, RH, 0, 4B00H); Put0(Fad+V, x.r, x.r, RH)
+		*)
+			loadReal(x);
+			ASSERT(RH < MT, 100);
+			ASSERT(RH # SP, 101);
+			(* save FPSCR *)
+				ARMv7M.EmitVMRS(armcode, pc, ER(RH));
+			(* FPSCR.RMode := RM (A2.6.2) *)
+				(* FPSCR - {22,23} *)
+					ARMv7M.EncodeMI12(0C00000H, i, imm3, imm8, ok);
+					ASSERT(ok, 102);
+					ARMv7M.EmitDPMI(armcode, pc,
+						i, 2 + S, ER(RH), imm3, ER(x.r - 100H), imm8);
+							(* S=1: N, Z, C will be updated *) (* NOTE: C *)
+				(* FPSCR - {22} + {23} *)
+					ARMv7M.EncodeMI12(800000H, i, imm3, imm8, ok);
+					ASSERT(ok, 103);
+					ARMv7M.EmitDPMI(armcode, pc,
+						i, 4 + S, ER(x.r - 100H), imm3, ER(x.r - 100H), imm8);
+							(* S=1: N, Z, C will be updated *) (* NOTE: C *)
+				(* FPSCR := FPSCR - {22} + {23} *)
+					ARMv7M.EmitVMSR(armcode, pc, ER(x.r - 100H));
+			ARMv7M.EmitVCVTRInt(armcode, pc,
+				TRUE, TRUE, TRUE, ER(x.r - 100H), ER(x.r - 100H));
+			(* restore saved FPSCR *)
+				ARMv7M.EmitVMSR(armcode, pc, ER(RH));
+			FPUToARMReg(x)
+	END Floor;
+
+	PROCEDURE Float*(VAR x: Item);
+	BEGIN
+		(*
+		load0(0, x); Put10(0, Mov+U, RH, 0, 4B00H); Put0(Fad+U, x.r, x.r, RH)
+		*)
+			loadReal(x);
+			ARMv7M.EmitVCVTRInt(armcode, pc,
+				FALSE, FALSE, TRUE, ER(x.r - 100H), ER(x.r - 100H))
+	END Float;
+
+	PROCEDURE Ord*(VAR x: Item);
+	BEGIN
+		IF x.mode IN {ORB.Var, ORB.Par, RegI, Cond} THEN load(x) END
+	END Ord;
+
+	PROCEDURE Len*(VAR x: Item);
+	BEGIN
+		IF x.type.len >= 0 THEN
+			IF x.mode = RegI THEN DEC(RH) END;
+			x.mode := ORB.Const; x.a := x.type.len
+		ELSE (*open array*) Put2(Ldr, RH, SP, x.a + 4 + frame); x.mode := Reg; x.r := RH; incR
+		END
+	END Len;
+
+	PROCEDURE Shift*(fct: LONGINT; VAR x, y: Item);
+		VAR op: LONGINT;
+	BEGIN load0(0, x);
+		IF fct = 0 THEN op := Lsl ELSIF fct = 1 THEN op := Asr ELSE op := Ror END ;
+		IF y.mode = ORB.Const THEN Put1(op, x.r, x.r, y.a MOD 20H)
+		ELSE load0(0, y); Put0(op, RH-2, x.r, y.r); DEC(RH); x.r := RH-1
+		END
+	END Shift;
+
+	PROCEDURE ADC*(VAR x, y: Item);
+	BEGIN load0(0, x); load0(0, y); Put0(Add+U, x.r, x.r, y.r); DEC(RH)
+	END ADC;
+
+	PROCEDURE SBC*(VAR x, y: Item);
+	BEGIN load0(0, x); load0(0, y); Put0(Sub+U, x.r, x.r, y.r); DEC(RH)
+	END SBC;
+
+	PROCEDURE UML*(VAR x, y: Item);
+	BEGIN load0(0, x); load0(0, y); Put0(Mul+U, x.r, x.r, y.r); DEC(RH)
+	END UML;
+
+	PROCEDURE Bit*(VAR x, y: Item);
+	BEGIN load0(0, x); Put20(0, Ldr, x.r, x.r, 0);
+		IF y.mode = ORB.Const THEN Put1(Ror, x.r, x.r, y.a+1); DEC(RH)
+		ELSE load0(0, y); Put10(0, Add, y.r, y.r, 1); Put0(Ror, x.r, x.r, y.r); DEC(RH, 2)
+		END;
+		SetCC(x, MI)
+	END Bit;
+
+	PROCEDURE Register*(VAR x: Item);
+	BEGIN (*x.mode = Const*)
+		Put0(Mov, RH, 0, DR(x.a MOD 10H)); x.mode := Reg; x.r := RH; incR
+	END Register;
+
+	PROCEDURE H* (VAR x: Item);
+	BEGIN (*x.mode = Const*)
+		(* Put0(Mov+U + x.a MOD 2 * V, RH, 0, 0); *) ORS.Mark("not supported");
+		x.mode := Reg; x.r := RH; incR
+	END H;
+
+	PROCEDURE Adr*(VAR x: Item);
+	BEGIN
+		IF x.mode IN {ORB.Var, ORB.Par, RegI} THEN loadAdr(x)
+		ELSIF (x.mode = ORB.Const) & (x.type.form = ORB.Proc) THEN load(x)
+		ELSIF (x.mode = ORB.Const) & (x.type.form = ORB.String) THEN loadStringAdr(x)
+		ELSE ORS.Mark("not addressable")
+		END
+	END Adr;
+
+	PROCEDURE Condition*(VAR x: Item);
+	BEGIN (*x.mode = Const*) SetCC(x, x.a)
+	END Condition;
+
+	PROCEDURE Open* (v: INTEGER);
+	BEGIN pc := 0; tdx := 0; strx := 0; RH := 0; FR := {}; updateCarry := FALSE; fixorgP := 0; fixorgD := 0; fixorgT := 0; check := v # 0; version := v;
+		IF v = 0 THEN
+			armcode[0] := 0; armcode[1] := 0;
+			(* CPU exceptions (NMI..SysTick) *)
+				pc := 4; WHILE pc < 40H DIV 2 DO
+					armcode[pc] := 1; INC(pc);
+					armcode[pc] := 0; INC(pc)
+				END;
+			(* IRQ 0..239 (Cortex-M4 allows up to 240 IRQs) *)
+				WHILE pc < 40H DIV 2 + 240 * 2 DO
+					armcode[pc] := 1; INC(pc);
+					armcode[pc] := 0; INC(pc)
+				END
+		ELSE ARMv6M.EmitNOP(armcode, pc) (* pc must be not zero (fixups) *)
+		END
+	END Open;
+
+	PROCEDURE SetDataSize* (dc: LONGINT);
+	BEGIN varsize := dc
+	END SetDataSize;
+
+	PROCEDURE Header*;
+		VAR i, cs: INTEGER;
+	BEGIN entry := pc*4;
+		IF version = 0 THEN (*RISC-0*)
+			armcode[2] := (entry DIV 2 + 1) MOD 10000H;
+			armcode[3] := (entry DIV 2 + 1) DIV 10000H MOD 10000H;
+			(* NXP checksum *)
+				cs := 0; i := 0;
+				WHILE i < 7 DO
+					cs := cs + armcode[2 * i] + 10000H * armcode[2 * i + 1];
+					INC(i)
+				END;
+				armcode[2 * i] := (-cs) MOD 10000H;
+				armcode[2 * i + 1] := (-cs) DIV 10000H MOD 10000H
+		ELSE ARMv6M.EmitPUSH(armcode, pc, {LNK}); invalSB
+		END
+	END Header;
+
+	PROCEDURE NofPtrs(typ: ORB.Type): LONGINT;
+		VAR fld: ORB.Object; n: LONGINT;
+	BEGIN
+		IF (typ.form = ORB.Pointer) OR (typ.form = ORB.NilTyp) THEN n := 1
+		ELSIF typ.form = ORB.Record THEN
+			fld := typ.dsc; n := 0;
+			WHILE fld # NIL DO n := NofPtrs(fld.type) + n; fld := fld.next END
+		ELSIF typ.form = ORB.Array THEN n := NofPtrs(typ.base) * typ.len
+		ELSE n := 0
+		END ;
+		RETURN n
+	END NofPtrs;
+
+	PROCEDURE FindPtrs(VAR R: Files.Rider; typ: ORB.Type; adr: LONGINT);
+		VAR fld: ORB.Object; i, s: LONGINT;
+	BEGIN
+		IF (typ.form = ORB.Pointer) OR (typ.form = ORB.NilTyp) THEN Files.WriteLInt(R, adr)
+		ELSIF typ.form = ORB.Record THEN
+			fld := typ.dsc;
+			WHILE fld # NIL DO FindPtrs(R, fld.type, fld.val + adr); fld := fld.next END
+		ELSIF typ.form = ORB.Array THEN
+			s := typ.base.size;
+			FOR i := 0 TO typ.len-1 DO FindPtrs(R, typ.base, i*s + adr) END
+		END
+	END FindPtrs;
+
+	PROCEDURE Close* (VAR modid: ORS.Ident; key, nofent: LONGINT);
+		VAR obj: ORB.Object;
+			i, comsize, nofimps, nofptrs, size: LONGINT;
+			name: ORS.Ident;
+			F: Files.File; R: Files.Rider;
+	BEGIN	(*exit code*)
+		FixRng(0, pc);
+		IF version = 0 THEN Put3(BC, 7, -1)	(*RISC-0*)
+		ELSE ARMv6M.EmitPOP(armcode, pc, {ARMv6M.PC})
+		END;
+		obj := ORB.topScope.next; nofimps := 0; comsize := 4; nofptrs := 0;
+		WHILE obj # NIL DO
+			IF (obj.class = ORB.Mod) & (obj.dsc # ORB.system) THEN INC(nofimps) (*count imports*)
+			ELSIF (obj.exno # 0) & (obj.class = ORB.Const) & (obj.type.form = ORB.Proc)
+					& (obj.type.nofpar = 0) & (obj.type.base = ORB.noType) THEN i := 0; (*count commands*)
+				WHILE obj.name[i] # 0X DO INC(i) END ;
+				i := (i+4) DIV 4 * 4; INC(comsize, i+4)
+			ELSIF obj.class = ORB.Var THEN INC(nofptrs, NofPtrs(obj.type))	(*count pointers*)
+			END;
+			obj := obj.next
+		END;
+		size := varsize + strx + comsize + (pc + nofimps + nofent + nofptrs + 1)*4;	(*varsize includes type descriptors*)
+
+		ORB.MakeFileName(name, modid, ".a7m"); (*write code file*)
+		F := Files.New(name); Files.Set(R, F, 0); Files.WriteString(R, modid); Files.WriteLInt(R, key); Files.Write(R, CHR(version));
+		Files.WriteLInt(R, size);
+		obj := ORB.topScope.next;
+		WHILE (obj # NIL) & (obj.class = ORB.Mod) DO	(*imports*)
+			IF obj.dsc # ORB.system THEN Files.WriteString(R, obj(ORB.Module).orgname); Files.WriteLInt(R, obj.val) END ;
+			obj := obj.next
+		END;
+		Files.Write(R, 0X);
+		Files.WriteLInt(R, tdx*4);
+		i := 0;
+		WHILE i < tdx DO Files.WriteLInt(R, data[i]); INC(i) END ; (*type descriptors*)
+		Files.WriteLInt(R, varsize - tdx*4);	(*data*)
+		Files.WriteLInt(R, strx);
+		FOR i := 0 TO strx-1 DO Files.Write(R, str[i]) END ;	(*strings*)
+		Files.WriteLInt(R, pc);	(*code len*)
+		FOR i := 0 TO pc-1 DO
+			Files.WriteLInt(R, armcode[i])
+		END; (*program*)
+		obj := ORB.topScope.next;
+		WHILE obj # NIL DO	(*commands*)
+			IF (obj.exno # 0) & (obj.class = ORB.Const) & (obj.type.form = ORB.Proc) &
+					(obj.type.nofpar = 0) & (obj.type.base = ORB.noType) THEN
+				Files.WriteString(R, obj.name); Files.WriteLInt(R, obj.val)
+			END;
+			obj := obj.next
+		END;
+		Files.Write(R, 0X);
+		Files.WriteLInt(R, nofent); Files.WriteLInt(R, entry);
+		obj := ORB.topScope.next;
+		WHILE obj # NIL DO	(*entries*)
+			IF obj.exno # 0 THEN
+				IF (obj.class = ORB.Const) & (obj.type.form = ORB.Proc) OR (obj.class = ORB.Var) THEN
+					Files.WriteLInt(R, obj.val)
+				ELSIF obj.class = ORB.Typ THEN
+					IF obj.type.form = ORB.Record THEN Files.WriteLInt(R,	obj.type.len MOD 10000H)
+					ELSIF (obj.type.form = ORB.Pointer) & ((obj.type.base.typobj = NIL) OR (obj.type.base.typobj.exno = 0)) THEN
+						Files.WriteLInt(R, obj.type.base.len MOD 10000H)
+					END
+				END
+			END;
+			obj := obj.next
+		END;
+		obj := ORB.topScope.next;
+		WHILE obj # NIL DO	(*pointer variables*)
+			IF obj.class = ORB.Var THEN FindPtrs(R, obj.type, obj.val) END ;
+			obj := obj.next
+		END;
+		Files.WriteLInt(R, -1);
+		Files.WriteLInt(R, fixorgP); Files.WriteLInt(R, fixorgD); Files.WriteLInt(R, fixorgT); Files.WriteLInt(R, entry);
+		Files.Write(R, "O"); Files.Register(F)
+	END Close;
+
+BEGIN
+	relmap[0] := 1; relmap[1] := 9; relmap[2] := 5; relmap[3] := 6; relmap[4] := 14; relmap[5] := 13
+END O7ARMv7MG.
+
+(!)DevCompiler.CompileThis O7Files O7Texts O7Oberon O7S O7B O7ARMv6M O7ARMv7M O7ARMv7MG (!)
+
+(!)DevDebug.UnloadThis O7ARMv7MLinker O7ARMv7MTool O7ARMv7MP O7ARMv7MG O7ARMv7M O7ARMv6M O7B O7S O7Oberon O7Texts O7Files (!)

voc-O7/O7ARMv7MLinker.Mod

@@ -0,0 +1,1208 @@
+MODULE O7ARMv7MLinker;
+
+	(* Link and load on RISC; NW 20.10.2013 / 8.1.2019 *)
+
+	(* ARMv7-M: Alexander Shiryaev, 2014.10, 2015.02, 2016.06, 2017.01, 2019.11 *)
+
+	(*
+		TODO:
+			procedure addresses (progbase-relative...)
+			add support of version-0 files
+			resource files (simple copy to flashOrg before all)
+		NOTES:
+			we do not fill global data by zeros
+				do not call GC.Collect before all global pointers initialization!
+			pointer references for GC only
+			MTab stored in RAM for fast access
+			modules ptrs table stored in RAM for fast GC work
+	*)
+
+	IMPORT SYSTEM, Files (*:= O7Files*), Texts (*:= O7Texts*), Oberon (*:= O7Oberon*), ARMv6M := O7ARMv6M, ARMv7M := O7ARMv7M;
+
+	TYPE
+		LONGINT = INTEGER;
+		(* REAL = SHORTREAL; *)
+		LONGREAL = REAL;
+		(* BYTE = SHORTCHAR; *)
+		BYTE = CHAR;
+
+	CONST versionkey = 1X; MT = 6; SB = 3;
+		trace = FALSE;
+
+	TYPE Module = POINTER TO ModDesc;
+		ModuleName = ARRAY 32 OF CHAR;
+
+		ModDesc = RECORD
+			name: ModuleName;
+			next: Module;
+			key, num: INTEGER;
+			data: INTEGER; (* address, relative to mem, bytes *)
+			strs: INTEGER; (* address, relative to data, bytes *)
+			code: INTEGER; (* address, relative to flash start, halfwords *)
+			entries: POINTER TO ARRAY OF INTEGER;
+				entriesLen: INTEGER;
+			imports: ARRAY 16 OF Module;
+			body: INTEGER;
+			typeds: POINTER TO ARRAY OF INTEGER;
+				typedsLen: INTEGER;
+			strings: POINTER TO ARRAY OF INTEGER;
+				stringsLen: INTEGER;
+			fixorgT: INTEGER;
+			nPtrs: INTEGER; (* number of pointer references *)
+			ptr: INTEGER (* address, relative to flash start, halfwords *)
+		END;
+
+		TargetName = ARRAY 32 OF CHAR;
+		Target = POINTER TO RECORD
+			next: Target;
+			name: TargetName;
+			isNXP: BOOLEAN;
+			flashStart, flashSize: INTEGER;
+			maxExtInts, flashOrg: INTEGER;
+			SRAMStart, SRAMSize: INTEGER
+		END;
+
+	VAR
+		root: Module;
+		modules: ARRAY 100H OF Module;
+		flash: ARRAY 200000H DIV 2 OF INTEGER; flashW: INTEGER;
+		memW: INTEGER; (* bytes *)
+		nPtrs: INTEGER;
+		res: INTEGER;
+		importing, imported: ModuleName;
+
+		W: Texts.Writer;
+		target: Target;
+		targets: Target;
+
+	PROCEDURE BITS (x: INTEGER): SET;
+	BEGIN
+		RETURN SYSTEM.VAL(SET, x)
+	END BITS;
+
+	PROCEDURE ORDSET (x: SET): INTEGER;
+	BEGIN
+		RETURN SYSTEM.VAL(INTEGER, x)
+	END ORDSET;
+
+	PROCEDURE StrLen (VAR x: ARRAY OF CHAR): INTEGER;
+		VAR i: INTEGER;
+	BEGIN
+		i := 0;
+		WHILE (i < LEN(x)) & (x[i] # 0X) DO INC(i) END;
+		RETURN i
+	END StrLen;
+
+	PROCEDURE CmpStr (VAR a, b: ARRAY OF CHAR): BOOLEAN;
+		VAR i: INTEGER;
+			res: BOOLEAN;
+	BEGIN
+		i := 0;
+		WHILE (i < LEN(a)) & (i < LEN(b)) & (a[i] # 0X) & (b[i] # 0X) & (a[i] = b[i]) DO INC(i) END;
+		res := (i = LEN(a)) OR (i = LEN(b)) OR ((a[i] = 0X) & (b[i] = 0X));
+		RETURN res
+	END CmpStr;
+
+	PROCEDURE ReadInt (VAR R: Files.Rider; VAR x: INTEGER);
+		VAR y: SYSTEM.INT64;
+	BEGIN
+		Files.ReadLInt(R, y);
+		IF R.eof THEN x := -1
+		ELSE x := SHORT(y)
+		END
+	END ReadInt;
+
+	PROCEDURE ThisFile ((*IN*) VAR name: ARRAY OF CHAR): Files.File;
+		VAR i: INTEGER;
+			filename: ModuleName;
+	BEGIN i := 0;
+		WHILE name[i] # 0X DO filename[i] := name[i]; INC(i) END ;
+		filename[i] := "."; filename[i+1] := "a"; filename[i+2] := "7";
+		filename[i+3] := "m"; filename[i+4] := 0X;
+		RETURN Files.Old(filename)
+	END ThisFile;
+
+	PROCEDURE NewHexFile ((*IN*) VAR name: ARRAY OF CHAR): Files.File;
+		VAR i: INTEGER;
+			filename: ModuleName;
+	BEGIN i := 0;
+		WHILE name[i] # 0X DO filename[i] := name[i]; INC(i) END ;
+		filename[i] := "."; filename[i+1] := "h"; filename[i+2] := "e";
+		filename[i+3] := "x"; filename[i+4] := 0X;
+		RETURN Files.New(filename)
+	END NewHexFile;
+
+	PROCEDURE NewBinFile ((*IN*) VAR name: ARRAY OF CHAR): Files.File;
+		VAR i: INTEGER;
+			filename: ModuleName;
+	BEGIN i := 0;
+		WHILE name[i] # 0X DO filename[i] := name[i]; INC(i) END ;
+		filename[i] := "."; filename[i+1] := "b"; filename[i+2] := "i";
+		filename[i+3] := "n"; filename[i+4] := 0X;
+		RETURN Files.New(filename)
+	END NewBinFile;
+
+	PROCEDURE error (n: INTEGER; (*IN*) VAR name: ARRAY OF CHAR);
+	BEGIN res := n; COPY(name, importing)
+	END error;
+
+	PROCEDURE Check ((*IN*) VAR s: ARRAY OF CHAR);
+		VAR i: INTEGER; ch: CHAR;
+	BEGIN ch := s[0]; res := 1; i := 1;
+		IF (ch >= "A") & (ch <= "Z") OR (ch >= "a") & (ch <= "z") THEN
+			REPEAT ch := s[i]; INC(i)
+			UNTIL ~((ch >= "0") & (ch <= "9") OR (ch >= "A") & (ch <= "Z")
+				OR (ch >= "a") & (ch <= "z") OR (ch = ".")) OR (i = 32);
+			IF (i < 32) & (ch = 0X) THEN res := 0 END
+		END
+	END Check;
+
+	(* emit 2 instructions *)
+	PROCEDURE EmitADDSIm0 (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; a, b, im: INTEGER);
+		CONST S = 1;
+		VAR i, imm3, imm8: INTEGER; isMI: BOOLEAN;
+	BEGIN
+		ARMv7M.EncodeMI12(im, i, imm3, imm8, isMI);
+		IF isMI THEN
+			ASSERT(b # 15, 100);
+			ASSERT((b = 13) OR (a # 13), 101);
+			(* A7.7.3: ADD (immediate); encoding T3 ARMv7-M *)
+			(* A7.7.5: ADD (SP plus immediate); encoding T3 ARMv7-M *)
+				ARMv7M.EmitDPMI(code, pc, i, 16 + S, b, imm3, a, imm8)
+		ELSIF im <= 255 + 7 THEN
+			ARMv6M.EmitADDSIm(code, pc, a, b, 7);
+			ARMv6M.EmitADDSIm(code, pc, a, a, im - 7)
+		ELSE HALT(1)
+			(* fixup failed: offset is too big
+				(implementation limit) *)
+		END
+	END EmitADDSIm0;
+
+	(* search module in list; if not found, load module *)
+	PROCEDURE Load ((*IN*) VAR name: ARRAY OF CHAR; VAR newmod: Module);
+		VAR mod, impmod: Module;
+			i, n, key, impkey, mno, nofimps, size: INTEGER;
+			u, v, w: INTEGER; (*addresses*)
+			ch: CHAR;
+			fixorgP, fixorgD: INTEGER;
+			disp, adr, inst, pno, vno, dest, offset: INTEGER;
+			name1, impname: ModuleName;
+			F: Files.File; R: Files.Rider;
+			import: ARRAY 16 OF Module;
+			a, b: INTEGER;
+			op: INTEGER; (* 0: LW, 1: LB, 2: ADDS, 3: SW, 4: SB, 5: VLDR *)
+			nxt: INTEGER;
+			ok: BOOLEAN;
+	BEGIN
+		mod := root; error(0, name); nofimps := 0;
+		WHILE (mod # NIL) & ~CmpStr(name, mod.name) DO mod := mod.next END;
+		IF mod = NIL THEN (*load*)
+			Check(name);
+			IF res = 0 THEN F := ThisFile(name) ELSE F := NIL END;
+				IF F # NIL THEN
+					Files.Set(R, F, 0); Files.ReadString(R, name1);
+					ReadInt(R, key); Files.Read(R, ch);
+					ReadInt(R, size); importing := name1;
+					IF ch = versionkey THEN
+						Files.ReadString(R, impname); (*imports*)
+						WHILE (impname[0] # 0X) & (res = 0) DO
+							ReadInt(R, impkey);
+							Load(impname, impmod);
+							import[nofimps] := impmod; importing := name1;
+							IF res = 0 THEN
+							IF impmod.key = impkey THEN INC(nofimps)
+							ELSE error(3, name1); imported := impname
+							END
+						END;
+						Files.ReadString(R, impname)
+					END
+				ELSE error(2, name1)
+			END
+		ELSE error(1, name(*$*))
+		END;
+
+		IF res = 0 THEN NEW(mod); mod.next := root;
+			IF root = NIL THEN mod.num := 0
+			ELSE mod.num := root.num + 1
+			END;
+			root := mod
+		END;
+
+		IF res = 0 THEN (*read file*)
+			COPY(name, mod.name); mod.key := key;
+			mod.data := memW;
+			modules[mod.num] := mod;
+
+			(* type descriptors *)
+				ReadInt(R, n); ASSERT(n MOD 4 = 0, 100);
+				INC(memW, n);
+				n := n DIV 4;
+				IF n > 0 THEN NEW(mod.typeds, n) END;
+					mod.typedsLen := n;
+				i := 0;
+				WHILE n > 0 DO ReadInt(R, w);
+					mod.typeds[i] := w; INC(i);
+					DEC(n)
+				END;
+
+			(* variable space *)
+				ReadInt(R, n); INC(memW, n);
+
+			(* strings *)
+				mod.strs := memW - mod.data;
+				ReadInt(R, n); ASSERT(n MOD 4 = 0, 101);
+				INC(memW, n);
+				n := n DIV 4;
+				IF n > 0 THEN NEW(mod.strings, n) END;
+					mod.stringsLen := n;
+				i := 0;
+				WHILE n > 0 DO ReadInt(R, w);
+					mod.strings[i] := w; INC(i);
+					DEC(n)
+				END;
+
+			(* program *)
+				IF ODD(flashW) THEN
+					(* align, required for modules with
+						"LDR r, [pc, offset]" instructions, pc must be multiple of 4;
+						used for constants loading *)
+					ARMv6M.EmitNOP(flash, flashW)
+				END;
+				mod.code := flashW;
+				(* program code *)
+					ReadInt(R, n);
+					WHILE n > 0 DO ReadInt(R, w);
+						flash[flashW] := w; INC(flashW);
+						DEC(n)
+					END;
+				(* copy imports *)
+					i := 0;
+					WHILE i < nofimps DO
+						mod.imports[i] := import[i];
+						INC(i)
+					END;
+
+			(* skip commands *)
+				Files.Read(R, ch);
+				WHILE ch # 0X DO
+					REPEAT Files.Read(R, ch) UNTIL ch = 0X; ReadInt(R, n);
+					Files.Read(R, ch)
+				END;
+
+			(* entries *)
+				ReadInt(R, n);
+				NEW(mod.entries, n); mod.entriesLen := n; i := 0;
+				WHILE n > 0 DO ReadInt(R, w);
+					mod.entries[i] := w; INC(i);
+					DEC(n)
+				END;
+
+			(* pointer references *)
+				mod.nPtrs := 0;
+				ReadInt(R, w);
+				IF (w >= 0) & ODD(flashW) THEN (* align *)
+					flash[flashW] := 0; INC(flashW)
+				END;
+				mod.ptr := flashW;
+				WHILE w >= 0 DO
+					ASSERT(w < mod.strs, 100);
+					flash[flashW] := mod.data + w; (* will be fixed up in Link1 *)
+					INC(flashW, 2); INC(mod.nPtrs);
+					ReadInt(R, w)
+				END;
+				IF mod.nPtrs # 0 THEN
+					flash[flashW] := 0; INC(flashW);
+					flash[flashW] := 0; INC(flashW);
+					INC(nPtrs)
+				END;
+
+			ReadInt(R, fixorgP);
+			ReadInt(R, fixorgD);
+			ReadInt(R, mod.fixorgT);
+
+			(* entry point *)
+				ReadInt(R, w); ASSERT(w MOD 4 = 0, 100);
+				mod.body := mod.code + w DIV 4;
+
+			Files.Read(R, ch);
+			IF ch # "O" THEN (* corrupted file *) mod := NIL; error(4, name(*$*)) END
+		END;
+
+		IF res = 0 THEN
+
+			(* fixup of BL *)
+				adr := mod.code + fixorgP;
+				WHILE adr # mod.code DO
+					inst := flash[adr];
+					ASSERT(inst = 00FFFFFFH, 100);
+					DEC(adr);
+					inst := flash[adr];
+					ASSERT(inst DIV 1000000H MOD 100H = 0F7H, 101); (* BL *)
+					mno := inst DIV 100000H MOD 10H;
+					pno := inst DIV 1000H MOD 100H;
+					disp := inst MOD 1000H;
+					impmod := mod.imports[mno-1];
+					dest := impmod.entries[pno];
+					ASSERT(dest MOD 4 = 0, 102); dest := dest DIV 4;
+					dest := dest + impmod.code;
+					offset := dest - adr - 1;
+					i := adr; ARMv6M.EmitBL(flash, i, offset - 1);
+					adr := adr - disp
+				END;
+
+			(* fixup of LDR/STR/ADD *)
+				adr := (mod.code + fixorgD) * 4;
+				WHILE adr DIV 4 # mod.code DO
+					inst := flash[adr DIV 4];
+					mno := inst DIV 100000H MOD 10H;
+					disp := inst MOD 1000H;
+					a := inst DIV 1000000H MOD 10H;
+					ASSERT(a = SB, 103);
+					ASSERT(inst DIV 10000000H MOD 10H = 8, 103); (* Ldr *)
+					ASSERT(flash[adr DIV 4 + 1] = 00FFFFFDH);
+
+					IF mno = 0 THEN (* global *)
+						i := adr DIV 4;
+						ARMv7M.EmitLWImW(flash, i, a, MT, mod.num * 4)
+					ELSE (* import *)
+						impmod := mod.imports[mno-1]; v := impmod.num;
+						i := adr DIV 4; ARMv7M.EmitLWImW(flash, i, a, MT, v * 4);
+
+						inst := flash[adr DIV 4 + 2];
+						vno := inst MOD 100H;
+						a := inst DIV 1000000H MOD 10H;
+						b := inst DIV 100000H MOD 10H; ASSERT(b = SB, 100);
+						nxt := flash[adr DIV 4 + 3];
+						CASE inst DIV 10000000H MOD 10H OF 4:
+							ASSERT(nxt = 00FFFFFFH);
+							IF inst DIV 10000H MOD 10H = 8 (* Add *) THEN op := 2
+							ELSE HALT(1)
+							END
+						| 8: (* Ldr *)
+							IF nxt = 00FFFFFFH THEN op := 0
+							ELSIF nxt = 00FFFFFCH THEN op := 5
+							ELSE HALT(2)
+							END
+						| 9: (* LdrB *)
+							ASSERT(nxt = 00FFFFFFH);
+							op := 1
+						| 10: (* Str *)
+							ASSERT(nxt = 00FFFFFFH);
+							op := 3
+						| 11: (* StrB *)
+							ASSERT(nxt = 00FFFFFFH);
+							op := 4
+						END;
+
+						offset := impmod.entries[vno];
+						IF ODD(inst DIV 100H) THEN
+							ASSERT(offset MOD 4 = 0);
+							offset := offset DIV 2; (* now offset in bytes *)
+							offset := offset + impmod.code * 2;
+							HALT(126);
+							offset := offset - impmod.data
+						END;
+						i := adr DIV 4 + 2;
+						CASE op OF 0: ASSERT(offset MOD 4 = 0, 100);
+							ARMv7M.EmitLWImW(flash, i, a, b, offset)
+						| 1: ARMv7M.EmitLBImW(flash, i, a, b, offset)
+						| 2: ASSERT(a # b, 102);
+							EmitADDSIm0(flash, i, a, b, offset)
+						| 3: ASSERT(offset MOD 4 = 0, 126);
+							ARMv7M.EmitSWImW(flash, i, a, b, offset)
+						| 4: ARMv7M.EmitSBImW(flash, i, a, b, offset)
+						| 5: ASSERT(offset MOD 4 = 0);
+							ARMv7M.EmitVLDR(flash, i, a, b, 1, offset DIV 4)
+						END
+					END;
+					adr := adr - disp * 4
+				END
+
+				(* fixup of type descriptors will be made in Link1 *)
+
+			ELSIF res >= 3 THEN COPY(name, importing);
+			WHILE nofimps > 0 DO DEC(nofimps) END
+			END
+		END;
+		newmod := mod
+	END Load;
+
+	PROCEDURE WriteIHEX32 ((*IN*) VAR name: ARRAY OF CHAR; (*IN*) VAR code: ARRAY OF INTEGER; codeLen: INTEGER; startAdr: INTEGER; SLA: INTEGER; (*OUT*) VAR ok: BOOLEAN);
+		CONST maxRecLen = 16; (* <= 255 *)
+			(*
+				FlashMagic 7.50.3174 incorrectly handles hex files
+					with maxRecLen = 255 (actually 252)
+				Astrobe produces hex files with maxRecLen = 16
+			*)
+		VAR F: Files.File; R: Files.Rider;
+			a: ARRAY 1 + 2 + 1 + maxRecLen + 1 OF INTEGER;
+			r, offset, i: INTEGER;
+
+		PROCEDURE WriteRec;
+			VAR cs: INTEGER;
+			PROCEDURE WriteH (x: INTEGER);
+				PROCEDURE H (x: INTEGER);
+				BEGIN
+					IF x < 10 THEN Files.Write(R, CHR(x + ORD('0')))
+					ELSE Files.Write(R, CHR(x - 10 + ORD('A')))
+					END
+				END H;
+			BEGIN
+				ASSERT(x >= 0, 20);
+				ASSERT(x < 100H, 21);
+				H(x DIV 10H); H(x MOD 10H)
+			END WriteH;
+		BEGIN
+			Files.Write(R, ':');
+			cs := 0;
+			i := 0;
+			WHILE i < 1 + 2 + 1 + a[0] DO
+				WriteH(a[i]); cs := cs + a[i];
+				INC(i)
+			END;
+			WriteH((-cs) MOD 100H);
+			Files.Write(R, 0DX); Files.Write(R, 0AX)
+		END WriteRec;
+
+		PROCEDURE WriteELA (adr: INTEGER);
+		BEGIN
+			ASSERT(adr >= 0, 20);
+			ASSERT(adr < 10000H, 21);
+			a[0] := 2; (* len *)
+			a[1] := 0; a[2] := 0; (* offset *)
+			a[3] := 4; (* type: extended linear address *)
+			a[4] := adr DIV 100H;
+			a[5] := adr MOD 100H;
+			WriteRec
+		END WriteELA;
+
+	BEGIN
+		ASSERT(codeLen >= 0, 20);
+		ASSERT(startAdr MOD 4 = 0, 21);
+		F := NewHexFile(name);
+		IF F # NIL THEN
+			Files.Set(R, F, 0);
+			r := 0;
+
+			IF codeLen > 0 THEN
+				offset := startAdr MOD 10000H;
+				startAdr := startAdr DIV 10000H MOD 10000H;
+				WriteELA(startAdr);
+				REPEAT
+					a[0] := 0;
+					a[1] := offset DIV 100H; a[2] := offset MOD 100H;
+					a[3] := 0; (* type: data *)
+					i := 0;
+					WHILE (i <= maxRecLen - 2) & (offset <= 10000H - 2) & (codeLen > 0) DO
+						a[4+i] := code[r] MOD 100H;
+						a[5+i] := code[r] DIV 100H MOD 100H;
+						ASSERT(code[r] DIV 10000H = 0, 100); (* all fixups done *)
+						INC(a[0], 2);
+						INC(r); DEC(codeLen);
+						INC(i, 2);
+						INC(offset, 2)
+					END;
+					WriteRec;
+					IF (codeLen > 0) & (offset = 10000H) THEN
+						INC(startAdr);
+						WriteELA(startAdr);
+						offset := 0
+					END
+				UNTIL codeLen = 0
+			END;
+
+			a[0] := 4; (* len *)
+			a[1] := 0; a[2] := 0; (* offset *)
+			a[3] := 5; (* type: start linear address *)
+			a[4] := SLA DIV 1000000H MOD 100H;
+			a[5] := SLA DIV 10000H MOD 100H;
+			a[6] := SLA DIV 100H MOD 100H;
+			a[7] := SLA MOD 100H;
+			WriteRec;
+
+			a[0] := 0; a[1] := 0; a[2] := 0; a[3] := 1 (* type: EOF *); WriteRec;
+
+			Files.Register(F);
+			ok := TRUE
+		ELSE ok := FALSE
+		END
+	END WriteIHEX32;
+
+	PROCEDURE WriteBin ((*IN*) VAR name: ARRAY OF CHAR; (*IN*) VAR code: ARRAY OF INTEGER; codeLen: INTEGER; (*OUT*) VAR ok: BOOLEAN);
+		VAR F: Files.File; R: Files.Rider;
+			r: INTEGER;
+	BEGIN
+		ASSERT(codeLen >= 0, 20);
+		F := NewBinFile(name);
+		IF F # NIL THEN
+			Files.Set(R, F, 0); r := 0;
+			WHILE codeLen > 0 DO
+				ASSERT(code[r] DIV 10000H = 0, 100); (* all fixups done *)
+				Files.Write(*Byte*)(R, CHR(code[r] MOD 100H));
+				Files.Write(*Byte*)(R, CHR(code[r] DIV 100H));
+				INC(r); DEC(codeLen)
+			END;
+			Files.Register(F); ok := TRUE
+		ELSE ok := FALSE
+		END
+	END WriteBin;
+
+	PROCEDURE opcode (VAR d: INTEGER; w: LONGINT);
+		VAR s: ARRAY 64 OF CHAR;
+	BEGIN
+		ARMv6M.OpcodeRepr(d, w, s);
+		IF s[0] # 0X THEN Texts.WriteString(W, s) END
+	END opcode;
+
+	(* R.a := im *)
+	(* see ARMv7MG.MovIm *)
+	PROCEDURE MovIm0 (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; a: INTEGER; im: INTEGER);
+		CONST S = 0;
+		VAR shift: INTEGER;
+			isLR: BOOLEAN;
+			imInv: INTEGER; isMI: BOOLEAN; i, imm3, imm8, imm4: INTEGER;
+	BEGIN
+		ASSERT(a IN {0..14}, 21);
+
+		isLR := a DIV 8 = 0;
+		IF isLR & (im DIV 100H = 0) THEN
+			ARMv6M.EmitMOVSIm(code, pc, a, im)
+		ELSE
+			ARMv7M.EncodeMI12(im, i, imm3, imm8, isMI);
+			IF isMI THEN
+				(* A7.7.75: MOV (immediate); encoding T2 ARMv7-M *)
+					ARMv7M.EmitDPMI(code, pc, i, 4 + S, 0FH, imm3, a, imm8)
+				(* S=1: N, Z, C will be updated *) (* NOTE: C *)
+			ELSE
+				imInv := ORDSET(BITS(im) / {0..31});
+				ARMv7M.EncodeMI12(imInv, i, imm3, imm8, isMI);
+				IF isMI THEN
+					(* A7.7.84: MVN (immediate); encoding T1 ARMv7-M *)
+						ARMv7M.EmitDPMI(code, pc, i, 6 + S, 0FH, imm3, a, imm8)
+						(* S=1: N, Z, C will be updated *) (* NOTE: C *)
+				ELSIF isLR & (im > 255) & (im <= 255 + 255) THEN
+					ARMv6M.EmitMOVSIm(code, pc, a, 255);
+					ARMv6M.EmitADDSIm(code, pc, a, a, im - 255)
+				ELSE
+					shift := 8;
+					WHILE (shift < 32) & (SYSTEM.ROT(im DIV 100H * 100H, -shift) DIV 100H # 0) DO INC(shift) END;
+					IF isLR & (shift < 32) THEN
+						ASSERT(im =
+							SYSTEM.LSH(SYSTEM.ROT(im DIV 100H * 100H, -shift), shift)
+							+ im MOD 100H);
+						ARMv6M.EmitMOVSIm(code, pc, a, SYSTEM.ROT(im DIV 100H * 100H, -shift));
+						ARMv6M.EmitLSLSIm(code, pc, a, a, shift);
+						ARMv6M.EmitADDSIm(code, pc, a, a, im MOD 100H)
+					ELSE
+						(* TODO: 3 ops: mov; (add, lsl), (lsl, sub), (lsl, sub) | MI12; add, lsl, sub *)
+						IF isLR & (im MOD 10000H DIV 100H = 0) THEN
+							ARMv6M.EmitMOVSIm(code, pc, a, im MOD 10000H)
+						ELSE
+							(* A7.7.75: MOV (immediate); encoding T3 ARMv7-M *)
+								imm4 := im DIV 1000H MOD 10H;
+								i := im DIV 800H MOD 2;
+								imm3 := im DIV 100H MOD 8;
+								imm8 := im MOD 100H;
+								ARMv7M.EmitDPPBI(code, pc, i, 4, imm4, imm3 * 1000H + a * 100H + imm8)
+						END;
+						im := im DIV 10000H;
+						IF im # 0 THEN
+							(* A7.7.78: MOVT; encoding T1 ARMv7 *)
+								imm4 := im DIV 1000H MOD 10H;
+								i := im DIV 800H MOD 2;
+								imm3 := im DIV 100H MOD 8;
+								imm8 := im MOD 100H;
+								ARMv7M.EmitDPPBI(code, pc, i, 12, imm4, imm3 * 1000H + a * 100H + imm8)
+						END
+					END
+				END
+			END
+		END
+	END MovIm0;
+
+	PROCEDURE SubIm0 (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; d, n, im: INTEGER);
+	BEGIN
+		IF im DIV 8 = 0 THEN
+			ARMv6M.EmitSUBSIm(code, pc, d, n, im)
+		ELSE
+			IF d # n THEN
+				ARMv6M.EmitMOVSR(code, pc, d, n);
+			END;
+			ARMv6M.EmitSUBSIm(code, pc, d, d, im)
+		END
+	END SubIm0;
+
+	PROCEDURE StrIm0 (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; t, n, im: INTEGER);
+	BEGIN
+		IF im DIV 32 = 0 THEN ARMv6M.EmitSTRIm(code, pc, t, n, im)
+		ELSE ARMv7M.EmitSWImW(code, pc, t, n, im * 4)
+		END
+	END StrIm0;
+
+	PROCEDURE Link1 ((*IN*) VAR name: ARRAY OF CHAR);
+		VAR MTOrg, StkOrg, i, j: INTEGER;
+			ok: BOOLEAN;
+			mod, impmod: Module;
+			adr, inst, mno, vno, disp, offset: INTEGER;
+			r0, r1: INTEGER; r0a, r1a: BOOLEAN;
+	BEGIN
+		ASSERT(memW MOD 4 = 0, 100); (* should be aligned *)
+		(* memW := (memW + 3) DIV 4 * 4; *) (* align *)
+
+		MTOrg := target.SRAMStart + target.SRAMSize
+			- (root.num + 1) * 4; (* MTab *)
+
+		(* initial SP *)
+			StkOrg := MTOrg - (nPtrs + 1) * 4 - memW;
+			flash[0] := StkOrg MOD 10000H;
+			flash[1] := StkOrg DIV 10000H MOD 10000H;
+
+		(* reset vector *)
+			inst := target.flashStart + flashW * 2 + 1;
+			flash[2] := inst MOD 10000H;
+			flash[3] := inst DIV 10000H MOD 10000H;
+
+		(* CPU exceptions (NMI..SysTick) *)
+			i := 4; WHILE i < 40H DIV 2 DO
+				flash[i] := 1; INC(i);
+				flash[i] := 0; INC(i)
+			END;
+		WHILE i < 40H DIV 2 + target.maxExtInts * 2 DO
+			flash[i] := 1; INC(i);
+			flash[i] := 0; INC(i)
+		END;
+		WHILE i < target.flashOrg DIV 2 DO
+			flash[i] := 0; INC(i);
+			flash[i] := 0; INC(i)
+		END;
+		IF target.isNXP THEN
+			(* code read protection (CRP) *)
+				flash[2FCH DIV 2] := 0; flash[2FCH DIV 2 + 1] := 0;
+			(* NXP checksum *)
+				j := 0; i := 0; WHILE i < 7 DO
+					j := j + flash[2 * i] + 10000H * flash[2 * i + 1];
+					INC(i)
+				END;
+				flash[2 * i] := (-j) MOD 10000H;
+				flash[2 * i + 1] := (-j) DIV 10000H MOD 10000H
+		END;
+
+		IF memW > 0 THEN
+			(* R[MT] := MTOrg *)
+				MovIm0(flash, flashW, MT, MTOrg);
+
+			(* modules ptrs table *)
+				(* R[0] := MT - (nPtrs + 1) * 4 *)
+					SubIm0(flash, flashW, 0, MT, (nPtrs + 1) * 4);
+				i := 0; mod := root;
+				WHILE mod # NIL DO
+					IF mod.nPtrs # 0 THEN
+						(* R[1] := flashStart + mod.ptr * 2 *)
+							MovIm0(flash, flashW, 1,
+								target.flashStart + mod.ptr * 2);
+						(* Mem[R[0] + i * 4] := R[1] *)
+							StrIm0(flash, flashW, 1, 0, i);
+						INC(i)
+					END;
+					mod := mod.next
+				END;
+				ASSERT(i = nPtrs, 101);
+				(* R[1] := i *)
+					MovIm0(flash, flashW, 1, i);
+				(* Mem[R[0] + i * 4] := R[1] *)
+					StrIm0(flash, flashW, 1, 0, i);
+
+			(* MT, type descriptors and strings *)
+				j := 0;
+				r0a := FALSE; r1a := FALSE;
+				WHILE j <= root.num DO mod := modules[j];
+					IF ~r0a OR (r0 # StkOrg + mod.data) THEN
+						(* R[0] := StkOrg + mod.data *)
+							MovIm0(flash, flashW, 0, StkOrg + mod.data);
+							r0 := StkOrg + mod.data; r0a := TRUE
+					END;
+					(* MTab *)
+						(* Mem[R[MT] + mod.num * 4] := R[0] *)
+							StrIm0(flash, flashW, 0, MT, mod.num);
+
+					(* fixup of type descriptors *)
+						adr := mod.fixorgT * 4;
+						WHILE adr DIV 4 # 0 DO
+							inst := mod.typeds[adr DIV 4];
+							IF trace THEN Texts.WriteLn(W);
+								Texts.WriteString(W, "td fixup: ");
+								Texts.WriteInt(W, adr DIV 4, 0);
+								Texts.WriteHex(W, inst);
+								Texts.WriteString(W, " -> ")
+							END;
+							mno := inst DIV 1000000H MOD 10H;
+							vno := inst DIV 1000H MOD 1000H;
+							disp := inst MOD 1000H;
+							IF mno = 0 THEN (*global*) inst := StkOrg + mod.data + vno
+							ELSE (*import*)
+								impmod := mod.imports[mno-1];
+								offset := impmod.entries[vno];
+								inst := StkOrg + impmod.data + offset
+							END;
+							IF trace THEN Texts.WriteHex(W, inst) END;
+							mod.typeds[adr DIV 4] := inst;
+							adr := adr - disp * 4
+						END;
+
+					IF mod.typeds # NIL THEN (* type descriptors *)
+						i := 0;
+						WHILE i < mod.typedsLen DO
+							IF ~r1a OR (r1 # mod.typeds[i]) THEN
+								(* R[1] := mod.typeds[i] *)
+									MovIm0(flash, flashW, 1, mod.typeds[i]);
+									r1 := mod.typeds[i]; r1a := TRUE
+							END;
+							(* Mem[R[0] + i * 4] := R[1] *)
+								StrIm0(flash, flashW, 1, 0, i);
+							INC(i)
+						END
+					END;
+					IF mod.strings # NIL THEN (* strings *)
+						i := 0;
+						WHILE i < mod.stringsLen DO
+							IF ~r1a OR (r1 # mod.strings[i]) THEN
+								(* R[1] := mod.strings[i] *)
+									MovIm0(flash, flashW, 1, mod.strings[i]);
+									r1 := mod.strings[i]; r1a := TRUE
+							END;
+							(* Mem[R[0] + mod.strs + i * 4] := R[1] *)
+								ASSERT(mod.strs MOD 4 = 0);
+								StrIm0(flash, flashW, 1, 0, mod.strs DIV 4 + i);
+							INC(i)
+						END
+					END;
+
+					(* fixup of pointer references *)
+						i := 0;
+						WHILE i < mod.nPtrs DO
+							inst := StkOrg + flash[mod.ptr + i * 2];
+							flash[mod.ptr + i * 2] := inst MOD 10000H;
+							flash[mod.ptr + i * 2 + 1] := inst DIV 10000H MOD 10000H;
+							INC(i)
+						END;
+
+					INC(j)
+				END
+		END;
+
+		(* body calls *)
+			i := 0;
+			WHILE i <= root.num DO
+				ARMv6M.EmitBL(flash, flashW, modules[i].body - flashW - 1 - 1);
+				INC(i)
+			END;
+
+		(* stop *)
+			ARMv6M.EmitB(flash, flashW, -1 - 1);
+
+		IF ODD(flashW) THEN (* align *)
+			ARMv6M.EmitNOP(flash, flashW)
+		END;
+
+		IF flashW * 2 <= target.flashSize THEN
+			WriteIHEX32(name, flash, flashW,
+				target.flashStart, target.flashStart + 1, ok);
+			IF ~ok THEN res := 9 END;
+			WriteBin(name, flash, flashW, ok);
+			IF ~ok & (res = 0) THEN res := 10 END
+		ELSE
+			res := 8
+		END
+	END Link1;
+
+	PROCEDURE Link*;
+		VAR i: INTEGER;
+			S: Texts.Scanner;
+			mod: Module;
+			d: INTEGER;
+	BEGIN
+		(*Oberon.GetPar;*) Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
+		IF S.class = Texts.Name THEN
+			target := targets;
+			WHILE (target # NIL) & ~CmpStr(target.name, S.s) DO
+				target := target.next
+			END;
+			IF target # NIL THEN
+				Texts.Scan(S);
+				IF S.class = Texts.Name THEN
+					Texts.WriteString(W, "linking "); Texts.WriteString(W, S.s); Texts.WriteString(W, " ");
+
+					root := NIL;
+					flashW := target.flashOrg DIV 2;
+					memW := 0;
+					nPtrs := 0;
+					Load(S.s, mod);
+
+					IF res = 0 THEN Link1(S.s) END;
+
+					CASE res OF 0:
+						IF trace THEN Texts.WriteLn(W) END;
+						Texts.WriteString(W, "Ok"); Texts.WriteLn(W);
+
+						i := 0;
+						WHILE i <= root.num DO mod := modules[i];
+							Texts.Write(W, 9X);
+							Texts.WriteString(W, mod.name);
+							Texts.Write(W, 9X);
+							Texts.WriteInt(W, mod.code, 0); Texts.WriteLn(W);
+							INC(i)
+						END;
+
+						Texts.WriteString(W, "ROM: ");
+							Texts.WriteInt(W, flashW * 2 (* - target.flashOrg *), 0);
+							Texts.WriteString(W, " B; RAM: ");
+							Texts.WriteInt(W,
+								memW + (nPtrs + 1) * 4 + (root.num + 1) * 4, 0);
+								Texts.WriteString(W, " B");
+
+						IF trace THEN Texts.WriteLn(W);
+							mod := root;
+							WHILE mod # NIL DO
+								Texts.WriteString(W, mod.name); Texts.WriteString(W, ":"); Texts.WriteLn(W);
+									Texts.WriteString(W, "  num: ");
+										Texts.WriteInt(W, mod.num, 0); Texts.WriteLn(W);
+									Texts.WriteString(W, "  data: ");
+										Texts.WriteInt(W, mod.data, 0); Texts.WriteLn(W);
+									Texts.WriteString(W, "  strs: ");
+										Texts.WriteInt(W, mod.strs, 0); Texts.WriteLn(W);
+									Texts.WriteString(W, "  code: ");
+										Texts.WriteInt(W, mod.code, 0); Texts.WriteLn(W);
+									Texts.WriteString(W, "  entries:");
+										i := 0;
+										WHILE i < mod.entriesLen DO
+											Texts.Write(W, ' ');
+											Texts.WriteInt(W, mod.entries[i], 0);
+											INC(i)
+										END;
+										Texts.WriteLn(W);
+									Texts.WriteString(W, "  body: ");
+										Texts.WriteInt(W, mod.body, 0); Texts.WriteLn(W);
+								mod := mod.next
+							END;
+
+							i := 0; d := 0;
+							WHILE i < flashW DO
+								Texts.WriteInt(W, i, 4); Texts.Write(W, 9X);
+									Texts.WriteHex(W, flash[i]); Texts.Write(W, 9X); opcode(d, flash[i]);
+									Texts.WriteLn(W);
+								INC(i)
+							END;
+							IF d # 0 THEN
+								Texts.WriteString(W, "invalid decoder state");
+								Texts.WriteLn(W)
+							END
+						END
+					| 1: Texts.WriteString(W, "file not available: "); Texts.WriteString(W, importing)
+					| 2: Texts.WriteString(W, "invalid version: "); Texts.WriteString(W, importing)
+					| 3: Texts.WriteString(W, "key conflict: "); Texts.WriteString(W, importing); Texts.WriteString(W, ": "); Texts.WriteString(W, imported)
+					| 4: Texts.WriteString(W, "corrupted file: "); Texts.WriteString(W, importing)
+					| 7: Texts.WriteString(W, "no space: "); Texts.WriteString(W, importing)
+					| 8: Texts.WriteString(W, "end of flash")
+					| 9: Texts.WriteString(W, "write HEX failed")
+					| 10: Texts.WriteString(W, "write BIN failed")
+					END;
+					Texts.WriteLn(W)
+				END
+			ELSE Texts.WriteString(W, "invalid target"); Texts.WriteLn(W);
+				target := targets;
+				WHILE target # NIL DO
+					Texts.WriteString(W, target.name); Texts.WriteLn(W);
+					target := target.next
+				END
+			END;
+
+			Texts.Append(Oberon.Log(**), W.buf)
+		END;
+		(*Oberon.Collect(0)*)
+	END Link;
+
+	PROCEDURE EnterNXP ((*IN*) name: TargetName; maxExtInts, flashSize, SRAMSize, IAPReserve: INTEGER);
+		VAR target: Target;
+	BEGIN
+		ASSERT(maxExtInts > 0, 20);
+		ASSERT(maxExtInts <= 240 (* Cortex-M4 *), 21);
+		ASSERT(flashSize MOD 4 = 0, 22);
+		ASSERT(SRAMSize MOD 4 = 0, 23);
+
+		NEW(target); target.next := targets; targets := target;
+		target.name := name;
+		target.isNXP := TRUE;
+		target.flashStart := 0;
+		target.maxExtInts := maxExtInts;
+		target.flashOrg := (16 + maxExtInts) * 4;
+		IF target.flashOrg <= 2FCH (* CRP *) THEN
+			target.flashOrg := 2FCH (* CRP *) + 4
+		END;
+		target.flashSize := flashSize;
+		target.SRAMStart := 10000000H;
+		target.SRAMSize := SRAMSize - IAPReserve
+	END EnterNXP;
+
+	PROCEDURE EnterSTM ((*IN*) name0, fpo0, fpo1: ARRAY OF CHAR; maxExtInts, flashOrg, SRAMSize: INTEGER);
+		VAR target: Target; i, j, k: INTEGER;
+	BEGIN
+		ASSERT(maxExtInts > 0, 20);
+		ASSERT(maxExtInts <= 240 (* Cortex-M4 *), 21);
+		ASSERT(flashOrg MOD 4 = 0, 22);
+		ASSERT(flashOrg >= (16 + maxExtInts) * 4, 23);
+		ASSERT(SRAMSize MOD 4 = 0, 24);
+
+		i := 0;
+		WHILE i < StrLen(fpo0) DO
+			j := 0;
+			WHILE j < StrLen(fpo1) DO
+				NEW(target); target.next := targets; targets := target;
+				target.name := name0(*$*); k := StrLen(target.name);
+					target.name[k] := fpo0[i]; INC(k);
+					target.name[k] := fpo1[j]; INC(k);
+					target.name[k] := 0X;
+				target.isNXP := FALSE;
+				target.flashStart := 08000000H;
+				target.maxExtInts := maxExtInts;
+				target.flashOrg := flashOrg;
+				IF fpo1[j] = '4' THEN target.flashSize := 4000H (* 16 KiB *)
+				ELSIF fpo1[j] = '6' THEN target.flashSize := 8000H (* 32 KiB *)
+				ELSIF fpo1[j] = '8' THEN target.flashSize := 10000H (* 64 KiB *)
+				ELSIF fpo1[j] = 'B' THEN target.flashSize := 20000H (* 128 KiB *)
+				ELSIF fpo1[j] = 'C' THEN target.flashSize := 40000H (* 256 KiB *)
+				ELSIF fpo1[j] = 'D' THEN target.flashSize := 60000H (* 384 KiB *)
+				ELSIF fpo1[j] = 'E' THEN target.flashSize := 80000H (* 512 KiB *)
+				ELSIF fpo1[j] = 'F' THEN target.flashSize := 0C0000H (* 768 KiB *)
+				ELSIF fpo1[j] = 'G' THEN target.flashSize := 100000H (* 1 MiB *)
+				ELSIF fpo1[j] = 'I' THEN target.flashSize := 200000H (* 2 MiB *)
+				ELSE HALT(100) (* invalid fpo1[j] *)
+				END;
+				target.SRAMStart := 20000000H;
+				target.SRAMSize := SRAMSize;
+				INC(j)
+			END;
+			INC(i)
+		END
+	END EnterSTM;
+
+	(* Cortex-M3 *)
+	PROCEDURE EnterCC1310 ((*IN*) name: TargetName; flashSize, SRAMSize: INTEGER);
+		CONST
+			maxExtInts = 34;
+			CCFGSize = 88;
+	BEGIN
+		ASSERT(flashSize MOD 4 = 0, 20);
+		ASSERT(SRAMSize MOD 4 = 0, 21);
+
+		NEW(target); target.next := targets; targets := target;
+		target.name := name;
+		target.isNXP := FALSE;
+		target.flashStart := 0;
+		target.maxExtInts := maxExtInts;
+		target.flashOrg := (16 + maxExtInts) * 4;
+		target.flashSize := flashSize - CCFGSize;
+		target.SRAMStart := 20000000H;
+		target.SRAMSize := SRAMSize
+	END EnterCC1310;
+
+	(* Cortex-M3 *)
+	PROCEDURE EnterLM3S ((*IN*) name: TargetName; flashSize, SRAMSize: INTEGER; maxExtInts: INTEGER);
+	BEGIN
+		ASSERT(flashSize MOD 4 = 0, 20);
+		ASSERT(SRAMSize MOD 4 = 0, 21);
+		ASSERT(maxExtInts > 0, 22);
+		ASSERT(maxExtInts <= 240 (* Cortex-M4 *), 23);
+
+		NEW(target); target.next := targets; targets := target;
+		target.name := name;
+		target.isNXP := FALSE;
+		target.flashStart := 0;
+		target.maxExtInts := maxExtInts;
+		target.flashOrg := (16 + maxExtInts) * 4;
+		target.flashSize := flashSize;
+		target.SRAMStart := 20000000H;
+		target.SRAMSize := SRAMSize
+	END EnterLM3S;
+
+	PROCEDURE EnterSAM ((*IN*) name0, fpo0: ARRAY OF CHAR; maxExtInts, flashOrg, flashSize, SRAMSize: INTEGER);
+		CONST
+			flashStart = 400000H;
+			internalROMStart = 800000H;
+			SRAMStart = 20000000H;
+		VAR i, k: INTEGER;
+	BEGIN
+		ASSERT(maxExtInts > 0, 20);
+		ASSERT(maxExtInts <= 240 (* Cortex-M4 *), 21);
+		ASSERT(flashOrg MOD 80H = 0, 22);
+		ASSERT(flashOrg >= (16 + maxExtInts) * 4, 23);
+		ASSERT(flashSize MOD 4 = 0, 24);
+		ASSERT(flashStart + flashSize <= internalROMStart, 25);
+		ASSERT(SRAMSize MOD 4 = 0, 26);
+
+		i := 0;
+		WHILE i < StrLen(fpo0) DO
+			NEW(target); target.next := targets; targets := target;
+			target.name := name0(*$*); k := StrLen(target.name);
+				target.name[k] := fpo0[i]; INC(k);
+				target.name[k] := 0X;
+			target.isNXP := FALSE;
+			target.flashStart := flashStart;
+			target.maxExtInts := maxExtInts;
+			target.flashOrg := flashOrg;
+			target.flashSize := flashSize;
+			target.SRAMStart := SRAMStart;
+			target.SRAMSize := SRAMSize;
+			INC(i)
+		END
+	END EnterSAM;
+
+BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "OARMv7MLinker 11.1.2017");
+	Texts.WriteLn(W); Texts.Append(Oberon.Log(**), W.buf);
+
+	targets := NIL;
+
+	EnterNXP("LPC1311", 58, 2000H (* 8 KiB *), 1000H (* 4 KiB *), 32);
+	EnterNXP("LPC1313", 58, 8000H (* 32 KiB *), 2000H (* 8 KiB *), 32);
+	EnterNXP("LPC1342", 58, 4000H (* 16 KiB *), 1000H (* 4 KiB *), 32);
+	EnterNXP("LPC1343", 58, 8000H (* 32 KiB *), 2000H (* 8 KiB *), 32);
+
+	EnterNXP("LPC1751", 35, 8000H (* 32 KiB *), 2000H (* 8 KiB *), 32);
+	EnterNXP("LPC1752", 35, 10000H (* 64 KiB *), 4000H (* 16 KiB *), 32);
+	EnterNXP("LPC1754", 35, 20000H (* 128 KiB *), 8000H (* 32 KiB *), 32);
+	EnterNXP("LPC1756", 35, 40000H (* 256 KiB *), 8000H (* 32 KiB *), 32);
+	EnterNXP("LPC1758", 35, 80000H (* 512 KiB *), 10000H (* 64 KiB *), 32);
+	EnterNXP("LPC1759", 35, 80000H (* 512 KiB *), 10000H (* 64 KiB *), 32);
+	EnterNXP("LPC1763", 35, 40000H (* 256 KiB *), 10000H (* 64 KiB *), 32);
+	EnterNXP("LPC1764", 35, 20000H (* 128 KiB *), 8000H (* 32 KiB *), 32);
+	EnterNXP("LPC1765", 35, 40000H (* 256 KiB *), 10000H (* 64 KiB *), 32);
+	EnterNXP("LPC1766", 35, 40000H (* 256 KiB *), 10000H (* 64 KiB *), 32);
+	EnterNXP("LPC1767", 35, 80000H (* 512 KiB *), 10000H (* 64 KiB *), 32);
+	EnterNXP("LPC1768", 35, 80000H (* 512 KiB *), 10000H (* 64 KiB *), 32);
+	EnterNXP("LPC1769", 35, 80000H (* 512 KiB *), 10000H (* 64 KiB *), 32);
+
+	EnterNXP("LPC1773", 41, 20000H (* 128 KiB *), 8000H (* 32 KiB *), 32);
+	EnterNXP("LPC1774", 41, 20000H (* 128 KiB *), 8000H (* 32 KiB *), 32);
+	EnterNXP("LPC1776", 41, 40000H (* 256 KiB *), 10000H (* 64 KiB *), 32);
+	EnterNXP("LPC1777", 41, 80000H (* 512 KiB *), 10000H (* 64 KiB *), 32);
+	EnterNXP("LPC1778", 41, 80000H (* 512 KiB *), 10000H (* 64 KiB *), 32);
+	EnterNXP("LPC1785", 41, 40000H (* 256 KiB *), 10000H (* 64 KiB *), 32);
+	EnterNXP("LPC1786", 41, 40000H (* 256 KiB *), 10000H (* 64 KiB *), 32);
+	EnterNXP("LPC1787", 41, 80000H (* 512 KiB *), 10000H (* 64 KiB *), 32);
+	EnterNXP("LPC1788", 41, 80000H (* 512 KiB *), 10000H (* 64 KiB *), 32);
+
+	(* no FPU *)
+		EnterNXP("LPC4072", 41, 10000H (* 64 KiB *), 4000H (* 16 KiB *), 32);
+		EnterNXP("LPC4074", 41, 20000H (* 128 KiB *), 8000H (* 32 KiB *), 32);
+	EnterNXP("LPC4076", 41, 40000H (* 256 KiB *), 10000H (* 64 KiB *), 32);
+	EnterNXP("LPC4078", 41, 80000H (* 512 KiB *), 10000H (* 64 KiB *), 32);
+	EnterNXP("LPC4088", 41, 80000H (* 512 KiB *), 10000H (* 64 KiB *), 32);
+
+	(* 4 KiB of SRAM *)
+		EnterSTM("STM32F100", "CR", "46", 61, 200H, 1000H);
+		EnterSTM("STM32F101", "RT", "4", 60, 200H, 1000H);
+		EnterSTM("STM32F102", "CR", "4", 60, 200H, 1000H);
+
+	(* 6 KiB of SRAM *)
+		EnterSTM("STM32F101", "CRT", "6", 60, 200H, 1800H);
+		EnterSTM("STM32F102", "CR", "6", 60, 200H, 1800H);
+		EnterSTM("STM32F103", "CRT", "4", 60, 200H, 1800H);
+
+	(* 8 KiB of SRAM *)
+		EnterSTM("STM32F100", "CRV", "8B", 61, 200H, 2000H);
+
+	(* 10 KiB of SRAM *)
+		EnterSTM("STM32F101", "CRTV", "8", 60, 200H, 2800H);
+		EnterSTM("STM32F102", "CR", "8", 60, 200H, 2800H);
+		EnterSTM("STM32F103", "CRT", "6", 60, 200H, 2800H);
+
+	(* 16 KiB of SRAM *)
+		EnterSTM("STM32F101", "CRTV", "B", 60, 200H, 4000H);
+		EnterSTM("STM32F102", "CR", "B", 60, 200H, 4000H);
+		EnterSTM("STM32F301", "CKR", "68", 82, 200H, 4000H);
+		EnterSTM("STM32F302", "CKR", "68", 82, 200H, 4000H);
+		EnterSTM("STM32F303", "CKR", "68", 82, 200H, 4000H);
+
+	(* 20 KiB of SRAM *)
+		EnterSTM("STM32F103", "CRTV", "8B", 60, 200H, 5000H);
+
+	(* 24 KiB of SRAM *)
+		EnterSTM("STM32F100", "RVZ", "C", 61, 200H, 6000H);
+
+	(* 32 KiB of SRAM *)
+		EnterSTM("STM32F100", "RVZ", "DE", 61, 200H, 8000H);
+		EnterSTM("STM32F101", "RVZ", "C", 60, 200H, 8000H);
+		EnterSTM("STM32F302", "CRV", "B", 85, 200H, 8000H);
+
+	(* 40 KiB of SRAM *)
+		EnterSTM("STM32F302", "CRV", "C", 85, 200H, 0A000H);
+		EnterSTM("STM32F303", "CRV", "B", 85, 200H, 0A000H);
+
+	(* 48 KiB of SRAM *)
+		EnterSTM("STM32F101", "RVZ", "DE", 60, 200H, 0C000H);
+		EnterSTM("STM32F103", "RVZ", "C", 60, 200H, 0C000H);
+		EnterSTM("STM32F303", "CRV", "C", 85, 200H, 0C000H);
+
+	(* 64 KiB of SRAM *)
+		EnterSTM("STM32F103", "RVZ", "DE", 60, 200H, 10000H);
+		EnterSTM("STM32F105", "RV", "8BC", 68, 200H, 10000H);
+		EnterSTM("STM32F107", "RV", "BC", 68, 200H, 10000H);
+		EnterSTM("STM32F302", "RVZ", "DE", 85, 200H, 10000H);
+		EnterSTM("STM32F401", "CRV", "BC", 85, 200H, 10000H);
+
+(* memory hole?
+	(* 48+16 KiB of SRAM *)
+		EnterSTM("STM32F205", "RV", "B", 81, 200H, 10000H);
+*)
+
+	(* 80 KiB of SRAM *)
+		EnterSTM("STM32F101", "RVZ", "FG", 60, 200H, 14000H);
+		EnterSTM("STM32F303", "RVZ", "DE", 85, 200H, 14000H);
+
+	(* 96 KiB of SRAM *)
+		EnterSTM("STM32F103", "RVZ", "FG", 60, 200H, 18000H);
+		EnterSTM("STM32F401", "CRV", "DE", 85, 200H, 18000H);
+
+(* memory hole?
+	(* 80+16 KiB of SRAM *)
+		EnterSTM("STM32F205", "RVZ", "C", 81, 200H, 18000H);
+*)
+
+	(* 128 KiB of SRAM *)
+		EnterSTM("STM32F411", "CRV", "CE", 86, 200H, 20000H);
+
+	(* 112+16 KiB of SRAM *)
+		EnterSTM("STM32F205", "RVZ", "EFG", 81, 200H, 20000H);
+		EnterSTM("STM32F207", "IVZ", "CEFG", 81, 200H, 20000H);
+		EnterSTM("STM32F215", "RVZ", "EG", 81, 200H, 20000H);
+		EnterSTM("STM32F217", "IVZ", "EG", 81, 200H, 20000H);
+		EnterSTM("STM32F405", "O", "E", 82, 200H, 20000H);
+		EnterSTM("STM32F405", "ORVZ", "G", 82, 200H, 20000H);
+		EnterSTM("STM32F407", "IVZ", "EG", 82, 200H, 20000H);
+		EnterSTM("STM32F415", "ORVZ", "G", 82, 200H, 20000H);
+		EnterSTM("STM32F417", "IVZ", "EG", 82, 200H, 20000H);
+		EnterSTM("STM32F446", "MRVZ", "CE", 97, 200H, 20000H);
+
+	(* 112+16+64 KiB of SRAM *)
+		EnterSTM("STM32F427", "IVZ", "GI", 91, 200H, 30000H);
+		EnterSTM("STM32F429", "BINVZ", "EGI", 91, 200H, 30000H);
+		EnterSTM("STM32F437", "IVZ", "GI", 91, 200H, 30000H);
+		EnterSTM("STM32F439", "BINVZ", "GI", 91, 200H, 30000H);
+
+	(* 64 KiB (DTCM) + 240 KiB (SRAM1) + 16 KiB (SRAM2) *)
+		EnterSTM("STM32F756", "BINVZ", "EG",
+			240 (* FIXME *), (16 + 240) * 4 (* FIXME *), 50000H);
+
+	EnterCC1310("CC1310F32", 8000H (* 32 KiB *), 4000H (* 16 KiB *));
+	EnterCC1310("CC1310F64", 10000H (* 64 KiB *), 4000H (* 16 KiB *));
+	EnterCC1310("CC1310F128", 20000H (* 128 KiB *), 5000H (* 20 KiB *));
+
+	EnterLM3S("LM3S811", 10000H (* 64 KiB *), 2000H (* 8 KiB *), 26);
+	EnterLM3S("LM3S6965", 40000H (* 256 KiB *), 10000H (* 64 KiB *), 38);
+
+	EnterSAM("SAM3S1", "ABC", 35, 200H,
+		10000H (* 64 KiB *), 4000H (* 16 KiB *));
+	EnterSAM("SAM3S2", "ABC", 35, 200H,
+		20000H (* 128 KiB *), 8000H (* 32 KiB *));
+	EnterSAM("SAM3S4", "ABC", 35, 200H,
+		40000H (* 256 KiB *), 0C000H (* 48 KiB *))
+END O7ARMv7MLinker.

voc-O7/O7ARMv7MLinkerLink.Mod

@@ -0,0 +1,8 @@
+MODULE O7ARMv7MLinkerLink;
+
+	(* Alexander Shiryaev, 2020.09 *)
+
+	IMPORT O7ARMv7MLinker;
+
+BEGIN O7ARMv7MLinker.Link
+END O7ARMv7MLinkerLink.

voc-O7/O7ARMv7MP.Mod

@@ -0,0 +1,1247 @@
+MODULE O7ARMv7MP; (*N. Wirth 1.7.97 / 8.2.2020	Oberon compiler for RISC in Oberon-07*)
+
+	(* Translated for BlackBox by Alexander Shiryaev,
+		2016.05.07, 2017.09.26, 2019.10.21 *)
+
+	IMPORT ORS := O7S, ORB := O7B, ORG := O7ARMv7MG, Texts (*:= O7Texts*), Oberon (*:= O7Oberon*)(*, Kernel, Dialog, StdLog, DevCommanders, TextMappers, TextModels, TextViews, DevMarkers, TextControllers, Views, Files, StdDialog*);
+
+	(*Author: Niklaus Wirth, 2014.
+		Parser of Oberon-RISC compiler. Uses Scanner ORS to obtain symbols (tokens),
+		ORB for definition of data structures and for handling import and export, and
+		ORG to produce binary code. ORP performs type checking and data allocation.
+		Parser is target-independent, except for part of the handling of allocations.*)
+
+	TYPE
+		LONGINT = INTEGER;
+		(* REAL = SHORTREAL; *)
+		LONGREAL = REAL;
+		(* BYTE = SHORTCHAR; *)
+		BYTE = CHAR;
+
+	CONST
+		(* compiler options: *)
+			newsf = 0;
+			defopt = {newsf};
+
+		(* DevCompiler: additional scanner types *)
+			import = 100; module = 101; semicolon = 102; becomes = 103; comEnd = 104;
+
+	TYPE PtrBase = POINTER TO PtrBaseDesc;
+		PtrBaseDesc = RECORD	(*list of names of pointer base types*)
+			name: ORS.Ident; type: ORB.Type; next: PtrBase
+		END;
+
+(*
+	VAR
+		s: TextMappers.Scanner;
+*)
+
+	VAR sym: INTEGER;	 (*last symbol read*)
+		dc: LONGINT;		(*data counter*)
+		level, exno, version: INTEGER;
+		newSF: BOOLEAN;	(*option flag*)
+		expression: PROCEDURE (VAR x: ORG.Item);	(*to avoid forward reference*)
+		Type: PROCEDURE (VAR type: ORB.Type);
+		FormalType: PROCEDURE (VAR typ: ORB.Type; dim: INTEGER);
+		modid: ORS.Ident;
+		pbsList: PtrBase;	 (*list of names of pointer base types*)
+		dummy: ORB.Object;
+		W: Texts.Writer;
+
+	PROCEDURE Check (s: INTEGER; (*IN*) msg: ARRAY OF CHAR);
+	BEGIN
+		IF sym = s THEN ORS.Get(sym) ELSE ORS.Mark(msg) END
+	END Check;
+
+	PROCEDURE qualident (VAR obj: ORB.Object);
+	BEGIN obj := ORB.thisObj(); ORS.Get(sym);
+		IF obj = NIL THEN ORS.Mark("undef"); obj := dummy END;
+		IF (sym = ORS.period) & (obj.class = ORB.Mod) THEN
+			ORS.Get(sym);
+			IF sym = ORS.ident THEN obj := ORB.thisimport(obj); ORS.Get(sym);
+				IF obj = NIL THEN ORS.Mark("undef"); obj := dummy END
+			ELSE ORS.Mark("identifier expected"); obj := dummy
+			END
+		END
+	END qualident;
+
+	PROCEDURE CheckBool (VAR x: ORG.Item);
+	BEGIN
+		IF x.type.form # ORB.Bool THEN ORS.Mark("not Boolean"); x.type := ORB.boolType END
+	END CheckBool;
+
+	PROCEDURE CheckInt (VAR x: ORG.Item);
+	BEGIN
+		IF x.type.form # ORB.Int THEN ORS.Mark("not Integer"); x.type := ORB.intType END
+	END CheckInt;
+
+	PROCEDURE CheckReal (VAR x: ORG.Item);
+	BEGIN
+		IF x.type.form # ORB.Real THEN ORS.Mark("not Real"); x.type := ORB.realType END
+	END CheckReal;
+
+	PROCEDURE CheckSet (VAR x: ORG.Item);
+	BEGIN
+		IF x.type.form # ORB.Set THEN ORS.Mark("not Set"); x.type := ORB.setType END
+	END CheckSet;
+
+	PROCEDURE CheckSetVal (VAR x: ORG.Item);
+	BEGIN
+		IF x.type.form # ORB.Int THEN ORS.Mark("not Int"); x.type := ORB.setType
+		ELSIF x.mode = ORB.Const THEN
+			IF (x.a < 0) OR (x.a >= 32) THEN ORS.Mark("invalid set") END
+		END
+	END CheckSetVal;
+
+	PROCEDURE CheckConst (VAR x: ORG.Item);
+	BEGIN
+		IF x.mode # ORB.Const THEN ORS.Mark("not a constant"); x.mode := ORB.Const END
+	END CheckConst;
+
+	PROCEDURE CheckReadOnly (VAR x: ORG.Item);
+	BEGIN
+		IF x.rdo THEN ORS.Mark("read-only") END
+	END CheckReadOnly;
+
+	PROCEDURE CheckExport (VAR expo: BOOLEAN);
+	BEGIN
+		IF sym = ORS.times THEN
+			expo := TRUE; ORS.Get(sym);
+			IF level # 0 THEN ORS.Mark("remove asterisk") END
+		ELSE expo := FALSE
+		END
+	END CheckExport;
+
+	PROCEDURE IsExtension (t0, t1: ORB.Type): BOOLEAN;
+	BEGIN (*t1 is an extension of t0*)
+		RETURN (t0 = t1) OR (t1 # NIL) & IsExtension(t0, t1.base)
+	END IsExtension;
+
+	(* expressions *)
+
+	PROCEDURE TypeTest (VAR x: ORG.Item; T: ORB.Type; guard: BOOLEAN);
+		VAR xt: ORB.Type;
+	BEGIN xt := x.type;
+		IF (T.form = xt.form ) & ((T.form = ORB.Pointer) OR (T.form = ORB.Record) & (x.mode = ORB.Par)) THEN
+			WHILE (xt # T) & (xt # NIL) DO xt := xt.base END;
+			IF xt # T THEN xt := x.type;
+				IF xt.form = ORB.Pointer THEN
+					IF IsExtension(xt.base, T.base) THEN ORG.TypeTest(x, T.base, FALSE, guard); x.type := T
+					ELSE ORS.Mark("not an extension")
+					END
+				ELSIF (xt.form = ORB.Record) & (x.mode = ORB.Par) THEN
+					IF IsExtension(xt, T) THEN	ORG.TypeTest(x, T, TRUE, guard); x.type := T
+					ELSE ORS.Mark("not an extension")
+					END
+				ELSE ORS.Mark("incompatible types")
+				END
+			ELSIF ~guard THEN ORG.TypeTest(x, NIL, FALSE, FALSE)
+			END
+		ELSE ORS.Mark("type mismatch")
+		END;
+		IF ~guard THEN x.type := ORB.boolType END
+	END TypeTest;
+
+	PROCEDURE selector (VAR x: ORG.Item);
+		VAR y: ORG.Item; obj: ORB.Object;
+	BEGIN
+		WHILE (sym = ORS.lbrak) OR (sym = ORS.period) OR (sym = ORS.arrow)
+				OR (sym = ORS.lparen) & (x.type.form IN {ORB.Record, ORB.Pointer}) DO
+			IF sym = ORS.lbrak THEN
+				REPEAT ORS.Get(sym); expression(y);
+					IF x.type.form = ORB.Array THEN
+						CheckInt(y); ORG.Index(x, y); x.type := x.type.base
+					ELSE ORS.Mark("not an array")
+					END
+				UNTIL sym # ORS.comma;
+				Check(ORS.rbrak, "no ]")
+			ELSIF sym = ORS.period THEN ORS.Get(sym);
+				IF sym = ORS.ident THEN
+					IF x.type.form = ORB.Pointer THEN ORG.DeRef(x); x.type := x.type.base END;
+					IF x.type.form = ORB.Record THEN
+						obj := ORB.thisfield(x.type); ORS.Get(sym);
+						IF obj # NIL THEN ORG.Field(x, obj); x.type := obj.type
+						ELSE ORS.Mark("undef")
+						END
+					ELSE ORS.Mark("not a record")
+					END
+				ELSE ORS.Mark("ident?")
+				END
+			ELSIF sym = ORS.arrow THEN
+				ORS.Get(sym);
+				IF x.type.form = ORB.Pointer THEN ORG.DeRef(x); x.type := x.type.base
+				ELSE ORS.Mark("not a pointer")
+				END
+			ELSIF (sym = ORS.lparen) & (x.type.form IN {ORB.Record, ORB.Pointer}) THEN (*type guard*)
+				ORS.Get(sym);
+				IF sym = ORS.ident THEN
+					qualident(obj);
+					IF obj.class = ORB.Typ THEN TypeTest(x, obj.type, TRUE)
+					ELSE ORS.Mark("guard type expected")
+					END
+				ELSE ORS.Mark("not an identifier")
+				END;
+				Check(ORS.rparen, " ) missing")
+			END
+		END
+	END selector;
+
+	PROCEDURE EqualSignatures (t0, t1: ORB.Type): BOOLEAN;
+		VAR p0, p1: ORB.Object; com: BOOLEAN;
+	BEGIN com := TRUE;
+		IF (t0.base = t1.base) & (t0.nofpar = t1.nofpar) THEN
+			p0 := t0.dsc; p1 := t1.dsc;
+			WHILE p0 # NIL DO
+				IF (p0.class = p1.class) &	(p0.rdo = p1.rdo) &
+					((p0.type = p1.type) OR
+					(p0.type.form = ORB.Array) & (p1.type.form = ORB.Array) & (p0.type.len = p1.type.len) & (p0.type.base = p1.type.base) OR
+					(p0.type.form = ORB.Proc) & (p1.type.form = ORB.Proc) & EqualSignatures(p0.type, p1.type))
+				THEN p0 := p0.next; p1 := p1.next
+				ELSE p0 := NIL; com := FALSE
+				END
+			END
+		ELSE com := FALSE
+		END;
+		RETURN com
+	END EqualSignatures;
+
+	PROCEDURE CompTypes (t0, t1: ORB.Type; varpar: BOOLEAN): BOOLEAN;
+	BEGIN (*check for assignment compatibility*)
+		RETURN (t0 = t1) (*openarray assignment disallowed in ORG*)
+			OR (t0.form = ORB.Array) & (t1.form = ORB.Array) & (t0.base =  t1.base) & (t0.len = t1.len)
+			OR (t0.form = ORB.Record) & (t1.form = ORB.Record)	& IsExtension(t0, t1)
+			OR ~varpar &
+				((t0.form = ORB.Pointer) & (t1.form = ORB.Pointer)	& IsExtension(t0.base, t1.base)
+				OR (t0.form = ORB.Proc) & (t1.form = ORB.Proc) & EqualSignatures(t0, t1)
+				OR (t0.form IN {ORB.Pointer, ORB.Proc}) & (t1.form = ORB.NilTyp))
+	END CompTypes;
+
+	PROCEDURE Parameter (par: ORB.Object);
+		VAR x: ORG.Item; varpar: BOOLEAN;
+	BEGIN expression(x);
+		IF par # NIL THEN
+			varpar := par.class = ORB.Par;
+			IF CompTypes(par.type, x.type, varpar) THEN
+				IF ~varpar THEN ORG.ValueParam(x)
+				ELSE (*par.class = Par*)
+					IF ~par.rdo THEN CheckReadOnly(x) END;
+					ORG.VarParam(x, par.type)
+				END
+			ELSIF (x.type.form = ORB.Array) & (par.type.form = ORB.Array) &
+					(x.type.base = par.type.base) & (par.type.len < 0) THEN
+				IF ~par.rdo THEN CheckReadOnly(x) END;
+				ORG.OpenArrayParam(x)
+			ELSIF (x.type.form = ORB.String) & varpar & par.rdo & (par.type.form = ORB.Array) &
+					(par.type.base.form = ORB.Char) & (par.type.len < 0) THEN ORG.StringParam(x)
+			ELSIF ~varpar & (par.type.form = ORB.Int) & (x.type.form = ORB.Int) THEN ORG.ValueParam(x) (*BYTE*)
+			ELSIF (x.type.form = ORB.String) & (x.b = 2) & (par.class = ORB.Var) & (par.type.form = ORB.Char) THEN
+				ORG.StrToChar(x); ORG.ValueParam(x)
+			ELSIF (par.type.form = ORB.Array) & (par.type.base = ORB.byteType) &
+					(par.type.len >= 0) & (par.type.size = x.type.size) THEN
+				ORG.VarParam(x, par.type)
+			ELSE ORS.Mark("incompatible parameters")
+			END
+		END
+	END Parameter;
+
+	PROCEDURE ParamList (VAR x: ORG.Item);
+		VAR n: INTEGER; par: ORB.Object;
+	BEGIN par := x.type.dsc; n := 0;
+		IF sym # ORS.rparen THEN
+			Parameter(par); n := 1;
+			WHILE sym <= ORS.comma DO
+				Check(ORS.comma, "comma?");
+				IF par # NIL THEN par := par.next END;
+				INC(n); Parameter(par)
+			END;
+			Check(ORS.rparen, ") missing")
+		ELSE ORS.Get(sym);
+		END;
+		IF n < x.type.nofpar THEN ORS.Mark("too few params")
+		ELSIF n > x.type.nofpar THEN ORS.Mark("too many params")
+		END
+	END ParamList;
+
+	PROCEDURE StandFunc (VAR x: ORG.Item; fct: LONGINT; restyp: ORB.Type);
+		VAR y: ORG.Item; n, npar: LONGINT;
+	BEGIN Check(ORS.lparen, "no (");
+		npar := fct MOD 10; fct := fct DIV 10; expression(x); n := 1;
+		WHILE sym = ORS.comma DO ORS.Get(sym); expression(y); INC(n) END;
+		Check(ORS.rparen, "no )");
+		IF n = npar THEN
+			IF fct = 0 THEN (*ABS*)
+				IF x.type.form IN {ORB.Int, ORB.Real} THEN ORG.Abs(x); restyp := x.type ELSE ORS.Mark("bad type") END
+			ELSIF fct = 1 THEN (*ODD*) CheckInt(x); ORG.Odd(x)
+			ELSIF fct = 2 THEN (*FLOOR*) CheckReal(x); ORG.Floor(x)
+			ELSIF fct = 3 THEN (*FLT*) CheckInt(x); ORG.Float(x)
+			ELSIF fct = 4 THEN (*ORD*)
+				IF x.type.form <= ORB.Proc THEN ORG.Ord(x)
+				ELSIF (x.type.form = ORB.String) & (x.b = 2) THEN ORG.StrToChar(x)
+				ELSE ORS.Mark("bad type")
+				END
+			ELSIF fct = 5 THEN (*CHR*) CheckInt(x); ORG.Ord(x)
+			ELSIF fct = 6 THEN (*LEN*)
+					IF x.type.form = ORB.Array THEN ORG.Len(x) ELSE ORS.Mark("not an array") END
+			ELSIF fct IN {7, 8, 9} THEN (*LSL, ASR, ROR*) CheckInt(y);
+				IF x.type.form IN {ORB.Int, ORB.Set} THEN ORG.Shift(fct-7, x, y); restyp := x.type ELSE ORS.Mark("bad type") END
+			ELSIF fct = 11 THEN (*ADC*) ORG.ADC(x, y)
+			ELSIF fct = 12 THEN (*SBC*) ORG.SBC(x, y)
+			ELSIF fct = 13 THEN (*UML*) ORG.UML(x, y)
+			ELSIF fct = 14 THEN (*BIT*) CheckInt(x); CheckInt(y); ORG.Bit(x, y)
+			ELSIF fct = 15 THEN (*REG*) CheckConst(x); CheckInt(x); ORG.Register(x)
+			ELSIF fct = 16 THEN (*VAL*)
+				IF (x.mode= ORB.Typ) & (x.type.size <= y.type.size) THEN restyp := x.type; x := y
+				ELSE ORS.Mark("casting not allowed")
+				END
+			ELSIF fct = 17 THEN (*ADR*) ORG.Adr(x)
+			ELSIF fct = 18 THEN (*SIZE*)
+				IF x.mode = ORB.Typ THEN ORG.MakeConstItem(x, ORB.intType, x.type.size)
+				ELSE ORS.Mark("must be a type")
+				END
+			ELSIF fct = 19 THEN (*COND*) CheckConst(x); CheckInt(x); ORG.Condition(x)
+			ELSIF fct = 20 THEN (*H*) CheckConst(x); CheckInt(x); ORG.H(x)
+			END;
+			x.type := restyp
+		ELSE ORS.Mark("wrong nof params")
+		END
+	END StandFunc;
+
+	PROCEDURE element (VAR x: ORG.Item);
+		VAR y: ORG.Item;
+	BEGIN expression(x); CheckSetVal(x);
+		IF sym = ORS.upto THEN ORS.Get(sym); expression(y); CheckSetVal(y); ORG.Set(x, y)
+		ELSE ORG.Singleton(x)
+		END;
+		x.type := ORB.setType
+	END element;
+
+	PROCEDURE set (VAR x: ORG.Item);
+		VAR y: ORG.Item;
+	BEGIN
+		IF sym >= ORS.if THEN
+			IF sym # ORS.rbrace THEN ORS.Mark(" } missing") END;
+			ORG.MakeConstItem(x, ORB.setType, 0) (*empty set*)
+		ELSE element(x);
+			WHILE (sym < ORS.rparen) OR (sym > ORS.rbrace) DO
+				IF sym = ORS.comma THEN ORS.Get(sym)
+				ELSIF sym # ORS.rbrace THEN ORS.Mark("missing comma")
+				END;
+				element(y); ORG.SetOp(ORS.plus, x, y)
+			END
+		END
+	END set;
+
+	PROCEDURE factor(VAR x: ORG.Item);
+		VAR obj: ORB.Object; rx: LONGINT;
+	BEGIN (*sync*)
+		IF (sym < ORS.char) OR (sym > ORS.ident) THEN ORS.Mark("expression expected");
+			REPEAT ORS.Get(sym) UNTIL (sym >= ORS.char) & (sym <= ORS.for) OR (sym >= ORS.then)
+		END;
+		IF sym = ORS.ident THEN
+			qualident(obj);
+			IF obj.class = ORB.SFunc THEN StandFunc(x, obj.val, obj.type)
+			ELSE ORG.MakeItem(x, obj, level); selector(x);
+				IF sym = ORS.lparen THEN
+					ORS.Get(sym);
+					IF (x.type.form = ORB.Proc) & (x.type.base.form # ORB.NoTyp) THEN
+						ORG.PrepCall(x, rx); ParamList(x); ORG.Call(x, rx); x.type := x.type.base
+					ELSE ORS.Mark("not a function"); ParamList(x)
+					END
+				END
+			END
+		ELSIF sym = ORS.int THEN ORG.MakeConstItem(x, ORB.intType, ORS.ival); ORS.Get(sym)
+		ELSIF sym = ORS.real THEN ORG.MakeRealItem(x, ORS.rval); ORS.Get(sym)
+		ELSIF sym = ORS.char THEN ORG.MakeConstItem(x, ORB.charType, ORS.ival); ORS.Get(sym)
+		ELSIF sym = ORS.nil THEN ORS.Get(sym); ORG.MakeConstItem(x, ORB.nilType, 0)
+		ELSIF sym = ORS.string THEN ORG.MakeStringItem(x, ORS.slen); ORS.Get(sym)
+		ELSIF sym = ORS.lparen THEN ORS.Get(sym); expression(x); Check(ORS.rparen, "no )")
+		ELSIF sym = ORS.lbrace THEN ORS.Get(sym); set(x); Check(ORS.rbrace, "no }")
+		ELSIF sym = ORS.not THEN ORS.Get(sym); factor(x); CheckBool(x); ORG.Not(x)
+		ELSIF sym = ORS.false THEN ORS.Get(sym); ORG.MakeConstItem(x, ORB.boolType, 0)
+		ELSIF sym = ORS.true THEN ORS.Get(sym); ORG.MakeConstItem(x, ORB.boolType, 1)
+		ELSE ORS.Mark("not a factor"); ORG.MakeConstItem(x, ORB.intType, 0)
+		END
+	END factor;
+
+	PROCEDURE term (VAR x: ORG.Item);
+		VAR y: ORG.Item; op, f: INTEGER;
+	BEGIN factor(x); f := x.type.form;
+		WHILE (sym >= ORS.times) & (sym <= ORS.and) DO
+			op := sym; ORS.Get(sym);
+			IF op = ORS.times THEN
+				IF f = ORB.Int THEN factor(y); CheckInt(y); ORG.MulOp(x, y)
+				ELSIF f = ORB.Real THEN factor(y); CheckReal(y); ORG.RealOp(op, x, y)
+				ELSIF f = ORB.Set THEN factor(y); CheckSet(y); ORG.SetOp(op, x, y)
+				ELSE ORS.Mark("bad type")
+				END
+			ELSIF (op = ORS.div) OR (op = ORS.mod) THEN
+				CheckInt(x); factor(y); CheckInt(y); ORG.DivOp(op, x, y)
+			ELSIF op = ORS.rdiv THEN
+				IF f = ORB.Real THEN factor(y); CheckReal(y); ORG.RealOp(op, x, y)
+				ELSIF f = ORB.Set THEN factor(y); CheckSet(y); ORG.SetOp(op, x, y)
+				ELSE ORS.Mark("bad type")
+				END
+			ELSE (*op = and*) CheckBool(x); ORG.And1(x); factor(y); CheckBool(y); ORG.And2(x, y)
+			END
+		END
+	END term;
+
+	PROCEDURE SimpleExpression (VAR x: ORG.Item);
+		VAR y: ORG.Item; op: INTEGER;
+	BEGIN
+		IF sym = ORS.minus THEN ORS.Get(sym); term(x);
+			IF x.type.form IN {ORB.Int, ORB.Real, ORB.Set} THEN ORG.Neg(x) ELSE CheckInt(x) END
+		ELSIF sym = ORS.plus THEN ORS.Get(sym); term(x);
+		ELSE term(x)
+		END;
+		WHILE (sym >= ORS.plus) & (sym <= ORS.or) DO
+			op := sym; ORS.Get(sym);
+			IF op = ORS.or THEN ORG.Or1(x); CheckBool(x); term(y); CheckBool(y); ORG.Or2(x, y)
+			ELSIF x.type.form = ORB.Int THEN term(y); CheckInt(y); ORG.AddOp(op, x, y)
+			ELSIF x.type.form = ORB.Real THEN term(y); CheckReal(y); ORG.RealOp(op, x, y)
+			ELSE CheckSet(x); term(y); CheckSet(y); ORG.SetOp(op, x, y)
+			END
+		END
+	END SimpleExpression;
+
+	PROCEDURE expression0 (VAR x: ORG.Item);
+		VAR y: ORG.Item; obj: ORB.Object; rel, xf, yf: INTEGER;
+	BEGIN SimpleExpression(x);
+		IF (sym >= ORS.eql) & (sym <= ORS.geq) THEN
+			rel := sym; ORS.Get(sym); SimpleExpression(y); xf := x.type.form; yf := y.type.form;
+			IF x.type = y.type THEN
+				IF (xf IN {ORB.Char, ORB.Int}) THEN ORG.IntRelation(rel, x, y)
+				ELSIF xf = ORB.Real THEN ORG.RealRelation(rel, x, y)
+				ELSIF (xf IN {ORB.Set, ORB.Pointer, ORB.Proc, ORB.NilTyp, ORB.Bool}) THEN
+					IF rel <= ORS.neq THEN ORG.IntRelation(rel, x, y) ELSE ORS.Mark("only = or #") END
+				ELSIF (xf = ORB.Array) & (x.type.base.form = ORB.Char) OR (xf = ORB.String) THEN ORG.StringRelation(rel, x, y)
+				ELSE ORS.Mark("illegal comparison")
+				END
+			ELSIF (xf IN {ORB.Pointer, ORB.Proc}) & (yf = ORB.NilTyp)
+					OR (yf IN {ORB.Pointer, ORB.Proc}) & (xf = ORB.NilTyp) THEN
+				IF rel <= ORS.neq THEN ORG.IntRelation(rel, x, y) ELSE ORS.Mark("only = or #") END
+			ELSIF (xf = ORB.Pointer) & (yf = ORB.Pointer) &
+					(IsExtension(x.type.base, y.type.base) OR IsExtension(y.type.base, x.type.base)) OR (xf = ORB.Proc) & (yf = ORB.Proc) & EqualSignatures(x.type, y.type) THEN
+				IF rel <= ORS.neq THEN ORG.IntRelation(rel, x, y) ELSE ORS.Mark("only = or #") END
+			ELSIF (xf = ORB.Array) & (x.type.base.form = ORB.Char) &
+						((yf = ORB.String) OR (yf = ORB.Array) & (y.type.base.form = ORB.Char))
+					OR (yf = ORB.Array) & (y.type.base.form = ORB.Char) & (xf = ORB.String) THEN
+				ORG.StringRelation(rel, x, y)
+			ELSIF (xf = ORB.Char) & (yf = ORB.String) & (y.b = 2) THEN
+				ORG.StrToChar(y); ORG.IntRelation(rel, x, y)
+			ELSIF (yf = ORB.Char) & (xf = ORB.String) & (x.b = 2) THEN
+				ORG.StrToChar(x); ORG.IntRelation(rel, x, y)
+			ELSIF (xf = ORB.Int) & (yf = ORB.Int) THEN ORG.IntRelation(rel, x, y)	(*BYTE*)
+			ELSE ORS.Mark("illegal comparison")
+			END;
+			x.type := ORB.boolType
+		ELSIF sym = ORS.in THEN
+			ORS.Get(sym); CheckInt(x); SimpleExpression(y); CheckSet(y); ORG.In(x, y);
+			x.type := ORB.boolType
+		ELSIF sym = ORS.is THEN
+			ORS.Get(sym); qualident(obj); TypeTest(x, obj.type, FALSE);
+			x.type := ORB.boolType
+		END
+	END expression0;
+
+	(* statements *)
+
+	PROCEDURE StandProc (pno: LONGINT);
+		VAR nap, npar: LONGINT; (*nof actual/formal parameters*)
+			x, y, z: ORG.Item;
+	BEGIN Check(ORS.lparen, "no (");
+		npar := pno MOD 10; pno := pno DIV 10; expression(x); nap := 1;
+		IF sym = ORS.comma THEN
+			ORS.Get(sym); expression(y); nap := 2; z.type := ORB.noType;
+			WHILE sym = ORS.comma DO ORS.Get(sym); expression(z); INC(nap) END
+		ELSE y.type := ORB.noType
+		END;
+		Check(ORS.rparen, "no )");
+		IF (npar = nap) OR (pno IN {0, 1}) THEN
+			IF pno IN {0, 1} THEN (*INC, DEC*)
+				CheckInt(x); CheckReadOnly(x);
+				IF y.type # ORB.noType THEN CheckInt(y) END;
+				ORG.Increment(pno, x, y)
+			ELSIF pno IN {2, 3} THEN (*INCL, EXCL*)
+				CheckSet(x); CheckReadOnly(x); CheckInt(y); ORG.Include(pno-2, x, y)
+			ELSIF pno = 4 THEN CheckBool(x); ORG.Assert(x)
+			ELSIF pno = 5 THEN(*NEW*) CheckReadOnly(x);
+				 IF (x.type.form = ORB.Pointer) & (x.type.base.form = ORB.Record) THEN ORG.New(x)
+				 ELSE ORS.Mark("not a pointer to record")
+				 END
+			ELSIF pno = 6 THEN CheckReal(x); CheckInt(y); CheckReadOnly(x); ORG.Pack(x, y)
+			ELSIF pno = 7 THEN CheckReal(x); CheckInt(y); CheckReadOnly(x); ORG.Unpk(x, y)
+			ELSIF pno = 8 THEN
+				IF x.type.form <= ORB.Set THEN ORG.Led(x) ELSE ORS.Mark("bad type") END
+			ELSIF pno = 10 THEN CheckInt(x); ORG.Get(x, y)
+			ELSIF pno = 11 THEN CheckInt(x); ORG.Put(x, y)
+			ELSIF pno = 12 THEN CheckInt(x); CheckInt(y); CheckInt(z); ORG.Copy(x, y, z)
+			ELSIF pno = 13 THEN CheckConst(x); CheckInt(x); ORG.LDPSR(x)
+			ELSIF pno = 14 THEN CheckInt(x); ORG.LDREG(x, y)
+			END
+		ELSE ORS.Mark("wrong nof parameters")
+		END
+	END StandProc;
+
+	PROCEDURE StatSequence;
+		VAR obj: ORB.Object;
+			orgtype: ORB.Type; (*original type of case var*)
+			x, y, z, w: ORG.Item;
+			L0, L1, rx: LONGINT;
+
+		PROCEDURE TypeCase(obj: ORB.Object; VAR x: ORG.Item);
+			VAR typobj: ORB.Object;
+		BEGIN
+			IF sym = ORS.ident THEN
+				qualident(typobj); ORG.MakeItem(x, obj, level);
+				IF typobj.class # ORB.Typ THEN ORS.Mark("not a type") END;
+				TypeTest(x, typobj.type, FALSE); obj.type := typobj.type;
+				ORG.CFJump(x); Check(ORS.colon, ": expected"); StatSequence
+			ELSE ORG.CFJump(x); ORS.Mark("type id expected")
+			END
+		 END TypeCase;
+
+		PROCEDURE SkipCase;
+		BEGIN
+			WHILE sym # ORS.colon DO ORS.Get(sym) END;
+			ORS.Get(sym); StatSequence
+		END SkipCase;
+
+	BEGIN (* StatSequence *)
+		REPEAT (*sync*) obj := NIL;
+			IF ~((sym >= ORS.ident)  & (sym <= ORS.for) OR (sym >= ORS.semicolon)) THEN
+				ORS.Mark("statement expected");
+				REPEAT ORS.Get(sym) UNTIL (sym >= ORS.ident)
+			END ;
+			IF sym = ORS.ident THEN
+				qualident(obj); ORG.MakeItem(x, obj, level);
+				IF x.mode = ORB.SProc THEN StandProc(obj.val)
+				ELSE selector(x);
+					IF sym = ORS.becomes THEN (*assignment*)
+						ORS.Get(sym); CheckReadOnly(x); expression(y);
+						IF CompTypes(x.type, y.type, FALSE) THEN
+							IF (x.type.form <= ORB.Pointer) OR (x.type.form = ORB.Proc) THEN ORG.Store(x, y)
+							ELSE ORG.StoreStruct(x, y)
+							END
+						ELSIF (x.type.form = ORB.Array) & (y.type.form = ORB.Array) & (x.type.base = y.type.base) & (y.type.len < 0) THEN
+							ORG.StoreStruct(x, y)
+						ELSIF (x.type.form = ORB.Array) & (x.type.base.form = ORB.Char) & (y.type.form = ORB.String) THEN
+							ORG.CopyString(x, y)
+						ELSIF (x.type.form = ORB.Int) & (y.type.form = ORB.Int) THEN ORG.Store(x, y)	(*BYTE*)
+						ELSIF (x.type.form = ORB.Char) & (y.type.form = ORB.String) & (y.b = 2) THEN
+							ORG.StrToChar(y); ORG.Store(x, y)
+						ELSE ORS.Mark("illegal assignment")
+						END
+					ELSIF sym = ORS.eql THEN ORS.Mark("should be :="); ORS.Get(sym); expression(y)
+					ELSIF sym = ORS.lparen THEN (*procedure call*)
+						ORS.Get(sym);
+						IF (x.type.form = ORB.Proc) & (x.type.base.form = ORB.NoTyp) THEN
+							ORG.PrepCall(x, rx); ParamList(x); ORG.Call(x, rx)
+						ELSE ORS.Mark("not a procedure"); ParamList(x)
+						END
+					ELSIF x.type.form = ORB.Proc THEN (*procedure call without parameters*)
+						IF x.type.nofpar > 0 THEN ORS.Mark("missing parameters") END ;
+						IF x.type.base.form = ORB.NoTyp THEN ORG.PrepCall(x, rx); ORG.Call(x, rx) ELSE ORS.Mark("not a procedure") END
+					ELSIF x.mode = ORB.Typ THEN ORS.Mark("illegal assignment")
+					ELSE ORS.Mark("not a procedure")
+					END
+				END
+			ELSIF sym = ORS.if THEN
+				ORS.Get(sym); expression(x); CheckBool(x); ORG.CFJump(x);
+				Check(ORS.then, "no THEN");
+				StatSequence; L0 := 0;
+				WHILE sym = ORS.elsif DO
+					ORS.Get(sym); ORG.FJump(L0); ORG.Fixup(x); expression(x); CheckBool(x);
+					ORG.CFJump(x); Check(ORS.then, "no THEN"); StatSequence
+				END ;
+				IF sym = ORS.else THEN ORS.Get(sym); ORG.FJump(L0); ORG.Fixup(x); StatSequence
+				ELSE ORG.Fixup(x)
+				END ;
+				ORG.FixLink(L0); Check(ORS.end, "no END")
+			ELSIF sym = ORS.while THEN
+				ORS.Get(sym); L0 := ORG.Here(); expression(x); CheckBool(x); ORG.CFJump(x);
+				Check(ORS.do, "no DO"); StatSequence; ORG.BJump(L0);
+				WHILE sym = ORS.elsif DO
+					ORS.Get(sym); ORG.Fixup(x); expression(x); CheckBool(x); ORG.CFJump(x);
+					Check(ORS.do, "no DO"); StatSequence; ORG.BJump(L0)
+				END ;
+				ORG.Fixup(x); Check(ORS.end, "no END")
+			ELSIF sym = ORS.repeat THEN
+				ORS.Get(sym); L0 := ORG.Here(); StatSequence;
+				IF sym = ORS.until THEN
+					ORS.Get(sym); expression(x); CheckBool(x); ORG.CBJump(x, L0)
+				ELSE ORS.Mark("missing UNTIL")
+				END
+			ELSIF sym = ORS.for THEN
+				ORS.Get(sym);
+				IF sym = ORS.ident THEN
+					qualident(obj); ORG.MakeItem(x, obj, level); CheckInt(x); CheckReadOnly(x);
+					IF sym = ORS.becomes THEN
+						ORS.Get(sym); expression(y); CheckInt(y); ORG.For0(x, y); L0 := ORG.Here();
+						Check(ORS.to, "no TO"); expression(z); CheckInt(z); obj.rdo := TRUE;
+						IF sym = ORS.by THEN ORS.Get(sym); expression(w); CheckConst(w); CheckInt(w)
+						ELSE ORG.MakeConstItem(w, ORB.intType, 1)
+						END ;
+						Check(ORS.do, "no DO"); ORG.For1(x, y, z, w, L1);
+						StatSequence; Check(ORS.end, "no END");
+						ORG.For2(x, y, w); ORG.BJump(L0); ORG.FixLink(L1); obj.rdo := FALSE
+					ELSE ORS.Mark(":= expected")
+					END
+				ELSE ORS.Mark("identifier expected")
+				END
+			ELSIF sym = ORS.case THEN
+				ORS.Get(sym);
+				IF sym = ORS.ident THEN
+					qualident(obj); orgtype := obj.type;
+					IF (orgtype.form = ORB.Pointer) OR (orgtype.form = ORB.Record) & (obj.class = ORB.Par) THEN
+						Check(ORS.of, "OF expected"); TypeCase(obj, x); L0 := 0;
+						WHILE sym = ORS.bar DO
+							ORS.Get(sym); ORG.FJump(L0); ORG.Fixup(x); obj.type := orgtype; TypeCase(obj, x)
+						END ;
+						ORG.Fixup(x); ORG.FixLink(L0); obj.type := orgtype
+					ELSE ORS.Mark("numeric case not implemented");
+						Check(ORS.of, "OF expected"); SkipCase;
+						WHILE sym = ORS.bar DO SkipCase END
+					END
+				ELSE ORS.Mark("ident expected")
+				END ;
+				Check(ORS.end, "no END")
+			END ;
+			ORG.CheckRegs;
+			IF sym = ORS.semicolon THEN ORS.Get(sym)
+			ELSIF sym < ORS.semicolon THEN ORS.Mark("missing semicolon?")
+			END
+		UNTIL sym > ORS.semicolon
+	END StatSequence;
+
+	(* Types and declarations *)
+
+	PROCEDURE IdentList (class: INTEGER; VAR first: ORB.Object);
+		VAR obj: ORB.Object;
+	BEGIN
+		IF sym = ORS.ident THEN
+			ORB.NewObj(first, ORS.id, class); ORS.Get(sym); CheckExport(first.expo);
+			WHILE sym = ORS.comma DO
+				ORS.Get(sym);
+				IF sym = ORS.ident THEN ORB.NewObj(obj, ORS.id, class); ORS.Get(sym); CheckExport(obj.expo)
+				ELSE ORS.Mark("ident?")
+				END
+			END;
+			IF sym = ORS.colon THEN ORS.Get(sym) ELSE ORS.Mark(":?") END
+		ELSE first := NIL
+		END
+	END IdentList;
+
+	PROCEDURE ArrayType (VAR type: ORB.Type);
+		VAR x: ORG.Item; typ: ORB.Type; len: LONGINT;
+	BEGIN NEW(typ); typ.form := ORB.NoTyp;
+		expression(x);
+		IF (x.mode = ORB.Const) & (x.type.form = ORB.Int) & (x.a >= 0) THEN len := x.a
+		ELSE len := 1; ORS.Mark("not a valid length")
+		END;
+		IF sym = ORS.of THEN ORS.Get(sym); Type(typ.base);
+			IF (typ.base.form = ORB.Array) & (typ.base.len < 0) THEN ORS.Mark("dyn array not allowed") END
+		ELSIF sym = ORS.comma THEN ORS.Get(sym); ArrayType(typ.base)
+		ELSE ORS.Mark("missing OF"); typ.base := ORB.intType
+		END;
+		typ.size := (len * typ.base.size + 3) DIV 4 * 4;
+		typ.form := ORB.Array; typ.len := len; type := typ
+	END ArrayType;
+
+	PROCEDURE RecordType(VAR type: ORB.Type);
+		VAR obj, obj0, new, bot, base: ORB.Object;
+			typ, tp: ORB.Type;
+			offset, off, n: LONGINT;
+	BEGIN NEW(typ); typ.form := ORB.NoTyp; typ.base := NIL; typ.mno := -level; typ.nofpar := 0; offset := 0; bot := NIL;
+		IF sym = ORS.lparen THEN
+			ORS.Get(sym); (*record extension*)
+			IF level # 0 THEN ORS.Mark("extension of local types not implemented") END;
+			IF sym = ORS.ident THEN
+				qualident(base);
+				IF base.class = ORB.Typ THEN
+					IF base.type.form = ORB.Record THEN typ.base := base.type
+					ELSE typ.base := ORB.intType; ORS.Mark("invalid extension")
+					END;
+					typ.nofpar := typ.base.nofpar + 1; (*"nofpar" here abused for extension level*)
+					bot := typ.base.dsc; offset := typ.base.size
+				ELSE ORS.Mark("type expected")
+				END
+			ELSE ORS.Mark("ident expected")
+			END;
+			Check(ORS.rparen, "no )")
+		END;
+		WHILE sym = ORS.ident DO	(*fields*)
+			n := 0; obj := bot;
+			WHILE sym = ORS.ident DO
+				obj0 := obj;
+				WHILE (obj0 # NIL) & (obj0.name # ORS.id) DO obj0 := obj0.next END;
+				IF obj0 # NIL THEN ORS.Mark("mult def") END;
+				NEW(new); ORS.CopyId(new.name); new.class := ORB.Fld; new.next := obj; obj := new; INC(n);
+				ORS.Get(sym); CheckExport(new.expo);
+				IF (sym # ORS.comma) & (sym # ORS.colon) THEN ORS.Mark("comma expected")
+				ELSIF sym = ORS.comma THEN ORS.Get(sym)
+				END
+			END;
+			Check(ORS.colon, "colon expected"); Type(tp);
+			IF (tp.form = ORB.Array) & (tp.len < 0) THEN ORS.Mark("dyn array not allowed") END;
+			IF tp.size > 1 THEN offset := (offset+3) DIV 4 * 4 END;
+			offset := offset + n * tp.size; off := offset; obj0 := obj;
+			WHILE obj0 # bot DO obj0.type := tp; obj0.lev := 0; off := off - tp.size; obj0.val := off; obj0 := obj0.next END;
+			bot := obj;
+			IF sym = ORS.semicolon THEN ORS.Get(sym) ELSIF sym # ORS.end THEN ORS.Mark(" ; or END") END
+		END;
+		typ.form := ORB.Record; typ.dsc := bot; typ.size := (offset + 3) DIV 4 * 4; type := typ
+	END RecordType;
+
+	PROCEDURE FPSection (VAR adr: LONGINT; VAR nofpar: INTEGER);
+		VAR obj, first: ORB.Object; tp: ORB.Type;
+			parsize: LONGINT; cl: INTEGER; rdo: BOOLEAN;
+	BEGIN
+		IF sym = ORS.var THEN ORS.Get(sym); cl := ORB.Par ELSE cl := ORB.Var END;
+		IdentList(cl, first); FormalType(tp, 0); rdo := FALSE;
+		IF (cl = ORB.Var) & (tp.form >= ORB.Array) THEN cl := ORB.Par; rdo := TRUE END;
+		IF (tp.form = ORB.Array) & (tp.len < 0) OR (tp.form = ORB.Record) THEN
+			parsize := 2*ORG.WordSize	(*open array or record, needs second word for length or type tag*)
+		ELSE parsize := ORG.WordSize
+		END;
+		obj := first;
+		WHILE obj # NIL DO
+			INC(nofpar); obj.class := cl; obj.type := tp; obj.rdo := rdo; obj.lev := level; obj.val := adr;
+			adr := adr + parsize; obj := obj.next
+		END;
+		IF adr >= 52 THEN ORS.Mark("too many parameters") END
+	END FPSection;
+
+	PROCEDURE ProcedureType (ptype: ORB.Type; VAR parblksize: LONGINT);
+		VAR obj: ORB.Object; size: LONGINT; nofpar: INTEGER;
+	BEGIN ptype.base := ORB.noType; size := parblksize; nofpar := 0; ptype.dsc := NIL;
+		IF sym = ORS.lparen THEN
+			ORS.Get(sym);
+			IF sym = ORS.rparen THEN ORS.Get(sym)
+			ELSE FPSection(size, nofpar);
+				WHILE sym = ORS.semicolon DO ORS.Get(sym); FPSection(size, nofpar) END;
+				Check(ORS.rparen, "no )")
+			END;
+			IF sym = ORS.colon THEN (*function*)
+				ORS.Get(sym);
+				IF sym = ORS.ident THEN
+					qualident(obj); ptype.base := obj.type;
+					IF ~((obj.class = ORB.Typ) & (obj.type.form IN {ORB.Byte .. ORB.Pointer, ORB.Proc})) THEN
+						ORS.Mark("illegal function type")
+					END
+				ELSE ORS.Mark("type identifier expected")
+				END
+			END
+		END;
+		ptype.nofpar := nofpar; parblksize := size
+	END ProcedureType;
+
+	PROCEDURE FormalType0 (VAR typ: ORB.Type; dim: INTEGER);
+		VAR obj: ORB.Object; dmy: LONGINT;
+	BEGIN
+		IF sym = ORS.ident THEN
+			qualident(obj);
+			IF obj.class = ORB.Typ THEN typ := obj.type ELSE ORS.Mark("not a type"); typ := ORB.intType END
+		ELSIF sym = ORS.array THEN
+			ORS.Get(sym); Check(ORS.of, "OF ?");
+			IF dim >= 1 THEN ORS.Mark("multi-dimensional open arrays not implemented") END;
+			NEW(typ); typ.form := ORB.Array; typ.len := -1; typ.size := 2*ORG.WordSize;
+			FormalType(typ.base, dim+1)
+		ELSIF sym = ORS.procedure THEN
+			ORS.Get(sym); ORB.OpenScope;
+			NEW(typ); typ.form := ORB.Proc; typ.size := ORG.WordSize; dmy := 0; ProcedureType(typ, dmy);
+			typ.dsc := ORB.topScope.next; ORB.CloseScope
+		ELSE ORS.Mark("identifier expected"); typ := ORB.noType
+		END
+	END FormalType0;
+
+	PROCEDURE CheckRecLevel(lev: INTEGER);
+	BEGIN
+		IF lev # 0 THEN ORS.Mark("ptr base must be global") END
+	END CheckRecLevel;
+
+	PROCEDURE Type0 (VAR type: ORB.Type);
+		VAR dmy: LONGINT; obj: ORB.Object; ptbase: PtrBase;
+	BEGIN type := ORB.intType; (*sync*)
+		IF (sym # ORS.ident) & (sym < ORS.array) THEN ORS.Mark("not a type");
+			REPEAT ORS.Get(sym) UNTIL (sym = ORS.ident) OR (sym >= ORS.array)
+		END ;
+		IF sym = ORS.ident THEN
+			qualident(obj);
+			IF obj.class = ORB.Typ THEN
+				IF (obj.type # NIL) & (obj.type.form # ORB.NoTyp) THEN type := obj.type END
+			ELSE ORS.Mark("not a type or undefined")
+			END
+		ELSIF sym = ORS.array THEN ORS.Get(sym); ArrayType(type)
+		ELSIF sym = ORS.record THEN
+			ORS.Get(sym); RecordType(type); Check(ORS.end, "no END")
+		ELSIF sym = ORS.pointer THEN
+			ORS.Get(sym); Check(ORS.to, "no TO");
+			NEW(type);	type.form := ORB.Pointer; type.size := ORG.WordSize; type.base := ORB.intType;
+			IF sym = ORS.ident THEN
+				obj := ORB.thisObj();
+				IF obj # NIL THEN
+					IF (obj.class = ORB.Typ) & (obj.type.form IN {ORB.Record, ORB.NoTyp}) THEN
+						CheckRecLevel(obj.lev); type.base := obj.type
+					ELSIF obj.class = ORB.Mod THEN ORS.Mark("external base type not implemented")
+					ELSE ORS.Mark("no valid base type")
+					END
+				ELSE CheckRecLevel(level); (*enter into list of forward references to be fixed in Declarations*)
+					NEW(ptbase); ORS.CopyId(ptbase.name); ptbase.type := type; ptbase.next := pbsList; pbsList := ptbase
+				END ;
+				ORS.Get(sym)
+			ELSE Type(type.base);
+				IF (type.base.form # ORB.Record) OR (type.base.typobj = NIL) THEN ORS.Mark("must point to named record") END ;
+				CheckRecLevel(level)
+			END
+		ELSIF sym = ORS.procedure THEN
+			ORS.Get(sym); ORB.OpenScope;
+			NEW(type); type.form := ORB.Proc; type.size := ORG.WordSize; dmy := 0;
+			ProcedureType(type, dmy); type.dsc := ORB.topScope.next; ORB.CloseScope
+		ELSE ORS.Mark("illegal type")
+		END
+	END Type0;
+
+	PROCEDURE Declarations (VAR varsize: LONGINT);
+		VAR obj, first: ORB.Object;
+			x: ORG.Item; tp: ORB.Type; ptbase: PtrBase;
+			expo: BOOLEAN; id: ORS.Ident;
+	BEGIN (*sync*) pbsList := NIL;
+		IF (sym < ORS.const) & (sym # ORS.end) & (sym # ORS.return) THEN ORS.Mark("declaration?");
+			REPEAT ORS.Get(sym) UNTIL (sym >= ORS.const) OR (sym = ORS.end) OR (sym = ORS.return)
+		END;
+		IF sym = ORS.const THEN
+			ORS.Get(sym);
+			WHILE sym = ORS.ident DO
+				ORS.CopyId(id); ORS.Get(sym); CheckExport(expo);
+				IF sym = ORS.eql THEN ORS.Get(sym) ELSE ORS.Mark("= ?") END;
+				expression(x);
+				IF (x.type.form = ORB.String) & (x.b = 2) THEN ORG.StrToChar(x) END;
+				ORB.NewObj(obj, id, ORB.Const); obj.expo := expo;
+				IF x.mode = ORB.Const THEN obj.val := x.a; obj.lev := x.b; obj.type := x.type
+				ELSE ORS.Mark("expression not constant"); obj.type := ORB.intType
+				END;
+				Check(ORS.semicolon, "; missing")
+			END
+		END;
+		IF sym = ORS.type THEN
+			ORS.Get(sym);
+			WHILE sym = ORS.ident DO
+				ORS.CopyId(id); ORS.Get(sym); CheckExport(expo);
+				IF sym = ORS.eql THEN ORS.Get(sym) ELSE ORS.Mark("=?") END;
+				Type(tp);
+				ORB.NewObj(obj, id, ORB.Typ); obj.type := tp; obj.expo := expo; obj.lev := level;
+				IF tp.typobj = NIL THEN tp.typobj := obj END;
+				IF expo & (obj.type.form = ORB.Record) THEN obj.exno := exno; INC(exno) ELSE obj.exno := 0 END;
+				IF tp.form = ORB.Record THEN
+					ptbase := pbsList;	(*check whether this is base of a pointer type; search and fixup*)
+					WHILE ptbase # NIL DO
+						IF obj.name = ptbase.name THEN ptbase.type.base := obj.type END;
+						ptbase := ptbase.next
+					END;
+					IF level = 0 THEN ORG.BuildTD(tp, dc) END		(*type descriptor; len used as its address*)
+				END;
+				Check(ORS.semicolon, "; missing")
+			END
+		END;
+		IF sym = ORS.var THEN
+			ORS.Get(sym);
+			WHILE sym = ORS.ident DO
+				IdentList(ORB.Var, first); Type(tp);
+				obj := first;
+				WHILE obj # NIL DO
+					obj.type := tp; obj.lev := level;
+					IF tp.size > 1 THEN varsize := (varsize + 3) DIV 4 * 4 (*align*) END;
+					obj.val := varsize; varsize := varsize + obj.type.size;
+					IF obj.expo THEN obj.exno := exno; INC(exno) END;
+					obj := obj.next
+				END;
+				Check(ORS.semicolon, "; missing")
+			END
+		END;
+		varsize := (varsize + 3) DIV 4 * 4;
+		ptbase := pbsList;
+		WHILE ptbase # NIL DO
+			IF ptbase.type.base.form = ORB.Int THEN ORS.Mark("undefined pointer base of") END;
+			ptbase := ptbase.next
+		END;
+		IF (sym >= ORS.const) & (sym <= ORS.var) THEN ORS.Mark("declaration in bad order") END
+	END Declarations;
+
+	PROCEDURE ProcedureDecl;
+		VAR proc: ORB.Object;
+			type: ORB.Type;
+			procid: ORS.Ident;
+			x: ORG.Item;
+			locblksize, parblksize, L: LONGINT;
+			int: BOOLEAN;
+	BEGIN (* ProcedureDecl *) int := FALSE; ORS.Get(sym);
+		IF sym = ORS.times THEN ORS.Get(sym); int := TRUE END;
+		IF sym = ORS.ident THEN
+			ORS.CopyId(procid); ORS.Get(sym);
+			ORB.NewObj(proc, ORS.id, ORB.Const);
+			IF int THEN parblksize := ORG.parblksize0Int
+			ELSE parblksize := ORG.parblksize0Proc
+			END;
+			NEW(type); type.form := ORB.Proc; type.size := ORG.WordSize;
+			proc.type := type; proc.val := -1; proc.lev := level;
+			CheckExport(proc.expo);
+			IF proc.expo THEN proc.exno := exno; INC(exno) END;
+			ORB.OpenScope; INC(level); type.base := ORB.noType;
+			ProcedureType(type, parblksize);	(*formal parameter list*)
+			Check(ORS.semicolon, "no ;"); locblksize := parblksize;
+			Declarations(locblksize);
+			proc.val := ORG.Here() * 4; proc.type.dsc := ORB.topScope.next;
+			IF sym = ORS.procedure THEN
+				L := 0; ORG.FJump(L);
+				REPEAT ProcedureDecl; Check(ORS.semicolon, "no ;") UNTIL sym # ORS.procedure;
+				ORG.FixOne(L); proc.val := ORG.Here() * 4; proc.type.dsc := ORB.topScope.next
+			END;
+			ORG.Enter(parblksize, locblksize, int);
+			IF sym = ORS.begin THEN ORS.Get(sym); StatSequence END;
+			IF sym = ORS.return THEN
+				ORS.Get(sym); expression(x);
+				IF type.base = ORB.noType THEN ORS.Mark("this is not a function")
+				ELSIF ~CompTypes(type.base, x.type, FALSE) THEN ORS.Mark("wrong result type")
+				END
+			ELSIF type.base.form # ORB.NoTyp THEN
+				ORS.Mark("function without result"); type.base := ORB.noType
+			END;
+			ORG.Return(type.base.form, x, locblksize, int);
+			ORB.CloseScope; DEC(level); Check(ORS.end, "no END");
+			IF sym = ORS.ident THEN
+				IF ORS.id # procid THEN ORS.Mark("no match") END;
+				ORS.Get(sym)
+			ELSE ORS.Mark("no proc id")
+			END
+		ELSE ORS.Mark("proc id expected")
+		END
+	END ProcedureDecl;
+
+	PROCEDURE Import;
+		VAR impid, impid1: ORS.Ident;
+	BEGIN
+		IF sym = ORS.ident THEN
+			ORS.CopyId(impid); ORS.Get(sym);
+			IF sym = ORS.becomes THEN
+				ORS.Get(sym);
+				IF sym = ORS.ident THEN ORS.CopyId(impid1); ORS.Get(sym)
+				ELSE ORS.Mark("id expected"); impid1 := impid
+				END
+			ELSE impid1 := impid
+			END;
+			ORB.Import(impid, impid1)
+		ELSE ORS.Mark("id expected")
+		END
+	END Import;
+
+	PROCEDURE Module;
+		VAR key: LONGINT;
+	BEGIN Texts.WriteString(W, "  compiling "); ORS.Get(sym);
+		IF sym = ORS.module THEN
+			ORS.Get(sym);
+			IF sym = ORS.times THEN version := 0; dc := 8; Texts.Write(W, "*"); ORS.Get(sym) ELSE dc := 0; version := 1 END;
+			ORB.Init; ORB.OpenScope;
+			IF sym = ORS.ident THEN
+				ORS.CopyId(modid); ORS.Get(sym);
+				Texts.WriteString(W, modid); Texts.Append(Oberon.Log(**), W.buf)
+			ELSE ORS.Mark("identifier expected")
+			END;
+			Check(ORS.semicolon, "no ;"); level := 0; exno := 1; key := 0;
+			IF sym = ORS.import THEN
+				ORS.Get(sym); Import;
+				WHILE sym = ORS.comma DO ORS.Get(sym); Import END;
+				Check(ORS.semicolon, "; missing")
+			END;
+			ORG.Open(version); Declarations(dc); ORG.SetDataSize((dc + 3) DIV 4 * 4);
+			WHILE sym = ORS.procedure DO ProcedureDecl; Check(ORS.semicolon, "no ;") END;
+			ORG.Header;
+			IF sym = ORS.begin THEN ORS.Get(sym); StatSequence END;
+			Check(ORS.end, "no END");
+			IF sym = ORS.ident THEN
+				IF ORS.id # modid THEN ORS.Mark("no match") END;
+				ORS.Get(sym)
+			ELSE ORS.Mark("identifier missing")
+			END;
+			IF sym # ORS.period THEN ORS.Mark("period missing") END;
+			IF (ORS.errcnt = 0) & (version # 0) THEN
+				ORB.Export(modid, newSF, key);
+				IF newSF THEN Texts.WriteString(W, " new symbol file") END
+			END;
+			IF ORS.errcnt = 0 THEN
+				ORG.Close(modid, key, exno);
+				Texts.WriteInt(W, ORG.pc, 6); Texts.WriteInt(W, dc, 6); Texts.WriteHex(W, key)
+			ELSE Texts.WriteLn(W); Texts.WriteString(W, "compilation FAILED")
+			END;
+			Texts.WriteLn(W); Texts.Append(Oberon.Log(**), W.buf);
+			ORB.CloseScope; pbsList := NIL
+		ELSE ORS.Mark("must start with MODULE")
+		END
+	END Module;
+
+	PROCEDURE Option (VAR S: Texts.Scanner);
+	BEGIN newSF := FALSE;
+		IF S.nextCh = "/" THEN
+			Texts.Scan(S); Texts.Scan(S);
+			IF (S.class = Texts.Name) & (S.s[0] = "s") THEN newSF := TRUE END
+		END
+	END Option;
+
+	PROCEDURE Compile*;
+		VAR beg, end, time: LONGINT;
+			T: Texts.Text;
+			S: Texts.Scanner;
+	BEGIN (*Oberon.GetPar;*) Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos);
+		Texts.Scan(S);
+		IF S.class = Texts.Char THEN
+			(*
+			IF S.c = "@" THEN
+				Option(S); Oberon.GetSelection(T, beg, end, time);
+				IF time >= 0 THEN ORS.Init(T, beg); Module END
+			ELSIF S.c = "^" THEN
+				Option(S); Oberon.GetSelection(T, beg, end, time);
+				IF time >= 0 THEN
+					Texts.OpenScanner(S, T, beg); Texts.Scan(S);
+					IF S.class = Texts.Name THEN
+						Texts.WriteString(W, S.s); NEW(T); Texts.Open(T, S.s);
+						IF T.len > 0 THEN ORS.Init(T, 0); Module END
+					END
+				END
+			END
+			*)
+		ELSE
+			WHILE S.class = Texts.Name DO
+				NEW(T); Texts.Open(T, S.s);
+				IF T.len > 0 THEN Option(S); ORS.Init(T, 0); Module
+				ELSE Texts.WriteString(W, S.s); Texts.WriteString(W, " not found");
+					Texts.WriteLn(W); Texts.Append(Oberon.Log(**), W.buf)
+				END;
+				IF (T.len # 0) & (ORS.errcnt = 0) THEN Texts.Scan(S) ELSE S.class := 0 END
+			END
+		END;
+		(* Oberon.Collect(0) *)
+	END Compile;
+
+(*
+	(* DevCompiler *)
+
+		PROCEDURE Scan (VAR s: TextMappers.Scanner);
+		BEGIN
+			s.Scan;
+			IF s.type = TextMappers.string THEN
+				IF s.string = "MODULE" THEN s.type := module END
+			ELSIF s.type = TextMappers.char THEN
+				IF s.char = "(" THEN
+					IF s.rider.char = "*" THEN
+						s.rider.Read;
+						REPEAT Scan(s) UNTIL (s.type = TextMappers.eot) OR (s.type = comEnd);
+						Scan(s)
+					END
+				ELSIF s.char = "*" THEN
+					IF s.rider.char = ")" THEN s.rider.Read; s.type := comEnd END
+				END
+			END
+		END Scan;
+
+		PROCEDURE Do (source, log: TextModels.Model; beg: INTEGER; opt: SET; VAR error: BOOLEAN);
+			VAR s: TextMappers.Scanner;
+				str: Dialog.String;
+		BEGIN
+			(*
+			Dialog.MapString("#Dev:Compiling", str);
+			StdLog.String(str); StdLog.Char(" ");
+			s.ConnectTo(source); s.SetPos(beg);
+			Scan(s);
+			WHILE (s.type # TextMappers.eot) & (s.type # module) DO Scan(s) END;
+			IF s.type = module THEN
+				Scan(s);
+				IF s.type = TextMappers.string THEN
+					StdLog.Char('"'); StdLog.String(s.string); StdLog.Char('"')
+				END
+			END;
+			*)
+
+			(*
+			Module(sourceR, opt, log, error)
+			*)
+				ORS.Init(Texts.NewText(source), beg);
+				newSF := newsf IN opt;
+				Module;
+				error := ORS.errcnt # 0
+		END Do;
+
+		PROCEDURE Open;
+		BEGIN
+			Dialog.ShowStatus("#Dev:Compiling");
+			StdLog.buf.Delete(0, StdLog.buf.Length())
+		END Open;
+
+		PROCEDURE Close;
+		BEGIN
+			StdLog.text.Append(StdLog.buf);
+			TextViews.ShowRange(StdLog.text,
+				StdLog.text.Length(), StdLog.text.Length(), TextViews.any);
+			IF ORS.errcnt = 0 THEN Dialog.ShowStatus("#Dev:Ok")
+			END;
+			(* sourceR := NIL; *)
+			Kernel.Cleanup
+		END Close;
+
+		PROCEDURE Compile2*;
+			VAR t: TextModels.Model; error: BOOLEAN;
+		BEGIN
+			Open;
+			t := TextViews.FocusText();
+			IF t # NIL THEN
+				Do(t, StdLog.text, 0, defopt, error);
+				IF error THEN DevMarkers.ShowFirstError(t, TextViews.focusOnly) END
+			ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
+			END;
+			Close
+		END Compile2;
+
+		PROCEDURE CompileText* (text: TextModels.Model; beg: INTEGER; OUT error: BOOLEAN);
+		BEGIN
+			ASSERT(text # NIL, 20); ASSERT((beg >= 0) & (beg <= text.Length()), 21);
+			Open;
+			Do(text, StdLog.text, beg, defopt, error);
+			IF error THEN DevMarkers.ShowFirstError(text, TextViews.focusOnly) END;
+			Close
+		END CompileText;
+
+		PROCEDURE CompileSelection*;
+			VAR c: TextControllers.Controller; t: TextModels.Model; beg, end: INTEGER; error: BOOLEAN;
+		BEGIN
+			Open;
+			c := TextControllers.Focus();
+			IF c # NIL THEN
+				t := c.text;
+				IF c.HasSelection() THEN
+					c.GetSelection(beg, end); Do(t, StdLog.text, beg, defopt, error);
+					IF error THEN DevMarkers.ShowFirstError(t, TextViews.focusOnly) END
+				ELSE Dialog.ShowMsg("#Dev:NoSelectionFound")
+				END
+			ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
+			END;
+			Close
+		END CompileSelection;
+
+		PROCEDURE CompileList (beg, end: INTEGER; c: TextControllers.Controller);
+			VAR v: Views.View; i: INTEGER; error, one: BOOLEAN; name: Files.Name; loc: Files.Locator;
+				t: TextModels.Model; opts: SET;
+		BEGIN
+			s.SetPos(beg); s.Scan; one := FALSE;
+			WHILE (s.start < end) & (s.type = TextMappers.string) & (s.len < LEN(name)) DO
+				s.Scan; one := TRUE;
+				WHILE (s.start < end) & (s.type = TextMappers.char) &
+					((s.char = "-") OR (s.char = "+") OR
+					(s.char = "!") OR (s.char = "*") OR (s.char = "?") OR (s.char = "^") OR (s.char = "("))
+				DO
+					IF s.char = "(" THEN
+						WHILE (s.start < end) & ((s.type # TextMappers.char) OR (s.char # ")")) DO s.Scan END
+					END;
+					s.Scan
+				END
+			END;
+			IF one & (s.start >= end) THEN
+				s.SetPos(beg); s.Scan; error := FALSE;
+				WHILE (s.start < end) & (s.type = TextMappers.string) & ~error DO
+					i := 0; WHILE i < LEN(name) DO name[i] := 0X; INC(i) END;
+					StdDialog.GetSubLoc(s.string, "Mod", loc, name);
+					t := NIL;
+					IF loc # NIL THEN
+						v := Views.OldView(loc, name);
+						IF v # NIL THEN
+							WITH v: TextViews.View DO t := v.ThisModel()
+							ELSE Dialog.ShowParamMsg("#Dev:NoTextFileFound", name, "", ""); error := TRUE
+							END
+						ELSE Dialog.ShowParamMsg("#Dev:CannotOpenFile", name, "", ""); error := TRUE
+						END
+					ELSE Dialog.ShowParamMsg("#System:FileNotFound", name, "", ""); error := TRUE
+					END;
+					s.Scan; opts := defopt;
+					(*
+					WHILE (s.start < end) & (s.type = TextMappers.char) DO
+						IF s.char = "-" THEN
+							IF srcpos IN opts THEN EXCL(opts, srcpos)
+							ELSIF allref IN opts THEN EXCL(opts, allref)
+							ELSIF ref IN opts THEN EXCL(opts, ref)
+							ELSE EXCL(opts, obj)
+							END
+						ELSIF s.char = "!" THEN
+							IF assert IN opts THEN EXCL(opts, assert)
+							ELSE EXCL(opts, checks)
+							END
+						ELSIF s.char = "+" THEN INCL(opts, allchecks)
+						ELSIF s.char = "?" THEN INCL(opts, hint)
+						ELSIF s.char = "@" THEN INCL(opts, errorTrap)
+						ELSIF s.char = "$" THEN INCL(opts, oberon)
+						ELSIF s.char = "(" THEN
+							s.Scan;
+							WHILE (s.start < end) & (s.type = TextMappers.string) DO
+								title := s.string$; s.Scan;
+								IF (s.start < end) & (s.type = TextMappers.char) & (s.char = ":") THEN
+									s.Scan;
+									IF (s.start < end) & (s.type = TextMappers.string) THEN
+										entry := s.string$; s.Scan;
+										IF t # NIL THEN DevSelectors.ChangeTo(t, title, entry) END
+									END
+								END;
+								IF (s.start < end) & (s.type = TextMappers.char) & (s.char = ",") THEN s.Scan END
+							END
+						END;
+						s.Scan
+					END;
+					*)
+					IF t # NIL THEN
+						Do(t, StdLog.text, 0, opts, error)
+					END
+				END
+			ELSE Dialog.ShowMsg("#Dev:NotOnlyFileNames")
+			END;
+			s.ConnectTo(NIL);
+			IF error & (c # NIL) & c.HasSelection() & (s.start < end) THEN
+				c.SetSelection(s.start, end)
+			END;
+			IF error & (v # NIL) THEN
+				Views.Open(v, loc, name, NIL);
+				DevMarkers.ShowFirstError(t, TextViews.any)
+			END
+		END CompileList;
+
+		PROCEDURE CompileModuleList*;
+			VAR c: TextControllers.Controller; beg, end: INTEGER;
+		BEGIN
+			Open;
+			c := TextControllers.Focus();
+			IF c # NIL THEN
+				s.ConnectTo(c.text);
+				IF c.HasSelection() THEN c.GetSelection(beg, end)
+				ELSE beg := 0; end := c.text.Length()
+				END;
+				CompileList(beg, end, c)
+			ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
+			END;
+			Close
+		END CompileModuleList;
+
+		PROCEDURE CompileThis*;
+			VAR p: DevCommanders.Par; beg, end: INTEGER;
+		BEGIN
+			Open;
+			p := DevCommanders.par;
+			IF p # NIL THEN
+				DevCommanders.par := NIL;
+				s.ConnectTo(p.text); beg := p.beg; end := p.end;
+				CompileList(beg, end, NIL)
+			ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
+			END;
+			Close
+		END CompileThis;
+*)
+
+BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "Oberon -> ARMv7-M Compiler  8.2.2020");
+	Texts.WriteLn(W); Texts.Append(Oberon.Log(**), W.buf);
+	NEW(dummy); dummy.class := ORB.Var; dummy.type := ORB.intType;
+	expression := expression0; Type := Type0; FormalType := FormalType0
+END O7ARMv7MP.

voc-O7/O7ARMv7MPCompile.Mod

@@ -0,0 +1,8 @@
+MODULE O7ARMv7MPCompile;
+
+	(* Alexander Shiryaev, 2020.09 *)
+
+	IMPORT O7ARMv7MP;
+
+BEGIN O7ARMv7MP.Compile
+END O7ARMv7MPCompile.

voc-O7/O7ARMv7MTool.Mod

@@ -0,0 +1,355 @@
+MODULE O7ARMv7MTool;	(*NW 18.2.2013*)
+
+	(*
+		Alexander Shiryaev:
+			2014.09:
+				Modified for ARMv6-M and ARMv7-M
+				DecBin and DecHex added
+	*)
+
+	IMPORT SYSTEM, Files (*:= O7Files*), Texts (*:= O7Texts*), Oberon (*:= O7Oberon*), ORB := O7B, ARMv7M := O7ARMv7M;
+
+	TYPE
+		LONGINT = INTEGER;
+		(* REAL = SHORTREAL; *)
+		LONGREAL = REAL;
+		(* BYTE = SHORTCHAR; *)
+		BYTE = CHAR;
+
+	VAR W: Texts.Writer;
+		Form: INTEGER;	(*result of ReadType*)
+
+	PROCEDURE Read (VAR R: Files.Rider; VAR n: INTEGER);
+		VAR b: BYTE;
+	BEGIN Files.Read(*Byte*)(R, b);
+		IF ORD(b) < 80H THEN n := ORD(b) ELSE n := ORD(b) - 100H END
+	END Read;
+
+	PROCEDURE ReadInt (VAR R: Files.Rider; VAR x: INTEGER);
+		VAR y: SYSTEM.INT64;
+	BEGIN
+		Files.ReadLInt(R, y);
+		IF R.eof THEN x := -1
+		ELSE x := SHORT(y)
+		END
+	END ReadInt;
+
+	PROCEDURE ReadType (VAR R: Files.Rider);
+		VAR key, len, lev, size, off: INTEGER;
+			ref, mno, class, form, readonly: INTEGER;
+			name, modname: ARRAY 32 OF CHAR;
+	BEGIN Read(R, ref); Texts.Write(W, " "); Texts.Write(W, "[");
+		IF ref < 0 THEN Texts.Write(W, "^"); Texts.WriteInt(W, -ref, 1)
+		ELSE Texts.WriteInt(W, ref, 1);
+			Read(R, form); Texts.WriteString(W, " form = "); Texts.WriteInt(W, form, 1);
+			IF form = ORB.Pointer THEN ReadType(R)
+			ELSIF form = ORB.Array THEN
+				ReadType(R); Files.ReadNum(R, len); Files.ReadNum(R, size);
+				Texts.WriteString(W, " len = "); Texts.WriteInt(W, len, 1);
+				Texts.WriteString(W, " size = "); Texts.WriteInt(W, size, 1)
+			ELSIF form = ORB.Record THEN
+				ReadType(R);	(*base type*)
+				Files.ReadNum(R, off); Texts.WriteString(W, " exno = "); Texts.WriteInt(W, off, 1);
+				Files.ReadNum(R, off); Texts.WriteString(W, " extlev = "); Texts.WriteInt(W, off, 1);
+				Files.ReadNum(R, size); Texts.WriteString(W, " size = "); Texts.WriteInt(W, size, 1);
+				Texts.Write(W, " "); Texts.Write(W, "{"); Read(R, class);
+				WHILE class # 0 DO (*fields*)
+					Files.ReadString(R, name);
+					IF name[0] # 0X THEN Texts.Write(W, " "); Texts.WriteString(W, name); ReadType(R)
+					ELSE Texts.WriteString(W, " --")
+					END ;
+					Files.ReadNum(R, off); Texts.WriteInt(W, off, 4); Read(R, class)
+				END ;
+				Texts.Write(W, "}")
+			ELSIF form = ORB.Proc THEN
+				ReadType(R); Texts.Write(W, "("); Read(R, class);
+				WHILE class # 0 DO
+					Texts.WriteString(W, " class = "); Texts.WriteInt(W, class, 1); Read(R, readonly);
+					IF readonly = 1 THEN Texts.Write(W, "#") END ;
+					ReadType(R); Read(R, class)
+				END ;
+				Texts.Write(W, ")")
+			END ;
+			Files.ReadString(R, modname);
+			IF modname[0] # 0X THEN
+				ReadInt(R, key); Files.ReadString(R, name);
+				Texts.Write(W, " "); Texts.WriteString(W, modname); Texts.Write(W, "."); Texts.WriteString(W, name);
+				Texts.WriteHex(W, key)
+			END
+		END ;
+		Form := form; Texts.Write(W, "]")
+	END ReadType;
+
+	PROCEDURE DecSym*; (*decode symbol file*)
+		VAR class, typno, k: INTEGER;
+			name: ARRAY 32 OF CHAR;
+			F: Files.File; R: Files.Rider;
+			S: Texts.Scanner;
+	BEGIN (*Oberon.GetPar;*) Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
+		IF S.class = Texts.Name THEN
+			Texts.WriteString(W, "OR-decode "); Texts.WriteString(W, S.s);
+			Texts.WriteLn(W); Texts.Append(Oberon.Log(**), W.buf);
+			F := Files.Old(S.s);
+			IF F # NIL THEN
+				Files.Set(R, F, 0); ReadInt(R, k); ReadInt(R, k);
+				Files.ReadString(R, name); Texts.WriteString(W, name); Texts.WriteHex(W, k);
+				Read(R, class); Texts.WriteInt(W, class, 3); (*sym file version*)
+				IF class = ORB.versionkey THEN
+					Texts.WriteLn(W); Read(R, class);
+					WHILE class # 0 DO
+						Texts.WriteInt(W, class, 4); Files.ReadString(R, name); Texts.Write(W, " "); Texts.WriteString(W, name);
+						ReadType(R);
+						IF class = ORB.Typ THEN
+							Texts.Write(W, "("); Read(R, class);
+							WHILE class # 0 DO	(*pointer base fixup*)
+								Texts.WriteString(W, " ->"); Texts.WriteInt(W, class, 4); Read(R, class)
+							END ;
+							Texts.Write(W, ")")
+						ELSIF (class = ORB.Const) OR (class = ORB.Var) THEN
+							Files.ReadNum(R, k); Texts.WriteInt(W, k, 5);	(*Reals, Strings!*)
+						END ;
+						Texts.WriteLn(W); Texts.Append(Oberon.Log(**), W.buf);
+						Read(R, class)
+					END
+				ELSE Texts.WriteString(W, " bad symfile version")
+				END
+			ELSE Texts.WriteString(W, " not found")
+			END ;
+			Texts.WriteLn(W); Texts.Append(Oberon.Log(**), W.buf)
+		END;
+		(*Oberon.Collect(0)*)
+	END DecSym;
+
+(* ---------------------------------------------------*)
+
+	PROCEDURE opcode (VAR d: INTEGER; w: LONGINT);
+		VAR s: ARRAY 64 OF CHAR;
+	BEGIN
+		IF w DIV 10000H = 0 THEN
+			ARMv7M.OpcodeRepr(d, w, s);
+			IF s # "" THEN Texts.WriteString(W, s) END
+		END
+	END opcode;
+
+	PROCEDURE Sync (VAR R: Files.Rider);
+		VAR ch: CHAR;
+	BEGIN Files.Read(R, ch); Texts.WriteString(W, "Sync "); Texts.Write(W, ch); Texts.WriteLn(W)
+	END Sync;
+
+	PROCEDURE Write (VAR R: Files.Rider; x: INTEGER);
+	BEGIN Files.Write(*Byte*)(R, CHR(x))	(* -128 <= x < 128 *)
+	END Write;
+
+	PROCEDURE DecObj*;	 (*decode object file*)
+		VAR class, i, n, key, size, fix, adr, data, len: INTEGER;
+			ch: CHAR;
+			name: ARRAY 32 OF CHAR;
+			F: Files.File; R: Files.Rider;
+			S: Texts.Scanner;
+			d: INTEGER; (* ARMv7-M decoder state *)
+	BEGIN (*Oberon.GetPar;*) Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
+		IF S.class = Texts.Name THEN
+			Texts.WriteString(W, "decode "); Texts.WriteString(W, S.s); F := Files.Old(S.s);
+			IF F # NIL THEN
+				Files.Set(R, F, 0); Files.ReadString(R, name); Texts.WriteLn(W); Texts.WriteString(W, name);
+				ReadInt(R, key); Texts.WriteHex(W, key); Read(R, class); Texts.WriteInt(W, class, 4); (*version*)
+				ReadInt(R, size); Texts.WriteInt(W, size, 6); Texts.WriteLn(W);
+				Texts.WriteString(W, "imports:"); Texts.WriteLn(W); Files.ReadString(R, name);
+				WHILE name[0] # 0X DO
+					Texts.Write(W, 9X); Texts.WriteString(W, name);
+					ReadInt(R, key); Texts.WriteHex(W, key); Texts.WriteLn(W);
+					Files.ReadString(R, name)
+				END ;
+			(* Sync(R); *)
+				Texts.WriteString(W, "type descriptors"); Texts.WriteLn(W);
+				ReadInt(R, n); n := n DIV 4; i := 0;
+				WHILE i < n DO ReadInt(R, data); Texts.WriteHex(W, data); INC(i) END ;
+				Texts.WriteLn(W);
+				Texts.WriteString(W, "data"); ReadInt(R, data); Texts.WriteInt(W, data, 6); Texts.WriteLn(W);
+				Texts.WriteString(W, "strings"); Texts.WriteLn(W);
+				ReadInt(R, n); i := 0;
+				WHILE i < n DO Files.Read(R, ch); Texts.Write(W, ch); INC(i) END ;
+				Texts.WriteLn(W);
+				Texts.WriteString(W, "code"); Texts.WriteLn(W);
+				ReadInt(R, n); i := 0; d := 0;
+				WHILE i < n DO
+					ReadInt(R, data); Texts.WriteInt(W, i, 4); Texts.Write(W, 9X); Texts.WriteHex(W, data);
+					Texts.Write(W, 9X); opcode(d, data); Texts.WriteLn(W); INC(i)
+				END;
+				ASSERT(d = 0, 100);
+			(* Sync(R); *)
+				Texts.WriteString(W, "commands:"); Texts.WriteLn(W);
+				Files.ReadString(R, name);
+				WHILE name[0] # 0X DO
+					Texts.Write(W, 9X); Texts.WriteString(W, name);
+					ReadInt(R, adr); Texts.WriteInt(W, adr, 5); Texts.WriteLn(W);
+					Files.ReadString(R, name)
+				END ;
+			(* Sync(R); *)
+				Texts.WriteString(W, "entries"); Texts.WriteLn(W);
+				ReadInt(R, n); i := 0;
+				WHILE i < n DO
+					ReadInt(R, adr); Texts.WriteInt(W, adr, 6); INC(i)
+				END ;
+				Texts.WriteLn(W);
+			(* Sync(R); *)
+				Texts.WriteString(W, "pointer refs"); Texts.WriteLn(W); ReadInt(R, adr);
+				WHILE adr # -1 DO Texts.WriteInt(W, adr, 6); ReadInt(R, adr) END ;
+				Texts.WriteLn(W);
+			(* Sync(R); *)
+				ReadInt(R, data); Texts.WriteString(W, "fixP = "); Texts.WriteInt(W, data, 8); Texts.WriteLn(W);
+				ReadInt(R, data); Texts.WriteString(W, "fixD = "); Texts.WriteInt(W, data, 8); Texts.WriteLn(W);
+				ReadInt(R, data); Texts.WriteString(W, "fixT = "); Texts.WriteInt(W, data, 8); Texts.WriteLn(W);
+				ReadInt(R, data); Texts.WriteString(W, "entry = "); Texts.WriteInt(W, data, 8); Texts.WriteLn(W);
+				Files.Read(R, ch);
+				IF ch # "O" THEN Texts.WriteString(W, "format eror"); Texts.WriteLn(W) END
+			(* Sync(R); *)
+			ELSE Texts.WriteString(W, " not found"); Texts.WriteLn(W)
+			END ;
+			Texts.Append(Oberon.Log(**), W.buf)
+		END;
+		(*Oberon.Collect(0)*)
+	END DecObj;
+
+	PROCEDURE DecBin*;	(* decode binary image file *)
+		VAR i, data: INTEGER;
+			F: Files.File; R: Files.Rider;
+			S: Texts.Scanner;
+			d: INTEGER; (* ARMv7-M decoder state *)
+
+		PROCEDURE Read (VAR x: INTEGER);
+			VAR c0, c1: CHAR;
+		BEGIN
+			Files.Read(R, c0); Files.Read(R, c1);
+			x := ORD(c0) + 100H * ORD(c1);
+			ASSERT(x DIV 10000H = 0, 100)
+		END Read;
+
+	BEGIN
+		(*Oberon.GetPar;*) Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
+		IF S.class = Texts.Name THEN
+			Texts.WriteString(W, "decode "); Texts.WriteString(W, S.s); Texts.WriteLn(W); F := Files.Old(S.s);
+			IF F # NIL THEN
+				Files.Set(R, F, 0); Read(data); i := 0; d := 0;
+				WHILE ~R.eof DO
+					Texts.WriteInt(W, i, 4); Texts.Write(W, 9X); Texts.WriteHex(W, data); Texts.Write(W, 9X); opcode(d, data); Texts.WriteLn(W); INC(i);
+					Read(data)
+				END;
+				IF d # 0 THEN Texts.WriteString(W, "invalid decoder state");
+					Texts.WriteLn(W) END
+			ELSE Texts.WriteString(W, " not found"); Texts.WriteLn(W)
+			END;
+			Texts.Append(Oberon.Log(**), W.buf)
+		END;
+		(*Oberon.Collect(0)*)
+	END DecBin;
+
+	PROCEDURE DecHex*;	(* decode Intel HEX file *)
+		VAR ch: CHAR; err, eof: BOOLEAN;
+			pos, cs, offH: INTEGER;
+			F: Files.File; R: Files.Rider;
+			S: Texts.Scanner;
+			d: INTEGER; (* ARMv7-M decoder state *)
+
+		PROCEDURE Get;
+		BEGIN Files.Read(R, ch); IF R.eof THEN ch := 0X ELSE INC(pos) END
+		END Get;
+
+		PROCEDURE Err ((*IN*) msg: ARRAY OF CHAR);
+		BEGIN
+			IF ~err THEN Texts.WriteString(W, "pos = ");
+				Texts.WriteInt(W, pos, 0); Texts.WriteString(W, ": ");
+				Texts.WriteString(W, msg); Texts.WriteLn(W)
+			END; err := TRUE
+		END Err;
+
+		PROCEDURE CheckD;
+		BEGIN IF d # 0 THEN Err("invalid decoder state") END; d := 0
+		END CheckD;
+
+		PROCEDURE B ((*OUT*) VAR x: INTEGER);
+			PROCEDURE H;
+			BEGIN
+				IF (ch >= '0') & (ch <= '9') THEN x := x * 10H + ORD(ch) - ORD('0')
+				ELSIF (ch >= 'A') & (ch <= 'F') THEN x := x * 10H + ORD(ch) - ORD('A') + 10
+				ELSE Err("invalid HEX")
+				END; Get
+			END H;
+		BEGIN x := 0; H; H; cs := cs + x
+		END B;
+
+		PROCEDURE Line;
+			VAR len, offL, type, cs, i, x: INTEGER;
+				a: ARRAY 255 OF INTEGER;
+		BEGIN
+			IF eof THEN Err("EOF already reached") END;
+			IF ch # ':' THEN Err("':' expected") END; Get; cs := 0;
+			B(len); B(i); B(offL); offL := i * 100H + offL; B(type);
+			i := 0; WHILE i < len DO B(a[i]); INC(i) END;
+			B(i); IF cs MOD 100H # 0 THEN Err("checksum error") END;
+			WHILE (ch = 0AX) OR (ch = 0DX) DO Get END;
+			IF ~err THEN
+				CASE type OF 0: (* data *)
+					IF len # 0 THEN
+						IF (offL MOD 2 = 0) & (len MOD 2 = 0) THEN
+							i := 0;
+							WHILE i < len DIV 2 DO
+								Texts.WriteInt(W, offL DIV 2 + i, 4); Texts.Write(W, 9X);
+								x := a[i * 2] + 100H * a[i * 2 + 1];
+								Texts.WriteHex(W, x); Texts.Write(W, 9X); opcode(d, x); Texts.WriteLn(W); INC(i)
+							END
+						ELSE Err("unaligned data support not implemented")
+						END
+					ELSE Err("data length is zero")
+					END
+				| 1: (* EOF *)
+					IF (len = 0) & (offL = 0) THEN eof := TRUE
+					ELSE Err("invalid EOF")
+					END
+				| 2: (* extended segment address *)
+					IF (len = 2) & (offL = 0) THEN
+						Err("I16HEX support not implemented")
+					ELSE Err("invalid extended segment address")
+					END
+				| 3: (* start segment address *)
+					IF (len = 4) & (offL = 0) THEN
+						Err("I16HEX support not implemented")
+					ELSE Err("invalid start segment address")
+					END
+				| 4: (* extended linear address *)
+					IF (len = 2) & (offL = 0) THEN CheckD;
+						offH := (a[0] * 100H + a[1]) * 10000H;
+						Texts.WriteHex(W, offH); Texts.WriteString(W, "H:");
+						Texts.WriteLn(W)
+					ELSE Err("invalid extended linear address")
+					END
+				| 5: (* start linear address *)
+					IF (len = 4) & (offL = 0) THEN
+						Texts.WriteString(W, "start linear address: ");
+						x := a[0] * 1000000H + a[1] * 10000H + a[2] * 100H + a[3];
+						Texts.WriteHex(W, x); Texts.Write(W, 'H'); Texts.WriteLn(W)
+					ELSE Err("invalid start linear address")
+					END
+				ELSE Err("unexpected record type")
+				END
+			END
+		END Line;
+
+	BEGIN
+		(*Oberon.GetPar;*) Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
+		IF S.class = Texts.Name THEN
+			Texts.WriteString(W, "decode "); Texts.WriteString(W, S.s); Texts.WriteLn(W); F := Files.Old(S.s);
+			IF F # NIL THEN
+				Files.Set(R, F, 0); err := FALSE; eof := FALSE; pos := 0; Get;
+				offH := 0; d := 0; REPEAT Line UNTIL err OR (ch = 0X);
+				IF ~eof THEN Err("EOF expected") END; CheckD
+			ELSE Texts.WriteString(W, " not found"); Texts.WriteLn(W)
+			END;
+			Texts.Append(Oberon.Log(**), W.buf)
+		END;
+		(*Oberon.Collect(0)*)
+	END DecHex;
+
+BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "O7ARMv7MTool 19.9.2014");
+	Texts.WriteLn(W); Texts.Append(Oberon.Log(**), W.buf)
+END O7ARMv7MTool.

voc-O7/O7ARMv7MToolDecBin.Mod

@@ -0,0 +1,8 @@
+MODULE O7ARMv7MToolDecBin;
+
+	(* Alexander Shiryaev, 2020.09 *)
+
+	IMPORT O7ARMv7MTool;
+
+BEGIN O7ARMv7MTool.DecBin
+END O7ARMv7MToolDecBin.

voc-O7/O7ARMv7MToolDecHex.Mod

@@ -0,0 +1,8 @@
+MODULE O7ARMv7MToolDecHex;
+
+	(* Alexander Shiryaev, 2020.09 *)
+
+	IMPORT O7ARMv7MTool;
+
+BEGIN O7ARMv7MTool.DecHex
+END O7ARMv7MToolDecHex.

voc-O7/O7ARMv7MToolDecObj.Mod

@@ -0,0 +1,8 @@
+MODULE O7ARMv7MToolDecObj;
+
+	(* Alexander Shiryaev, 2020.09 *)
+
+	IMPORT O7ARMv7MTool;
+
+BEGIN O7ARMv7MTool.DecObj
+END O7ARMv7MToolDecObj.

voc-O7/O7ARMv7MToolDecSym.Mod

@@ -0,0 +1,8 @@
+MODULE O7ARMv7MToolDecSym;
+
+	(* Alexander Shiryaev, 2020.09 *)
+
+	IMPORT O7ARMv7MTool;
+
+BEGIN O7ARMv7MTool.DecSym
+END O7ARMv7MToolDecSym.

voc-O7/O7B.Mod

@@ -0,0 +1,453 @@
+MODULE O7B;	(*NW 25.6.2014  / 1.3.2019  in Oberon-07*)
+
+	IMPORT SYSTEM, Files, ORS := O7S;
+	(*Definition of data types Object and Type, which together form the data structure
+		called "symbol table". Contains procedures for creation of Objects, and for search:
+		NewObj, this, thisimport, thisfield (and OpenScope, CloseScope).
+		Handling of import and export, i.e. reading and writing of "symbol files" is done by procedures
+		Import and Export. This module contains the list of standard identifiers, with which
+		the symbol table (universe), and that of the pseudo-module SYSTEM are initialized. *)
+
+	TYPE
+		LONGINT = INTEGER;
+		(* REAL = SHORTREAL; *)
+		LONGREAL = REAL;
+		(* BYTE = SHORTCHAR; *)
+		BYTE = CHAR;
+
+	CONST versionkey* = 1; maxTypTab = 64;
+		(* class values*) Head* = 0;
+			Const* = 1; Var* = 2; Par* = 3; Fld* = 4; Typ* = 5;
+			SProc* = 6; SFunc* = 7; Mod* = 8;
+
+		(* form values*)
+			Byte* = 1; Bool* = 2; Char* = 3; Int* = 4; Real* = 5; Set* = 6;
+			Pointer* = 7; NilTyp* = 8; NoTyp* = 9; Proc* = 10;
+			String* = 11; Array* = 12; Record* = 13;
+
+	TYPE Object* = POINTER TO ObjDesc;
+		Module* = POINTER TO ModDesc;
+		Type* = POINTER TO TypeDesc;
+
+		ObjDesc*= (*EXTENSIBLE*) RECORD
+			class*, exno*: INTEGER;
+			expo*, rdo*: BOOLEAN;	 (*exported / read-only*)
+			lev*: INTEGER;
+			next*, dsc*: Object;
+			type*: Type;
+			name*: ORS.Ident;
+			val*: LONGINT
+		END ;
+
+		ModDesc* = RECORD (ObjDesc) orgname-: ORS.Ident END ;
+
+		TypeDesc* = RECORD
+			form*, ref*, mno*: INTEGER;	(*ref is only used for import/export*)
+			nofpar*: INTEGER;	(*for procedures, extension level for records*)
+			len*: LONGINT;	(*for arrays, len < 0 => open array; for records: adr of descriptor*)
+			dsc*, typobj*: Object;
+			base*: Type;	(*for arrays, records, pointers*)
+			size*: LONGINT;	(*in bytes; always multiple of 4, except for Byte, Bool and Char*)
+		END ;
+
+	(* Object classes and the meaning of "val":
+		class		val
+		----------
+		Var			address
+		Par			address
+		Const		value
+		Fld			offset
+		Typ			type descriptor (TD) address
+		SProc		inline code number
+		SFunc		inline code number
+		Mod			key
+
+	Type forms and the meaning of "dsc" and "base":
+		form		 dsc			base
+		------------------------
+		Pointer	-				type of dereferenced object
+		Proc		 params	 result type
+		Array		-				type of elements
+		Record	 fields	 extension *)
+
+	VAR topScope-, universe, system-: Object;
+		byteType-, boolType-, charType-: Type;
+		intType-, realType-, setType-, nilType-, noType-, strType-: Type;
+		nofmod, Ref: INTEGER;
+		typtab: ARRAY maxTypTab OF Type;
+
+	PROCEDURE NewObj* (VAR obj: Object; (*IN*) id: ORS.Ident; class: INTEGER);	(*insert new Object with name id*)
+		VAR new, x: Object;
+	BEGIN x := topScope;
+		WHILE (x.next # NIL) & (x.next.name # id) DO x := x.next END ;
+		IF x.next = NIL THEN
+			NEW(new); new.name := id; new.class := class; new.next := NIL; new.rdo := FALSE; new.dsc := NIL;
+			x.next := new; obj := new
+		ELSE obj := x.next; ORS.Mark("mult def")
+		END
+	END NewObj;
+
+	PROCEDURE thisObj* (): Object;
+		VAR s, x: Object;
+	BEGIN s := topScope;
+		REPEAT x := s.next;
+			WHILE (x # NIL) & (x.name # ORS.id) DO x := x.next END ;
+			s := s.dsc
+		UNTIL (x # NIL) OR (s = NIL);
+		RETURN x
+	END thisObj;
+
+	PROCEDURE thisimport* (mod: Object): Object;
+		VAR obj: Object;
+	BEGIN
+		IF mod.rdo THEN
+			IF mod.name[0] # 0X THEN
+				obj := mod.dsc;
+				WHILE (obj # NIL) & (obj.name # ORS.id) DO obj := obj.next END
+			ELSE obj := NIL
+			END
+		ELSE obj := NIL
+		END ;
+		RETURN obj
+	END thisimport;
+
+	PROCEDURE thisfield* (rec: Type): Object;
+		VAR fld: Object;
+	BEGIN fld := rec.dsc;
+		WHILE (fld # NIL) & (fld.name # ORS.id) DO fld := fld.next END ;
+		RETURN fld
+	END thisfield;
+
+	PROCEDURE OpenScope*;
+		VAR s: Object;
+	BEGIN NEW(s); s.class := Head; s.dsc := topScope; s.next := NIL; topScope := s
+	END OpenScope;
+
+	PROCEDURE CloseScope*;
+	BEGIN topScope := topScope.dsc
+	END CloseScope;
+
+	(*------------------------------- Import ---------------------------------*)
+
+	PROCEDURE MakeFileName* (VAR FName: ORS.Ident; (*IN*) name, ext: ARRAY OF CHAR);
+		VAR i, j: INTEGER;
+	BEGIN i := 0; j := 0;	(*assume name suffix less than 4 characters*)
+		WHILE (i < ORS.IdLen-5) & (name[i] > 0X) DO FName[i] := name[i]; INC(i) END ;
+		REPEAT FName[i]:= ext[j]; INC(i); INC(j) UNTIL ext[j] = 0X;
+		FName[i] := 0X
+	END MakeFileName;
+
+	PROCEDURE ThisModule ((*IN*) name, orgname: ORS.Ident; non: BOOLEAN; key: LONGINT): Object;
+		VAR mod: Module; obj, obj1: Object;
+	BEGIN obj1 := topScope; obj := obj1.next;	(*search for module*)
+		WHILE (obj # NIL) & (obj(Module).orgname # name) DO obj1 := obj; obj := obj1.next END ;
+		IF obj = NIL THEN	(*insert new module*)
+			NEW(mod); mod.class := Mod; mod.rdo := FALSE;
+			mod.name := name; mod.orgname := orgname; mod.val := key;
+			mod.lev := nofmod; INC(nofmod); mod.type := noType; mod.dsc := NIL; mod.next := NIL;
+			obj1.next := mod; obj := mod
+		ELSE (*module already present*)
+			IF non THEN ORS.Mark("invalid import order") END
+		END ;
+		RETURN obj
+	END ThisModule;
+
+	PROCEDURE Read (VAR R: Files.Rider; VAR x: INTEGER);
+		VAR b: BYTE;
+	BEGIN Files.Read(*Byte*)(R, b);
+		IF ORD(b) < 80H THEN x := ORD(b) ELSE x := ORD(b) - 100H END
+	END Read;
+
+	PROCEDURE ReadInt (VAR R: Files.Rider; VAR x: INTEGER);
+		VAR y: SYSTEM.INT64;
+	BEGIN
+		Files.ReadLInt(R, y);
+		IF R.eof THEN x := -1
+		ELSE x := SHORT(y)
+		END
+	END ReadInt;
+
+	PROCEDURE InType (VAR R: Files.Rider; thismod: Object; VAR T: Type);
+		VAR key: LONGINT;
+			ref, class, form, np, readonly: INTEGER;
+			fld, par, obj, mod, last: Object;
+			t: Type;
+			name, modname: ORS.Ident;
+	BEGIN Read(R, ref);
+		IF ref < 0 THEN T := typtab[-ref]	(*already read*)
+		ELSE NEW(t); T := t; typtab[ref] := t; t.mno := thismod.lev;
+			Read(R, form); t.form := form;
+			IF form = Pointer THEN InType(R, thismod, t.base); t.size := 4
+			ELSIF form = Array THEN
+				InType(R, thismod, t.base); Files.ReadNum(R, t.len); Files.ReadNum(R, t.size)
+			ELSIF form = Record THEN
+				InType(R, thismod, t.base);
+				IF t.base.form = NoTyp THEN t.base := NIL; obj := NIL ELSE obj := t.base.dsc END ;
+				Files.ReadNum(R, t.len); (*TD adr/exno*)
+				Files.ReadNum(R, t.nofpar);	(*ext level*)
+				Files.ReadNum(R, t.size);
+				Read(R, class); last := NIL;
+				WHILE class # 0 DO	(*fields*)
+					NEW(fld); fld.class := class; Files.ReadString(R, fld.name);
+					IF last = NIL THEN t.dsc := fld ELSE last.next := fld END ;
+					last := fld;
+					IF fld.name[0] # 0X THEN fld.expo := TRUE; InType(R, thismod, fld.type) ELSE fld.expo := FALSE; fld.type := nilType END ;
+					Files.ReadNum(R, fld.val); Read(R, class)
+				END ;
+				IF last = NIL THEN t.dsc := obj ELSE last.next := obj END
+			ELSIF form = Proc THEN
+				InType(R, thismod, t.base);
+				obj := NIL; np := 0; Read(R, class);
+				WHILE class # 0 DO	(*parameters*)
+					NEW(par); par.class := class; Read(R, readonly); par.rdo := readonly = 1;
+					InType(R, thismod, par.type); par.next := obj; obj := par; INC(np); Read(R, class)
+				END ;
+				t.dsc := obj; t.nofpar := np; t.size := 4
+			END ;
+			Files.ReadString(R, modname);
+			IF modname[0] #	0X THEN	(*re-import*)
+				ReadInt(R, key); Files.ReadString(R, name);
+				mod := ThisModule(modname, modname, FALSE, key);
+				obj := mod.dsc;	(*search type*)
+				WHILE (obj # NIL) & (obj.name # name) DO obj := obj.next END ;
+				IF obj # NIL THEN T := obj.type	 (*type object found in object list of mod*)
+				ELSE (*insert new type object in object list of mod*)
+					NEW(obj); obj.name := name; obj.class := Typ; obj.next := mod.dsc; mod.dsc := obj; obj.type := t;
+					t.mno := mod.lev; t.typobj := obj; T := t
+				END ;
+				typtab[ref] := T
+			END
+		END
+	END InType;
+
+	PROCEDURE Import* (VAR modid, modid1: ORS.Ident);
+		VAR key: LONGINT; class, k: INTEGER;
+			obj: Object; t: Type;
+			thismod: Object;
+			modname, fname: ORS.Ident;
+			F: Files.File; R: Files.Rider;
+	BEGIN
+		IF modid1 = "SYSTEM" THEN
+			thismod := ThisModule(modid, modid1, TRUE, key); DEC(nofmod);
+			thismod.lev := 0; thismod.dsc := system; thismod.rdo := TRUE
+		ELSE MakeFileName(fname, modid1, ".smb"); F := Files.Old(fname);
+			IF F # NIL THEN
+				Files.Set(R, F, 0); ReadInt(R, key); ReadInt(R, key); Files.ReadString(R, modname);
+				thismod := ThisModule(modid, modid1, TRUE, key); thismod.rdo := TRUE;
+				Read(R, class); (*version key*)
+				IF class # versionkey THEN ORS.Mark("wrong version") END ;
+				Read(R, class);
+				WHILE class # 0 DO
+					NEW(obj); obj.class := class; Files.ReadString(R, obj.name);
+					InType(R, thismod, obj.type); obj.lev := -thismod.lev;
+					IF class = Typ THEN
+						t := obj.type; t.typobj := obj; Read(R, k); (*fixup bases of previously declared pointer types*)
+						WHILE k # 0 DO typtab[k].base := t; Read(R, k) END
+					ELSE
+						IF class = Const THEN
+							IF obj.type.form = Real THEN ReadInt(R, obj.val) ELSE Files.ReadNum(R, obj.val) END
+							ELSIF class = Var THEN Files.ReadNum(R, obj.val); obj.rdo := TRUE
+						END
+					END;
+					obj.next := thismod.dsc; thismod.dsc := obj; Read(R, class)
+				END;
+			ELSE ORS.Mark("import not available")
+			END
+		END
+	END Import;
+
+	(*-------------------------------- Export ---------------------------------*)
+
+	PROCEDURE Write (VAR R: Files.Rider; x: INTEGER);
+	BEGIN Files.Write(*Byte*)(R, CHR(x))
+	END Write;
+
+	PROCEDURE OutType (VAR R: Files.Rider; t: Type);
+		VAR obj, mod, fld, bot: Object;
+
+		PROCEDURE OutPar (VAR R: Files.Rider; par: Object; n: INTEGER);
+			VAR cl: INTEGER;
+		BEGIN
+			IF n > 0 THEN
+				OutPar(R, par.next, n-1); cl := par.class;
+				Write(R, cl);
+				IF par.rdo THEN Write(R, 1) ELSE Write(R, 0) END ;
+				OutType(R, par.type)
+			END
+		END OutPar;
+
+		PROCEDURE FindHiddenPointers (VAR R: Files.Rider; typ: Type; offset: LONGINT);
+			VAR fld: Object; i, n: LONGINT;
+		BEGIN
+			IF (typ.form = Pointer) OR (typ.form = NilTyp) THEN Write(R, Fld); Write(R, 0); Files.WriteNum(R, offset)
+			ELSIF typ.form = Record THEN fld := typ.dsc;
+				WHILE fld # NIL DO FindHiddenPointers(R, fld.type, fld.val + offset); fld := fld.next END
+			ELSIF typ.form = Array THEN i := 0; n := typ.len;
+				WHILE i < n DO FindHiddenPointers(R, typ.base, typ.base.size * i + offset); INC(i) END
+			END
+		END FindHiddenPointers;
+
+	BEGIN
+		IF t.ref > 0 THEN (*type was already output*) Write(R, -t.ref)
+		ELSE obj := t.typobj;
+			IF obj # NIL THEN Write(R, Ref); t.ref := Ref; INC(Ref) ELSE (*anonymous*) Write(R, 0) END ;
+			Write(R, t.form);
+			IF t.form = Pointer THEN OutType(R, t.base)
+			ELSIF t.form = Array THEN OutType(R, t.base); Files.WriteNum(R, t.len); Files.WriteNum(R, t.size)
+			ELSIF t.form = Record THEN
+				IF t.base # NIL THEN OutType(R, t.base); bot := t.base.dsc ELSE OutType(R, noType); bot := NIL END ;
+				IF obj # NIL THEN Files.WriteNum(R, obj.exno) ELSE Write(R, 0) END;
+				Files.WriteNum(R, t.nofpar); Files.WriteNum(R, t.size);
+				fld := t.dsc;
+				WHILE fld # bot DO	(*fields*)
+					IF fld.expo THEN
+						Write(R, Fld); Files.WriteString(R, fld.name); OutType(R, fld.type); Files.WriteNum(R, fld.val)	(*offset*)
+					ELSE FindHiddenPointers(R, fld.type, fld.val)
+					END ;
+					fld := fld.next
+				END ;
+				 Write(R, 0)
+			ELSIF t.form = Proc THEN OutType(R, t.base); OutPar(R, t.dsc, t.nofpar); Write(R, 0)
+			END ;
+			IF (t.mno > 0) & (obj # NIL) THEN	(*re-export, output name*)
+				mod := topScope.next;
+				WHILE (mod # NIL) & (mod.lev # t.mno) DO mod := mod.next END ;
+				IF mod # NIL THEN Files.WriteString(R, mod(Module).orgname); Files.WriteLInt(R, mod.val); Files.WriteString(R, obj.name)
+				ELSE ORS.Mark("re-export not found"); Write(R, 0)
+				END
+			ELSE Write(R, 0)
+			END
+		END
+	END OutType;
+
+	PROCEDURE Export* (VAR modid: ORS.Ident; VAR newSF: BOOLEAN; VAR key: LONGINT);
+		VAR x, sum, oldkey: LONGINT;
+			obj, obj0: Object;
+			filename: ORS.Ident;
+			F, F1: Files.File; R, R1: Files.Rider;
+	BEGIN Ref := Record + 1; MakeFileName(filename, modid, ".smb");
+		F := Files.New(filename);
+		IF F # NIL THEN
+			Files.Set(R, F, 0);
+			Files.WriteLInt(R, 0); (*placeholder*)
+			Files.WriteLInt(R, 0); (*placeholder for key to be inserted at the end*)
+			Files.WriteString(R, modid); Write(R, versionkey);
+			obj := topScope.next;
+			WHILE obj # NIL DO
+				IF obj.expo THEN
+					Write(R, obj.class); Files.WriteString(R, obj.name);
+					OutType(R, obj.type);
+					IF obj.class = Typ THEN
+						IF obj.type.form = Record THEN
+							obj0 := topScope.next; (*check whether this is base of previously declared pointer types*)
+							WHILE obj0 # obj DO
+								IF (obj0.type.form = Pointer) & (obj0.type.base = obj.type) & (obj0.type.ref > 0) THEN Write(R, obj0.type.ref) END;
+								obj0 := obj0.next
+							END
+						END;
+						Write(R, 0)
+					ELSIF obj.class = Const THEN
+						IF obj.type.form = Proc THEN Files.WriteNum(R, obj.exno)
+						ELSIF obj.type.form = Real THEN Files.WriteLInt(R, obj.val)
+						ELSE Files.WriteNum(R, obj.val)
+						END
+					ELSIF obj.class = Var THEN Files.WriteNum(R, obj.exno)
+					END
+				END;
+				obj := obj.next
+			END;
+			REPEAT Write(R, 0) UNTIL Files.Length(F) MOD 4 = 0;
+			FOR Ref := Record+1 TO maxTypTab-1 DO typtab[Ref] := NIL END ;
+			Files.Set(R, F, 0); sum := 0; ReadInt(R, x); (* compute key (checksum) *)
+			WHILE ~R.eof DO sum := sum + x; ReadInt(R, x) END ;
+			F1 := Files.Old(filename); (*sum is new key*)
+			IF F1 # NIL THEN Files.Set(R1, F1, 4); ReadInt(R1, oldkey) ELSE oldkey := sum+1 END ;
+			IF sum # oldkey THEN
+				IF newSF OR (F1 = NIL) THEN
+					key := sum; newSF := TRUE; Files.Set(R, F, 4); Files.WriteLInt(R, sum); Files.Register(F)	(*insert checksum*)
+				ELSE ORS.Mark("new symbol file inhibited")
+				END
+			ELSE newSF := FALSE; key := sum
+			END
+		ELSE newSF := FALSE; ORS.Mark("symbol file not opened")
+		END
+	END Export;
+
+	PROCEDURE Init*;
+	BEGIN topScope := universe; nofmod := 1
+	END Init;
+
+	PROCEDURE type (ref, form: INTEGER; size: LONGINT): Type;
+		VAR tp: Type;
+	BEGIN NEW(tp); tp.form := form; tp.size := size; tp.ref := ref; tp.base := NIL;
+		typtab[ref] := tp; RETURN tp
+	END type;
+
+	PROCEDURE enter ((*IN*) name: ARRAY OF CHAR; cl: INTEGER; type: Type; n: LONGINT);
+		VAR obj: Object;
+	BEGIN NEW(obj); obj.name := name(*$*); obj.class := cl; obj.type := type; obj.val := n; obj.dsc := NIL;
+		IF cl = Typ THEN type.typobj := obj END ;
+		obj.next := system; system := obj
+	END enter;
+
+BEGIN
+	byteType := type(Byte, Int, 1);
+	boolType := type(Bool, Bool, 1);
+	charType := type(Char, Char,1);
+	intType := type(Int, Int, 4);
+	realType := type(Real, Real, 4);
+	setType := type(Set, Set,4);
+	nilType := type(NilTyp, NilTyp, 4);
+	noType := type(NoTyp, NoTyp, 4);
+	strType := type(String, String, 8);
+
+	(*initialize universe with data types and in-line procedures;
+		LONGINT is synonym to INTEGER, LONGREAL to REAL.
+		LED, ADC, SBC; LDPSR, LDREG, REG, COND are not in language definition*)
+	system := NIL;	(*n = procno*10 + nofpar*)
+	enter("UML", SFunc, intType, 132);	(*functions*)
+	enter("SBC", SFunc, intType, 122);
+	enter("ADC", SFunc, intType, 112);
+	enter("ROR", SFunc, intType, 92);
+	enter("ASR", SFunc, intType, 82);
+	enter("LSL", SFunc, intType, 72);
+	enter("LEN", SFunc, intType, 61);
+	enter("CHR", SFunc, charType, 51);
+	enter("ORD", SFunc, intType, 41);
+	enter("FLT", SFunc, realType, 31);
+	enter("FLOOR", SFunc, intType, 21);
+	enter("ODD", SFunc, boolType, 11);
+	enter("ABS", SFunc, intType, 1);
+	enter("LED", SProc, noType, 81);	(*procedures*)
+	enter("UNPK", SProc, noType, 72);
+	enter("PACK", SProc, noType, 62);
+	enter("NEW", SProc, noType, 51);
+	enter("ASSERT", SProc, noType, 41);
+	enter("EXCL", SProc, noType, 32);
+	enter("INCL", SProc, noType, 22);
+	enter("DEC", SProc, noType, 11);
+	enter("INC", SProc, noType, 1);
+	enter("SET", Typ, setType, 0);	 (*types*)
+	enter("BOOLEAN", Typ, boolType, 0);
+	enter("BYTE", Typ, byteType, 0);
+	enter("CHAR", Typ, charType, 0);
+	enter("LONGREAL", Typ, realType, 0);
+	enter("REAL", Typ, realType, 0);
+	enter("LONGINT", Typ, intType, 0);
+	enter("INTEGER", Typ, intType, 0);
+	topScope := NIL; OpenScope; topScope.next := system; universe := topScope;
+
+	system := NIL;	(* initialize "unsafe" pseudo-module SYSTEM*)
+	enter("H", SFunc, intType, 201);		 (*functions*)
+	enter("COND", SFunc, boolType, 191);
+	enter("SIZE", SFunc, intType, 181);
+	enter("ADR", SFunc, intType, 171);
+	enter("VAL", SFunc, intType, 162);
+	enter("REG", SFunc, intType, 151);
+	enter("BIT", SFunc, boolType, 142);
+	enter("LDREG", SProc, noType, 142);	(*procedures*)
+	enter("LDPSR", SProc, noType, 131);
+	enter("COPY", SProc, noType, 123);
+	enter("PUT", SProc, noType, 112);
+	enter("GET", SProc, noType, 102);
+END O7B.

voc-O7/O7S.Mod

@@ -0,0 +1,330 @@
+MODULE O7S; (* NW 19.9.93 / 20.3.2017	Scanner in Oberon-07*)
+
+	IMPORT SYSTEM, Texts, Oberon;
+
+(* Oberon Scanner does lexical analysis. Input is Oberon-Text, output is
+	sequence of symbols, i.e identifiers, numbers, strings, and special symbols.
+	Recognises all Oberon keywords and skips comments. The keywords are
+	recorded in a table.
+	Get(sym) delivers next symbol from input text with Reader R.
+	Mark(msg) records error and delivers error message with Writer W.
+	If Get delivers ident, then the identifier (a string) is in variable id, if int or char
+	in ival, if real in rval, and if string in str (and slen) *)
+
+	TYPE
+		LONGINT = INTEGER;
+		(* REAL = SHORTREAL; *)
+		LONGREAL = REAL;
+		(* CHAR = SHORTCHAR; *)
+		(* BYTE = SHORTCHAR; *)
+		BYTE = CHAR;
+
+	CONST IdLen* = 32;
+		NKW = 34; (*nof keywords*)
+		maxExp = 38; stringBufSize = 256;
+
+		(*lexical symbols*)
+		null = 0; times* = 1; rdiv* = 2; div* = 3; mod* = 4;
+		and* = 5; plus* = 6; minus* = 7; or* = 8; eql* = 9;
+		neq* = 10; lss* = 11; leq* = 12; gtr* = 13; geq* = 14;
+		in* = 15; is* = 16; arrow* = 17; period* = 18;
+		char* = 20; int* = 21; real* = 22; false* = 23; true* = 24;
+		nil* = 25; string* = 26; not* = 27; lparen* = 28; lbrak* = 29;
+		lbrace* = 30; ident* = 31;
+		if* = 32; while* = 34; repeat* = 35; case* = 36; for* = 37;
+		comma* = 40; colon* = 41; becomes* = 42;
+		upto* = 43; rparen* = 44;
+		rbrak* = 45; rbrace* = 46; then* = 47; of* = 48; do* = 49;
+		to* = 50; by* = 51; semicolon* = 52; end* = 53; bar* = 54;
+		else* = 55; elsif* = 56; until* = 57; return* = 58;
+		array* = 60; record* = 61; pointer* = 62; const* = 63; type* = 64;
+		var* = 65; procedure* = 66; begin* = 67; import* = 68;
+		module* = 69; eot = 70;
+
+	TYPE Ident* = ARRAY IdLen OF CHAR;
+
+	VAR ival-, slen-: LONGINT; (*results of Get*)
+		rval-: REAL;
+		id-: Ident; (*for identifiers*)
+		str-: ARRAY stringBufSize OF CHAR;
+		errcnt-: INTEGER;
+
+		ch: CHAR; (*last character read*)
+		errpos: LONGINT;
+		R: Texts.Reader;
+		W: Texts.Writer;
+		k: INTEGER;
+		KWX: ARRAY 10 OF INTEGER;
+		keyTab: ARRAY NKW OF
+				RECORD sym: INTEGER; id: ARRAY 12 OF CHAR END;
+
+	PROCEDURE FLT (x: INTEGER): REAL;
+	BEGIN RETURN x
+	END FLT;
+
+	PROCEDURE CopyId* (VAR ident: Ident);
+	BEGIN ident := id
+	END CopyId;
+
+	PROCEDURE Pos* (): LONGINT;
+	BEGIN RETURN SHORT(Texts.Pos(R)) - 1
+	END Pos;
+
+	PROCEDURE Mark* ((*IN*) msg: ARRAY OF CHAR);
+		VAR p: LONGINT;
+	BEGIN p := Pos();
+		IF (p > errpos) & (errcnt < 25) THEN
+			Texts.WriteLn(W); Texts.WriteString(W, "  pos "); Texts.WriteInt(W, p, 1); Texts.Write(W, " ");
+			Texts.WriteString(W, msg); Texts.Append(Oberon.Log, W.buf);
+			(* DevMarkers.Insert(R.r.Base(), p, DevMarkers.dir.NewMsg(msg)) *)
+		END ;
+		INC(errcnt); errpos := p + 4
+	END Mark;
+
+	PROCEDURE Identifier (VAR sym: INTEGER);
+		VAR i, k: INTEGER;
+	BEGIN i := 0;
+		REPEAT
+			IF i < IdLen-1 THEN id[i] := ch; INC(i) END ;
+			Texts.Read(R, ch)
+		UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "Z") & (ch < "a") OR (ch > "z");
+		id[i] := 0X;
+		IF i < 10 THEN k := KWX[i-1]; (*search for keyword*)
+			WHILE (id # keyTab[k].id) & (k < KWX[i]) DO INC(k) END ;
+			IF k < KWX[i] THEN sym := keyTab[k].sym ELSE sym := ident END
+		ELSE sym := ident
+		END
+	END Identifier;
+
+	PROCEDURE String;
+		VAR i: INTEGER;
+	BEGIN i := 0; Texts.Read(R, ch);
+		WHILE ~R.eot & (ch # 22X) DO
+			IF ch >= " " THEN
+				IF i < stringBufSize-1 THEN str[i] := ch; INC(i) ELSE Mark("string too long") END ;
+			END ;
+			Texts.Read(R, ch)
+		END ;
+		str[i] := 0X; INC(i); Texts.Read(R, ch); slen := i
+	END String;
+
+	PROCEDURE HexString;
+		VAR i, m, n: INTEGER;
+	BEGIN i := 0; Texts.Read(R, ch);
+		WHILE ~R.eot & (ch # "$") DO
+			WHILE ~R.eot & (ch <= " ") DO Texts.Read(R, ch) END ;  (*skip*)
+			IF ("0" <= ch) & (ch <= "9") THEN m := ORD(ch) - 30H
+			ELSIF ("A" <= ch) & (ch <= "F") THEN m := ORD(ch) - 37H
+			ELSE m := 0; Mark("hexdig expected")
+			END;
+			Texts.Read(R, ch);
+			IF ("0" <= ch) & (ch <= "9") THEN n := ORD(ch) - 30H
+			ELSIF ("A" <= ch) & (ch <= "F") THEN n := ORD(ch) - 37H
+			ELSE n := 0; Mark("hexdig expected")
+			END;
+			IF i < stringBufSize THEN str[i] := CHR(m*10H + n); INC(i) ELSE Mark("string too long") END;
+			Texts.Read(R, ch)
+		END;
+		Texts.Read(R, ch); slen := i (*no 0X appended!*)
+	END HexString;
+
+	PROCEDURE Ten (e: LONGINT): REAL;
+		VAR x, t: REAL;
+	BEGIN x := 1.0; t := 10.0;
+		WHILE e > 0 DO
+			IF ODD(e) THEN x := t * x END ;
+			t := t * t; e := e DIV 2
+		END ;
+		RETURN x
+	END Ten;
+
+	PROCEDURE Number (VAR sym: INTEGER);
+		CONST max = 2147483647 (*2^31 - 1*);
+		VAR i, k, e, n, s, h: LONGINT; x: REAL;
+			d: ARRAY 16 OF INTEGER;
+			negE: BOOLEAN;
+	BEGIN ival := 0; i := 0; n := 0; k := 0;
+		REPEAT
+			IF n < 16 THEN d[n] := ORD(ch)-30H; INC(n) ELSE Mark("too many digits"); n := 0 END ;
+			Texts.Read(R, ch)
+		UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "F");
+		IF (ch = "H") OR (ch = "R") OR (ch = "X") THEN (*hex*)
+			REPEAT h := d[i];
+				IF h >= 10 THEN h := h-7 END ;
+				k := k*10H + h; INC(i) (*no overflow check*)
+			UNTIL i = n;
+			IF ch = "X" THEN sym := char;
+				IF k < 100H THEN ival := k ELSE Mark("illegal value"); ival := 0 END
+			ELSIF ch = "R" THEN sym := real; rval := SYSTEM.VAL(REAL, k)
+			ELSE sym := int; ival := k
+			END ;
+			Texts.Read(R, ch)
+		ELSIF ch = "." THEN
+			Texts.Read(R, ch);
+			IF ch = "." THEN (*double dot*) ch := 7FX; (*decimal integer*)
+				REPEAT
+					IF d[i] < 10 THEN
+						IF k <= (max-d[i]) DIV 10 THEN k := k *10 + d[i] ELSE Mark("too large"); k := 0 END
+					ELSE Mark("bad integer")
+					END ;
+					INC(i)
+				UNTIL i = n;
+				sym := int; ival := k
+			ELSE (*real number*) x := 0.0; e := 0;
+				REPEAT (*integer part*) x := x * 10.0 + FLT(d[i]); INC(i) UNTIL i = n;
+				WHILE (ch >= "0") & (ch <= "9") DO (*fraction*)
+					x := x * 10.0 + FLT(ORD(ch) - 30H); DEC(e); Texts.Read(R, ch)
+				END ;
+				IF (ch = "E") OR (ch = "D") THEN (*scale factor*)
+					Texts.Read(R, ch); s := 0;
+					IF ch = "-" THEN negE := TRUE; Texts.Read(R, ch)
+					ELSE negE := FALSE;
+						IF ch = "+" THEN Texts.Read(R, ch) END
+					END ;
+					IF (ch >= "0") & (ch <= "9") THEN
+						REPEAT s := s*10 + ORD(ch)-30H; Texts.Read(R, ch)
+						UNTIL (ch < "0") OR (ch >"9");
+						IF negE THEN e := e-s ELSE e := e+s END
+					ELSE Mark("digit?")
+					END
+				END ;
+				IF e < 0 THEN
+					IF e >= -maxExp THEN x := x / Ten(-e) ELSE x := 0.0 END
+				ELSIF e > 0 THEN
+					IF e <= maxExp THEN x := Ten(e) * x ELSE x := 0.0; Mark("too large") END
+				END ;
+				sym := real; rval := x
+			END
+		ELSE (*decimal integer*)
+			REPEAT
+				IF d[i] < 10 THEN
+					IF k <= (max-d[i]) DIV 10 THEN k := k*10 + d[i] ELSE Mark("too large"); k := 0 END
+				ELSE Mark("bad integer")
+				END ;
+				INC(i)
+			UNTIL i = n;
+			sym := int; ival := k
+		END
+	END Number;
+
+	PROCEDURE comment;
+	BEGIN Texts.Read(R, ch);
+		REPEAT
+			WHILE ~R.eot & (ch # "*") DO
+				IF ch = "(" THEN Texts.Read(R, ch);
+					IF ch = "*" THEN comment END
+				ELSE Texts.Read(R, ch)
+				END
+			END ;
+			WHILE ch = "*" DO Texts.Read(R, ch) END
+		UNTIL (ch = ")") OR R.eot;
+		IF ~R.eot THEN Texts.Read(R, ch) ELSE Mark("unterminated comment") END
+	END comment;
+
+	PROCEDURE Get* (VAR sym: INTEGER);
+	BEGIN
+		REPEAT
+			WHILE ~R.eot & (ch <= " ") DO Texts.Read(R, ch) END;
+			IF R.eot THEN sym := eot
+			ELSIF ch < "A" THEN
+				IF ch < "0" THEN
+					IF ch = 22X THEN String; sym := string
+					ELSIF ch = "#" THEN Texts.Read(R, ch); sym := neq
+					ELSIF ch = "$" THEN HexString; sym := string
+					ELSIF ch = "&" THEN Texts.Read(R, ch); sym := and
+					ELSIF ch = "(" THEN Texts.Read(R, ch);
+						IF ch = "*" THEN sym := null; comment ELSE sym := lparen END
+					ELSIF ch = ")" THEN Texts.Read(R, ch); sym := rparen
+					ELSIF ch = "*" THEN Texts.Read(R, ch); sym := times
+					ELSIF ch = "+" THEN Texts.Read(R, ch); sym := plus
+					ELSIF ch = "," THEN Texts.Read(R, ch); sym := comma
+					ELSIF ch = "-" THEN Texts.Read(R, ch); sym := minus
+					ELSIF ch = "." THEN Texts.Read(R, ch);
+						IF ch = "." THEN Texts.Read(R, ch); sym := upto ELSE sym := period END
+					ELSIF ch = "/" THEN Texts.Read(R, ch); sym := rdiv
+					ELSE Texts.Read(R, ch); (* ! % ' *) sym := null
+					END
+				ELSIF ch < ":" THEN Number(sym)
+				ELSIF ch = ":" THEN Texts.Read(R, ch);
+					IF ch = "=" THEN Texts.Read(R, ch); sym := becomes ELSE sym := colon END
+				ELSIF ch = ";" THEN Texts.Read(R, ch); sym := semicolon
+				ELSIF ch = "<" THEN	Texts.Read(R, ch);
+					IF ch = "=" THEN Texts.Read(R, ch); sym := leq ELSE sym := lss END
+				ELSIF ch = "=" THEN Texts.Read(R, ch); sym := eql
+				ELSIF ch = ">" THEN Texts.Read(R, ch);
+					IF ch = "=" THEN Texts.Read(R, ch); sym := geq ELSE sym := gtr END
+				ELSE (* ? @ *) Texts.Read(R, ch); sym := null
+				END
+			ELSIF ch < "[" THEN Identifier(sym)
+			ELSIF ch < "a" THEN
+				IF ch = "[" THEN sym := lbrak
+				ELSIF ch = "]" THEN	sym := rbrak
+				ELSIF ch = "^" THEN sym := arrow
+				ELSE (* _ ` *) sym := null
+				END ;
+				Texts.Read(R, ch)
+			ELSIF ch < "{" THEN Identifier(sym) ELSE
+				IF ch = "{" THEN sym := lbrace
+				ELSIF ch = "}" THEN sym := rbrace
+				ELSIF ch = "|" THEN sym := bar
+				ELSIF ch = "~" THEN	sym := not
+				ELSIF ch = 7FX THEN	sym := upto
+				ELSE sym := null
+				END ;
+				Texts.Read(R, ch)
+			END
+		UNTIL sym # null
+	END Get;
+
+	PROCEDURE Init* (T: Texts.Text; pos: LONGINT);
+	BEGIN errpos := pos; errcnt := 0; Texts.OpenReader(R, T, pos);
+(* DevMarkers.Unmark(R.r.Base()); *)
+Texts.Read(R, ch)
+	END Init;
+
+	PROCEDURE EnterKW (sym: INTEGER; (*IN*) name: ARRAY OF CHAR);
+	BEGIN keyTab[k].id := name(*$*); keyTab[k].sym := sym; INC(k)
+	END EnterKW;
+
+BEGIN Texts.OpenWriter(W); k := 0; KWX[0] := 0; KWX[1] := 0;
+	EnterKW(if, "IF");
+	EnterKW(do, "DO");
+	EnterKW(of, "OF");
+	EnterKW(or, "OR");
+	EnterKW(to, "TO");
+	EnterKW(in, "IN");
+	EnterKW(is, "IS");
+	EnterKW(by, "BY");
+	KWX[2] := k;
+	EnterKW(end, "END");
+	EnterKW(nil, "NIL");
+	EnterKW(var, "VAR");
+	EnterKW(div, "DIV");
+	EnterKW(mod, "MOD");
+	EnterKW(for, "FOR");
+	KWX[3] := k;
+	EnterKW(else, "ELSE");
+	EnterKW(then, "THEN");
+	EnterKW(true, "TRUE");
+	EnterKW(type, "TYPE");
+	EnterKW(case, "CASE");
+	KWX[4] := k;
+	EnterKW(elsif, "ELSIF");
+	EnterKW(false, "FALSE");
+	EnterKW(array, "ARRAY");
+	EnterKW(begin, "BEGIN");
+	EnterKW(const, "CONST");
+	EnterKW(until, "UNTIL");
+	EnterKW(while, "WHILE");
+	KWX[5] := k;
+	EnterKW(record, "RECORD");
+	EnterKW(repeat, "REPEAT");
+	EnterKW(return, "RETURN");
+	EnterKW(import, "IMPORT");
+	EnterKW(module, "MODULE");
+	KWX[6] := k;
+	EnterKW(pointer, "POINTER");
+	KWX[7] := k; KWX[8] := k;
+	EnterKW(procedure, "PROCEDURE");
+	KWX[9] := k
+END O7S.