voc-version added

voc-O7/Makefile

@@ -1,4 +1,7 @@
-all: O7ARMv7MPCompile O7ARMv7MToolDecObj O7ARMv7MToolDecSym O7ARMv7MToolDecBin O7ARMv7MToolDecHex O7ARMv7MLinkerLink
+all: O7ARMv6MPCompile O7ARMv7MPCompile O7ARMv7MToolDecObj O7ARMv7MToolDecSym O7ARMv7MToolDecBin O7ARMv7MToolDecHex O7ARMv6MLinkerLink O7ARMv7MLinkerLink
+
+O7ARMv6MPCompile: O7ARMv6MP.o O7ARMv6MPCompile.Mod SYSTEM.h
+	voc -OC O7ARMv6MPCompile.Mod -m
 
 O7ARMv7MPCompile: O7ARMv7MP.o O7ARMv7MPCompile.Mod SYSTEM.h
 	voc -OC O7ARMv7MPCompile.Mod -m
@@ -15,6 +18,9 @@ O7ARMv7MToolDecBin: O7ARMv7MTool.o O7ARMv7MToolDecBin.Mod SYSTEM.h
 O7ARMv7MToolDecHex: O7ARMv7MTool.o O7ARMv7MToolDecHex.Mod SYSTEM.h
 	voc -OC O7ARMv7MToolDecHex.Mod -m
 
+O7ARMv6MLinkerLink: O7ARMv6MLinker.o O7ARMv6MLinkerLink.Mod SYSTEM.h
+	voc -OC O7ARMv6MLinkerLink.Mod -m
+
 O7ARMv7MLinkerLink: O7ARMv7MLinker.o O7ARMv7MLinkerLink.Mod SYSTEM.h
 	voc -OC O7ARMv7MLinkerLink.Mod -m
 
@@ -30,15 +36,24 @@ O7ARMv6M.o: O7ARMv6M.Mod SYSTEM.h
 O7ARMv7M.o: O7ARMv6M.o O7ARMv7M.Mod SYSTEM.h
 	voc -OC -c O7ARMv7M.Mod
 
+O7ARMv6MG.o: O7S.o O7B.o O7ARMv6M.o O7ARMv6MG.Mod SYSTEM.h
+	voc -OC -c O7ARMv6MG.Mod
+
 O7ARMv7MG.o: O7S.o O7B.o O7ARMv6M.o O7ARMv7M.o O7ARMv7MG.Mod SYSTEM.h
 	voc -OC -c O7ARMv7MG.Mod
 
+O7ARMv6MP.o: O7S.o O7B.o O7ARMv6MG.o O7ARMv6MP.Mod SYSTEM.h
+	voc -OC -c O7ARMv6MP.Mod
+
 O7ARMv7MP.o: O7S.o O7B.o O7ARMv7MG.o O7ARMv7MP.Mod SYSTEM.h
 	voc -OC -c O7ARMv7MP.Mod
 
 O7ARMv7MTool.o: O7B.o O7ARMv7MG.o O7ARMv7M.o O7ARMv7MTool.Mod SYSTEM.h
 	voc -OC -c O7ARMv7MTool.Mod
 
+O7ARMv6MLinker.o: O7ARMv6M.o O7ARMv6MLinker.Mod SYSTEM.h
+	voc -OC -c O7ARMv6MLinker.Mod
+
 O7ARMv7MLinker.o: O7ARMv6M.o O7ARMv7M.o O7ARMv7MLinker.Mod SYSTEM.h
 	voc -OC -c O7ARMv7MLinker.Mod
 
@@ -48,10 +63,16 @@ clean:
 		O7B.c O7B.h \
 		O7ARMv6M.c O7ARMv6M.h \
 		O7ARMv7M.c O7ARMv7M.h \
+		O7ARMv6MG.c O7ARMv6MG.h \
 		O7ARMv7MG.c O7ARMv7MG.h \
+		O7ARMv6MP.c O7ARMv6MP.h \
 		O7ARMv7MP.c O7ARMv7MP.h \
+		O7ARMv6MLinker.c O7ARMv6MLinker.h \
 		O7ARMv7MLinker.c O7ARMv7MLinker.h \
 		O7ARMv7MTool.c O7ARMv7MTool.h \
+		O7ARMv6MPCompile.c O7ARMv6MLinkerLink.c \
 		O7ARMv7MPCompile.c O7ARMv7MLinkerLink.c \
 		O7ARMv7MToolDecObj.c O7ARMv7MToolDecSym.c O7ARMv7MToolDecBin.c O7ARMv7MToolDecHex.c \
-		O7ARMv7MPCompile O7ARMv7MToolDecObj O7ARMv7MToolDecSym O7ARMv7MToolDecBin O7ARMv7MToolDecHex O7ARMv7MLinkerLink
+		O7ARMv6MPCompile O7ARMv7MPCompile \
+		O7ARMv6MLinkerLink O7ARMv7MLinkerLink \
+		O7ARMv7MToolDecObj O7ARMv7MToolDecSym O7ARMv7MToolDecBin O7ARMv7MToolDecHex

voc-O7/O7ARMv6MG.Mod

@@ -0,0 +1,2256 @@
+MODULE O7ARMv6MG; (* NW  18.4.2016 / 31.5.2019  code generator in Oberon-07 for RISC*)
+
+	(* Modified for ARMv6-M by A. V. Shiryaev, 2016.05.07, 2019.10.21 *)
+
+	(*
+http://www.inf.ethz.ch/personal/wirth/FPGA-relatedWork/RISC-Arch.pdf
+
+		ARMv6-M Architecture Reference Manual
+http://ecee.colorado.edu/ecen3000/labs/lab3/files/DDI0419C_arm_architecture_v6m_reference_manual.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:
+				long B branches: use BX
+			optimizations:
+				optimize MovIm (3-4 instr-s)
+				arrays assignment (see PO.Applications.pdf, 45):
+					use special command instead of loop
+				bits:
+					SYSTEM.BIT(adr, bit)
+					...
+				register procedures	https://github.com/aixp/ProjectOberon2013/commit/873fe7ef74a2c41592f9904ad7c3893e4a368d58
+	*)
+
+	IMPORT SYSTEM, Files, ORS := O7S, ORB := O7B, ARMv6M := O7ARMv6M;
+	(*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;
+		BYTE = CHAR;
+
+	CONST WordSize* = 4;
+
+		parblksize0Proc* = 0; parblksize0Int* = 0;
+
+		(* MT = 12; SB = 13; SP = 14; LNK = 15;	 (*dedicated registers*) *)
+
+		MT = 6; SB = 7; SP = ARMv6M.SP; LNK = ARMv6M.LR;
+
+		maxCode = 8000; 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;
+		Fad = 12; Fsb = 13; Fml = 14; Fdv = 15;
+		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
+		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;
+
+	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*)
+
+	(* encode register *)
+	PROCEDURE ER (a: INTEGER): INTEGER;
+	BEGIN
+		IF a = SB THEN RETURN 3
+		ELSIF a = 3 THEN RETURN SB
+		ELSE RETURN a
+		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
+		IF a = SB THEN RETURN 3
+		ELSIF a = 3 THEN RETURN SB
+		ELSE RETURN a
+		END
+	END DR;
+
+	PROCEDURE UpdateFlags (a: INTEGER);
+	BEGIN
+		ARMv6M.EmitCMPIm(armcode, pc, ER(a), 0)
+	END UpdateFlags;
+
+	(* emit RSBS a, a, #0 *)
+	PROCEDURE RSBS0 (a: INTEGER);
+	BEGIN
+		INCL(RM, a);
+		a := ER(a);
+		ARMv6M.EmitRSBS0(armcode, pc, a, a)
+	END RSBS0;
+
+	(* A6.7.17 *)
+	PROCEDURE IsCMPIm (c: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN c DIV 800H = 5
+	END IsCMPIm;
+
+	PROCEDURE RemoveRedundantCmp;
+	BEGIN
+		IF (pc >= 2) & ~ARMv6M.IsLThumb32(armcode[pc - 2]) & IsCMPIm(armcode[pc - 1]) THEN DEC(pc) END
+	END RemoveRedundantCmp;
+
+	(* 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 c = SP THEN
+						ARMv6M.EmitADDSPIm(armcode, pc, ER(a), 0);
+						IF S = 1 THEN UpdateFlags(a) END
+					ELSIF c = LNK THEN
+						ARMv6M.EmitPUSH(armcode, pc, {LNK});
+						ARMv6M.EmitPOP(armcode, pc, {ER(a)});
+						IF S = 1 THEN UpdateFlags(a) END
+					ELSE
+						ARMv6M.EmitMOVSR(armcode, pc, ER(a), ER(c))
+					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 a = b THEN
+					ARMv6M.EmitLSLSR(armcode, pc, ER(a), ER(c))
+				ELSIF a # c THEN
+					Put00(0, Mov, a, 0, b);
+					ARMv6M.EmitLSLSR(armcode, pc, ER(a), ER(c))
+				ELSE (* R.a := R.b <- R.a *)
+					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);
+					Put00(0, Mov, r, 0, a);
+					Put00(0, Mov, a, 0, b);
+					ARMv6M.EmitLSLSR(armcode, pc, ER(a), ER(r))
+				END
+			| Asr: (* R.a := R.b -> R.c *)
+				ASSERT(~u, 109);
+				ASSERT(~v, 110);
+				IF a = b THEN
+					ARMv6M.EmitASRSR(armcode, pc, ER(a), ER(c))
+				ELSIF a # c THEN
+					Put00(0, Mov, a, 0, b);
+					ARMv6M.EmitASRSR(armcode, pc, ER(a), ER(c))
+				ELSE (* R.a := R.b -> R.a *)
+					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);
+					Put00(0, Mov, r, 0, a);
+					Put00(0, Mov, a, 0, b);
+					ARMv6M.EmitASRSR(armcode, pc, ER(a), ER(r))
+				END
+			| Ror: (* R.a := R.b rot R.c *)
+				ASSERT(~u, 114);
+				ASSERT(~v, 115);
+				IF a = b THEN
+					ARMv6M.EmitRORSR(armcode, pc, ER(a), ER(c))
+				ELSIF a # c THEN
+					Put00(0, Mov, a, 0, b);
+					ARMv6M.EmitRORSR(armcode, pc, ER(a), ER(c))
+				ELSE (* R.a := R.b rot R.a *)
+					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);
+					Put00(0, Mov, r, 0, a);
+					Put00(0, Mov, a, 0, b);
+					ARMv6M.EmitRORSR(armcode, pc, ER(a), ER(r))
+				END
+			| And: (* R.a := R.b & R.c *)
+				ASSERT(~u, 119);
+				ASSERT(~v, 120);
+				IF a = b THEN
+					ARMv6M.EmitANDSR(armcode, pc, ER(a), ER(c))
+				ELSIF a = c THEN
+					ARMv6M.EmitANDSR(armcode, pc, ER(a), ER(b))
+				ELSIF b = c THEN HALT(1) (* R.a := R.b *)
+				ELSE
+					Put00(0, Mov, a, 0, b);
+					ARMv6M.EmitANDSR(armcode, pc, ER(a), ER(c))
+				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 a = b THEN (* R.a := R.a & ~R.c *)
+					ARMv6M.EmitBICSR(armcode, pc, ER(a), ER(c))
+				ELSIF a # c THEN
+					Put00(0, Mov, a, 0, b);
+					ARMv6M.EmitBICSR(armcode, pc, ER(a), ER(c))
+				ELSE (* R.a := R.b & ~R.a *)
+					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);
+					Put00(0, Mov, r, 0, a);
+					Put00(0, Mov, a, 0, b);
+					ARMv6M.EmitBICSR(armcode, pc, ER(a), ER(r))
+				END
+			| Ior: (* R.a := R.b or R.c *)
+				ASSERT(~u, 104);
+				ASSERT(~v, 105);
+				IF a = b THEN
+					ARMv6M.EmitORRSR(armcode, pc, ER(a), ER(c))
+				ELSIF a = c THEN
+					ARMv6M.EmitORRSR(armcode, pc, ER(a), ER(b))
+				ELSIF b = c THEN HALT(1) (* R.a := R.b *)
+				ELSE
+					Put00(0, Mov, a, 0, b);
+					ARMv6M.EmitORRSR(armcode, pc, ER(a), ER(c))
+				END
+			| Xor: (* R.a := R.b xor R.c *)
+				ASSERT(~u, 109);
+				ASSERT(~v, 110);
+				IF a = b THEN
+					ARMv6M.EmitEORSR(armcode, pc, ER(a), ER(c))
+				ELSIF a = c THEN
+					ARMv6M.EmitEORSR(armcode, pc, ER(a), ER(b))
+				ELSIF b = c THEN HALT(1)
+				ELSE
+					Put00(0, Mov, a, 0, b);
+					ARMv6M.EmitEORSR(armcode, pc, ER(a), ER(c))
+				END
+			| Add: (* R.a := R.b + R.c *)
+				ASSERT(~v, 114);
+				IF ~u THEN
+					IF b = SP THEN
+						ARMv6M.EmitADDSPR(armcode, pc, ER(a), ER(c));
+						IF S = 1 THEN UpdateFlags(a) END
+					ELSIF c = SP THEN
+						ARMv6M.EmitADDSPR(armcode, pc, ER(a), ER(b));
+						IF S = 1 THEN UpdateFlags(a) END
+					ELSIF (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 a = b THEN
+						ARMv6M.EmitADDR(armcode, pc, ER(a), ER(c));
+						IF S = 1 THEN UpdateFlags(a) END
+					ELSIF a = c THEN
+						ARMv6M.EmitADDR(armcode, pc, ER(a), ER(b));
+						IF S = 1 THEN UpdateFlags(a) END
+					ELSE HALT(126)
+					END
+				ELSE (* with carry *)
+					IF a = b THEN
+						ARMv6M.EmitADCSR(armcode, pc, ER(a), ER(c))
+					ELSIF a = c THEN
+						ARMv6M.EmitADCSR(armcode, pc, ER(a), ER(b))
+					ELSE HALT(126)
+					END
+				END
+			| Sub: (* R.a := R.b - R.c *)
+				ASSERT(~v, 119);
+				IF ~u THEN
+					ARMv6M.EmitSUBSR(armcode, pc, ER(a), ER(b), ER(c))
+				ELSE (* with carry *)
+					ASSERT(a = b, 120);
+					ARMv6M.EmitSBCSR(armcode, pc, ER(a), ER(c))
+				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;
+					ASSERT(a = b, 126);
+					ARMv6M.EmitMULSR(armcode, pc, ER(a), ER(c))
+				ELSE
+					HALT(126)
+				END
+			| Div: (* R.a := R.b div R.c *)
+				ASSERT(~u, 103);
+				ASSERT(~v, 104);
+				ORS.Mark("not implemented")
+			| Fad,Fsb,Fml,Fdv:
+				ASSERT(~u, 108);
+				ASSERT(~v, 109);
+				ORS.Mark("not implemented")
+			END
+
+		END
+	END Put00;
+
+	PROCEDURE Put0 (op, a, b, c: INTEGER);
+	BEGIN
+		Put00(1, op, a, b, c)
+	END Put0;
+
+	(* R.a := im *)
+	(* NOTE: ARMv6MLinker.MovIm0 *)
+	PROCEDURE MovIm (S: INTEGER; a: INTEGER; im: INTEGER);
+		VAR shift: INTEGER;
+	BEGIN
+		ASSERT(S IN {0,1}, 20);
+		ASSERT(a IN {0..14}, 21);
+
+		INCL(RM, a);
+
+		IF a # SP THEN
+			shift := 0;
+			WHILE (shift < 32) & ~(
+				(SYSTEM.LSH(im, -shift) DIV 100H = 0)
+				& (im = SYSTEM.LSH(SYSTEM.LSH(im, -shift), shift))
+			) DO INC(shift)
+			END;
+			IF shift < 32 THEN
+				ARMv6M.EmitMOVSIm(armcode, pc, ER(a), SYSTEM.LSH(im, -shift));
+				IF shift # 0 THEN
+					ARMv6M.EmitLSLSIm(armcode, pc, ER(a), ER(a), shift)
+				END
+			ELSIF (im > 255) & (im <= 255 + 255) THEN
+				ARMv6M.EmitMOVSIm(armcode, pc, ER(a), 255);
+				ARMv6M.EmitADDSIm(armcode, pc, ER(a), ER(a), im - 255)
+			ELSIF (im >= -255) & (im < 0) THEN
+				ARMv6M.EmitMOVSIm(armcode, pc, ER(a), 0);
+				ARMv6M.EmitSUBSIm(armcode, pc, ER(a), ER(a), -im)
+			ELSE
+				shift := 8;
+				WHILE (shift < 32) & (SYSTEM.ROT(im DIV 100H * 100H, -shift) DIV 100H # 0) DO INC(shift) END;
+				IF 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) *)
+					ARMv6M.EmitMOVSIm(armcode, pc, ER(a),
+						im DIV 1000000H MOD 100H);
+					IF im DIV 1000000H MOD 100H # 0 THEN
+						ARMv6M.EmitLSLSIm(armcode, pc, ER(a), ER(a), 8)
+					END;
+					IF im DIV 10000H MOD 100H # 0 THEN
+						ARMv6M.EmitADDSIm(armcode, pc, ER(a), ER(a),
+							im DIV 10000H MOD 100H)
+					END;
+					ARMv6M.EmitLSLSIm(armcode, pc, ER(a), ER(a), 8);
+					IF im DIV 100H MOD 100H # 0 THEN
+						ARMv6M.EmitADDSIm(armcode, pc, ER(a), ER(a),
+							im DIV 100H MOD 100H)
+					END;
+					ARMv6M.EmitLSLSIm(armcode, pc, ER(a), ER(a), 8);
+					IF im MOD 100H # 0 THEN
+						ARMv6M.EmitADDSIm(armcode, pc, ER(a), ER(a), im MOD 100H)
+					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;
+			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
+					CASE op OF Lsl: (* R.a := R.b <- im *)
+						ARMv6M.EmitLSLSIm(armcode, pc, ER(a), ER(b), im)
+					| Asr: (* R.a := R.b -> im *)
+						ARMv6M.EmitASRSIm(armcode, pc, ER(a), ER(b), im)
+					| Ror: (* R.a := R.b rot im *)
+						IF a = b THEN
+							r := RH;
+							IF (a < MT) & (r <= a) THEN r := a + 1 END;
+							ASSERT(r < MT, 101);
+							MovIm(0, r, im);
+							Put00(S, op, a, b, r)
+						ELSE
+							MovIm(0, a, im);
+							Put00(S, op, a, b, a)
+						END
+					END
+				END
+			ELSIF op = Mov THEN
+				MovIm(S, a, im)
+			ELSE
+				CASE op OF And: (* R.a := R.b & im *)
+					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
+				| Ior: (* R.a := R.b or im *)
+					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
+				| Xor: (* R.a := R.b xor im *)
+					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
+				| Add: (* R.a := R.b + im *)
+					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) THEN
+						ARMv6M.EmitADDSPIm(armcode, pc, ER(a), im DIV 4);
+						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 *)
+					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) THEN
+						ARMv6M.EmitSUBSPIm(armcode, pc, im DIV 4);
+						IF S = 1 THEN UpdateFlags(a) END
+					ELSIF (b = LNK) & (a # b) THEN
+						Put00(0, Mov, a, 0, b);
+						Put10(S, Sub, a, a, im)
+					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
+				| Fad,Fsb,Fml,Fdv:
+					IF a = b THEN
+						r := RH; IF (a < MT) & (r <= a) THEN r := a + 1 END;
+						ASSERT(r < MT, 114);
+						MovIm(0, r, im); (* TODO: optimize: move to coprocessor register... *)
+						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(a DIV 10H = 0, 21);
+			ASSERT(b DIV 10H = 0, 22);
+
+			ASSERT(off >= 0, 23);
+			ASSERT(off < 100000H, 24);
+
+			v := ODD(op); IF v THEN DEC(op) END;
+
+			RemoveRedundantCmp;
+
+			IF op = Ldr THEN (* R.a := Mem[R.b + off] *)
+				INCL(RM, a);
+				IF ~v THEN (* load word *)
+					ASSERT(off MOD 4 = 0, 100);
+					IF (b = SP) OR (off DIV 4 DIV 32 = 0) THEN
+						ARMv6M.EmitLDRIm(armcode, pc, ER(a), ER(b), off DIV 4)
+					ELSIF a # b THEN
+						MovIm(0, a, off);
+						ARMv6M.EmitLDRR(armcode, pc, ER(a), ER(b), ER(a))
+					ELSE
+						r := RH;
+						IF (a < MT) & (r <= a) THEN r := a + 1 END;
+						ASSERT(r < MT, 101);
+						MovIm(0, r, off);
+						ARMv6M.EmitLDRR(armcode, pc, ER(a), ER(b), ER(r))
+					END
+				ELSE (* load byte *)
+					IF b # SP THEN
+						IF off DIV 32 = 0 THEN
+							ARMv6M.EmitLDRBIm(armcode, pc, ER(a), ER(b), off)
+						ELSIF a # b THEN
+							MovIm(0, a, off);
+							ARMv6M.EmitLDRBR(armcode, pc, ER(a), ER(b), ER(a))
+						ELSE
+							r := RH;
+							IF (a < MT) & (r <= a) THEN r := a + 1 END;
+							ASSERT(r < MT, 101);
+							MovIm(0, r, off);
+							ARMv6M.EmitLDRBR(armcode, pc, ER(a), ER(b), ER(r))
+						END
+					ELSE
+						r := RH;
+						IF (a < MT) & (r <= a) THEN r := a + 1 END;
+						ASSERT(r < MT, 101);
+						Put00(0, Mov, r, 0, b);
+						ARMv6M.EmitLDRBIm(armcode, pc, ER(a), ER(r), off)
+					END
+				END;
+				IF S = 1 THEN UpdateFlags(a) END
+			ELSIF op = Str THEN (* Mem[R.b + off] := R.a *)
+				IF ~v THEN (* store word *)
+					ASSERT(off MOD 4 = 0, 102);
+					IF (b = SP) OR (off DIV 4 DIV 32 = 0) THEN
+						ARMv6M.EmitSTRIm(armcode, pc, ER(a), ER(b), off DIV 4)
+					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);
+						MovIm(0, r, off);
+						ARMv6M.EmitSTRR(armcode, pc, ER(a), ER(b), ER(r))
+					END
+				ELSE (* store byte *)
+					IF b # SP THEN
+						IF off DIV 32 = 0 THEN
+							ARMv6M.EmitSTRBIm(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);
+							MovIm(0, r, off);
+							ARMv6M.EmitSTRBR(armcode, pc, ER(a), ER(b), ER(r))
+						END
+					ELSE
+						r := RH;
+						IF (a < MT) & (r <= a) THEN r := a + 1 END;
+						ASSERT(r < MT, 103);
+						Put00(0, Mov, r, 0, b);
+						ARMv6M.EmitSTRBIm(armcode, pc, ER(a), ER(r), off)
+					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
+						ORS.Mark("unconditional branch is too long")
+					END
+				ELSIF cond = 15 THEN
+					ARMv6M.EmitNOP(armcode, pc)
+				ELSE
+					IF (off >= -128) & (off <= 127) THEN
+						ARMv6M.EmitBC(armcode, pc, CondRISCToARM(cond), off)
+					ELSE
+						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
+		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 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 *)
+
+	(* 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*)
+			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)
+		END Put3orig;
+
+	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
+		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);
+						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 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;
+	BEGIN
+		res := ~ARMv6M.IsLThumb32(armcode[pc - 2]) & IsCMPIm(armcode[pc - 1]);
+		ASSERT(~res OR (armcode[pc - 1] DIV 100H MOD 8 = ER(r)), 100);
+		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*)
+				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;
+				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); 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)
+			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;
+
+	(*
+http://www.inf.ethz.ch/personal/wirth/Oberon/Oberon.ARM.Compiler.pdf
+			p. 14
+	*)
+	PROCEDURE Div0 (Rx, Ry, Rq, Rr: INTEGER);
+		VAR Ri, Rtmp, pc0, pc1: INTEGER;
+	BEGIN
+		(* q := ABS(x) *)
+			Put00(1, Mov, Rq, 0, Rx);
+			pc0 := pc; Put3orig(BC, GE, 0);
+				RSBS0(Rq);
+			fix(pc0, pc - pc0 - 1);
+
+		Put10(0, Mov, Rr, 0, 0);
+		incR; Ri := RH-1; Rtmp := RH;
+			Put10(0, Mov, Ri, 0, 32);
+			(* REPEAT *) pc0 := pc;
+				(* rq := rq * 2 *)
+					Put00(1, Add, Rq, Rq, Rq);
+					Put00(0, Add+U, Rr, Rr, Rr);
+				(* IF r >= y *)
+					Put00(1, Sub, Rtmp, Rr, Ry);
+					pc1 := pc; Put3orig(BC, LT, 0);
+				(* THEN *)
+						Put00(0, Mov, Rr, 0, Rtmp);
+						Put10(0, Add, Rq, Rq, 1);
+				(* END *) fix(pc1, pc - pc1 - 1);
+				(* DEC(i) *)
+					Put10(1, Sub, Ri, Ri, 1);
+			(* UNTIL i = 0 *)
+				Put3orig(BC, NE, pc0 - pc - 1);
+		DEC(RH);
+
+		(* IF x < 0 *)
+			Put1(Cmp, Rx, Rx, 0);
+			pc0 := pc; Put3orig(BC, GE, 0);
+		(* THEN *)
+				(* q := -q *)
+					RSBS0(Rq);
+				(* IF r # 0 *)
+					Put1(Cmp, Rr, Rr, 0);
+					pc1 := pc; Put3orig(BC, EQ, 0);
+				(* THEN *)
+						Put10(0, Sub, Rq, Rq, 1);
+						Put00(0, Sub, Rr, Ry, Rr);
+				(* END *) fix(pc1, pc - pc1 - 1);
+		(* END *) fix(pc0, pc - pc0 - 1);
+	END Div0;
+
+	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)
+					*)
+					incR; incR; incR;
+						Put10(0, Mov, RH-3, 0, y.a); Div0(x.r, RH-3, RH-2, RH-1);
+						Put0(Mov, x.r, 0, RH-2);
+					DEC(RH, 3)
+				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);
+				*)
+				incR; incR; Div0(x.r, y.r, RH-2, RH-1); DEC(RH, 2);
+				Put0(Mov, RH-2, 0, RH-2+2);
+				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; incR;
+						Put10(0, Mov, RH-3, 0, y.a); Div0(x.r, RH-3, RH-2, RH-1);
+						Put0(Mov, x.r, 0, RH-1);
+					DEC(RH, 3)
+				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; incR; Div0(x.r, y.r, RH-2, RH-1); DEC(RH, 2);
+				Put0(Mov, RH-2, 0, RH-1+2);
+				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
+	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 IsCmp00 (r: INTEGER): BOOLEAN;
+	BEGIN
+		RETURN ~ARMv6M.IsLThumb32(armcode[pc - 2]) & IsCMPIm(armcode[pc - 1])  & (armcode[pc - 1] DIV 100H MOD 8 = ER(r))
+	END IsCmp00;
+
+	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);
+			IF (y.a # 0) (* OR ~(op IN {ORS.eql, ORS.neq}) *) OR ~IsCmp00(x.r) THEN
+				IF IsCmp00(x.r) THEN DEC(pc) END;
+				Put1a(Cmp, x.r, x.r, y.a)
+			(* ELSE HALT(1) *)
+			END;
+			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 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 RealRelation*(op: INTEGER; VAR x, y: Item); (* x := x < y *)
+	BEGIN
+		IF (y.mode = ORB.Const) & (y.a = 0) THEN
+			load(x); Put1a(Cmp, x.r, x.r, y.a);
+			DEC(RH)
+		ELSE load0(0, x); load0(0, y); Put0(Fsb, x.r, x.r, y.r); 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 GetSB(x.r);
+				IF x.r # 0 THEN
+					Put2orig(op, ER(y.r), ER(SB), x.a)
+				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)
+	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 Put2(Str, r0, SP, (r-r0-1)*4); 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); Put20(0, Ldr, r0, SP, (r-r0-1)*4) 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 ;
+		r := RH;
+		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);
+					armcode[pc] := 00FFFFFFH; INC(pc);
+					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*)
+			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; *)
+			ARMv6M.EmitPUSH(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 *)
+					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) 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;
+			ARMv6M.EmitPOP(armcode, pc, ERs(RM) * {4..7} - {ER(MT)} + {ARMv6M.PC});
+			pc0 := pc; pc := enterPushFixup;
+			ARMv6M.EmitPUSH(armcode, pc, ERs(RM) * {4..7} - {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)
+		ELSE load0(0, x);
+			IF x.type.form = ORB.Real THEN Put10(0, Lsl, x.r, x.r, 1); Put1(Ror, x.r, x.r, 1)
+			ELSE
+				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
+	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;
+
+	PROCEDURE Floor*(VAR x: Item);
+	BEGIN load0(0, x); Put10(0, Mov+U, RH, 0, 4B00H); Put0(Fad+V, x.r, x.r, RH)
+	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)
+	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; 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, ".a6m"); (*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 O7ARMv6MG.

voc-O7/O7ARMv6MLinker.Mod

@@ -0,0 +1,1205 @@
+MODULE O7ARMv6MLinker;
+
+	(* Link and load on RISC; NW 20.10.2013 / 8.1.2019 *)
+
+	(* ARMv6-M: Alexander Shiryaev, 2014.10, 2015.01, 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;
+
+	TYPE
+		LONGINT = INTEGER;
+		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] := "6";
+		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;
+
+	(* 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 *)
+			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 *)
+
+					IF mno = 0 THEN (* global *)
+						i := adr DIV 4;
+						ARMv6M.EmitLDRIm(flash, i, a, MT, mod.num)
+					ELSE (* import *)
+						impmod := mod.imports[mno-1]; v := impmod.num;
+						i := adr DIV 4; ARMv6M.EmitLDRIm(flash, i, a, MT, v);
+
+						inst := flash[adr DIV 4 + 1];
+						vno := inst MOD 100H;
+						a := inst DIV 1000000H MOD 10H;
+						b := inst DIV 100000H MOD 10H; ASSERT(b = SB, 100);
+						CASE inst DIV 10000000H MOD 10H OF 4:
+							IF inst DIV 10000H MOD 10H = 8 (* Add *) THEN
+								ASSERT(flash[adr DIV 4 + 2] = 00FFFFFFH, 101);
+								op := 2
+							ELSE HALT(1)
+							END
+						| 8: (* Ldr *) op := 0
+						| 9: (* LdrB *) op := 1
+						| 10: (* Str *) op := 3
+						| 11: (* StrB *) 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 + 1;
+						CASE op OF 0: ASSERT(offset MOD 4 = 0, 126);
+							ARMv6M.EmitLDRIm(flash, i, a, b, offset DIV 4)
+						| 1: ARMv6M.EmitLDRBIm(flash, i, a, b, offset)
+						| 2: ASSERT(a # b, 102);
+							(* emit 2 instructions *)
+							IF offset DIV 8 = 0 THEN
+								ARMv6M.EmitADDSIm(flash, i, a, b, offset);
+								ARMv6M.EmitNOP(flash, i)
+							ELSIF offset DIV 100H = 0 THEN
+								ARMv6M.EmitMOVSR(flash, i, a, b);
+								ARMv6M.EmitADDSIm(flash, i, a, a, offset)
+							ELSIF offset <= 255 + 7 THEN
+								ARMv6M.EmitADDSIm(flash, i, a, b, 7);
+								ARMv6M.EmitADDSIm(flash, i, a, a, offset - 7)
+							ELSE HALT(1)
+								(* fixup failed: offset is too big
+									(implementation limit) *)
+							END
+						| 3: ASSERT(offset MOD 4 = 0, 126);
+							ARMv6M.EmitSTRIm(flash, i, a, b, offset DIV 4)
+						| 4: ARMv6M.EmitSTRBIm(flash, i, a, b, offset)
+						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 ARMv6MG.MovIm *)
+	PROCEDURE MovIm0 (VAR code: ARRAY OF INTEGER; VAR pc: INTEGER; a: INTEGER; im: INTEGER);
+		VAR shift: INTEGER;
+	BEGIN
+		ASSERT(a IN {0..14}, 21);
+
+		shift := 0;
+		WHILE (shift < 32) & ~(
+			(SYSTEM.LSH(im, -shift) DIV 100H = 0)
+			& (im = SYSTEM.LSH(SYSTEM.LSH(im, -shift), shift))
+		) DO INC(shift)
+		END;
+		IF shift < 32 THEN
+			ARMv6M.EmitMOVSIm(code, pc, a, SYSTEM.LSH(im, -shift));
+			IF shift # 0 THEN
+				ARMv6M.EmitLSLSIm(code, pc, a, a, shift)
+			END
+		ELSIF (im > 255) & (im <= 255 + 255) THEN
+			ARMv6M.EmitMOVSIm(code, pc, a, 255);
+			ARMv6M.EmitADDSIm(code, pc, a, a, im - 255)
+		ELSIF (im >= -255) & (im < 0) THEN
+			ARMv6M.EmitMOVSIm(code, pc, a, 0);
+			ARMv6M.EmitSUBSIm(code, pc, a, a, -im)
+		ELSE
+			shift := 8;
+			WHILE (shift < 32) & (SYSTEM.ROT(im DIV 100H * 100H, -shift) DIV 100H # 0) DO INC(shift) END;
+			IF 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) *)
+				ARMv6M.EmitMOVSIm(code, pc, a, im DIV 1000000H MOD 100H);
+				IF im DIV 1000000H MOD 100H # 0 THEN
+					ARMv6M.EmitLSLSIm(code, pc, a, a, 8)
+				END;
+				IF im DIV 10000H MOD 100H # 0 THEN
+					ARMv6M.EmitADDSIm(code, pc, a, a, im DIV 10000H MOD 100H)
+				END;
+				ARMv6M.EmitLSLSIm(code, pc, a, a, 8);
+				IF im DIV 100H MOD 100H # 0 THEN
+					ARMv6M.EmitADDSIm(code, pc, a, a, im DIV 100H MOD 100H)
+				END;
+				ARMv6M.EmitLSLSIm(code, pc, a, a, 8);
+				IF im MOD 100H # 0 THEN
+					ARMv6M.EmitADDSIm(code, pc, a, a, im MOD 100H)
+				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
+		ARMv6M.EmitSTRIm(code, pc, t, n, im)
+	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
+		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, "OARMv6MLinker 11.1.2017");
+	Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
+
+	targets := NIL;
+
+	EnterNXP("LPC1114FBD48302", 32 (* Cortex-M0 *),
+		8000H (* 32 KiB *), 2000H (* 8 KiB *), 32);
+	EnterNXP("LPC1115", 32 (* Cortex-M0 *),
+		10000H (* 64 KiB *), 2000H (* 8 KiB *), 32);
+
+	(* 4 KiB of SRAM *)
+		EnterSTM("STM32F030", "CK", "6", 32, 200H, 1000H);
+		EnterSTM("STM32F030", "F", "4", 32, 200H, 1000H);
+		EnterSTM("STM32F031", "CFGK", "46", 32, 200H, 1000H);
+		EnterSTM("STM32F031", "E", "6", 32, 200H, 1000H);
+		EnterSTM("STM32F038", "CEFGK", "6", 32, 200H, 1000H);
+
+	(* 6 KiB of SRAM *)
+		EnterSTM("STM32F042", "CFGK", "46", 32, 200H, 1800H);
+		EnterSTM("STM32F042", "T", "6", 32, 200H, 1800H);
+		EnterSTM("STM32F048", "CGT", "6", 32, 200H, 1800H);
+		EnterSTM("STM32F070", "CF", "6", 32, 200H, 1800H);
+
+	(* 8 KiB of SRAM *)
+		EnterSTM("STM32F030", "CR", "8", 32, 200H, 2000H);
+		EnterSTM("STM32F051", "CKR", "468", 32, 200H, 2000H);
+		EnterSTM("STM32F051", "T", "8", 32, 200H, 2000H);
+		EnterSTM("STM32F058", "CRT", "8", 32, 200H, 2000H);
+
+	(* 16 KiB of SRAM *)
+		EnterSTM("STM32F070", "CR", "B", 32, 200H, 4000H);
+		EnterSTM("STM32F071", "CRV", "B", 32, 200H, 4000H);
+		EnterSTM("STM32F071", "V", "8", 32, 200H, 4000H);
+		EnterSTM("STM32F072", "CRV", "8B", 32, 200H, 4000H);
+		EnterSTM("STM32F078", "CRV", "B", 32, 200H, 4000H);
+
+	(* 32 KiB of SRAM *)
+		EnterSTM("STM32F030", "CR", "C", 32, 200H, 8000H);
+		EnterSTM("STM32F091", "CRV", "BC", 32, 200H, 8000H);
+		EnterSTM("STM32F098", "CRV", "C", 32, 200H, 8000H);
+
+	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 O7ARMv6MLinker.

voc-O7/O7ARMv6MLinkerLink.Mod

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

voc-O7/O7ARMv6MP.Mod

@@ -0,0 +1,1013 @@
+MODULE O7ARMv6MP; (*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 := O7ARMv6MG, Texts (*:= O7Texts*), Oberon (*:= O7Oberon*);
+
+	(*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;
+		BYTE = CHAR;
+
+	TYPE PtrBase = POINTER TO PtrBaseDesc;
+		PtrBaseDesc = RECORD	(*list of names of pointer base types*)
+			name: ORS.Ident; type: ORB.Type; next: PtrBase
+		END;
+
+	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 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;
+
+BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "Oberon -> ARMv6-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 O7ARMv6MP.

voc-O7/O7ARMv6MPCompile.Mod

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

voc-O7/O7ARMv7MLinker.Mod

@@ -818,7 +818,7 @@ MODULE O7ARMv7MLinker;
 			mod: Module;
 			d: INTEGER;
 	BEGIN
-		(*Oberon.GetPar;*) Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
+		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
@@ -913,7 +913,7 @@ MODULE O7ARMv7MLinker;
 				END
 			END;
 
-			Texts.Append(Oberon.Log(**), W.buf)
+			Texts.Append(Oberon.Log, W.buf)
 		END;
 		(*Oberon.Collect(0)*)
 	END Link;
@@ -1054,7 +1054,7 @@ MODULE O7ARMv7MLinker;
 	END EnterSAM;
 
 BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "OARMv7MLinker 11.1.2017");
-	Texts.WriteLn(W); Texts.Append(Oberon.Log(**), W.buf);
+	Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
 
 	targets := NIL;
 

voc-O7/O7ARMv7MP.Mod

@@ -1003,7 +1003,7 @@ MODULE O7ARMv7MP; (*N. Wirth 1.7.97 / 8.2.2020	Oberon compiler for RISC in Obero
 				IF (T.len # 0) & (ORS.errcnt = 0) THEN Texts.Scan(S) ELSE S.class := 0 END
 			END
 		END;
-		(* Oberon.Collect(0) *)
+		(*Oberon.Collect(0)*)
 	END Compile;
 
 BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "Oberon -> ARMv7-M Compiler  8.2.2020");