Moved the arm runtime and floating point emulation to A2 trunk.

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

source/ARM.ARMRuntime.Mod

@@ -0,0 +1,634 @@
+MODULE ARMRuntime;
+IMPORT SYSTEM, FPE64;
+
+CONST
+	B = 127; 
+	C = 800000H; 
+	E = 100H; 
+	S = LONGINT(80000000H); (* used by VFP unit emulation *)
+	MAXREAL = LONGINT(7F7FFFFFH);
+
+TYPE
+	ULONGINT = LONGINT; (* alias to make distinction between signed and unsigned more clear *)
+	UHUGEINT = HUGEINT;
+	FLOAT32 = LONGINT; (* alias to make clear that the integer actually contains a IEEE 32 bit float *)
+	FLOAT64= HUGEINT;
+
+	PROCEDURE DivS8*(left, right: SHORTINT): SHORTINT;
+	VAR result, dummy: LONGINT;
+	BEGIN	 DivModS32(left, right, result, dummy); RETURN SHORTINT(result)
+	END DivS8;
+
+	PROCEDURE DivS16*(left, right: INTEGER): INTEGER;
+	VAR result, dummy: LONGINT;
+	BEGIN	 DivModS32(left, right, result, dummy); RETURN INTEGER(result)
+	END DivS16;
+
+	PROCEDURE DivS32*(left, right: LONGINT): LONGINT;
+	VAR result, dummy: LONGINT;
+	BEGIN	 DivModS32(left, right, result, dummy); RETURN result
+	END DivS32;
+
+	PROCEDURE DivU32*(left, right: ULONGINT): ULONGINT;
+	VAR result, dummy: LONGINT;
+	BEGIN DivModU32(left, right, result, dummy); RETURN result
+	END DivU32;
+
+	PROCEDURE DivS64*(left, right: HUGEINT): HUGEINT;
+	VAR result, dummy: HUGEINT;
+	BEGIN
+		DivModS64(left, right, result, dummy); RETURN result
+	END DivS64;
+
+	PROCEDURE ModS8*(left, right: SHORTINT): SHORTINT;
+	VAR result, dummy: LONGINT;
+	BEGIN DivModS32(left, right, dummy, result); RETURN SHORTINT(result)
+	END ModS8;
+
+	PROCEDURE ModS16*(left, right: INTEGER): INTEGER;
+	VAR result, dummy: LONGINT;
+	BEGIN DivModS32(left, right, dummy, result); RETURN INTEGER(result)
+	END ModS16;
+
+	PROCEDURE ModS32*(left, right: LONGINT): LONGINT;
+	VAR result, dummy: LONGINT;
+	BEGIN DivModS32(left, right, dummy, result); RETURN result
+	END ModS32;
+
+	PROCEDURE ModU32*(left, right: ULONGINT): ULONGINT;
+	VAR result, dummy: LONGINT;
+	BEGIN DivModU32(left, right, dummy, result); RETURN result
+	END ModU32;
+
+	PROCEDURE ModS64*(left, right: HUGEINT): HUGEINT;
+	VAR result, dummy: HUGEINT;
+	BEGIN
+			DivModS64(left, right, dummy, result); RETURN result
+	END ModS64;
+
+	PROCEDURE RolS64*(source: HUGEINT; amount: ULONGINT): HUGEINT;
+	CODE
+		LDR R2, [FP, #+8] ; R2 := amount
+		LDR R3, [FP, #+12] ; R3 := source[Low]
+		LDR R4, [FP, #+16] ; R4 := source[High]
+
+		; source = R4:R3
+
+		AND R2, R2, #3FH ; R2 := R2 MOD 64
+
+		CMP R2, #32
+
+		; IF R2 < 32:
+		MOVLT R0, R3, LSL R2
+		MOVLT R1, R4, LSL R2
+		RSBLT R2, R2, #32 ; R2 := 32 - R2
+		ORRLT R0, R0, R4, LSR R2
+		ORRLT R1, R1, R3, LSR R2
+
+		; IF R2 >= 32:
+		SUBGE R2, R2, #32 ; R2 := R2 - 32
+		MOVGE R0, R4, LSL R2
+		MOVGE R1, R3, LSL R2
+		RSBGE R2, R2, #32 ; R2 := 32 - R2
+		ORRGE R0, R0, R3, LSR R2
+		ORRGE R1, R1, R4, LSR R2
+
+		; result = R1:R0
+	END RolS64;
+
+	PROCEDURE RolU64*(source: HUGEINT; amount: ULONGINT): HUGEINT;
+	BEGIN RETURN RolS64(source, amount)
+	END RolU64;
+
+	PROCEDURE RorS64*(source: HUGEINT; amount: ULONGINT): HUGEINT;
+	BEGIN RETURN RolS64(source, 64 - (amount MOD 64))
+	END RorS64;
+	
+	PROCEDURE RorU64*(source: HUGEINT; amount: ULONGINT): HUGEINT;
+	BEGIN RETURN RolS64(source, 64 - (amount MOD 64))
+	END RorU64;
+
+	(* signed division and modulus
+	- note: this implements the mathematical definition of DIV and MOD in contrast to the symmetric one
+	*)
+	PROCEDURE DivModS32(dividend, divisor: LONGINT; VAR quotient, remainder: LONGINT);
+	BEGIN
+		ASSERT(divisor > 0);
+		IF dividend >= 0 THEN
+			DivModU32(dividend, divisor, quotient, remainder)
+		ELSE
+			dividend := -dividend;
+			DivModU32(dividend, divisor, quotient, remainder);
+			quotient := -quotient;
+			IF remainder # 0 THEN
+				DEC(quotient);
+				remainder := divisor - remainder
+			END
+		END
+	END DivModS32;
+
+	(*
+		Fast 32-bit unsigned integer division/modulo (author Alexey Morozov)
+	*)
+	PROCEDURE DivModU32(dividend, divisor: ULONGINT; VAR quotient, remainder: ULONGINT);
+	CODE
+		MOV R2, #0 ; quotient will be stored in R2
+
+		LDR R0, [FP,#dividend] ; R0 := dividend
+		LDR R1, [FP,#divisor] ; R1 := divisor
+
+		; check for the case dividend < divisor
+		CMP R0, R1
+		BLT Exit ; nothing to do than setting quotient to 0 and remainder to dividend (R0)
+
+		CLZ R3, R0 ; R3 := clz(dividend)
+		CLZ R4, R1 ; R4 := clz(divisor)
+
+		SUB R3, R4, R3 ; R2 := clz(divisor) - clz(dividend) , R2 >= 0
+		LSL R1, R1, R3 ; scale divisor: divisor := LSH(divisor,clz(divisor)-clz(dividend))
+
+	Loop:
+		CMP R0, R1
+		ADC R2, R2, R2
+		SUBCS R0, R0, R1
+		LSR R1, R1, #1
+		SUBS R3, R3, #1
+		BPL Loop
+
+		; R0 holds the remainder
+
+	Exit:
+		LDR R1, [FP,#quotient] ; R1 := address of quotient
+		LDR R3, [FP,#remainder] ; R3 := address of remainder
+
+		STR R2, [R1,#0] ; quotient := R1
+		STR R0, [R3,#0] ; remainder := R0
+	END DivModU32;
+
+	(**
+		Signed 64-bit multiplication. Adapted version based on the original code
+		from "Runtime ABI for the ARM Cortex-M0" (https://github.com/bobbl/libaeabi-cortexm0/blob/master/lmul.S)
+
+		/* Runtime ABI for the ARM Cortex-M0
+		 * lmul.S: 64 bit multiplication
+		 *
+		 * Copyright (c) 2013 Jörg Mische <bobbl@gmx.de>
+		 *
+		 * Permission to use, copy, modify, and/or distribute this software for any
+		 * purpose with or without fee is hereby granted, provided that the above
+		 * copyright notice and this permission notice appear in all copies.
+		 *
+		 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+		 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+		 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+		 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+		 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+		 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+		 * OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+		 */
+
+		Multiply r1:r0 and r3:r2 and return the product in r1:r0
+		Can also be used for unsigned long product
+	*)
+	PROCEDURE MulS64*(x, y: HUGEINT): HUGEINT;
+	CODE
+		ldr r0, [FP,#x]
+		ldr r1, [FP,#x+4]
+
+		ldr r2, [FP,#y]
+		ldr r3, [FP,#y+4]
+
+		muls	r1, r1, r2
+		muls	r3, r3, r0
+		adds	r1, r1, r3
+
+		lsrs	r3, r0, #16
+		lsrs	r4, r2, #16
+		muls	r3, r3, r4
+		adds	r1, r1, r3
+
+		lsrs	r3, r0, #16
+		uxth	r0, r0
+		uxth	r2, r2
+		muls	r3, r3, r2
+		muls	r4, r4, r0
+		muls	r0, r0, r2
+
+		movs	r2, #0
+		adds	r3, r3, r4
+		adcs	r2, r2, r2
+		lsls	r2, r2, #16
+		adds	r1, r1, r2
+
+		lsls	r2, r3, #16
+		lsrs	r3, r3, #16
+		adds	r0, r0, r2
+		adcs	r1, r1, r3
+
+	END MulS64;
+
+	(* signed division and modulus
+	- note: this implements the mathematical definition of DIV and MOD in contrast to the symmetric one
+	*)
+	PROCEDURE DivModS64*(dividend, divisor: HUGEINT; VAR quotient, remainder: HUGEINT);
+	BEGIN
+		ASSERT(divisor > 0);
+		IF dividend >= 0 THEN
+			DivModU64(dividend, divisor, quotient, remainder)
+		ELSE
+			dividend := -dividend;
+			DivModU64(dividend, divisor, quotient, remainder);
+			quotient := -quotient;
+			IF remainder # 0 THEN
+				DEC(quotient);
+				remainder := divisor - remainder
+			END
+		END
+	END DivModS64;
+
+	(* Count leading zeros in a binary representation of a given 64-bit integer number *)
+	PROCEDURE Clz64*(x: UHUGEINT): LONGINT;
+	CODE
+		; high-half
+		LDR R1, [FP,#x+4]
+		CMP R1, #0 ; if high-half is zero count leading zeros of the low-half
+		BEQ LowHalf
+
+		CLZ R0, R1
+		B Exit
+
+		; low-half
+	LowHalf:
+		LDR R1, [FP,#x]
+		CLZ R0, R1
+		ADD R0, R0, #32 ; add 32 zeros from the high-half
+
+	Exit:
+	END Clz64;
+
+	(*
+		Fast 64-bit unsigned integer division/modulo (Alexey Morozov)
+	*)
+	PROCEDURE DivModU64*(dividend, divisor: UHUGEINT; VAR quotient, remainder: UHUGEINT);
+	VAR m: LONGINT;
+	BEGIN
+		quotient := 0;
+
+		IF dividend = 0 THEN remainder := 0; RETURN; END;
+		IF dividend < divisor THEN remainder := dividend; RETURN; END;
+
+		m := Clz64(divisor) - Clz64(dividend);
+		ASSERT(m >= 0);
+
+		divisor := LSH(divisor,m);
+		WHILE m >= 0 DO
+			quotient := LSH(quotient,1);
+			IF dividend >= divisor THEN
+				INC(quotient);
+				DEC(dividend,divisor);
+			END;
+			divisor := LSH(divisor,-1);
+			DEC(m);
+		END;
+
+		remainder := dividend;
+	(*
+	CODE
+
+		ldr r0, [FP,#dividend]
+		ldr r1, [FP,#dividend+4]
+
+		ldr r2, [FP,#divisor]
+		ldr r3, [FP,#divisor+4]
+
+
+
+
+		ldr r5, [FP,#quotient]
+		ldr r6, [FP,#remainder]
+
+		str r0, [r5,#0]
+		str r1, [r5,#4]
+
+		str r2, [r6,#0]
+		str r3, [r6,#4]
+	*)
+	END DivModU64;
+
+	(* ---- FLOATING POINT EMULATION ----
+	The following procedures are used in case the target platform does not feature a math coprocessor (aka VFP unit).
+	Most of the code was taken from the Minos FPU emulation module "FPU.Mos".
+
+	Note that parameters and return types are declared as integers, even though they do contain floating point values
+	according to the IEEE standard.
+	*)
+
+	(** Tests for 0.0 (+0 or -0)
+	- corresponds to SYSTEM.NULL **)
+	PROCEDURE IsZeroF32(float: FLOAT32): BOOLEAN;
+	CODE
+		LDR R0, [FP, #+float] ; R0 := float
+		BIC R0, R0, #S ; clear the sign bit
+		CMP R0, #0 ; IF R0 = 0
+		MOVEQ R0, #1 ; THEN RETURN TRUE
+		MOVNE R0, #0 ; ELSE RETURN FALSE
+	END IsZeroF32;
+
+	(** Serves to obtain the sign for products and quotients.
+	- corresponds to SYSTEM.XOR **)
+	PROCEDURE SignXorF32(left, right: FLOAT32): FLOAT32;
+	CODE
+		LDR R0, [FP, #+left] ; R0 := left
+		LDR R1, [FP, #+right] ; R1: = right
+		EOR R0, R0, R1 ; R0 := R0 xor R1
+		AND R0, R0, #S ; clear all bits except the sign bit
+	END SignXorF32;
+
+	(** multiplies two 32-bit unsigned integer to produce a 64-bit result: [resultLow | resultHigh] = left * right
+	- corresponds to SYSTEM.MULD (but the low and high part of the result are passed explicitly) **)
+	PROCEDURE MulD(VAR resultLow, resultHigh: FLOAT32; left, right: FLOAT32);
+	CODE
+		LDR R2, [FP, #+resultLow] ; R2 := address of resultLow
+		LDR R3, [FP, #+resultHigh] ; R3: = address of resultHigh
+		LDR R4, [FP, #+left] ; R4 := left
+		LDR R5, [FP, #+right] ; R5: = right
+
+		UMULL R0, R1, R4, R5
+
+		STR R0, [R4, #+0]
+		STR R1, [R5, #+0]
+	END MulD;
+
+	PROCEDURE NegF32*(float: FLOAT32): FLOAT32;
+	CODE
+		LDR R0, [FP, #+float] ; R0 := float
+		EOR R0, R0, #S ; invert only the sign bit
+	END NegF32;
+
+	PROCEDURE AbsF32*(float: FLOAT32): FLOAT32;
+	CODE
+		LDR R0, [FP, #+float] ; R0 := float
+		BIC R0, R0, #S ; clear the sign bit
+	END AbsF32;
+
+	PROCEDURE AddF32*(x, y: FLOAT32): FLOAT32;		
+	VAR xe, ye, s: LONGINT;
+	BEGIN
+		IF SYSTEM.NULL(x) = TRUE THEN x := y
+		ELSIF SYSTEM.NULL(y) = FALSE THEN
+			xe := x DIV C MOD E; (* exponent with bias *)
+			IF x >= 0 THEN x := (x MOD C + C)*2 ELSE x := -(x MOD C + C)*2 END ;
+			ye := y DIV C MOD E; (* exponent with bias *)
+			IF y >= 0 THEN y := (y MOD C + C)*2 ELSE y := -(y MOD C + C)*2 END ;
+			IF xe < ye THEN
+				ye := ye - xe; xe := xe + ye; (*denorm x*)
+				IF ye <= 25 THEN x := ASH(x, -ye) ELSE x := 0 END
+			ELSIF ye < xe THEN
+				ye := xe - ye;  (*denorm y*)
+				IF ye <= 25 THEN y := ASH(y, -ye) ELSE y := 0 END
+			END ;
+			s := x + y; x := ABS(s);
+			s := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, s)*{31});
+			IF x # 0 THEN
+				IF x >= 4*C THEN x := (x+2) DIV 4; INC(xe)
+				ELSIF x >= 2*C THEN x := (x+1) DIV 2
+				ELSE DEC(xe);
+					WHILE x < C DO x := 2*x; DEC(xe) END
+				END ;
+				IF xe < 0 THEN x := 0  (*underflow*)
+				ELSIF xe > 0FEH THEN x := MAXREAL + s; (* overflow *)
+				ELSE x := xe*C + (x - C) + s;
+				END;
+			END
+		END ;
+		RETURN x
+	END AddF32;
+	
+	PROCEDURE AddF64*(x,y: FLOAT64): FLOAT64;
+	VAR z: FLOAT64;
+	BEGIN FPE64.Add(SYSTEM.VAL(FPE64.Float64,x),SYSTEM.VAL(FPE64.Float64,y),SYSTEM.VAL(FPE64.Float64,z)); RETURN z
+	END AddF64;
+
+	PROCEDURE MulF64*(x,y: FLOAT64): FLOAT64;
+	VAR z: FLOAT64;
+	BEGIN FPE64.Mul(SYSTEM.VAL(FPE64.Float64,x),SYSTEM.VAL(FPE64.Float64,y),SYSTEM.VAL(FPE64.Float64,z)); RETURN z
+	END MulF64;
+
+	PROCEDURE DivF64*(x,y: FLOAT64): FLOAT64;
+	VAR z: FLOAT64;
+	BEGIN FPE64.Div(SYSTEM.VAL(FPE64.Float64,x),SYSTEM.VAL(FPE64.Float64,y),SYSTEM.VAL(FPE64.Float64,z)); RETURN z
+	END DivF64;
+
+	PROCEDURE SubF64*(x,y: FLOAT64): FLOAT64;
+	VAR z: FLOAT64;
+	BEGIN FPE64.Sub(SYSTEM.VAL(FPE64.Float64,x),SYSTEM.VAL(FPE64.Float64,y),SYSTEM.VAL(FPE64.Float64,z)); RETURN z
+	END SubF64;
+
+	PROCEDURE AbsF64*(x: FLOAT64): FLOAT64;
+	VAR z: FLOAT64;
+	BEGIN FPE64.Abs(SYSTEM.VAL(FPE64.Float64,x),SYSTEM.VAL(FPE64.Float64,z)); RETURN z
+	END AbsF64;
+
+	PROCEDURE NegF64*(x: FLOAT64): FLOAT64;
+	VAR z: FLOAT64;
+	BEGIN FPE64.Neg(SYSTEM.VAL(FPE64.Float64,x),SYSTEM.VAL(FPE64.Float64,z)); RETURN z
+	END NegF64;
+
+	PROCEDURE ConvS32F64*(x: FLOAT64): LONGINT;
+	BEGIN RETURN FPE64.Fix(SYSTEM.VAL(FPE64.Float64,x))
+	END ConvS32F64;
+
+	PROCEDURE ConvF32F64*(x: FLOAT64): REAL;
+	BEGIN RETURN FPE64.Single(SYSTEM.VAL(FPE64.Float64,x))
+	END ConvF32F64;
+
+	PROCEDURE ConvF64F32*(x: REAL): FLOAT64;
+	VAR z: FLOAT64;
+	BEGIN FPE64.Double(x,SYSTEM.VAL(FPE64.Float64,z)); RETURN z
+	END ConvF64F32;
+
+	PROCEDURE ConvF64S32*(x: LONGINT): FLOAT64;
+	VAR flt: FLOAT64;
+	BEGIN FPE64.Float(x, SYSTEM.VAL(FPE64.Float64,flt)); RETURN flt
+	END ConvF64S32;
+
+	PROCEDURE ConvF64S16*(x: INTEGER): FLOAT64;
+	VAR flt: FLOAT64;
+	BEGIN FPE64.Float(x, SYSTEM.VAL(FPE64.Float64,flt)); RETURN flt
+	END ConvF64S16;
+
+	PROCEDURE ConvF32S16*(x: INTEGER): REAL;
+	BEGIN
+		RETURN ConvF32S32(LONGINT(x))
+	END ConvF32S16;
+	
+	PROCEDURE ConvF32S8*(x: SHORTINT): REAL;
+	BEGIN
+		RETURN ConvF32S16(INTEGER(x))
+	END ConvF32S8;
+	
+	PROCEDURE ConvF64S8*(x: SHORTINT): FLOAT64;
+	BEGIN
+		RETURN ConvF64S16(INTEGER(x))
+	END ConvF64S8;
+
+	PROCEDURE SubF32*(left, right: FLOAT32): FLOAT32;
+	BEGIN RETURN AddF32(left, NegF32(right))
+	END SubF32;
+
+	PROCEDURE MulF32*(x, y: FLOAT32): FLOAT32;
+	VAR xe, zh, ye, s: LONGINT;  (*zh, ye in this order; ye used as zh in MULD*)
+	BEGIN
+		IF SYSTEM.NULL(y) = TRUE THEN x := 0
+		ELSIF SYSTEM.NULL(y) = FALSE THEN
+			s := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, SYSTEM.XOR(x, y))*{31});
+			xe := x DIV C MOD E; (* exponent with bias *)
+			ye := y DIV C MOD E; (* exponent with bias *)
+			x := (x MOD C + C) * 20H;
+			y := (y MOD C + C) * 20H;
+			xe := xe + ye - B; (* exponent with bias *)
+			
+			SYSTEM.MULD(ye, x, y); (* note that this implicitly changes zh *)
+			
+			IF zh >= 4*C THEN
+				x := (zh+2) DIV 4;
+				INC(xe);
+			ELSE
+				x := (zh+1) DIV 2;
+			END;
+			IF xe < 0 THEN (* underflow *)
+				x := 0;
+			ELSIF xe > 0FEH THEN (* overflow *)
+				x := MAXREAL + s;
+			ELSE
+				x := xe*C + (x-C) + s;
+			END;
+		END ;
+		RETURN x
+	END MulF32;
+	
+	PROCEDURE DivF32*(x, y: FLOAT32): FLOAT32;
+	VAR xe, ye, q, s: LONGINT;
+	BEGIN
+		s := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, SYSTEM.XOR(x, y))*{31});
+		IF SYSTEM.NULL(y) = TRUE THEN
+			x := MAXREAL + s;
+		ELSIF SYSTEM.NULL(x) = FALSE THEN
+			xe := x DIV C MOD E; (* exponent with bias *)
+			ye := y DIV C MOD E; (* exponent with bias *)
+			x := x MOD C + C;
+			y := y MOD C + C;
+			xe := xe - ye + B; (* exponent with bias *)
+			IF x < y THEN
+				x := x*2; DEC(xe);
+			END ;
+			IF xe < 0 THEN (* underflow *)
+				x := 0;
+			ELSIF xe > 0FEH THEN (* overflow *)
+				x := MAXREAL + s;
+			ELSE (* divide *)
+				q := 0;
+				WHILE q < LONGINT(1000000H) DO (* 2*C *)
+					q := 2*q;
+					IF x >= y THEN
+						x := x - y;
+						INC(q);
+					END;
+					x := 2*x;
+				END;
+				q := (q+1) DIV 2;  (*round*)
+				x := xe*C + (q-C) + s;
+			END;
+		END;
+		RETURN x
+	END DivF32;
+
+	(** converts a float into an integer, ignores the fractional part
+	- corresponds to ENTIER(x) **)
+	PROCEDURE ConvS32F32*(x: FLOAT32): LONGINT;
+	VAR xe, s: LONGINT;
+	BEGIN
+		IF SYSTEM.NULL(x) = TRUE THEN
+			x := 0
+		ELSE
+			s := x; xe := x DIV C MOD E - B; x := x MOD C + C;
+			IF s < 0 THEN x := -x END ;
+			IF xe < 24 THEN x := ASH(x, xe - 23)
+			ELSIF xe < 31 THEN x := LSH(x, xe - 23)
+			ELSIF s < 0 THEN x := LONGINT(80000000H);
+			ELSE x := LONGINT(7FFFFFFFH);
+			END;
+		END ;
+		RETURN x
+	END ConvS32F32;
+	
+	(** converts an integer into a float, ignores the non-integer part
+	- corresponds to REAL(int)
+	- note that no rounding occurs
+	**)
+	PROCEDURE ConvF32S32*(x: LONGINT): FLOAT32;
+	VAR xe, s: LONGINT;
+	BEGIN
+		IF x = LONGINT(80000000H) THEN (* ABS cannot handle the most negative LONGINT number! *)
+			x := LONGINT(0CF000000H);
+		ELSIF x # 0 THEN
+			s := x;
+			x := ABS(x); xe := 23;
+			WHILE x >= 2*C DO
+				x := x DIV 2; INC(xe);
+			END;
+			WHILE x < C DO
+				x := 2*x; DEC(xe);
+			END;
+			x := (xe + B)*C - C + x;
+			IF s < 0 THEN x := x+S END
+		END ;
+		RETURN x
+	END ConvF32S32;
+	
+	(** whether x < y
+	- note that this operation should rather be done by direct code emission of the backend
+	**)
+	PROCEDURE LessThanF32(x, y: FLOAT32): BOOLEAN;
+	BEGIN
+		HALT(200)
+	END LessThanF32;
+
+	(* ---- STRING OPERATIONS ---- *)
+
+	(** compare two strings
+	- returns 0 if both strings are lexicographically equal
+	- returns +1 if 'left' is lexicographically greater than 'right'
+	- returns -1 if 'left' is lexicographically less than 'right'
+	**)
+	PROCEDURE CompareString*(CONST left, right: ARRAY OF CHAR): SHORTINT;
+	VAR
+		result: SHORTINT;
+		i: LONGINT;
+		leftChar, rightChar: CHAR;
+	BEGIN
+		result := 0;
+		i := 0;
+		REPEAT
+			leftChar := left[i]; rightChar := right[i];
+			IF leftChar < rightChar THEN result := -1
+			ELSIF leftChar > rightChar THEN result := +1
+			END;
+			INC(i)
+		UNTIL (result # 0) OR (leftChar = 0X) OR (rightChar = 0X);
+		RETURN result
+	END CompareString;
+
+	(** copy a string from 'source' to 'destination'
+	- note that PACO semantics are used **)
+	PROCEDURE CopyString*(VAR destination: ARRAY OF CHAR; CONST source: ARRAY OF CHAR);
+	VAR
+		sourceLength, destinationLength: LONGINT;
+	BEGIN
+		destinationLength := LEN(destination);
+		sourceLength := LEN(source);
+		IF destinationLength < sourceLength THEN sourceLength := destinationLength END;
+		SYSTEM.MOVE(ADDRESSOF(source[0]), ADDRESSOF(destination[0]), sourceLength)
+	END CopyString;
+
+END ARMRuntime.

source/ARM.FPE64.Mod

@@ -0,0 +1,485 @@
+MODULE FPE64;
+
+	IMPORT SYSTEM;
+
+	CONST
+		B = 1023; M = 40000000H; C = 100000H; E = 800H; K = 400H;
+
+	TYPE
+		Float64* = RECORD
+			low*, high*: LONGINT
+		END;
+
+	PROCEDURE Addd(VAR x1, x0: LONGINT; y1, y0: LONGINT);
+	CODE
+		LDR R2, [FP, #+x1]; R2 := address of x1
+		LDR R3, [FP, #+x0]; R3 := address of x0
+		LDR R0, [FP, #+y1]; R0 := y1
+		LDR R1, [FP, #+y0]; R1 := y0
+
+		LDR R4, [R2, #+0]; R4 := value of x1
+		LDR R5, [R3, #+0]; R5 := value of x0
+		ADDS R5, R5, R1;
+		ADCS R4, R4, R0;
+		STR R5, [R3, #+0]; store new value at x0
+		STR R4, [R2, #+0]; store new value at x1
+	END Addd;
+
+	PROCEDURE Subd(VAR x1, x0: LONGINT; y1, y0: LONGINT);
+	CODE
+		LDR R2, [FP, #+x1]; R2 := address of x1
+		LDR R3, [FP, #+x0]; R3 := address of x0
+		LDR R0, [FP, #+y1]; R0 := y1
+		LDR R1, [FP, #+y0]; R1 := y0
+
+		LDR R4, [R2, #+0]; R4 := value of x1
+		LDR R5, [R3, #+0]; R5 := value of x0
+		SUBS R5, R5, R1;
+		SBCS R4, R4, R0;
+		STR R5, [R3, #+0]; store new value at x0
+		STR R4, [R2, #+0]; store new value at x1
+	END Subd;
+
+	PROCEDURE Muld(x0, y0: LONGINT; VAR z1, z0: LONGINT);
+	CODE
+		LDR R2, [FP, #+z0]; R2 := address of resultLow
+		LDR R3, [FP, #+z1]; R3: = address of resultHigh
+		LDR R4, [FP, #+x0] ; R4 := left
+		LDR R5, [FP, #+y0] ; R5: = right
+		UMULL R0, R1, R4, R5
+		STR R0, [R2, #+0]
+		STR R1, [R3, #+0]
+	END Muld;
+
+	PROCEDURE AddFloat64Sigs(CONST a, b: Float64; VAR z: Float64);	(* (a >= 0 & b >= 0) OR (a <= 0 & b <= 0) *)
+		VAR x0, x1, xe, s, y0, y1, ye: LONGINT;
+	BEGIN
+		x0 := a.low;
+		x1 := a.high;
+		y0 := b.low;
+		y1 := b.high;
+		IF ((x0 # 0) OR (x1 # 0)) & ((y0 # 0) OR (y1 # 0)) THEN
+			s := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, a.high) * {31});
+			xe := x1 DIV C MOD E; (* exponent with bias *)
+			x1 := x1 MOD C + C;
+			ye := y1 DIV C MOD E; (* exponent with bias *)
+			y1 := y1 MOD C + C;
+			IF xe < ye THEN
+				ye := ye - xe;
+				xe := xe + ye; (* exponent with bias *)
+				IF ye < 32 THEN
+					x0 := LSH(x0, -ye) + LSH(x1, 32 - ye);
+					x1 := LSH(x1, -ye)
+				ELSIF ye < 64 THEN
+					x0 := LSH(x1, 32 - ye);
+					x1 := 0
+				ELSE
+					x0 := 0;
+					x1 := 0
+				END
+			ELSIF ye < xe THEN
+				ye := xe - ye;
+				IF ye < 32 THEN
+					y0 := LSH(y0, -ye) + LSH(y1, 32 - ye);
+					y1 := LSH(y1, -ye)
+				ELSIF ye < 64 THEN
+					y0 := LSH(y1, 32 - ye);
+					y1 := 0
+				ELSE
+					y0 := 0;
+					y1 := 0
+				END
+			END;
+			Addd(x1, x0, y1, y0);
+			IF x1 >= 2*C THEN
+				x0 := x0 DIV 2 + LSH(x1, 31);
+				x1 := x1 DIV 2;
+				INC(xe)
+			END;
+			IF xe > 7FEH THEN	(* check overflow and underflow *)
+				z.high := LONGINT(7FEFFFFFH) + s;
+				z.low := -1;
+			ELSIF xe < 0 THEN
+				z.high := 0;
+				z.low := 0
+			ELSE
+				z.high := xe*C + (x1 - C) + s;
+				z.low := x0;
+			END
+		ELSIF (x0 = 0) & (x1 = 0) THEN
+			z.high := y1;
+			z.low := y0
+		ELSE
+			z.high := x1;
+			z.low := x0;
+		END;
+	END AddFloat64Sigs;
+
+	PROCEDURE SubFloat64Sigs(CONST a, b: Float64; VAR z: Float64);	(* (a >= 0 & b <= 0) OR (a <= 0 & b >= 0) *)
+		VAR x0, x1, s, y0, y1, xe, ye, z0, z1: LONGINT;
+	BEGIN
+		x0 := a.low;
+		x1 := a.high;
+		y0 := b.low;
+		y1 := b.high;
+		IF ((x0 # 0) OR (x1 # 0)) & ((y0 # 0) OR (y1 # 0)) THEN
+			s := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, a.high) * {31});
+			xe := x1 DIV C MOD E; (* exponent with bias *)
+			x1 := x1 MOD C + C;
+			ye := y1 DIV C MOD E; (* exponent with bias *)
+			y1 := y1 MOD C + C;
+			IF xe < ye THEN
+				ye := ye - xe;
+				xe := xe + ye; (* exponent with bias *)
+				IF ye < 32 THEN
+					x0 := LSH(x0, -ye) + LSH(x1, 32 - ye);
+					x1 := LSH(x1, -ye)
+				ELSIF ye < 64 THEN
+					x0 := LSH(x1, 32 - ye);
+					x1 := 0
+				ELSE
+					x0 := 0;
+					x1 := 0
+				END;
+				(* swap x and y *)
+				z0 := x0; x0 := y0; y0 := z0;
+				z1 := x1; x1 := y1; y1 := z1;
+				(* result has inversed sign of x *)
+				s := SYSTEM.XOR(s, LONGINT(80000000H))
+			ELSIF ye < xe THEN
+				ye := xe - ye;
+				IF ye < 32 THEN
+					y0 := LSH(y0, -ye) + LSH(y1, 32 - ye);
+					y1 := LSH(y1, -ye)
+				ELSIF ye < 64 THEN
+					y0 := LSH(y1, 32 - ye);
+					y1 := 0
+				ELSE
+					y0 := 0;
+					y1 := 0
+				END
+			ELSE (* xe = ye, check if x > y *)
+				IF LessThanUH(x0, x1, y0, y1) THEN (* x < y, swap x and y *)
+					z0 := x0; x0 := y0; y0 := z0;
+					z1 := x1; x1 := y1; y1 := z1;
+					(* result has inversed sign of x *)
+					s := SYSTEM.XOR(s, LONGINT(80000000H))
+				END;
+			END;
+			Subd(x1, x0, y1, y0);
+			IF (x0 # 0) OR (x1 # 0) THEN
+				WHILE x1 < C DO x1 := 2*x1 + LSH(x0, -31); x0 := x0*2; DEC(xe) END;
+				IF xe > 7FEH THEN	(* check overflow and underflow *)
+					z.high := LONGINT(7FEFFFFFH) + s;
+					z.low := -1;
+				ELSIF xe < 0 THEN
+					z.high := 0;
+					z.low := 0
+				ELSE
+					z.high := xe*C + (x1 - C) + s;
+					z.low := x0;
+				END
+			ELSE
+				z.low := 0;
+				z.high := 0;
+			END
+		ELSIF (x0 = 0) & (x1 = 0) & ((y0 # 0) OR (y1 # 0)) THEN
+			z.low := y0;
+			z.high := SYSTEM.XOR(y1, LONGINT(80000000H))	(* inverse sign *)
+		ELSE
+			z.low := x0;
+			z.high := x1
+		END
+	END SubFloat64Sigs;
+
+	PROCEDURE Neg*(CONST a: Float64; VAR z: Float64);
+	BEGIN
+		z.low := a.low;
+		z.high := SYSTEM.XOR(a.high, LONGINT(80000000H));
+	END Neg;
+
+	PROCEDURE Abs*(CONST a: Float64; VAR z: Float64);
+	BEGIN
+		z.low := a.low;
+		z.high := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, a.high)-{31});
+	END Abs;
+
+	PROCEDURE Add*(CONST a, b: Float64; VAR z: Float64);
+		VAR t: Float64;
+	BEGIN
+		IF SYSTEM.XOR(a.high, b.high) < 0 THEN
+			t.high := SYSTEM.XOR(b.high, LONGINT(80000000H));
+			t.low := b.low;
+			SubFloat64Sigs(a, t, z)
+		ELSE
+			AddFloat64Sigs(a, b, z)
+		END
+	END Add;
+
+	PROCEDURE Sub*(CONST a, b: Float64; VAR z: Float64);
+		VAR t: Float64;
+	BEGIN
+		IF SYSTEM.XOR(a.high, b.high) < 0 THEN
+			t.high := SYSTEM.XOR(b.high, LONGINT(80000000H));
+			t.low := b.low;
+			AddFloat64Sigs(a, t, z)
+		ELSE
+			SubFloat64Sigs(a, b, z)
+		END
+	END Sub;
+
+	PROCEDURE Addd0(x1, x0, y1, y0: LONGINT; VAR z1, z0: LONGINT);
+	CODE
+		LDR R2, [FP, #+z1]; R2 := address of z1
+		LDR R3, [FP, #+z0]; R3 := address of z0
+		LDR R0, [FP, #+y1]; R0 := y1
+		LDR R1, [FP, #+y0]; R1 := y0
+		LDR R4, [FP, #+x1]; R4 := x1
+		LDR R5, [FP, #+x0]; R5 := x0
+
+		ADDS R5, R5, R1;
+		ADCS R4, R4, R0;
+		STR R5, [R3, #+0]; store new value at x0
+		STR R4, [R2, #+0]; store new value at x1
+	END Addd0;
+
+	PROCEDURE Mul64To128(a1, a0, b1, b0: LONGINT; VAR z3, z2, z1, z0: LONGINT);
+		VAR more1, more2: LONGINT;
+	BEGIN
+		Muld(a0, b0, z1, z0);
+		Muld(a0, b1, z2, more2);
+		Addd0(z2, more2, 0, z1, z2, z1);
+		Muld(a1, b1, z3, more1);
+		Addd0(z3, more1, 0, z2, z3, z2);
+		Muld(a1, b0, more1, more2);
+		Addd0(more1, more2, 0, z1, more1, z1);
+		Addd0(z3, z2, 0, more1, z3, z2)
+	END Mul64To128;
+
+	PROCEDURE Mul*(CONST x, y: Float64; VAR z: Float64);
+		VAR x0, x1, xe, y0, y1, ye, s, z0, z1, z2, z3: LONGINT;
+	BEGIN
+		x0 := x.low;
+		x1 := x.high;
+		y0 := y.low;
+		y1 := y.high;
+		(* sign of result *)
+		s := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, SYSTEM.XOR(x1,y1)) * {31});
+		IF ((x0 # 0) OR (x1 # 0)) & ((y0 # 0) OR (y1 # 0)) THEN
+			xe := x1 DIV C MOD E; (* exponent with bias *)
+			x1 := x1 MOD C + C;
+			ye := y1 DIV C MOD E; (* exponent with bias *)
+			y1 := y1 MOD C + C;
+			xe := xe + ye - B; (* exponent with bias *)
+			Mul64To128(x1, x0, y1, y0, z3, z2, z1, z0);
+			IF z3 < 200H THEN
+				z3 := z3*1000H + LSH(z2, -20);
+				z2 := z2*1000H + LSH(z1, -20);
+			ELSE
+				z3 := z3*800H + LSH(z2, -21);
+				z2 := z2*800H + LSH(z1, -21);
+				INC(xe)
+			END;
+			IF xe > 7FEH THEN	(* overflow *)
+				z.high := LONGINT(7FEFFFFFH) + s;
+				z.low := -1;
+			ELSIF xe < 0 THEN (* underflow *)
+				z.high := 0;
+				z.low := 0;
+			ELSE
+				z.high := xe*C + (z3 - C) + s;
+				z.low := z2;
+			END
+		ELSE
+			z.high := 0;
+			z.low := 0;
+		END;
+	END Mul;
+
+	(* Less than unsigned LONGINT *)
+	PROCEDURE LessThanUL(CONST x, y: LONGINT): BOOLEAN;
+	BEGIN
+		RETURN (LSH(x, -1) < LSH(y, -1)) OR ((LSH(x, -1) = LSH(y, -1)) & ODD(x) & ~ODD(y));
+	END LessThanUL;
+
+	(* Less than unsigned HUGEINT *)
+	PROCEDURE LessThanUH(CONST x1, x0, y1, y0: LONGINT): BOOLEAN;
+	BEGIN
+		RETURN LessThanUL(x1, y1) OR ((x1 = y1) & LessThanUL(x0, y0));
+	END LessThanUH;
+
+	PROCEDURE LessThan*(CONST x, y: Float64): BOOLEAN;
+		VAR z: Float64;
+	BEGIN
+		Sub(x, y, z);
+		RETURN LSH(z.high, -31) # 0;
+	END LessThan;
+
+	PROCEDURE Div*(CONST x, y: Float64; VAR z: Float64);
+		VAR x0, x1, y0, y1, s, xe, ye, q1, q0: LONGINT;
+	BEGIN
+		x0 := x.low;
+		x1 := x.high;
+		y0 := y.low;
+		y1 := y.high;
+		(* sign of result *)
+		s := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, SYSTEM.XOR(x1,y1)) * {31});
+		IF (x0 = 0) & (x1 = 0) THEN
+			(* 0/y = 0 *)
+			(* 0/0, 0/inf, 0/NaN, -0/... not handled *)
+			z.high := 0;
+			z.low := 0;
+		ELSIF (y0 = 0) & (y1 = 0) THEN
+			(* inf/0, NaN/0, .../-0 not handled *)
+			z.high := LONGINT(7FEFFFFFH) + s;
+			z.low := -1;
+		ELSE
+			xe := x1 DIV C MOD E; (* exponent with bias *)
+			ye := y1 DIV C MOD E; (* exponent with bias *)
+			xe := xe - ye + B; (* exponent with bias *)
+			x1 := x1 MOD C + C;
+			y1 := y1 MOD C + C;
+			IF LessThanUH(x1, x0, y1, y0) THEN
+				(* x < y *)
+				(* x := 2x *)
+				x1 := 2*x1 + LSH(x0, -31);
+				x0 := 2*x0;
+				DEC(xe);
+			END;
+			IF xe < 0 THEN (* underflow *)
+				z.high := 0;
+				z.low := 0;
+			ELSIF xe > 7FEH THEN (* overflow *)
+				z.high := LONGINT(7FEFFFFFH) + s;
+				z.low := -1;
+			ELSE (* divide *)
+				q1 := 0;
+				q0 := 0;
+				WHILE q1 < LONGINT(200000H) DO
+					(* q := 2q *)
+					q1 := 2*q1 + LSH(q0, -31);
+					q0 := 2*q0;
+					IF ((y1 = x1) & (y0 = x0)) OR LessThanUH(y1, y0, x1, x0) THEN
+						(* y <= x *)
+						(* x := x - y *)
+						x1 := x1 - y1; (* no underflow since x1 >= y1 *)
+						IF LessThanUL(x0, y0) THEN
+							DEC(x1);
+						END;
+						x0 := x0 - y0; (* underflow is handled above *)
+						(* INC(q) *)
+						INC(q0); (* no overflow since bit0 is always 0 *)
+					END;
+					(* x := 2x *)
+					x1 := 2*x1 + LSH(x0, -31);
+					x0 := 2*x0;
+				END;
+				(** round **)
+				(* INC(q) *)
+				INC(q0);
+				IF q0 = 0 THEN (* overflow *)
+					INC(q1);
+				END;
+				(* q := q DIV 2 *)
+				q0 := LSH(q0, -1) + LSH(q1, 31);
+				q1 := LSH(q1, -1);
+				z.low := q0;
+				z.high := xe*C + (q1 - C) + s;
+			END;
+		END;
+	END Div;
+
+	PROCEDURE Float*(i: LONGINT; VAR z: Float64);
+		VAR x0, x1, xe: LONGINT;
+	BEGIN
+		x1 := i;
+		x0 := 0;
+		IF x1 # 0 THEN
+			IF x1 = LONGINT(80000000H) THEN
+				x1 := LONGINT(40000000H);
+				xe := 31+B;
+			ELSE
+				IF x1 < 0 THEN
+					x1 := -x1
+				END;
+				xe := 30+B;
+				WHILE x1 < LONGINT(40000000H) DO x1 := x1*2; DEC(xe) END;
+			END;
+			z.low := x1*400000H;
+			x1 := LSH(x1, -10);
+			z.high := xe*C + (x1-C) + SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, i) * {31});
+		ELSE
+			z.low := x0;
+			z.high := x1
+		END
+	END Float;
+
+	PROCEDURE Fix*(CONST a: Float64): LONGINT;
+		VAR x0, x1, xe: LONGINT;
+	BEGIN
+		x0 := a.low;
+		x1 := a.high;
+		IF (x0 # 0) OR (x1 # 0) THEN
+			xe := x1 DIV C MOD E - B;
+			IF x1 > 0 THEN
+				x1 := (x1 MOD C + C)*K;
+				x1 := LSH(x0, -22) + x1
+			ELSE
+				x1 := -(x1 MOD C + C)*K;
+				x1 := x1 - LSH(x0, -22)
+			END;
+			IF xe < 0 THEN x1 := ASH(x1, -31)
+			ELSIF xe <= 30 THEN x1 := ASH(x1, xe - 30)
+			ELSIF x1 > 0 THEN x1 := LONGINT(7FFFFFFFH)
+			ELSE x1 := LONGINT(80000000H)
+			END
+		END;
+		RETURN x1
+	END Fix;
+
+	PROCEDURE Single*(VAR a: Float64): REAL;
+		VAR x0, x1, s, xe, m, i: LONGINT; x: REAL;
+	BEGIN
+		x0 := a.low;
+		x1 := a.high;
+		s := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, x1) * {31});
+		xe := x1 DIV C MOD E - B + 127; (* exponent with bias *)
+		IF xe > 0FEH THEN (* overflow *)
+			i := LONGINT(7F7FFFFFH) + s;
+		ELSIF xe < 0 THEN (* underflow *)
+			i := 0;
+		ELSE
+			(* extract mantissa and compute 1 + mantissa *)
+			m := (x1 MOD C)*10H + x0 DIV 10000000H MOD 10H;
+			INC(m);
+			m := m DIV 2;
+			(* make short float value *)
+			i := xe*800000H + m + s;
+		END;
+		SYSTEM.PUT32(ADDRESSOF(x), i);
+		RETURN x
+	END Single;
+
+	PROCEDURE Double*(x: REAL; VAR z: Float64);
+		VAR i, m, xe: LONGINT;
+	BEGIN
+		SYSTEM.GET(ADDRESSOF(x), i);
+		IF i = 0 THEN
+			z.high := 0;
+			z.low := 0;
+		ELSE
+			m := i MOD 800000H;
+			xe := i DIV 800000H MOD 100H - 127 + B;
+			z.high := xe*C + LSH(m, -3) + SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, i) * {31});
+			z.low := m*20000000H;
+		END
+	END Double;
+
+END FPE64.
+
+nan = FFF8'0000'0000'0000
+inf = 7FF0'0000'0000'0000
+max = 7FEF'FFFF'FFFF'FFFF
+
+1.5 = 3FF8'0000'0000'0000
+