removed files moved to the source trunk

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

ARM/ARM.A2/ARM.Initializer.Mod

@@ -1,201 +0,0 @@
-MODULE Initializer;
-(**
-	AUTHOR "Timothée Martiel";
-	PURPOSE "Processor initialization code for ARM kernel";
-
-	This module provides initialization for CPUs. It contains the initial procedure that begins the execution of
-	the kernel. It also provides a mechanism for starting secondary processors: all processors should start executing
-	at the beginning of the kernel image (i.e. Init): only CPU with id 0 will continue and start the kernel. The other
-	processors will be sleeping in Init, waiting to be started later.
-*)
-IMPORT SYSTEM (* Needed to avoid Runtime importing Heaps *);
-VAR
-	(**
-		Wakeup address for secondary processors: if set # 0, the CPU with id matching "secondaryProcId" will jump to
-		that address.
-	*)
-	secondaryBootProc *: ADDRESS;
-	(**
-		Wakup id for secondary processors: when executing SEV, all CPUs wakup. Only the CPU with id matching this field
-		will read and jump to "secondaryBootProc".
-	*)
-	secondaryProcId *: LONGINT;
-
-	(** Configuration string base address *)
-	configBase *: ADDRESS;
-	(** Configuration string size *)
-	configSize *: LONGINT;
-
-	(**
-		Initial kernel code: this code is placed at the beginning of the kernel image and is executed by all CPUs.
-		This code:
-			- sets up a stack
-			- disables interrupts and MMU
-			- sets the interrupt vector to 0
-			- invalidates caches
-			- put secondary processors into the sleeping loop
-			- allow CPU0 to continue kernel initialization
-	*)
-	PROCEDURE {INITIAL,NOPAF} Init;
-	CODE
-		; set IRQ vector base register to zero
-		MOV	R2, #0
-		MCR	P15, 0, R2, C12, C0, 0
-
-		; disable MMU
-		MRC	P15, 0, R2, C1, C0, 0
-		BIC		R2, R2, #1
-		MCR	P15, 0, R2, C1, C0, 0
-
-		LDR	FP, [pc, #InitialFP-$-8]				; set stack pointer
-		LDR	SP, [pc, #InitialFP-$-8]				; set frame pointer
-
-		B		getProcId
-	InitialFP: 			d32 0001B000H				; initial frame pointer address, internal memory bank
-
-		; Set SMP mode
-		MRC p15, 0, R2, C1, C0, 1
-		ORR R2, R2, #041H
-		MCR p15, 0, R2, C1, C0, 1
-		ISB
-
-		; Filter CPUs: only CPU0 must initialize the kernel, other are started later on demand
-		MOV	R2, #0
-
-	getProcId:
-		MRC	P15, 0, R3, C0, C0, 5
-		AND	R3, R3, #0FH
-		CMP	R3, #0
-		BEQ	bootProc								; CPU 0 continues to booting the kernel
-
-	secondaryProcLoop:								; Secondary CPUs (i.e. CPUs that do not start the kernel) are
-		BL		InvalidateDCache
-		WFE											; sleeping and waiting to be started by SEV.
-
-
-		LDR	R0, [PC, #sndProcIdAdr-$-8]
-		LDR	R0, [R0, #0]							; R0 := secondaryProcId
-
-		MRC	P15, 0, R1, C0, C0, 5
-		AND	R1, R1, #0FH							; R1 := CPU ID
-
-		CMP	R0, R1									; IF R1 # R0: loop again
-		BNE	secondaryProcLoop
-
-		LDR	R0, [PC, #sndBootProcAdr-$-8]
-		LDR	R1, [R0, #0]							; R1 := secondaryBootProc
-		CMP	R1, #0									; IF R1 = 0: loop again
-		BEQ	secondaryProcLoop
-		BX		R1										; Jump to secondaryBootProc
-
-	sndBootProcAdr:	d32 secondaryBootProc
-	sndProcIdAdr:		d32 secondaryProcId
-
-	bootProc:											; CPU0 continues executing the kernel image
-		; Save configuration parameters
-		LDR	R2, [PC, #CfgBase - 8 - $]
-		STR	R0, [R2, #0]
-		LDR	R2, [PC, #CfgSize - 8 - $]
-		STR	R1, [R2, #0]
-
-		BL		InvalidateDCache						; After invalidating DCache
-
-		; Setup the interrupt vector: copy it from the data section below
-		MOV	R0, #0									; R0 := dst
-		LDR	R1, [PC, #intVecAdr - $ - 8]			; R1 := src
-		MOV	R2, #fiq - RESET + 4					; R2 := LEN(src) in bytes
-
-	copyInts:
-		LDR	R4, [R1, #0]
-		STR	R4, [R0, #0]
-		ADD	R0, R0, #4
-		ADD	R1, R1, #4
-		SUBS	R2, R2, #4
-		BNE	copyInts
-
-		; Start the kernel now
-		B		startKernel
-
-	; Interrupt vector data: to install the interrupt vector, we just have to copy
-	; from RESET to fiq (included) at address 0.
-	RESET: 	LDR	PC, [PC, #reset-$-8]			; RESET
-	UNDEF: 	LDR	PC, [PC, #undef-$-8]			; UNDEF
-	SWI: 		LDR	PC, [PC, #swi-$-8]			; SWI
-	PREF: 		LDR	PC, [PC, #prefetch-$-8]		; Prefetch Abort
-	DATA: 		LDR	PC, [PC, #data-$-8]			; Data Abort
-	INVALID: 	B		INVALID						; (not assigned)
-	IRQ: 		LDR	PC, [PC, #irq-$-8]				; IRQ
-	FIQ: 		LDR	PC, [PC, #fiq-$-8]				; FIQ
-		; initial interrupt vector setup such that inifinte loop is triggered
-	reset: 		d32 Init								; Reset starts the kernel
-	undef: 		d32 04H
-	swi: 		d32 08H
-	prefetch: 	d32 0CH
-	data: 		d32 10H
-	empty:		d32 0
-	irq: 		d32 14H
-	fiq: 		d32 1CH
-
-		; Address of the interrupt vector data to copy
-	intVecAdr:	d32 RESET
-
-	CfgBase:			d32 configBase
-	CfgSize:			d32 configSize
-
-
-	startKernel:
-	END Init;
-
-	PROCEDURE {NOPAF} InvalidateDCache *;
-	CODE
-		invalidate_dcache:
-			mrc	p15, 1, r0, c0, c0, 1		; read CLIDR
-			ands	r3, r0, #7000000H
-			mov	r3, r3, lsr #23			; cache level value (naturally aligned)
-			beq	finished
-			mov	r10, #0					; start with level 0
-		loop1:
-			add	r2, r10, r10, lsr #1		; work out 3xcachelevel
-			mov	r1, r0, lsr r2			; bottom 3 bits are the Cache type for this level
-			and	r1, r1, #7				; get those 3 bits alone
-			cmp	r1, #2
-			blt		skip					; no cache or only instruction cache at this level
-			mcr	p15, 2, r10, c0, c0, 0	; write the Cache Size selection register
-			isb								 ; isb to sync the change to the CacheSizeID reg
-			mrc	p15, 1, r1, c0, c0, 0		; reads current Cache Size ID register
-			and	r2, r1, #7				; extract the line length field
-			add	r2, r2, #4				; add 4 for the line length offset (log2 16 bytes)
-			ldr	r4, [pc, #H0x3ff-$-8]
-			ands	r4, r4, r1, lsr #3		; r4 is the max number on the way size (right aligned)
-			clz	r5, r4						; r5 is the bit position of the way size increment
-			ldr	r7, [pc, #H0x7fff-$-8]
-			ands	r7, r7, r1, lsr #13		; r7 is the max number of the index size (right aligned)
-		loop2:
-			mov	r9, r4					; r9 working copy of the max way size (right aligned)
-		loop3:
-			orr		r11, r10, r9, lsl r5		; factor in the way number and cache number into r11
-			orr		r11, r11, r7, lsl r2		; factor in the index number
-			mcr	p15, 0, r11, c7, c14, 2	; clean & invalidate by set/way
-			subs	r9, r9, #1				; decrement the way number
-			bge		loop3
-			subs	r7, r7, #1				; decrement the index
-			bge		loop2
-		skip:
-			add	r10, r10, #2				; increment the cache number
-			cmp	r3, r10
-			bgt		loop1
-
-		finished:
-			mov	r10, #0					; swith back to cache level 0
-			mcr	p15, 2, r10, c0, c0, 0	; select current cache level in cssr
-			dsb								; dsb
-			isb								; isb
-
-			bx	lr
-
-		H0x3ff:		d32 03FFH
-		H0x7fff:	d32 07FFFH
-	END InvalidateDCache;
-END Initializer.
-
-FoxARMInstructionSet.Disassemble A2.Bin -a=100120H ~

ARM/ARM.A2/ARM.Kernel.Mod

@@ -1,229 +0,0 @@
-MODULE Kernel;	(** AUTHOR "pjm"; PURPOSE "Implementation-independent kernel interface"; *)
-
-IMPORT SYSTEM, Trace, Machine, Heaps, Modules, Objects;
-
-CONST
-	TimerFree = 0; TimerSleeping = 1; TimerWoken = 2; TimerExpired = 3;	(* Timer state *)
-
-	Second* = Machine.Second;
-
-TYPE
-	(** Finalizer for FinalizedCollection.Add. *)
-	Finalizer* = Heaps.Finalizer;	(** PROCEDURE (obj: ANY) *)
-
-	(** Enumerator for FinalizedCollection.Enumerate. *)
-	Enumerator* = PROCEDURE {DELEGATE} (obj: ANY; VAR cont: BOOLEAN);
-
-	FinalizerNode = POINTER TO RECORD (Objects.FinalizerNode)
-		nextObj {UNTRACED} : FinalizerNode;   (* in Collection c *)
-	END;
-
-	(** Polling timer. *)
-	MilliTimer* = RECORD start, target: LONGINT END;
-
-TYPE
-	(** Delay timer. *)
-	Timer* = OBJECT
-		VAR timer: Objects.Timer; state: SHORTINT;
-
-		PROCEDURE HandleTimeout;
-		BEGIN {EXCLUSIVE}
-			IF state # TimerFree THEN state := TimerExpired END
-		END HandleTimeout;
-
-		(** Delay the calling process the specified number of milliseconds or until Wakeup is called. Only one process may sleep on a specific timer at a time. *)
-		PROCEDURE Sleep*(ms: LONGINT);
-		BEGIN {EXCLUSIVE}
-			ASSERT(state = TimerFree);	(* only one process may sleep on a timer *)
-			state := TimerSleeping;
-			Objects.SetTimeout(timer, HandleTimeout, ms);
-			AWAIT(state # TimerSleeping);
-			IF state # TimerExpired THEN Objects.CancelTimeout(timer) END;
-			state := TimerFree
-		END Sleep;
-
-		(** Wake up the process sleeping on the timer, if any. *)
-		PROCEDURE Wakeup*;
-		BEGIN {EXCLUSIVE}
-			IF state = TimerSleeping THEN state := TimerWoken END
-		END Wakeup;
-
-		(** Initializer. *)
-		PROCEDURE &Init*;
-		BEGIN
-			state := TimerFree; NEW(timer)
-		END Init;
-
-	END Timer;
-
-TYPE
-	(** A collection of objects that are finalized automatically by the garbage collector. *)
-	FinalizedCollection* = OBJECT (Objects.FinalizedCollection)
-		VAR root: FinalizerNode;	(* weak list of contents linked by nextObj *)
-
-		(** Add obj to collection. Parameter fin specifies finalizer, or NIL if not required. *)	(* may be called multiple times *)
-		PROCEDURE Add*(obj: ANY; fin: Finalizer);
-		VAR n: FinalizerNode;
-		BEGIN
-			NEW(n); n.c := SELF; n.finalizer := fin;
-			Heaps.AddFinalizer(obj, n);
-			BEGIN {EXCLUSIVE}
-				n.nextObj := root.nextObj; root.nextObj := n	(* add to collection *)
-			END
-		END Add;
-
-		(** Remove one occurrence of obj from collection. *)
-		PROCEDURE Remove*(obj: ANY);
-		VAR p, n: FinalizerNode;
-		BEGIN {EXCLUSIVE}
-			p := root; n := p.nextObj;
-			WHILE (n # NIL) & (n.objWeak # obj) DO
-				p := n; n := n.nextObj
-			END;
-			IF n # NIL THEN p.nextObj := n.nextObj END;
-			(* leave in global finalizer list *)
-		END Remove;
-
-		(** Remove all occurrences of obj from collection. *)
-		PROCEDURE RemoveAll*(obj: ANY);
-		VAR p, n: FinalizerNode;
-		BEGIN {EXCLUSIVE}
-			p := root; n := p.nextObj;
-			WHILE n # NIL DO
-				IF n.objWeak = obj THEN
-					p.nextObj := n.nextObj;
-				ELSE
-					p := n;
-				END;
-				n := n.nextObj
-			END
-		END RemoveAll;
-
-		(** Enumerate all objects in the collection (Enumerator may not call Remove, Add, Enumerate or Clear). *)
-		PROCEDURE Enumerate*(enum: Enumerator);
-		VAR fn, next: FinalizerNode; cont: BOOLEAN;
-		BEGIN {EXCLUSIVE}
-			fn := root.nextObj; cont := TRUE;
-			WHILE fn # NIL DO
-				next := fn.nextObj;	(* current (or other) object may be removed by enum call *)
-				enum(fn.objWeak, cont);
-				IF cont THEN fn := next ELSE fn := NIL END
-			END
-		END Enumerate;
-		(** Enumerate all objects in the collection not being finalized (Enumerator may not call Remove, Add, Enumerate or Clear). *)
-
-		PROCEDURE EnumerateN*( enum: Enumerator );
-		VAR fn, next: FinalizerNode; cont: BOOLEAN; obj: ANY;
-		BEGIN {EXCLUSIVE}
-			fn := root.nextObj; cont := TRUE;
-			WHILE fn # NIL DO
-				next := fn.nextObj;	(* current (or other) object may be removed by enum call *)
-				obj := NIL;
-
-				Machine.Acquire( Machine.Processors );	(* prevent GC from running *)
-
-				IF (fn.objWeak # NIL ) & (fn.objStrong = NIL ) THEN (* object is not yet on the finalizers list *)
-					obj := fn.objWeak; (* now object is locally referenced, will therefore not be GCed *)
-				END;
-
-				Machine.Release(Machine.Processors);
-
-				IF obj # NIL THEN enum( obj, cont ); END;
-				IF cont THEN fn := next ELSE fn := NIL END
-			END
-		END EnumerateN;
-
-		(** Initialize new collection. May also be called to clear an existing collection. *)
-		PROCEDURE &Clear*;
-		BEGIN {EXCLUSIVE}
-			NEW(root); root.nextObj := NIL	(* head *)
-		END Clear;
-
-	END FinalizedCollection;
-
-VAR
-	second- : LONGINT;  (** number of ticks per second (Hz) *)
-
-(** Return the number of ticks since system start. For timeouts, time measurements, etc, please use MilliTimer instead.
-	Ticks increment rate is stored in "second" variable in Hz. *)
-PROCEDURE GetTicks*(): LONGINT;
-BEGIN
-	RETURN Machine.ticks;
-END GetTicks;
-
-(** -- Garbage collection -- *)
-
-(** Activate the garbage collector immediately. *)
-PROCEDURE GC*;
-BEGIN
-	Heaps.LazySweepGC
-END GC;
-
-(** -- Timers -- *)
-
-(** Set timer to expire in approximately "ms" milliseconds. *)
-PROCEDURE SetTimer*(VAR t: MilliTimer; ms: LONGINT);
-BEGIN
-	IF Second # 1000 THEN	(* convert to ticks *)
-		ASSERT((ms >= 0) & (ms <= MAX(LONGINT) DIV Second));
-		ms := ms * Second DIV 1000
-	END;
-	IF ms < 5 THEN INC(ms) END;	(* Nyquist adjustment *)
-	t.start := Machine.ticks;
-	t.target := t.start + ms
-END SetTimer;
-
-(** Test whether a timer has expired. *)
-PROCEDURE Expired*(CONST t: MilliTimer): BOOLEAN;
-BEGIN
-	RETURN Machine.ticks - t.target >= 0
-END Expired;
-
-(** Return elapsed time on a timer in milliseconds. *)
-PROCEDURE Elapsed*(CONST t: MilliTimer): LONGINT;
-BEGIN
-	RETURN (Machine.ticks- t.start) * (1000 DIV Second)
-END Elapsed;
-
-(** Return time left on a timer in milliseconds. *)
-PROCEDURE Left*(CONST t: MilliTimer): LONGINT;
-BEGIN
-	RETURN (t.target - Machine.ticks) * (1000 DIV Second)
-END Left;
-
-BEGIN
-	Machine.start := Objects.Start;
-	Machine.Timeslice := Objects.Timeslice;
-	Machine.EnableInterrupts;
-	Machine.InitProcessors;
-	Heaps.GC := Heaps.InvokeGC; (* must be done after all processors have started *)
-	IF Machine.numProcessors > 1 THEN Machine.StartAll
-	ELSE Objects.ProcessorHLT := Machine.KernelCallHLT	(* enable waiting for interrupt when idle *)
-	END;
-	Machine.SetNumberOfProcessors(Machine.numProcessors);
-	ASSERT(1000 MOD Second = 0); (* for Elapsed *)
-	second := Second;
-	Machine.Acquire(Machine.TraceOutput);
-	Trace.String("Kernel: Initialized and started."); Trace.Ln;
-	Machine.Release(Machine.TraceOutput);
-END Kernel.
-
-(**
-Notes:
-o The FinalizedCollection object implements collections of finalized objects.
-o Objects added to a finalized collection (with Add) are removed automatically by the garbage collector when no references to them exist any more. They can also be removed explicitly with Remove.
-o All the objects currently in a collection can be enumerated by Enumerate, which takes an enumerator procedure as parameter. The enumerator can also be a method in an object, which is useful when state information is required during the enumeration. The enumerator may not call other methods of the same collection.
-o An object in a finalized collection can have an finalizer procedure associated with it, which gets called by a separate process when there are no references left to the object any more. A finalizer is usually used for some cleanup functions, e.g. releasing external resources. It is executed exactly once per object. During the next garbage collector cycle the object is finally removed.
-*)
-
-(*
-to do:
-o cancel finalizer when removing object
-o fix module free race: module containing finalizer is freed. although the finalizer list is cleared, the FinalizerCaller has already taken a reference to a finalizer, but hasn't called it yet.
-o consider: a module has a FinalizedCollection, without finalizers (NIL). when the module is freed, the objects are still in the finalization list, and will get finalized in the next garbage collection. The FinalizedCollection will survive the first collection, as the objects all have references to it through their c field. After all objects have been finalized, the FinalizedCollection itself is collected. No dangling pointers occur, except the untraced module field references from the type descriptors, which are only used for tracing purposes.
-o check cyclic dependencies between finalized objects.
-o GetTime(): LONGINT - return current time in ms
-o Delay(td: LONGINT) - wait td ms
-o AwaitTime(t: LONGINT) - wait at least until time t
-o Wakeup(obj: ANY) - wake up object that is waiting
-*)

ARM/ARM.A2/ARM.Machine.Mod

@@ -1,3633 +0,0 @@
-MODULE Machine; (** AUTHOR "Timothée Martiel"; PURPOSE "Machine abstraction module for ARM"; *)
-(**
- * Machine abstraction:
- * - processor management: caches, FPU
- * - interrupts and exceptions
- * - virtual memory management
- *)
-
-IMPORT SYSTEM, Initializer, Trace, Platform, TraceDevice, BootConfig, PrivateWatchdog;
-
-CONST
-	Version = "A2 on ARM, revision 4677 (15.10.2017)";
-	DefaultObjectFileExtension* = ".Gof";
-
-	(* Interrupts Dummy Test *)
-	DummyTest = FALSE;
-	
-	(*
-		Used for compatibility with WMPerfMon
-	*)
-	MMX* = 23; (** bits in features variable *)
-
-	(* Lock levels *)
-	TraceOutput* = 0;
-	Memory* = 1;
-	Heaps* = 2;
-	Interrupts* = 3	;
-	Modules* = 4;
-	Objects* = 5;
-	Processors* = 6;
-	KernelLog* = 7;
-
-	MaxLock = 8;
-
-	(* Unit prefixes *)
-	k = 1024;
-	M = k * k;
-	G = M * k;
-	LogM = 20; (* log2(M) *)
-	(*LogK = 10;  (* log2(K) *)*)
-
-	(* CPU number *)
-	MaxCPU* = 32(*BootConfig.CpuNb*);
-
-	(* If TRUE, enables some assertions in the code *)
-	StrongChecks = TRUE;
-
-	(* Page size, in bytes *)
-	PS = 4 * k;
-	PSlog2 = 12;		(* ASH(1, PSlog2) = PS *)
-
-	PTSize = 400H;	(* size of a coarse page table *)
-	(*PTEntries = 100H;	(* 32bit entries per page table *)*)
-
-	(* Absolute maximal process stack numbers *)
-	MaxStackNb = 1024;
-
-	(* Hard limit on cache reference size *)
-	MaxCacheRefSize = M;
-
-	(* Interrupt Vector base. Valid only after MMU is enabled *)
-	InterruptVector = 0FFFF0000H;
-
-	(* Interrupts *)
-	MinIRQ* = 0;
-	MaxIRQ* = 255;
-	IRQ0* = MinIRQ; (* Alias *)
-	(** ID of the global timer IRQ *)
-	TimerIRQ* = 27;
-	PrivateTimerIRQ* = 29;
-
-	MaxIRQHandlers = 16;
-
-	(* Exceptions codes. DO NOT CHANGE: they represent interrupt vector offsets *)
-	Reset * = 20H;		(** Reset *)
-	Undef * = 24H;	(** Undefined Exception *)
-	Swi * = 28H;		(** Software Interrupt *)
-	Prefetch * = 2CH;	(** Prefetch Abort *)
-	Data * = 30H;		(** Data Abort *)
-	Irq * = 38H;		(** Interrupt Request *)
-	Fiq * = 3CH;		(** Fast Interrupt *)
-
-	(* Initial Stack size for user stacks *)
-	(*InitUserStackSize = PS;*)
-
-	HeapMin = 50;					(* "minimum" heap size as percentage of total memory size (used for heap expansion in scope of GC ) *)
-	HeapMax = 95;				(* "maximum" heap size as percentage of total memory size (used for heap expansion in scope of GC) *)
-	ExpandRate = 1;				(* always extend heap with at least this percentage of total memory size *)
-	Threshold = 10;				(* periodic GC initiated when this percentage of total memory size bytes has "passed through" NewBlock *)
-
-	(* Stack parameters *)
-	InitStackSize = PS;
-	StackGuardSize = PS;
-
-	(* access permissions *)
-	SrwUrw = 3;
-	FullAccess = (*SrwUrw*400H+SrwUrw*100H+SrwUrw*40H+*)SrwUrw*10H; (* for small pages only *)
-	LastStackPage = SrwUrw*400H+SrwUrw*100H+SrwUrw*40H; (* for small pages only *)
-
-	(* first level page table types *)
-	flCoarse = 1;
-	flSection = 2;
-
-	(* Second Level *)
-	slFault = 0;
-	slSmall = 2;
-
-	(* cachable/bufferable mapping options *)
-	cb = 0;
-	C = 8;
-	B = 4;
-	CB = C + B + 440H;
-	(* Inner and Outer Cacheable, Write-Through, no Write Allocate *)
-	Cacheable = 100CH; (* here inner cacheable, write-back, write-allocate *)
-	(* Shareable *)
-	Shareable = 10000H;
-
-	(* NIL *)
-	NilAdr* = -1;
-
-	(* Control Register Flags *)
-	DCache = 2;
-	ICache = 12;
-
-	Second* = 1000; (* frequency of ticks increments in Hz *)
-
-	Preemption* = 31;	(** flag for BreakAll() *)
-
-	(* TEMP. Temporary implementation to get Objects to compile *)
-	SSESupport* = FALSE;
-	SSE2Support* = FALSE;
-	KernelLevel * = 1;
-	UserLevel* = 1;
-	(*CS* = 1;*)
-	VMBit* = 2;
-
-	(** Period at which the CPU timer interrupts, in micro seconds *)
-	TimerPeriod* = 1000;
-
-	(** Last reboot info *)
-	RebootPowerOn * = 0;
-	RebootHardReset * = 1;
-	RebootSoftReset * = 2;
-	RebootSystemWatchdog * = 3;
-	RebootWatchdogCPU0 * = 4;
-	RebootWatchdogCPU1 * = 5;
-	RebootDebug * = 6;
-
-	(** Needed, but not used yet by Reals.Mod *)
-	fcr * = {};
-
-	IsCooperative * = FALSE;
-
-TYPE
-	(** processor state *)
-	State* = RECORD
-		R*: ARRAY 12 OF ADDRESS;		(** registers 0-11 *)
-		BP*, SP*, LR*, PC*: ADDRESS;	(** special registers *)
-		PSR*: ADDRESS;					(** processor state register *)
-		INT*: ADDRESS;					(** IRQ number *)
-	END;
-
-	(** NEON Coprocessor state *)
-	NEONState* = RECORD
-		D*: ARRAY 32 OF HUGEINT; (* 32 64-bits registers *)
-		FPSCR*: ADDRESS;
-		FPEXC*: ADDRESS;
-	END;
-
-	(** exception state *)
-	ExceptionState* = RECORD
-		halt*: LONGINT;	 	(** halt code *)
-		instn*: LONGINT;		(** undefined instruction *)
-		pf*: ADDRESS;		(** page fault address *)
-		status*: LONGINT;	(** page fault status *)
-		locks*: SET;			(** active locks *)
-	END;
-
-	(** Interrupt Hanlder *)
-	Handler* = PROCEDURE {DELEGATE} (VAR state: State);
-	EventHandler = PROCEDURE (id: LONGINT; CONST state: State);
-
-	(** Spinlock *)
-	Lock = RECORD
-		locked: BOOLEAN;
-		(* Padding to the granularity of exclusive monitor: 8 words on Cortex-A9 *)
-		pad: ARRAY 31 OF CHAR;
-	END;
-
-	(** Processor status *)
-	Proc* = RECORD
-		locksHeld*: SET;
-		preemptCount*: LONGINT;
-		(*nestCount-: LONGINT;	(** total locks held by a processor *)*)
-		intStatus*, mmu*: BOOLEAN; (* muu: if the MMU is enabled for this processor *)
-	END;
-
-	(** Virtual/physical address pair *)
-	AddressTuple = RECORD virtual, physical: ADDRESS; END;
-
-	(** Stack descriptor:
-	low:	lowest possible stack address
-	adr:	current lowest allocated address
-	high:	highest address
-	*)
-	Stack* = RECORD
-		low: ADDRESS;
-		adr*: ADDRESS;
-		high*: ADDRESS;
-	END;
-
-	(** Heap memory block *)
-	MemoryBlock* = POINTER TO MemoryBlockDesc;
-	MemoryBlockDesc* = RECORD
-		next- {UNTRACED}: MemoryBlock;
-		startAdr-: ADDRESS; 		(* unused field for I386 *)
-		size-: SIZE; 					(* unused field for I386 *)
-		beginBlockAdr-, endBlockAdr-: ADDRESS
-	END;
-
-	Address32* = ADDRESS;
-	Range* = RECORD
-		adr*: ADDRESS; size*: SIZE;
-	END;
-
-	CacheRefs = POINTER {UNSAFE,UNTRACED} TO ARRAY MaxCacheRefSize OF SHORTINT;
-VAR
-	version -: ARRAY 64 OF CHAR;
-	
-	features-: SET;	(** processor features *)
-
-	sp, fp: ADDRESS;
-
-	(** Interrupt Mask *)
-	IRQMask: SET;
-	(** IRQ Handlers. IRQ can have multiple handlers. Dispatching to those is done in IRQGlue and IRQCaller. *)
-	irqHandler: ARRAY MaxIRQ + 1, MaxIRQHandlers OF Handler;
-
-	(* Exception handlers. Called by *Glue. *)
-	undefHandler, swiHandler, prefetchHandler, dataHandler, fiqHandler: Handler;
-
-	stateTag: LONGINT;
-	dummyIRQHandler: ARRAY MaxIRQ+1 OF RECORD h: Handler; END;
-
-	(** Low level locks *)
-	lock: ARRAY MaxLock OF Lock;
-
-	(** Processors status:
-	- locksHeld:		set of low-level locks held by the processor
-	- preemptCount:	preemption counter
-	*)
-	proc-: ARRAY MaxCPU OF Proc;
-	(** IDs of all successfully started processors. *)
-	allProcessors-: SET;
-
-	heapHigh, heapLow, stackHigh, stackLow: AddressTuple;
-
-	(* Memory *)
-	pageTable: RECORD virtual, memory: ADDRESS END;	  (* contains the virtual & memory address of the first level page table *)
-	memory: RECORD size, free: SIZE; END;
-	stackPT: ADDRESS;
-
-	(* Free stack bitmap: each set element is set to indicate free stack *)
-	freeStack: ARRAY (MaxStackNb + 31) DIV 32 OF SET;
-	freeStackIndex: SIZE;
-
-	(* Address of the highest free page *)
-	freePage: ADDRESS;
-
-	(* Memory blocks -- For the heap *)
-	memBlockHead-{UNTRACED}, memBlockTail-{UNTRACED}: MemoryBlock;
-	initialMemBlock: MemoryBlockDesc;
-
-	dCacheBase: ADDRESS;
-
-	(** GC parameters *)
-	expandMin, heapMinKB, heapMaxKB : SIZE;
-	gcThreshold: SIZE;
-
-	(** For preemptive scheduling. *)
-	Timeslice*: Handler;
-	timer: EventHandler;
-
-	(** timer ticks. Written to by GetTicks. Read-only *)
-	ticks*: LONGINT;
-	eventCount, eventMax: LONGINT;
-	event: Handler;
-
-	(** Number of processor used. *)
-	numProcessors*: LONGINT;
-	numberOfProcessors: LONGINT;
-
-	(** Scheduling start procedure for non-booting processors. *)
-	start*: PROCEDURE;
-
-	(** Upcall to get current stack -- used for stack extension *)
-	getStack*: PROCEDURE (VAR stack: Stack);
-
-	(* Memory Layout *)
-	(* The system area contains:
-	 *		- the interrupt vector, which will be mapped high
-	 *		- interrupt stacks
-	 *		- the page table
-	 * Except for the first 4kB page, it is mapped 1:1.
-	 *)
-	memSysLowStart,
-	memSysLowStop,
-	(* The heap area contains:
-	 *		- the static kernel image
-	 *		- the heap
-	 * The heap is mapped 1:1 with 1MB pages.
-	 *)
-	memHeapStart,
-	memHeapStop,
-	(* Process Stacks are allocated in this area.
-	 * Stacks are mapped with 4kB pages. They take at least 2 pages:
-	 *		- 1 for the actual stack
-	 *		- 1 kept unmapped as the stack guard.
-	 * Stacks are mapped 1:1.
-	 * The stack size can be tuned to allow the system to run more processes.
-	 *)
-	memStackStart,
-	memStackStop,
-	(* Boot configuration is placed in memory. It takes 4 kB at most *)
-	memConfigStart,
-	memConfigStop,
-	(* IO registers and peripheral control are located in this region. Mapped 1:1 with 1MB and 4kB
-	 * pages, as necessary. Mapped as Device memory. *)
-	memIOStart,
-	memIOStop,
-	(* High system memory region. Within the last MB, contains: interrupt vector and reference counts
-	 * for caching. *)
-	memSysHighStart,
-	memSysHighStop,
-
-	(* System Parameters *)
-	(* Interrupt stacks. 8kB of virtual space (4kB for stack, 4kB for guard) and 4 stacks per processor. *)
-	sysIntStackStart,
-	sysIntStackStop,
-	(* First Level Page Table: size of 16 * k to map 4GB with 1MB pages. *)
-	sysFirstLvlPtStart,
-	sysFirstLvlPtStop,
-	(*
-	 * Second Level Page Table:
-	 *		- 2 * 256 entries for the system area (first and last MB of VMem)
-	 *		- 256 entries for each MB of virtual stack space
-	 * 256 entries take 1kB memory space.
-	 *)
-	sysSecondLvlPtStart,
-	sysSecondLvlPtStop,
-	(*
-	 * Interrupt Vector. Located at 0FFFFFFF0H
-	 *)
-	sysVectorStart,
-	sysVectorStop,
-	sysCacheRefStart,
-	sysCacheRefStop,
-	(*
-	 * Number of ref counters: 1 per 1st level heap page, 1 per 2nd level stack page.
-	 * This memory region is organized as follows: the first part [0 .. SysCacheStackOfs) is used for heap pages,
-	 * the second part, [SysCacheStackOfs .. SysCacheRefSize) is used for stack pages.
-	 *)
-	sysCacheRefSize,
-	(* Offset in the ref count table for stack pages. *)
-	sysCacheStackOfs: ADDRESS;
-
-	(* Process stack system *)
-	maxUserStackSize: SIZE;
-	maxUserStacks: LONGINT;
-
-	(* TRUE iff caching should be globally enabled *)
-	enableCaching: BOOLEAN;
-
-	(* UART used for kernel output *)
-	kernelOutputUart -: LONGINT;
-
-	(** Interrupt tracing option *)
-	traceInterrupts: BOOLEAN;
-	(** Trace option for CPU state *)
-	traceCpus: BOOLEAN;
-
-	(** Use private watchdog to check scheduling timers? *)
-	enableWatchdog: BOOLEAN;
-
-	(** Array of reference counts for page caching *)
-	cacheRefs -: CacheRefs;
-
-	(** Reason for last reboot *)
-	lastReboot -: LONGINT;
-
-	(* ===== Processor Management ===== *)
-	(* Current processor's ID, between 0 and MaxProc - 1 *)
-	PROCEDURE - ID*(): LONGINT;
-	CODE
-		MRC p15, 0, R0, C0, C0, 5
-		AND R0, R0, #3H; Get the last 2 bits of R0
-	END ID;
-
-	(** Enables current processor's L1 caches *)
-	PROCEDURE EnableL1Cache;
-	CODE
-		; Enable Cache and TLB maintenance broadcast
-		mrc	p15, 0, r0, c1, c0, 1
-		orr	r0, r0, #1H
-		mcr	p15, 0, r0, c1, c0, 1
-		isb
-
-		; Enable Caching in SCTLR
-		mrc	p15, 0, r0, c1, c0, 0
-		orr r0, r0, #4H
-		mcr	p15, 0, r0, c1, c0, 0
-		isb
-	END EnableL1Cache;
-
-	(** Enable L2 cache, prefetching and other speculative execution support *)
-	PROCEDURE EnableL2Cache;
-	CODE
-			ldr	r0,[pc, #L2CCCrtl-$-8]			; Load L2CC base address base + control register
-			mov	r1, #0				; force the disable bit
-			str	r1, [r0,#0]			; disable the L2 Caches
-
-			ldr	r0, [pc, #L2CCAuxCtrl-$-8]			; Load L2CC base address base + Aux control register
-			ldr	r1,[r0,#0]				; read the register
-			ldr	r2, [pc, #L2CCAuxControl-$-8]		; set the default bits
-			orr	r1,r1,r2
-			str	r1, [r0,#0]			; store the Aux Control Register
-
-			ldr	r0,[pc, #L2CCTAGLatReg-$-8]		; Load L2CC base address base + TAG Latency address
-			ldr	r1, [pc, #L2CCTAGLatency-$-8]		; set the latencies for the TAG
-			str	r1, [r0,#0]			; store the TAG Latency register Register
-
-			ldr	r0, [pc, #L2CCDataLatReg-$-8]		; Load L2CC base address base + Data Latency address
-			ldr	r1,[pc, #L2CCDataLatency-$-8]		; set the latencies for the Data
-			str	r1, [r0,#0]			; store the Data Latency register Register
-
-			ldr	r0,[pc, #L2CCWay-$-8]			; Load L2CC base address base + way register
-			ldr	r2, [pc, #H0xffff-$-8]
-			str	r2, [r0,#0]			; force invalidate
-
-			ldr	r0, [pc, #L2CCSync-$-8]			; need to poll 0x730, PSS_L2CC_CACHE_SYNC_OFFSET
-								; Load L2CC base address base + sync register
-			; poll for completion
-
-		Sync:
-			ldr	r1, [r0,#0]
-			cmp	r1, #0
-			bne	Sync
-
-			ldr	r0,[pc, #L2CCIntRaw-$-8]			; clear pending interrupts
-			ldr	r1,[r0,#0]
-			ldr	r0,[pc, #L2CCIntClear-$-8]
-			str	r1,[r0,#0]
-			ldr	r0,[pc,#L2CCCrtl-$-8]		; Load L2CC base address base + control register
-			ldr	r1,[r0,#0]					; read the register
-			mov	r2, #1					; set the enable bit
-			orr	r1,r1,r2
-			str	r1, [r0,#0]					; enable the L2 Caches
-
-			mrc	p15,0,r0,c1,c0,0		; flow prediction enable
-			orr	r0, r0, #0x800		; #0x800
-			mcr	p15,0,r0,c1,c0,0
-			isb
-
-			mrc	p15,0,r0,c1,c0,1		; read Auxiliary Control Register
-			orr	r0, r0, #4				; enable Dside prefetch
-			orr	r0, r0, #2				; enable L2 Prefetch hint
-			mcr	p15,0,r0,c1,c0,1		; write Auxiliary Control Register
-			isb
-
-			b exit
-		; Data
-		H0xffff: 			d32 0FFFFH
-		L2CCWay:			d32 0F8F02000H + 077CH
-		L2CCSync:			d32 0F8F02000H + 0730H
-		L2CCCrtl:			d32 0F8F02000H + 0100H
-		L2CCAuxCtrl:		d32 0F8F02000H + 0104H
-		L2CCTAGLatReg: 	d32 0F8F02000H + 0108H
-		L2CCDataLatReg: 	d32 0F8F02000H + 010CH
-		L2CCIntClear:		d32 0F8F02000H + 0220H
-		L2CCIntRaw:		d32 0F8F02000H + 021CH
-		L2CCAuxControl:	d32 72360000H
-		L2CCTAGLatency:	d32 0111H
-		L2CCDataLatency:	d32 0121H
-
-		exit:
-	END EnableL2Cache;
-
-	(** Enables the Snoop Control Unit
-		for L1 coherency and LDREX/STREX global monitor
-	*)
-	PROCEDURE EnableSCU;
-	CODE
-		; set scu enable bit in scu
-		ldr	r7, [pc, #H0xf8f00000-$-8]
-		ldr	r0, [r7, #0]
-		orr	r0, r0, #1
-		str	r0, [r7,#0]
-
-		; invalidate scu
-		ldr	r7, [pc, #H0xf8f0000c-$-8]
-		ldr	r6, [pc, #H0xffff-$-8]
-		str	r6, [r7, #0]
-
-		b exit
-
-	; Data
-	H0xf8f00000: 		d32 0F8F00000H
-	H0xf8f0000c: 		d32 0F8F0000CH
-	H0xffff: 			d32 0FFFFH
-	exit:
-	END EnableSCU;
-
-	(** Init NEON / VFP Engine *)
-	PROCEDURE InitFPU;
-	CODE
-		MRC p15, 0, R0, C1, C0, 2;
-		ORR R0, R0, #0x00f00000;
-		MCR p15, 0, R0, C1, C0, 2;
-		ISB
-		MOV R0, #0x40000000;
-		VMSR FPEXC, R0;
-		
-		VMRS R0, FPSCR
-		BIC R0, R0, #0x0c00000 ; round to nearest as the default
-		; remark: if we put round to minus infinity as the default, we can spare quite some instructions in emission of ENTIER
-		VMSR FPSCR, R0;
-	END InitFPU;
-
-	(** Activate the Symmetric Multiprocessing Mode for current CPU.
-		This activates L1 cache coherency.
-	*)
-	PROCEDURE SetSmpMode;
-	CODE
-		(*
-		mrc	p15, 0, r0, c1, c0, 1		/* Read ACTLR*/
-		orr	r0, r0, #(0x01 << 6)		/* set SMP bit */
-		orr	r0, r0, #(0x01 )		/* */
-		mcr	p15, 0, r0, c1, c0, 1		/* Write ACTLR*/
-		*)
-		MRC p15, 0, R0, C1, C0, 1
-		ORR R0, R0, #047H
-		MCR p15, 0, R0, C1, C0, 1
-		ISB
-	END SetSmpMode;
-
-	(** Activate Assymmetric Multiprocessing Mode for current CPU.
-		This desactivates L1 cache coherency
-	*)
-	PROCEDURE SetAmpMode;
-	CODE
-		MRC p15, 0, R0, C1, C0, 1
-		MOV R1, #040H
-		RSB R1, R1, #0
-		ORR R0, R0, R1
-		MCR p15, 0, R0, C1, C0, 1
-		ISB
-	END SetAmpMode;
-
-	(** Enable coprocessors CP10 and CP11(= VFP and NEON engine) *)
-	PROCEDURE EnableCoprocessors;
-	CODE
-		mov	r0, r0
-		mrc	p15, 0, r1, c1, c0, 2		; read cp access control register (CACR) into r1
-		orr	r1, r1, #0xf00000		; enable full access for p10 & p11
-		mcr	p15, 0, r1, c1, c0, 2		; write back into CACR
-		isb
-	END EnableCoprocessors;
-
-	(* Initializes a processor. Has to be called once by each processor. *)
-	PROCEDURE InitProcessor*;
-	BEGIN
-		timer := DummyEvent;
-		Timeslice := DummyTimeslice;
-		SetSmpMode;
-		EnableSCU;
-		EnableL1Cache;
-		InvalidateTLB;
-		InvalidateICache;
-		Initializer.InvalidateDCache;
-		(*InvalidateDCacheRange(0, SYSTEM.VAL(ADDRESS, LastAddress));*)
-		(* SCU and L2 caches are enabled in the initialization sequence *)
-		EnableL2Cache;
-		EnableCoprocessors;
-		InitFPU;
-		allProcessors := {0}
-	END InitProcessor;
-
-	(** Shut system down. If reboot is TRUE, attempts to restart system. *)
-	PROCEDURE Shutdown*(reboot: BOOLEAN);
-	VAR i: LONGINT; procs: SET;
-	BEGIN
-		IF enableWatchdog THEN PrivateWatchdog.Stop END;
-		StopTicks;
-		Trace.String("Shutting down secondary CPUs... ");
-		procs := allProcessors;
-		FOR i := 0 TO numberOfProcessors - 1 DO
-			IF (i # ID()) & (i IN allProcessors) THEN
-				EXCL(allProcessors, i)
-			END
-		END;
-		FOR i := 0 TO numberOfProcessors - 1 DO
-			IF (i #ID()) & (i IN procs) THEN
-				REPEAT	 UNTIL i IN allProcessors
-			END
-		END;
-		Trace.StringLn("done");
-
-		IF reboot THEN
-			Platform.slcr.SLCR_UNLOCK := Platform.SlcrUnlockKey;
-			Platform.slcr.PSS_RST_CTRL := 1
-		ELSE
-			EndInterrupts;
-			LOOP
-				CODE
-					WFE
-				END;
-			END
-		END;
-	END Shutdown;
-
-	(** Shut down secondary processors *)
-	PROCEDURE ShutdownSecondary;
-	BEGIN
-		IF enableWatchdog THEN PrivateWatchdog.Stop END;
-		INCL(allProcessors, ID());
-		LOOP
-			CODE
-				WFE
-			END
-		END
-	END ShutdownSecondary;
-
-	(** Cleans the whole DCache. Taken from Minos *)
-	PROCEDURE CleanDCache *;
-	CONST
-		L2CCBBase	= 0F8F02000H;
-		L2COfs		= L2CCBBase + 7BCH;
-		L2CSync	= L2CCBBase + 730H;
-	CODE
-		; Clean all sets of all ways of L1 cache
-		MOV	R0, #0
-	WayLoop:
-		CMP	R0, #4
-		BEQ	EndWayLoop
-		LSL		R4, R0, #30
-		MOV	R1, #0
-	SetLoop:
-		CMP	R1, #256
-		BEQ	EndSetLoop
-
-		LSL		R3, R1, #5
-		ORR	R3, R4, R3
-		MCR	P15, 0, R3, C7, C10, 2
-
-		ADD	R1, R1, #1
-		B		SetLoop
-	EndSetLoop:
-		ADD	R0, R0, #1
-		B		WayLoop
-
-	EndWayLoop:
-		DSB
-
-		; Invalidate all L2 ways
-		LDR	R0, [PC, #L2COfsAdr - $ - 8]	; R0 := reg7_inv_way address
-		MOV	R1, #0FH			; R1 := 0FH => invalidate all ways
-		STR	R1, [R0, #0]		; reg7_inv_way <- R1
-
-	Sync:
-		DSB
-		LDR	R0, [PC, #L2CSyncAdr - $ - 8]	; R0 := L2 cache sync register address
-		MOV	R1, #1
-		STR	R1, [R0, #0]		; [R0] := 1
-	SyncLoop:						; repeat
-		LDR	R1, [R0, #0]		; R1 := l2 cache syc state
-		CMP	R1, #0
-		BEQ	Exit					; until R1 = 0
-		B		SyncLoop
-
-	L2COfsAdr:		d32 L2COfs
-	L2CSyncAdr:	d32 L2CSync
-	Exit:
-	END CleanDCache;
-
-	PROCEDURE FlushDCacheRange*(adr:ADDRESS; len: SIZE);
-	CONST
-		cacheline = 32;
-		L2CCBBase				= 0F8F02000H; (*XPS_L2CC_BASEADDR*)
-		L2CCCacheSync		= L2CCBBase + 00730H;		(* Cache Sync *)(*XPS_L2CC_CACHE_SYNC_OFFSET	*)
-		L2CCCacheInvClnPAOfs= 007F0H;		(* Cache Clean by PA *)(*XPS_L2CC_CACHE_INV_CLN_PA_OFFSET*)
-		L2CCOffset				= L2CCBBase + L2CCCacheInvClnPAOfs;
-	BEGIN
-		IF ~enableCaching OR (len = 0) THEN RETURN END;
-		IF len MOD cacheline # 0 THEN INC(len, cacheline - len MOD cacheline) END;
-		IF adr MOD cacheline # 0 THEN DEC(adr, len MOD cacheline) END;
-		CODE
-			LDR	R0, [FP, #adr]						; R0 := adr
-			LDR	R1, [FP, #len]						; R1 := len
-
-			LDR	R2, [PC, #Cacheline - 8 - $]		; R2 := cacheline
-			SUB	R3, R2, #1							; R3 := cacheline - 1
-			AND	R3, R0, R3							; R3 := adr MOD cacheline
-
-			ADD	R1, R1, R0
-			SUB	R0, R0, R3							; R0 := adr - adr MOD cacheline
-			;ADD	R1, R1, R3							; R1 := len + adr MOD cacheline
-
-			MOV	R3, #0
-			MCR	P15, 2, R3,  C0,  C0, 0				; Select cache level 1
-			LDR	R4, [PC, #L2COfs - 8 - $]			; R4 := L2 cache flush address register address
-
-		Loop:
-			CMP	R0, R1								; while R0 < R1
-			BEQ	Sync
-			BHI		Sync
-
-			MCR	P15, 0, R0,  C7, C14, 1				; Clean Cache Level 1 By MVA (R0)
-			STR	R0, [R4, #0]						; Clean Cache Level 2 By PA (R0)
-			DSB
-			ADD	R0, R0, R2							; R0 := R0 + cacheline
-
-			B		Loop								; end
-
-		Sync:
-			DSB
-			LDR	R0, [PC, #L2CSync - 8 - $]		; R0 := L2 cache sync register address
-			;MOV	R1, #1
-			;STR	R1, [R0, #0]						; [R0] := 1
-		SyncLoop:										; repeat
-			LDR	R1, [R0, #0]						; R1 := l2 cache syc state
-			CMP	R1, #0
-			BEQ	Exit									; until R1 = 0
-			B		SyncLoop
-
-		Cacheline:	d32 cacheline
-		L2COfs:	d32 L2CCOffset
-		L2CSync:	d32 L2CCCacheSync
-
-		Exit:
-		END;
-	END FlushDCacheRange;
-
-	PROCEDURE FlushDCachePhysRange * (adr: ADDRESS; len: LONGINT; CONST ranges: ARRAY OF Range; numRanges: LONGINT);
-	CONST
-		cacheline = 32;
-		L2CCBBase				= 0F8F02000H; (*XPS_L2CC_BASEADDR*)
-		L2CCCacheSync		= L2CCBBase + 00730H;		(* Cache Sync *)(*XPS_L2CC_CACHE_SYNC_OFFSET	*)
-		L2CCCacheInvClnPAOfs= 007F0H;		(* Cache Clean by PA *)(*XPS_L2CC_CACHE_INV_CLN_PA_OFFSET*)
-		L2CCOffset				= L2CCBBase + L2CCCacheInvClnPAOfs;
-	VAR
-		cur, end: ADDRESS;
-		r: LONGINT;
-	BEGIN
-		IF ~enableCaching & (len # 0) THEN
-			IF len MOD cacheline # 0 THEN INC(len, cacheline - len MOD cacheline) END;
-			(* Select cache L0 Data cache in CSSR *)
-			CODE
-				mov	r0, #0
-				mcr	p15, 2, r0,  c0,  c0, 0	(*		mtcp(XREG_CP15_CACHE_SIZE_SEL, 0);*)
-			END;
-
-			(* Flush all cache lines in the memory region *)
-			FOR r := 0 TO numRanges - 1 DO
-				cur := ranges[r].adr;
-				end := cur + ranges[r].size;
-				WHILE (cur < end)  DO
-					(* Flush L1 Data cache line with virtual address *)
-					CODE
-						ldr r3, [fp, #adr]    (* load*)
-						mcr	p15, 0, r3,  c7, c14, 1;				MCR XREG_CP15_CLEAN_INVAL_DC_LINE_MVA_POC :: "r" (adr));
-					END;
-					(* Flush L2 cache line with physical address *)
-					SYSTEM.PUT(L2CCOffset, cur);
-					cur := cur + cacheline;
-					adr := adr + cacheline
-				END
-			END
-		END;
-		(* Wait for L1 and L2 flush to complete *)
-		CODE
-			DSB
-		END;
-
-		SYSTEM.PUT32(L2CCCacheSync, 1);
-		REPEAT UNTIL SYSTEM.GET32(L2CCCacheSync) = 0;
-	END FlushDCachePhysRange;
-
-	PROCEDURE InvalidateDCacheRange*(adr: ADDRESS; len: SIZE);
-	CONST
-		cacheline = 32;
-		L2CCBBase				= 0F8F02000H; (*XPS_L2CC_BASEADDR*)
-		L2CCCacheSync		= L2CCBBase + 00730H;		(* Cache Sync *)(*XPS_L2CC_CACHE_SYNC_OFFSET	*)
-		L2CCCacheInvPAOfs	= 00770H;		(* Cache Invalidate by PA *)(*XPS_L2CC_CACHE_INV_CLN_PA_OFFSET*)
-		L2CCOffset = L2CCBBase + L2CCCacheInvPAOfs;
-	BEGIN
-		IF ~enableCaching OR (len = 0) THEN RETURN END;
-		IF len MOD cacheline # 0 THEN INC(len, cacheline - len MOD cacheline) END;
-		IF adr MOD cacheline # 0 THEN DEC(adr, len MOD cacheline) END;
-		CODE
-			LDR	R0, [FP, #adr]						; R0 := adr
-			LDR	R1, [FP, #len]						; R1 := len
-
-			LDR	R2, [PC, #Cacheline - 8 - $]		; R2 := cacheline
-			SUB	R3, R2, #1							; R3 := cacheline - 1
-			AND	R3, R0, R3							; R3 := adr MOD cacheline
-
-			SUB	R0, R0, R3							; R0 := adr - adr MOD cacheline
-			ADD	R1, R1, R3							; R1 := len + adr MOD cacheline
-			MOV	R5, #0								; R5 := 0 (counter value)
-
-			MOV	R3, #0
-			MCR	P15, 2, R3,  C0,  C0, 0				; Select cache level 1
-			LDR	R4, [PC, #L2COfs - 8 - $]			; R4 := L2 cache invalidate address register address
-
-		Loop:
-			CMP	R5, R1								; while R5 < R1
-			BEQ	Sync
-			BHI		Sync
-			STR	R0, [R4, #0]						; Invalidate Cache Level 2 By PA (R0)
-			DSB
-
-			MCR	P15, 0, R0,  C7, C6, 1				; Invalidate Cache Level 1 By MVA (R0)
-			ADD	R0, R0, R2							; R0 := R0 + cacheline
-			ADD	R5, R5, R2
-
-			B		Loop								; end
-
-		Sync:
-			DSB
-			LDR	R0, [PC, #L2CSync - 8 - $]		; R0 := L2 cache sync register address
-			MOV	R1, #1
-			STR	R1, [R0, #0]						; [R0] := 1
-		SyncLoop:										; repeat
-			LDR	R1, [R0, #0]						; R1 := l2 cache syc state
-			CMP	R1, #0
-			BEQ	Exit									; until R1 = 0
-			B		SyncLoop
-
-		Cacheline:	d32 cacheline
-		L2COfs:	d32 L2CCOffset
-		L2CSync:	d32 L2CCCacheSync
-
-		Exit:
-		END;
-	END InvalidateDCacheRange;
-
-	(**
-		Disable data cache for the memory range [adr, adr + len). Repeated cache disabling is recorded. A maximum of 127 successive disabling is supported.
-		Cache disabling is allowed for heap and stack memory ranges only.
-	*)
-	PROCEDURE DisableDCacheRange * (adr: ADDRESS; len: LONGINT);
-	VAR
-		range: ARRAY 1 OF Range;
-		end: ADDRESS;
-		ofs, entry: LONGINT;
-	BEGIN
-		(* Changing cache status allowed for heap and stack only. *)
-		ASSERT(((memHeapStart <= adr) & (adr + len <= memHeapStop)) OR ((memStackStart <= adr) & (adr + len <= memStackStop)));
-		end := adr + len;
-		Acquire(Memory);
-		WHILE adr < end DO
-			entry := GetFirstLevelEntry(adr - adr MOD M);
-			CASE entry MOD 4 OF
-				 0:
-					(* Page is not allocated: generate a data abort trap *)
-					Release(Memory);
-					ASSERT(entry MOD 4 # 0);
-				|flSection:
-					(* 1 MB heap page *)
-					IF enableCaching THEN
-						(* index in cache reference count array *)
-						ofs := (adr - memHeapStart) DIV M;
-						IF cacheRefs[ofs] = 0 THEN
-							(* First disabling: disable cache *)
-							range[0].adr := adr - adr MOD M;
-							range[0].size := M;
-							SetFirstLevelEntry(adr - adr MOD M, adr - adr MOD M(*SHRL(entry, 20)*), SrwUrw, Shareable + B, flSection);
-							InvalidateTLBEntry(adr);
-							FlushDCachePhysRange(adr - adr MOD M, M, range, 1);
-							cacheRefs[ofs] := 1
-						ELSE
-							(* Increase reference count and avoid overflows. *)
-							ASSERT(cacheRefs[ofs] < 127);
-							INC(cacheRefs[ofs])
-						END
-					END;
-					INC(adr, M);
-					DEC(adr, adr MOD M);
-				|flCoarse:
-					(* Second level pt *)
-					entry := GetSecondLevelEntry(adr - adr MOD PS);
-					CASE entry MOD 4 OF
-						 0:
-							(* Page is not allocated: generate a data abort trap *)
-							Release(Memory);
-							ASSERT(entry MOD 4 # 0);
-						|slSmall:
-							(* 4 kB stack page *)
-							IF enableCaching THEN
-								(* Index in cache reference count array *)
-								ofs := (adr - memStackStart) DIV PS + sysCacheStackOfs;
-								IF cacheRefs[ofs] = 0 THEN
-									(* First disabling: disable cache *)
-									range[0].adr := adr - adr MOD PS;
-									range[0].size := PS;
-									SetSecondLevelEntry(adr - adr MOD PS, SHRL(entry, PSlog2), FullAccess + 400H + B);
-									InvalidateTLBEntry(adr);
-									FlushDCachePhysRange(adr - adr MOD PS, PS, range, 1);
-									cacheRefs[ofs] := 1
-								ELSE
-									(* Increase reference count and avoid overflows *)
-									ASSERT(cacheRefs[ofs] < 127);
-									INC(cacheRefs[ofs])
-								END
-							END;
-							INC(adr, PS);
-							DEC(adr, adr MOD PS)
-					END;
-			END;
-		END;
-		Release(Memory)
-	END DisableDCacheRange;
-
-	(**
-		Enable data cache for the memory range [adr, adr + len).
-		The memory range must have been previously disabled.
-		It is the responsibility of client software to re-enable cache for the regions that it disabled.
-	*)
-	PROCEDURE EnableDCacheRange * (adr: ADDRESS; len: LONGINT);
-	VAR
-		end: ADDRESS;
-		ofs, entry: LONGINT;
-	BEGIN
-		(* Changing cache status allowed for heap and stack only. *)
-		ASSERT(((memHeapStart <= adr) & (adr < memHeapStop)) OR ((memStackStart <= adr) & (adr < memStackStop)));
-		(*InvalidateDCacheRange(adr - (adr MOD M), len + M - (adr + len) MOD M + adr MOD M);*)
-		Acquire(Memory);
-		end := adr + len;
-		WHILE adr < end DO
-			entry := GetFirstLevelEntry(SHRL(adr, LogM));
-			CASE entry MOD 4 OF
-				 0:
-					(* page not mapped: generate trap *)
-					Release(Memory);
-					ASSERT(entry MOD 4 # 0);
-				|flSection:
-					(* 1 MB heap page *)
-					IF enableCaching THEN
-						ofs := (adr - memHeapStart) DIV M;
-						ASSERT(cacheRefs[ofs] > 0);
-						IF cacheRefs[ofs] = 1 THEN
-							SetFirstLevelEntry(SHRL(adr, LogM), SHRL(entry, LogM), SrwUrw, Cacheable + Shareable, entry MOD 4);
-							InvalidateTLBEntry(adr);
-							cacheRefs[ofs] := 0
-						ELSE
-							DEC(cacheRefs[ofs])
-						END
-					END;
-					INC(adr, M);
-					DEC(adr, adr MOD M)
-				|flCoarse:
-					(* Second-level pt entry *)
-					entry := GetSecondLevelEntry(SHRL(adr, PSlog2));
-					CASE entry MOD 4 OF
-						 0:
-							(* Page not mapped: generate trap *)
-							Release(Memory);
-							ASSERT(entry MOD 4 # 0);
-						|slSmall:
-							(* 4 kB stack page *)
-							IF enableCaching THEN
-								ofs := (adr - memStackStart) DIV PS + sysCacheStackOfs;
-								ASSERT(cacheRefs[ofs] > 0);
-								IF cacheRefs[ofs] = 1 THEN
-									SetSecondLevelEntry(SHRL(adr, PSlog2), SHRL(entry, PSlog2), FullAccess + CB);
-									InvalidateTLBEntry(SHRL(adr, PSlog2));
-									cacheRefs[ofs] := 0
-								ELSE
-									DEC(cacheRefs[ofs])
-								END
-							END;
-							INC(adr, PS);
-							DEC(adr, adr MOD PS)
-					END;
-			END;
-		END;
-		Release(Memory)
-	END EnableDCacheRange;
-
-	(* InvalidateICache - invalidates the ICache. Works only in a priviledged mode. *)
-	PROCEDURE InvalidateICache*;
-	CODE
-		MCR p15, 0, R0, c7, c5, 0	; invalidate ICache & BTB
-		ISB
-		; cpwait
-		MRC p15, 0, R0, c2, c0, 0
-		MOV R0, R0
-		SUB PC, PC, #4
-		MOV R0, R0
-		MOV R0, R0
-		MOV R0, R0
-		MOV R0, R0
-	END InvalidateICache;
-
-	(* InvalidateTLB: data and instruction TLBs - Works only in a priviledged mode *)
-	PROCEDURE - InvalidateTLB *;
-	CODE
-		MCR p15, 0, R0, c8, c3, 0	; invalidate I+D TLB
-		ISB
-		; cpwait
-		MRC p15, 0, R0, c2, c0, 0
-		MOV R0, R0
-		SUB PC, PC, #4
-		MOV R0, R0
-		MOV R0, R0
-		MOV R0, R0
-		MOV R0, R0
-		DSB
-	END InvalidateTLB;
-
-	(* InvalidateTLBEntry - invalidates the TLB for a given virtual address. Works only in a priviledged mode *)
-	PROCEDURE - InvalidateTLBEntry(address: LONGINT);
-	CODE
-		LDR R0, [SP, #address]
-		ADD SP, SP, #4
-		;MCR p15, 0, R0, c8, c6, 1	; invalidate address
-		MCR p15, 0, R0, c8, c3, 1	; invalidate address
-		ISB
-		; cpwait
-		MRC p15, 0, R0, c2, c0, 0
-		MOV R0, R0
-		SUB PC, PC, #4
-		MOV R0, R0
-		MOV R0, R0
-		MOV R0, R0
-		MOV R0, R0
-		DSB
-	END InvalidateTLBEntry;
-
-	(* GetControlRegister - returns the control register of coprocessor 15 *)
-	PROCEDURE -GetControlRegister(): SET;
-	CODE
-		MRC p15, 0, R0, c1, c0, 0
-	END GetControlRegister;
-
-	(* SetControlRegister - sets the control register of coprocessor 15. Works only in a priviledged mode *)
-	PROCEDURE -SetControlRegister(cr: SET);
-	CODE
-		LDR R0, [SP, #cr]
-		ADD SP, SP, #4	; remove parameter
-		MCR p15, 0, R0, c1, c0, 0
-		ISB
-		; cpwait
-		MRC p15, 0, R0, c2, c0, 0
-		MOV R0, R0
-		SUB PC, PC, #4
-		MOV R0, R0
-		MOV R0, R0
-		MOV R0, R0
-		MOV R0, R0
-	END SetControlRegister;
-
-	(* DrainWriteBuffer - drains the write buffer. Works only in a priviledged mode *)
-	PROCEDURE DrainWriteBuffer*;
-	CODE
-		MCR p15, 0, R0, c7, c10, 4	; drain WB
-		ISB
-		; cpwait
-		MRC p15, 0, R0, c2, c0, 0
-		MOV R0, R0
-		SUB PC, PC, #4
-		MOV R0, R0
-		MOV R0, R0
-		MOV R0, R0
-		MOV R0, R0
-	END DrainWriteBuffer;
-
-	PROCEDURE -CurrentBP*(): ADDRESS;
-	CODE
-		MOV R0, FP
-	END CurrentBP;
-
-	PROCEDURE -CurrentSP*(): ADDRESS;
-	CODE
-		MOV R0, SP
-	END CurrentSP;
-
-	PROCEDURE -CurrentPC*(): ADDRESS;
-	CODE
-		MOV R0, PC
-	END CurrentPC;
-
-	PROCEDURE -SetSP*(sp: ADDRESS);
-	CODE
-		LDR R0, [SP, #sp]
-		MOV SP, R0
-		;STR SP, [SP, #sp]
-	END SetSP;
-
-	PROCEDURE -SetBP*(bp: ADDRESS);
-	CODE
-		STR FP, [SP, #bp]
-		ADD SP, SP, #4
-	END SetBP;
-
-	PROCEDURE -GetSP*(): LONGINT;
-	CODE
-		MOV R0, SP
-	END GetSP;
-
-	PROCEDURE -GetBP*(): LONGINT;
-	CODE
-		MOV R0, FP
-	END GetBP;
-
-	PROCEDURE GetTimer*(): HUGEINT;
-	VAR t: ARRAY 2 OF LONGINT;
-	BEGIN
-		REPEAT
-			t[1] := SYSTEM.GET32(Platform.GlobalTimerCounterRegister1);
-			t[0] := SYSTEM.GET32(Platform.GlobalTimerCounterRegister0);
-		UNTIL t[1] = SYSTEM.GET32(Platform.GlobalTimerCounterRegister1);
-		RETURN SYSTEM.VAL(HUGEINT,t);
-	END GetTimer;
-
-	(* ===== Multiprocessor booting ===== *)
-	(** Initializes non-booting processors *)
-	PROCEDURE InitProcessors*;
-	VAR
-		i: LONGINT;
-		val: ARRAY 8 OF CHAR;
-	BEGIN
-		GetConfig("TraceCpu", val);
-		traceCpus := val = "1";
-		InstallHandler(HandleUPTimer, PrivateTimerIRQ);
-		InstallHandler(TimerInterruptHandler, PrivateTimerIRQ);
-		InitTicks;
-		InitWatchdog;
-		CleanDCache;
-		DrainWriteBuffer;
-		FOR i := 1 TO numProcessors - 1 DO
-			StartProcessor(i, BootMP);
-		END;
-	END InitProcessors;
-
-	PROCEDURE StartAll*;
-	BEGIN
-	END StartAll;
-
-	(** Start core id on procedure p. *)
-	PROCEDURE StartProcessor(id: LONGINT; p: PROCEDURE);
-	VAR
-		time: LONGINT;
-		started: BOOLEAN;
-	BEGIN
-		IF traceCpus THEN
-			Acquire(TraceOutput);
-			Trace.String("Starting CPU");
-			Trace.Int(id, 0);
-			Trace.String(" on address ");
-			Trace.Address(SYSTEM.VAL(ADDRESS, p));
-			Trace.Ln;
-			Release(TraceOutput)
-		END;
-		time := ticks + 5000;
-		Initializer.secondaryProcId := id;
-		Initializer.secondaryBootProc :=  SYSTEM.VAL(ADDRESS, p);
-		FlushDCacheRange(ADDRESSOF(Initializer.secondaryProcId), 4);
-		FlushDCacheRange(ADDRESSOF(Initializer.secondaryBootProc), 4);
-		CODE
-			SEV
-		END;
-
-		REPEAT
-			started := id IN allProcessors;
-		UNTIL started OR (time <= ticks);
-		IF id IN allProcessors THEN
-			IF traceCpus THEN
-				Acquire(TraceOutput);
-				Trace.String("Confirm: CPU");
-				Trace.Int(id, 0);
-				Trace.StringLn(" started");
-				Release(TraceOutput)
-			END
-		ELSE
-			Acquire(TraceOutput);
-			Trace.String("WARNING: Could not start CPU");
-			Trace.Int(id, 0);
-			Trace.Ln;
-			Release(TraceOutput)
-		END
-	END StartProcessor;
-
-	(** Init Memory for non-booting processors.
-		This enables MMU and copies the mapping of CPU0
-	*)
-	PROCEDURE InitMPMemory;
-	VAR
-		tbFlags: LONGINT;
-	BEGIN
-		IF enableCaching THEN
-			tbFlags := 7BH
-		ELSE
-			tbFlags := 0
-		END;
-		EnableMM(sysFirstLvlPtStart, tbFlags, 2000H + 1007H);
-	END InitMPMemory;
-
-	(** Init code fo a non-booting processor. No local variable allowed. *)
-	PROCEDURE {NOPAF} BootMP;
-	BEGIN
-		(* Setup stack *)
-		SYSTEM.LDPSR( 0, Platform.IRQMode + Platform.FIQDisabled + Platform.IRQDisabled );
-		SYSTEM.SETSP(sysIntStackStart + 1000H * 5);
-
-		SYSTEM.LDPSR( 0, Platform.UndefMode + Platform.FIQDisabled + Platform.IRQDisabled );
-		SYSTEM.SETSP(sysIntStackStart + 1000H * 6);
-
-		SYSTEM.LDPSR( 0, Platform.AbortMode + Platform.FIQDisabled + Platform.IRQDisabled );
-		SYSTEM.SETSP(sysIntStackStart + 1000H * 7);
-
-		SYSTEM.LDPSR( 0, Platform.SVCMode + Platform.FIQDisabled + Platform.IRQDisabled );   (* Disable interrupts, init SP, FP *)
-		SYSTEM.SETSP(sysIntStackStart + 1000H * 8);
-
-		SYSTEM.LDPSR( 0, Platform.SystemMode + Platform.FIQDisabled + Platform.IRQDisabled );   (* Disable interrupts, init SP, FP *)
-		SYSTEM.SETSP(sysIntStackStart + 1000H * 8);
-
-		Initializer.InvalidateDCache;
-		SetSmpMode;
-		EnableL1Cache;
-		EnableCoprocessors;
-		InitFPU;
-		InvalidateICache;
-		Initializer.InvalidateDCache;
-		InitMPMemory;
-		(*InvalidateDCacheRange(4096, SYSTEM.VAL(ADDRESS, LastAddress));*)
-		(*InvalidateDCacheRange(memSysHighStart, memSysHighStop - memSysHighStart);*)
-		(*CODE
-			DSB
-		END;*)
-
-		InitInterrupts;
-		EnableIRQ(PrivateTimerIRQ);
-		EnableInterrupts;
-
-		IF traceCpus THEN
-			Acquire(TraceOutput);
-			Trace.String("CPU "); Trace.Int(ID(), 0); Trace.StringLn(" started.");
-			Release(TraceOutput)
-		END;
-		Acquire(Processors);
-		INCL(allProcessors, ID());
-		Release(Processors);
-		InitTicks;
-		InitWatchdog;
-		start;
-		HALT(400)
-	END BootMP;
-
-	PROCEDURE KernelCallHLT*;
-	BEGIN
-	END KernelCallHLT;
-
-	(* function returning the number of processors that are available to Aos *)
-	PROCEDURE NumberOfProcessors*( ): LONGINT;
-	BEGIN
-		RETURN numberOfProcessors
-	END NumberOfProcessors;
-
-	(*! non portable code, for native Aos only *)
-	PROCEDURE SetNumberOfProcessors*(num: LONGINT);
-	BEGIN
-		numberOfProcessors := num;
-	END SetNumberOfProcessors;
-
-	(* ===== Context Switching ===== *)
-	(** Pushes state of the processor on the stack. Used in task-switching.
-		Does not exactly represent the layout of State. Pushed data is always used by JumpState.
-	 *)
-	PROCEDURE -PushState*(CONST state: State);
-	CODE
-		LDR R0, [SP, #0]	; R0 <- address of state
-		ADD SP, SP, #8
-
-		LDR R1, [R0, #60]	; push PC
-		STR R1, [SP, #-4]!
-		LDR R1, [R0, #56]	; push LR
-		STR R1, [SP, #-4]!
-		LDR R1, [R0, #48]	; push FP
-		STR R1, [SP, #-4]!
-		LDR R1, [R0, #44]	; push R11
-		STR R1, [SP, #-4]!
-		LDR R1, [R0, #40]	; push R10
-		STR R1, [SP, #-4]!
-		LDR R1, [R0, #36]	; push R9
-		STR R1, [SP, #-4]!
-		LDR R1, [R0, #32]	; push R8
-		STR R1, [SP, #-4]!
-		LDR R1, [R0, #28]	; push R7
-		STR R1, [SP, #-4]!
-		LDR R1, [R0, #24]	; push R6
-		STR R1, [SP, #-4]!
-		LDR R1, [R0, #20]	; push R5
-		STR R1, [SP, #-4]!
-		LDR R1, [R0, #16]	; push R4
-		STR R1, [SP, #-4]!
-		LDR R1, [R0, #12]	; push R3
-		STR R1, [SP, #-4]!
-		LDR R1, [R0, #8]	; push R2
-		STR R1, [SP, #-4]!
-		LDR R1, [R0, #4]	; push R1
-		STR R1, [SP, #-4]!
-		LDR R1, [R0, #0]	; push R0
-		STR R1, [SP, #-4]!
-		LDR R1, [R0, #64]	; push SPSR
-		STR R1, [SP, #-4]!
-	END PushState;
-
-	(** Pops a processor state from the stack and restore it. Including jumping to the PC. *)
-	PROCEDURE -JumpState*;
-	CODE
-		; Load PSR
-		LDR R0, [SP], #4
-		MSR CPSR_cxsf, R0	; set CPSR
-
-		; Load registers, including branch
-		LDMIA SP!, {R0, R1, R2, R3, R4, R5, R6, R7, R8, R9, R10, R11, FP, LR}
-		LDR PC, [SP], #4
-	END JumpState;
-
-	PROCEDURE CopyState*(CONST from: State; VAR to: State);
-	BEGIN
-		to.R[0] := from.R[0];
-		to.R[1] := from.R[1];
-		to.R[2] := from.R[2];
-		to.R[3] := from.R[3];
-		to.R[4] := from.R[4];
-		to.R[5] := from.R[5];
-		to.R[6] := from.R[6];
-		to.R[7] := from.R[7];
-		to.R[8] := from.R[8];
-		to.R[9] := from.R[9];
-		to.R[10] := from.R[10];
-		to.R[11] := from.R[11];
-		to.BP := from.BP;
-		to.SP := from.SP;
-		to.LR := from.LR;
-		to.PC := from.PC;
-		to.PSR := from.PSR;
-	END CopyState;
-
-	PROCEDURE -JumpToUserLevel*(userFP: ADDRESS);
-	CODE
-		; this is an inlined procedure, so the 'userFP' parameter lies on top of the stack
-		LDR	FP, [SP, #userFP]	; pop FP (FP is not a banked register)
-		ADD	SP, SP, #4
-
-		MRS	R0, CPSR			; get current PSR
-		BIC		R0, R0, #1FH		; clear bits 4:0
-		ORR	R0, R0, #1FH		; CPU mode = System
-		MSR	CPSR_c, R0			; switch mode
-
-		MOV	SP, FP
-		LDMIA	SP! ,  {FP, LR}
-		BX		LR
-
-	END JumpToUserLevel;
-
-	PROCEDURE UpdateState*;
-	BEGIN
-	END UpdateState;
-
-	(** Save complete VFP/NEON state *)
-	PROCEDURE -FPUSaveFull*(VAR state: NEONState);
-	CODE
-		LDR R0, [SP, #state]
-		ADD SP, SP, #8
-
-		VST1 D0, R0
-		ADD R0, R0, #8
-		VST1 D1, R0
-		ADD R0, R0, #8
-		VST1 D2, R0
-		ADD R0, R0, #8
-		VST1 D3, R0
-		ADD R0, R0, #8
-		VST1 D4, R0
-		ADD R0, R0, #8
-		VST1 D5, R0
-		ADD R0, R0, #8
-		VST1 D6, R0
-		ADD R0, R0, #8
-		VST1 D7, R0
-		ADD R0, R0, #8
-		VST1 D8, R0
-		ADD R0, R0, #8
-		VST1 D9, R0
-		ADD R0, R0, #8
-		VST1 D10, R0
-		ADD R0, R0, #8
-		VST1 D11, R0
-		ADD R0, R0, #8
-		VST1 D12, R0
-		ADD R0, R0, #8
-		VST1 D13, R0
-		ADD R0, R0, #8
-		VST1 D14, R0
-		ADD R0, R0, #8
-		VST1 D15, R0
-		ADD R0, R0, #8
-		
-		VSTR D16, R0, #0
-		ADD R0, R0, #8
-		VSTR D17, R0, #0
-		ADD R0, R0, #8
-		VSTR D18, R0, #0
-		ADD R0, R0, #8
-		VSTR D19, R0, #0
-		ADD R0, R0, #8
-		VSTR D20, R0, #0
-		ADD R0, R0, #8
-		VSTR D21, R0, #0
-		ADD R0, R0, #8
-		VSTR D22, R0, #0
-		ADD R0, R0, #8
-		VSTR D23, R0, #0
-		ADD R0, R0, #8
-		VSTR D24, R0, #0
-		ADD R0, R0, #8
-		VSTR D25, R0, #0
-		ADD R0, R0, #8
-		VSTR D26, R0, #0
-		ADD R0, R0, #8
-		VSTR D27, R0, #0
-		ADD R0, R0, #8
-		VSTR D28, R0, #0
-		ADD R0, R0, #8
-		VSTR D29, R0, #0
-		ADD R0, R0, #8
-		VSTR D30, R0, #0
-		ADD R0, R0, #8
-		VSTR D31, R0, #0
-		ADD R0, R0, #8
-
-		VMRS	R1, FPSCR
-		STR	R1, [R0, #0]
-		ADD	R0, R0, #4
-		VMRS	R1, FPEXC
-		STR	R1, [R0, #0]
-	END FPUSaveFull;
-
-	(** Save minimal VFP/NEON state *)
-	PROCEDURE -FPUSaveMin*(VAR state: NEONState);
-	CODE
-		ADD SP, SP, #4
-	END FPUSaveMin;
-
-	(** Restore full VFP/NEON state *)
-	PROCEDURE -FPURestoreFull*(VAR state: NEONState);
-	CODE
-		LDR R0, [SP, #state];
-		ADD SP, SP, #8
-
-		VLD1 D0, R0
-		ADD R0, R0, #8
-		VLD1 D1, R0
-		ADD R0, R0, #8
-		VLD1 D2, R0
-		ADD R0, R0, #8
-		VLD1 D3, R0
-		ADD R0, R0, #8
-		VLD1 D4, R0
-		ADD R0, R0, #8
-		VLD1 D5, R0
-		ADD R0, R0, #8
-		VLD1 D6, R0
-		ADD R0, R0, #8
-		VLD1 D7, R0
-		ADD R0, R0, #8
-		VLD1 D8, R0
-		ADD R0, R0, #8
-		VLD1 D9, R0
-		ADD R0, R0, #8
-		VLD1 D10, R0
-		ADD R0, R0, #8
-		VLD1 D11, R0
-		ADD R0, R0, #8
-		VLD1 D12, R0
-		ADD R0, R0, #8
-		VLD1 D13, R0
-		ADD R0, R0, #8
-		VLD1 D14, R0
-		ADD R0, R0, #8
-		VLD1 D15, R0
-		ADD R0, R0, #8
-
-		VLDR D16, R0, #0
-		ADD R0, R0, #8
-		VLDR D17, R0, #0
-		ADD R0, R0, #8
-		VLDR D18, R0, #0
-		ADD R0, R0, #8
-		VLDR D19, R0, #0
-		ADD R0, R0, #8
-		VLDR D20, R0, #0
-		ADD R0, R0, #8
-		VLDR D21, R0, #0
-		ADD R0, R0, #8
-		VLDR D22, R0, #0
-		ADD R0, R0, #8
-		VLDR D23, R0, #0
-		ADD R0, R0, #8
-		VLDR D24, R0, #0
-		ADD R0, R0, #8
-		VLDR D25, R0, #0
-		ADD R0, R0, #8
-		VLDR D26, R0, #0
-		ADD R0, R0, #8
-		VLDR D27, R0, #0
-		ADD R0, R0, #8
-		VLDR D28, R0, #0
-		ADD R0, R0, #8
-		VLDR D29, R0, #0
-		ADD R0, R0, #8
-		VLDR D30, R0, #0
-		ADD R0, R0, #8
-		VLDR D31, R0, #0
-		ADD R0, R0, #8
-
-		LDR	R1, [R0, #0]
-		VMSR	FPSCR, R1
-		ADD	R0, R0, #4
-		LDR	R1, [R0, #0]
-		VMSR	FPEXC, R1
-	END FPURestoreFull;
-
-	(** Restore minimal VFP/NEON state *)
-	PROCEDURE -FPURestoreMin*(VAR state: NEONState);
-	CODE
-		ADD SP, SP, #4
-	END FPURestoreMin;
-
-	(* ===== Interrupts ===== *)
-	(* Taken from Minos/Kernel.Mos *)
-	PROCEDURE EnableInterrupts*;
-	VAR cpsr: LONGINT;
-	BEGIN
-		SYSTEM.STPSR(0, cpsr);
-		cpsr := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, cpsr) - {7(*, 8*)});
-		SYSTEM.LDPSR(0, cpsr);
-		(*SYSTEM.PUT32(Platform.ICDDCR, {EnableSecure, EnableNonSecure});*)
-	END EnableInterrupts;
-
-	(* Taken from Minos/Kernel.Mos *)
-	PROCEDURE DisableInterrupts*;
-	VAR cpsr: LONGINT;
-	BEGIN
-		SYSTEM.STPSR(0, cpsr);
-		cpsr := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, cpsr) + {7(*, 8*)});
-		SYSTEM.LDPSR( 0, cpsr);
-		(*SYSTEM.PUT32(Platform.ICDDCR, {});*)
-	END DisableInterrupts;
-
-	(** AreInterruptsEnabled - returns TRUE if interrupts are enabled at the current processor level, FALSE otherwise *)
-	PROCEDURE AreInterruptsEnabled*(): BOOLEAN;
-	CODE
-		MRS	R0, CPSR	; move CPSR to R0
-		TST	R0, #80H	; was IBit set ?
-		MOVEQ	R0, #1	; no, interrupts are enabled
-		MOVNE	R0, #0	; yep, interrupts are disabled
-	END AreInterruptsEnabled;
-
-	(* InstallDefaultInterrupts - installs default interrupt handlers *)
-	PROCEDURE InstallDefaultInterrupts;
-		VAR p: PROCEDURE; base: ADDRESS;
-		i, int: LONGINT;
-	BEGIN
-		base := 0;
-		(* Install all *Glue procedures. *)
-		p := undefGlue; SYSTEM.PUT32(base + Undef, SYSTEM.VAL(LONGINT, p));
-		p := SWIGlue; SYSTEM.PUT32(base + Swi, SYSTEM.VAL(LONGINT, p));
-		p := prefetchGlue; SYSTEM.PUT32(base + Prefetch, SYSTEM.VAL(LONGINT, p));
-		p := dataGlue; SYSTEM.PUT32(base + Data, SYSTEM.VAL(LONGINT, p));
-		p := DefaultIRQ; SYSTEM.PUT32(base + Irq, SYSTEM.VAL(LONGINT, p));
-		p := fiqGlue; SYSTEM.PUT32(base + Fiq, SYSTEM.VAL(LONGINT, p));
-
-		(* Install default exception handlers *)
-		InstallExceptionHandler(DefaultUndefined, Undef);
-		InstallExceptionHandler(DefaultSWI, Swi);
-		InstallExceptionHandler(DefaultPrefetchAbort, Prefetch);
-		InstallExceptionHandler(DefaultDataAbort, Data);
-		InstallExceptionHandler(DefaultFIQ, Fiq);
-
-		FOR int := 0 TO MaxIRQ DO
-			FOR i := 0 TO MaxIRQHandlers -1 DO
-				irqHandler[int, i] := NIL
-			END
-		END;
-	END InstallDefaultInterrupts;
-
-	(* DefaultUndef - default handler for undefined instruction exceptions *)
-	PROCEDURE DefaultUndefined (VAR state: State);
-	VAR
-		instn: LONGINT;
-	BEGIN
-		instn := SYSTEM.GET32(state.PC);
-
-		Acquire(TraceOutput);
-		Trace.Ln;
-		Trace.StringLn("Undefined Instruction Trap:");
-		Trace.String("  pc: "); Trace.Address(state.PC); Trace.Ln;
-		Trace.String("  instruction: "); Trace.Hex(instn, -8); Trace.Ln;
-		Trace.String("  CPU: "); Trace.Int(ID(), 0); Trace.Ln;
-
-		TraceState(state);
-		Trace.String("Kernel Halted");
-		Release(TraceOutput);
-		LOOP END
-	END DefaultUndefined;
-
-	(* DefaultSWI - default handler for software interrupts *)
-	PROCEDURE DefaultSWI (VAR state: State);
-	BEGIN
-		Acquire(TraceOutput);
-		Trace.Ln;
-		Trace.StringLn("Software Interrupt:");
-		Trace.String("  pc: "); Trace.Address(state.PC); Trace.Ln;
-		Trace.String("  number: "); Trace.Int(state.INT, -8); Trace.Ln;
-		Trace.String("  CPU: "); Trace.Int(ID(), 0); Trace.Ln;
-
-		TraceState(state);
-		Trace.Ln;
-		Trace.String("Kernel halted.");
-		Release(TraceOutput);
-		LOOP END
-	END DefaultSWI;
-
-	(* Instruction Prefetch abort *)
-	PROCEDURE DefaultPrefetchAbort (VAR state: State);
-	BEGIN
-		Acquire(TraceOutput);
-		Trace.String("Prefetch abort at location: "); Trace.Address(state.PC); Trace.Ln;
-		Trace.String(" CPU: "); Trace.Int(ID(), 0); Trace.Ln;
-		Trace.String("  FP: "); Trace.Address(state.BP); Trace.Ln;
-		Trace.String("SPSR: "); Trace.Hex(state.PSR, -8); Trace.Ln;
-
-		TraceState(state);
-		Trace.Ln;
-		Trace.StringLn("Kernel Halted");
-		Release(TraceOutput);
-		LOOP END;
-	END DefaultPrefetchAbort;
-
-	(* DefaultDataAbort - default handler for data abort exceptions *)
-	PROCEDURE DefaultDataAbort (VAR state: State);
-	VAR
-		faultAdr: ADDRESS;
-		faultStatus: LONGINT;
-		stack: Stack;
-	BEGIN
-		GetPageFault(faultAdr, faultStatus);
-		(*getStack(stack);
-
-		IF ~ExtendStack(stack, faultAdr) THEN*)
-			Acquire(TraceOutput);
-			IF faultAdr < 4 * k THEN
-				Trace.StringLn("NIL pointer exception");
-				Trace.String("pc:	"); Trace.Address(state.PC); Trace.Ln
-			ELSE
-				Trace.StringLn("Data Abort Trap");
-				Trace.String("pc:		"); Trace.Address(state.PC); Trace.Ln;
-				Trace.String("instn:	"); Trace.Address(SYSTEM.GET32(state.PC)); Trace.Ln;
-				Trace.String("address:	"); Trace.Address(faultAdr); Trace.Ln;
-				Trace.String("status:	"); Trace.Address(faultStatus); Trace.Ln
-			END;
-
-			TraceState(state);
-			Trace.Ln; Trace.StringLn("Kernel Halted.");
-			Release(TraceOutput);
-			LOOP END
-		(*END*)
-	END DefaultDataAbort;
-
-	(* DefaultIRQ - default handler for IRQs *)
-	PROCEDURE DefaultIRQ;
-	BEGIN
-		Acquire(TraceOutput);
-		Trace.StringLn("(IRQ)");
-		Trace.String("  CPU: "); Trace.Address(ID()); Trace.Ln;
-
-		Trace.Ln; Trace.StringLn("Kernel Halted");
-		Release(TraceOutput);
-		LOOP END
-	END DefaultIRQ;
-
-	(* DefaultFIQ - default handler for fast interrupts *)
-	(*PROCEDURE DefaultFIQ;
-	BEGIN
-		Trace.StringLn("Fast IRQ Trap");
-		Trace.String("  CPU: "); Trace.Address(ID()); Trace.Ln;
-		Trace.String("Kernel halted.");
-		LOOP END
-	END DefaultFIQ;*)
-	PROCEDURE DefaultFIQ (VAR state: State);
-	BEGIN
-		Acquire(TraceOutput);
-		Trace.StringLn("Fast IRQ Trap");
-		Trace.String("  CPU: "); Trace.Address(ID()); Trace.Ln;
-		Trace.String("Kernel halted.");
-		Release(TraceOutput);
-		LOOP END
-	END DefaultFIQ;
-
-	PROCEDURE DummyISR(VAR state: State);
-	VAR i: LONGINT; icip : SET;
-	BEGIN
-		icip := SYSTEM.VAL(SET, SYSTEM.GET32((*IC +*) Platform.ICIP));
-		FOR i:=MinIRQ TO MaxIRQ DO
-			IF i IN icip THEN
-				state.INT := i;
-				dummyIRQHandler[state.INT].h(state);
-			END;
-		END;
-	END DummyISR;
-
-	(** EnableIRQ - enables a hardware interrupt (also done automatically by InstallHandler) *)
-	PROCEDURE InEnableIRQ(num: LONGINT);
-	BEGIN
-		ASSERT((MinIRQ <= num) & (num<= MaxIRQ));
-		(*IF TRUE OR (num = 53) THEN Trace.StringLn("Enable USB IRQ") END;*)
-		SYSTEM.PUT32(Platform.ICDISER + 4 * (num DIV 32) , {num MOD 32});
-	END InEnableIRQ;
-
-	PROCEDURE EnableIRQ*(int: LONGINT);
-	BEGIN
-		Acquire(Interrupts);
-		InEnableIRQ(int);
-		Release(Interrupts)
-	END EnableIRQ;
-
-	(** DisableIRQ - disables a hardware interrupt (also done automatically by RemoveHandler) *)
-	PROCEDURE InDisableIRQ(num: LONGINT);
-	BEGIN
-		ASSERT((MinIRQ <= num) & (num <= MaxIRQ));
-		(*IF TRUE OR (num = 53) THEN Trace.StringLn("Disable USB IRQ") END;*)
-		SYSTEM.PUT32(Platform.ICDICER + 4 * (num DIV 32) , {num MOD 32});
-	END InDisableIRQ;
-
-	PROCEDURE DisableIRQ*(int: LONGINT);
-	BEGIN
-		Acquire(Interrupts);
-		InDisableIRQ(int);
-		Release(Interrupts)
-	END DisableIRQ;
-
-	PROCEDURE IsIRQEnabled(int: LONGINT): BOOLEAN;
-	VAR
-		enabled: BOOLEAN;
-		reg: SET;
-	BEGIN
-		Acquire(Interrupts);
-		SYSTEM.GET(Platform.ICDISER + 4 * (int DIV 32) , reg);
-		enabled := (int MOD 32) IN reg;
-		Release(Interrupts);
-		RETURN enabled
-	END IsIRQEnabled;
-
-	(** InstallHandler - installs a interrupt handler & enable IRQ if necessary.
-		On entry to h interrupts are disabled and may be enabled with XXXXX.  After handling the interrupt
-		the state of interrupts are restored.  The acknowledgement of a hardware interrupt is done automatically.
-		IRQs are mapped from MinIRQ to MaxIRQ. *)
-	PROCEDURE InstallHandler*(h: Handler; int: LONGINT);
-	VAR
-		i: LONGINT;
-	BEGIN
-		(*NEW(n);*)	(* outside locked region, to allow gc *)
-		i := 0;
-		WHILE irqHandler[int, i] # NIL DO
-			INC(i)
-		END;
-
-		Acquire(Interrupts);
-			(* IRQGlue may traverse list while it is being modified. *)
-		irqHandler[int, i] := h;
-
-		IF DummyTest THEN
-			irqHandler[int, i] := DummyISR;
-			dummyIRQHandler[int].h := h;
-		END;
-
- 		IF (int >= MinIRQ) & (int <= MaxIRQ) THEN InEnableIRQ(int) END;
-
-		Release(Interrupts);
-
-		IF traceInterrupts THEN
-			Acquire(TraceOutput);
-			Trace.String("[Machine]InstallHandler: h = 0x"); Trace.Address(SYSTEM.VAL(LONGINT, h));
-			Trace.String("; int = "); Trace.Address(int);
-			Trace.String("; IRQMask = 0x"); Trace.Address(SYSTEM.VAL(LONGINT, IRQMask));
-			Trace.Ln;
-			Release(TraceOutput)
-		END
-	END InstallHandler;
-
-	PROCEDURE RemoveHandler * (h: Handler; int: LONGINT);
-	END RemoveHandler;
-
-	PROCEDURE InstallExceptionHandler * (h: Handler; e: LONGINT);
-	BEGIN
-		CASE e OF
-			 Undef: undefHandler := h
-			|Swi: swiHandler := h
-			|Prefetch: prefetchHandler := h
-			|Data: dataHandler := h
-			|Fiq: fiqHandler := h
-		ELSE
-			Trace.String("Unknown exception offset: ");
-			Trace.Int(e, 0);
-			Trace.Ln;
-			HALT(99)
-		END
-	END InstallExceptionHandler;
-
-	(*
-		IRQGlue - every IRQ enters through this handler. It reads the IRR (Interrupt Request Register) of the PIC and calls the
-		appropriate handlers for each pending IRQ. A problem (which caused a nice debugging session of ~1 day...) is this
-		'VAR state: State' parameter. Theoretically, a interrupt handler can change the values of this field to continue execution in
-		a different process, e.g. the scheduler works that way. This means that we can't call the handlers of every pending IRQ in
-		one loop - we must exit this procedure after each handled IRQ.
-
-		- routine has been changed so that all handlers of pending interrupts will be called
-		- using ICIP (interrupt Pending Register) instead of IRR (Interrupt Request Register)
-		- after handler call we don't turn interrupts off explicitly
-	*)
-	PROCEDURE {NOPAF} IRQGlue;
-	CODE
-		CLREX
-		SUB		SP, SP, #72						; Room for the State record
-		STMIA		SP, {R0, R1, R2, R3, R4, R5, R6, R7, R8, R9, R10, R11, FP, SP, LR}^
-		MOV		R0, R0
-		ADD		SP, SP, #60
-		SUB		R0, LR, #4						; return address = LR-4
-		STR		R0, [SP], #4					; push ('PC' in 'State'). SP points to offset 64
-		MRS		R0, SPSR						; get saved PSR
-		STR		R0, [SP], #4					; push ('PSR' in 'State'). SP points to offset 68
-
-		SUB		SP, SP, #68
-		MOV		R11, SP
-
-		LDR		R5, [pc, #state-$-8]			; load address of stateTag constant
-		STR		R5, [SP, #-4]!					; push value (type tag)
-		STR		R11, [SP, #-4]!					; push parameter (address of 'State' parameter)
-
-		BL			IRQCaller
-		LDR		R11, [SP], #4
-		ADD		SP, SP, #4
-
-		ADD		SP, SP, #72						; adjust SP & remove PAF
-		LDR		R0, [R11, #64]					; load 'State.PSR'
-		MSR		SPSR_cxsf, R0					; and store it into SPSR
-		LDR		R0, [R11, #60]					; load 'State.PC'...
-		MOV		LR, R0							; ...into LR (because we will return to LR, not PC)
-		ADD		R0, R11, #48					; R0 points to 'State.SP'
-		LDMIA		R0, { FP, SP, LR }^				; load 'State.SP' & 'State.LR' into user mode registers
-		MOV		R0, R0							; nop, to not access banked registers after LDM ^
-		LDMIA		R11, { R0, R1, R2, R3, R4, R5, R6, R7, R8, R9, R10 } 				; restore unbanked regs
-		LDR		R11, [R11, #44]
-
-		MOVS		PC, LR							; SPSR -> CPSR & return
-
-		; Data section
-	state:	d32 stateTag							; address of stateTag
-	END IRQGlue;
-
-	(** Calls all handlers for all pending IRQs.
-		Is called by IRQGlue.
-	*)
-	PROCEDURE IRQCaller(VAR state: State);
-	VAR i, reg, irq, ack, count: LONGINT;  handler: Handler;  icip: SET;
-	BEGIN
-		ack := SYSTEM.GET32(Platform.ICCIAR);
-		(* service this irq *)
-		irq := ack MOD 1024;
-		IF irq # 1023 THEN (* not a spurious IRQ *)
-			state.INT := irq;
-			IF (MinIRQ <= irq) & (irq<= MaxIRQ) THEN
-				count := 0;
-				handler := irqHandler[irq, count];
-				WHILE (handler # NIL) & (count < MaxIRQHandlers - 1) DO
-					handler(state);
-					DisableInterrupts; (* handler may have reactivated interrupts *)
-					INC(count);
-					handler := irqHandler[irq, count];
-				END;
-				SYSTEM.PUT32(Platform.ICCEOIR, ack);
-			END;
-		END;
-
-		(* service pending IRQs *)
-		FOR reg := 0 TO 2 DO
-			SYSTEM.GET( Platform.ICDISPR+reg*4, icip );
-			i := 0;
-			WHILE (i <= 31) & (icip # {}) DO
-				IF (i IN icip) THEN
-					icip := icip - {i};
-					irq := i+reg*32;
-
-					(* Do not service pending interrupts that are disabled: this allows state triggered interrupts to be
-					 * handled by software in an interrupt process. *)
-					IF IsIRQEnabled(irq) & (irq # PrivateTimerIRQ) THEN
-						(*Trace.String("Pending IRQ "); Trace.Int(irq, 0); Trace.Ln;*)
-						count := 0;
-						state.INT := irq;
-						handler := irqHandler[irq, count];
-						WHILE (handler # NIL) & (count < MaxIRQHandlers - 1) DO
-							handler(state);
-							DisableInterrupts; (* handler may have reactivated interrupts *)
-							INC(count);
-							handler := irqHandler[irq, count]
-						END;
-						SYSTEM.PUT32(Platform.ICCEOIR, irq); (* end of interrupt *)
-						SYSTEM.PUT32(Platform.ICDICPR+reg*4, {i}); (* clear pending bit *)
-					END
-				END;
-				INC( i )
-			END
-		END;
-	END IRQCaller;
-
-	(** Undefined Exception Handler. Saves the processor state and calls the registered handler. *)
-	PROCEDURE {NOPAF} undefGlue;
-	CODE
-		CLREX
-		SUB		SP, SP, #72						; Room for the State record
-		STMIA		SP, {R0, R1, R2, R3, R4, R5, R6, R7, R8, R9, R10, R11, FP, SP, LR}^
-		MOV		R0, R0
-		ADD		SP, SP, #60
-		SUB		R0, LR, #4						; return address = LR-4
-		STR		R0, [SP], #4					; push ('PC' in 'State'). SP points to offset 64
-		MRS		R0, SPSR						; get saved PSR
-		STR		R0, [SP], #4					; push ('PSR' in 'State'). SP points to offset 68
-		LDR		R0, [PC, #undefined-8-$]		; save -Undef in the INT field
-		STR		R0, [SP], #4
-
-		SUB		SP, SP, #72
-		MOV		R11, SP
-
-		LDR		R5, [pc, #state-$-8]			; load address of stateTag constant
-		STR		R5, [SP, #-4]!					; push value (type tag)
-		STR		R11, [SP, #-4]!					; push parameter (address of 'State' parameter)
-
-		LDR		R0, [PC,#handler-8-$]
-		LDR		R0, [R0, #0]
-		BLX		R0
-		LDR		R11, [SP], #4
-		ADD		SP, SP, #4
-
-		ADD		SP, SP, #72						; adjust SP & remove PAF
-		LDR		R0, [R11, #64]					; load 'State.PSR'
-		MSR		SPSR_cxsf, R0					; and store it into SPSR
-		LDR		R0, [R11, #60]					; load 'State.PC'...
-		MOV		LR, R0							; ...into LR (because we will return to LR, not PC)
-		ADD		R0, R11, #48					; R0 points to 'State.SP'
-		LDMIA		R0, { FP, SP, LR }^				; load 'State.SP' & 'State.LR' into user mode registers
-		MOV		R0, R0							; nop, to not access banked registers after LDM ^
-		LDMIA		R11, { R0, R1, R2, R3, R4, R5, R6, R7, R8, R9, R10 } 				; restore unbanked regs
-		LDR		R11, [R11, #44]
-
-		MOVS		PC, LR							; SPSR -> CPSR & return
-
-		; Data section
-	state:			d32 stateTag					; address of stateTag
-	handler:		d32 undefHandler				; handler
-	undefined:		d32 -Undef					; INT number for undefined instructions
-	END undefGlue;
-
-	(**
-	 * Software Interrupt Handler. Saves the processor state and calls the registered handler.
-	 * The SWI number is stored into the INT field of the state record.
-	 *)
-	PROCEDURE {NOPAF} SWIGlue;
-	CODE
-		SUB		SP, SP, #72						; Room for the State record
-		STMIA		SP, {R0, R1, R2, R3, R4, R5, R6, R7, R8, R9, R10, R11, FP, SP, LR}^
-		MOV		R0, R0
-		ADD		SP, SP, #60
-		SUB		R1, LR, #4						; return address = LR-4
-		STR		R1, [SP], #4					; push ('PC' in 'State'). SP points to offset 64
-		MRS		R0, SPSR						; get saved PSR
-		STR		R0, [SP], #4					; push ('PSR' in 'State'). SP points to offset 68
-		LDR		R0, [R1, #0]					; Load SWI instruction
-		LDR		R2, [PC, #HFFFFFF-8-$]
-		AND		R0, R0, R2						; R0 MOD 1000000 = SWI number
-		STR		R0, [SP], #4					; push SWI number as INT. SP points to offset 72
-
-		SUB		SP, SP, #72						; Update SP to correct location
-		MOV		R11, SP
-
-		LDR		R5, [pc, #state-$-8]			; load address of stateTag constant
-		STR		R5, [SP, #-4]!					; push value (type tag)
-		STR		R11, [SP, #-4]!					; push parameter (address of 'State' parameter)
-
-		LDR		R0, [PC,#handler-8-$]
-		LDR		R0, [R0, #0]
-		BLX		R0
-		LDR		R11, [SP], #4
-		ADD		SP, SP, #4
-
-		ADD		SP, SP, #72						; adjust SP & remove PAF
-		LDR		R0, [R11, #64]					; load 'State.PSR'
-		MSR		SPSR_cxsf, R0					; and store it into SPSR
-		LDR		R0, [R11, #60]					; load 'State.PC'...
-		MOV		LR, R0							; ...into LR (because we will return to LR, not PC)
-		ADD		R0, R11, #48					; R0 points to 'State.SP'
-		LDMIA		R0, { FP, SP, LR }^				; load 'State.SP' & 'State.LR' into user mode registers
-		MOV		R0, R0							; nop, to not access banked registers after LDM ^
-		LDMIA		R11, { R0, R1, R2, R3, R4, R5, R6, R7, R8, R9, R10 } 				; restore unbanked regs
-		LDR		R11, [R11, #44]
-
-		MOVS		PC, LR							; SPSR -> CPSR & return
-
-		; Data section
-	state:		d32 stateTag						; address of stateTag
-	HFFFFFF:	d32 0FFFFFFH						; SWI number mask
-	handler:	d32 swiHandler					; swiHandler
-	END SWIGlue;
-
-	(**
-	 * Prefetch Abort Handler. Saves the processor state and calls the registered handler.
-	 * The PC field of the state record holds the address at which the prefetch fault occurred.
-	 *)
-	PROCEDURE {NOPAF} prefetchGlue;
-	CODE
-		CLREX
-		SUB		SP, SP, #72						; Room for the State record
-		STMIA		SP, {R0, R1, R2, R3, R4, R5, R6, R7, R8, R9, R10, R11, FP, SP, LR}^
-		MOV		R0, R0
-		ADD		SP, SP, #60
-		SUB		R0, LR, #4						; return address = LR-4
-		STR		R0, [SP], #4					; push ('PC' in 'State'). SP points to offset 64
-		MRS		R0, SPSR						; get saved PSR
-		STR		R0, [SP], #4					; push ('PSR' in 'State'). SP points to offset 68
-		LDR		R0, [PC, #prefetchAbort-8-$]		; save -Data in the INT field
-		STR		R0, [SP], #4
-
-		SUB		SP, SP, #72
-		MOV		R11, SP
-
-		LDR		R5, [pc, #state-$-8]			; load address of stateTag constant
-		STR		R5, [SP, #-4]!					; push value (type tag)
-		STR		R11, [SP, #-4]!					; push parameter (address of 'State' parameter)
-
-		LDR		R0, [PC,#handler-8-$]
-		LDR		R0, [R0, #0]
-		BLX		R0
-		LDR		R11, [SP], #4
-		ADD		SP, SP, #4
-
-		ADD		SP, SP, #72						; adjust SP & remove PAF
-		LDR		R0, [R11, #64]					; load 'State.PSR'
-		MSR		SPSR_cxsf, R0					; and store it into SPSR
-		LDR		R0, [R11, #60]					; load 'State.PC'...
-		MOV		LR, R0							; ...into LR (because we will return to LR, not PC)
-		ADD		R0, R11, #48					; R0 points to 'State.SP'
-		LDMIA		R0, { FP, SP, LR }^				; load 'State.SP' & 'State.LR' into user mode registers
-		MOV		R0, R0							; nop, to not access banked registers after LDM ^
-		LDMIA		R11, { R0, R1, R2, R3, R4, R5, R6, R7, R8, R9, R10 } 				; restore unbanked regs
-		LDR		R11, [R11, #44]
-
-		MOVS		PC, LR							; SPSR -> CPSR & return
-
-		; Data section
-	state:			d32 stateTag					; address of stateTag
-	handler:		d32 prefetchHandler			; handler
-	prefetchAbort:	d32 -Prefetch					; prefetch INT number
-	END prefetchGlue;
-
-	(**
-	 * Data Abort Handler. Saves the processor state and calls the registered handler.
-	 * Use procedure GetPageFault to get abort status and address.
-	 *)
-	PROCEDURE {NOPAF} dataGlue;
-	CODE
-		CLREX
-		SUB		SP, SP, #72						; Room for the State record
-		STMIA		SP, {R0, R1, R2, R3, R4, R5, R6, R7, R8, R9, R10, R11, FP, SP, LR}^
-		MOV		R0, R0
-		ADD		SP, SP, #60
-		SUB		R0, LR, #8						; return address = LR-8
-		STR		R0, [SP], #4					; push ('PC' in 'State'). SP points to offset 64
-		MRS		R0, SPSR						; get saved PSR
-		STR		R0, [SP], #4					; push ('PSR' in 'State'). SP points to offset 68
-		LDR		R0, [PC, #dataAbort-8-$]		; save -Data in the INT field
-		STR		R0, [SP], #4
-
-		SUB		SP, SP, #72
-		MOV		R11, SP
-
-		LDR		R5, [pc, #state-$-8]			; load address of stateTag constant
-		STR		R5, [SP, #-4]!					; push value (type tag)
-		STR		R11, [SP, #-4]!					; push parameter (address of 'State' parameter)
-
-		LDR		R0, [PC,#handler-8-$]
-		LDR		R0, [R0, #0]
-		BLX		R0
-		LDR		R11, [SP], #4
-		ADD		SP, SP, #4
-
-		ADD		SP, SP, #72						; adjust SP & remove PAF
-		LDR		R0, [R11, #64]					; load 'State.PSR'
-		MSR		SPSR_cxsf, R0					; and store it into SPSR
-		LDR		R0, [R11, #60]					; load 'State.PC'...
-		MOV		LR, R0							; ...into LR (because we will return to LR, not PC)
-		ADD		R0, R11, #48					; R0 points to 'State.SP'
-		LDMIA		R0, { FP, SP, LR }^				; load 'State.SP' & 'State.LR' into user mode registers
-		MOV		R0, R0							; nop, to not access banked registers after LDM ^
-		LDMIA		R11, { R0, R1, R2, R3, R4, R5, R6, R7, R8, R9, R10 } 				; restore unbanked regs
-		LDR		R11, [R11, #44]
-
-		MOVS		PC, LR							; SPSR -> CPSR & return
-
-		; Data section
-	state:			d32 stateTag					; address of stateTag
-	handler:		d32 dataHandler				; address of the handler variable
-	dataAbort:		d32 -Data
-	END dataGlue;
-
-	(** Fast Interrupt Handler. Saves the processor state and calls the registered handler *)
-	PROCEDURE {NOPAF} fiqGlue;
-	CODE
-		CLREX
-		SUB		SP, SP, #72						; Room for the State record
-		STMIA		SP, {R0, R1, R2, R3, R4, R5, R6, R7, R8, R9, R10, R11, FP, SP, LR}^
-		MOV		R0, R0
-		ADD		SP, SP, #60
-		SUB		R0, LR, #4						; return address = LR-4
-		STR		R0, [SP], #4					; push ('PC' in 'State'). SP points to offset 64
-		MRS		R0, SPSR						; get saved PSR
-		STR		R0, [SP], #4					; push ('PSR' in 'State'). SP points to offset 68
-
-		SUB		SP, SP, #68
-		MOV		R11, SP
-
-		LDR		R5, [pc, #state-$-8]			; load address of stateTag constant
-		STR		R5, [SP, #-4]!					; push value (type tag)
-		STR		R11, [SP, #-4]!					; push parameter (address of 'State' parameter)
-
-		BL			fiqHandler
-		LDR		R11, [SP], #4
-		ADD		SP, SP, #4
-
-		ADD		SP, SP, #72						; adjust SP & remove PAF
-		LDR		R0, [R11, #64]					; load 'State.PSR'
-		MSR		SPSR_cxsf, R0					; and store it into SPSR
-		LDR		R0, [R11, #60]					; load 'State.PC'...
-		MOV		LR, R0							; ...into LR (because we will return to LR, not PC)
-		ADD		R0, R11, #48					; R0 points to 'State.SP'
-		LDMIA		R0, { FP, SP, LR }^				; load 'State.SP' & 'State.LR' into user mode registers
-		MOV		R0, R0							; nop, to not access banked registers after LDM ^
-		LDMIA		R11, { R0, R1, R2, R3, R4, R5, R6, R7, R8, R9, R10 } 				; restore unbanked regs
-		LDR		R11, [R11, #44]
-
-		MOVS		PC, LR							; SPSR -> CPSR & return
-
-		; Data section
-	state:	d32 stateTag							; address of stateTag
-	END fiqGlue;
-
-	(** Initializes IRQ handling. *)
-	PROCEDURE InitInterrupts*;
-	CONST
-		EnableSecure=0;
-		EnableNonSecure=1;
-		NumberIRQs = 96;
-	VAR p: PROCEDURE; i: LONGINT;
-	BEGIN
-		Acquire(Interrupts);
-		IRQMask := {};
-		p := IRQGlue;
-		SYSTEM.PUT32(InterruptVector + Irq, SYSTEM.VAL(LONGINT, p));	(* install new IRQ handler *)
-		SYSTEM.PUT32(Platform.ICDDCR, 0);
-
-
-		FOR i := 32 DIV 16 TO (NumberIRQs-1) DIV 16 (* 2 bits per IRQ *)  DO
-			SYSTEM.PUT32(Platform.ICDICFR+i*4, 0);
-		END;
-
-		FOR i := 0  TO (NumberIRQs-1) DIV 4 (* 8 bits per IRQ *) DO
-			SYSTEM.PUT32(Platform.ICDIPR+i*4, LONGINT(0A0A0A0A0H)); (* set priority of each interrupt to 160 *)
-		END;
-
-		FOR i := (32 DIV 4) TO (NumberIRQs-1) DIV 4 (* 8 bits per IRQ *) DO
-			SYSTEM.PUT32(Platform.ICDIPTR+i*4, 1010101H); (* reset interrupt targets to processor 0 *)
-		END;
-
-		(* disable all interrupt forwardings *)
-		FOR i := 0 TO (NumberIRQs-1) DIV 32 (* 1 bit per IRQ *) DO
-			SYSTEM.PUT32(Platform.ICDICER+i*4, LONGINT(0FFFFFFFFH));
-		END;
-
-		SYSTEM.PUT32(Platform.ICCPMR, 0F0H);
-		SYSTEM.PUT32(Platform.ICCICR, {0,1,2});
-		SYSTEM.PUT32(Platform.ICCBPR, 0);
-
-		SYSTEM.PUT32(Platform.ICDDCR, {EnableSecure, EnableNonSecure});
-		Release(Interrupts);
-
-		(*InvalidateDCache(dCacheBase);*)
-		(*EnableIRQ(PrivateTimerIRQ);*)
-	END InitInterrupts;
-
-	(** Restore silent, infinitly-looping exception handlers *)
-	PROCEDURE EndInterrupts;
-	BEGIN
-		SYSTEM.PUT32(InterruptVector + Undef, InterruptVector + Undef);
-		SYSTEM.PUT32(InterruptVector + Swi, InterruptVector + Swi);
-		SYSTEM.PUT32(InterruptVector + Prefetch, InterruptVector + Prefetch);
-		SYSTEM.PUT32(InterruptVector + Data, InterruptVector + Data);
-		SYSTEM.PUT32(InterruptVector + Irq, InterruptVector + Irq);
-		SYSTEM.PUT32(InterruptVector + Fiq, InterruptVector + Fiq);
-	END EndInterrupts;
-
-	(* GetExceptionState *)
-	PROCEDURE GetExceptionState*(VAR int: State; VAR exc: ExceptionState);
-	BEGIN
-		(* save all state information while interrupts are still disabled *)
-		exc.locks := BreakAll();
-		IF int.INT = -Undef THEN
-			exc.halt := 17;
-			exc.instn := SYSTEM.GET32(int.PC)
-		ELSIF int.INT = -Prefetch THEN
-			exc.pf := int.PC;
-			exc.status := -1;
-			exc.halt := 19
-		ELSIF int.INT = -Data THEN
-			GetPageFault(exc.pf, exc.status);
-			IF exc.pf < 4 * k THEN
-				(* NIL pointer *)
-				exc.halt := 18
-			ELSE
-				exc.halt := 19
-			END
-		ELSE
-			(* SWI *)
-			exc.halt := int.INT
-		END
-	END GetExceptionState;
-
-	PROCEDURE GetPageFault * (VAR adr: ADDRESS; VAR status: LONGINT);
-	CODE
-		MRC	p15, 0, R0, C5, C0	; load fault status register (FSR)
-		AND	R0, R0, #0FFH			; only bits 7:0 are valid
-		LDR	R1, [FP, #status]
-		STR R0, [R1, #0]
-
-		MRC	p15, 0, R0, C6, C0	; load fault address (FAR)
-		LDR	R1, [FP, #adr]
-		STR R0, [R1, #0]
-	END GetPageFault;
-
-	(* FAR - returns the Fault Address Register. *)
-	PROCEDURE -FAR*(): LONGINT;
-	CODE
-		MRC	p15, 0, R0, C6, C0	; FAR is co-processor 15 register 6
-	END FAR;
-
-	(** Init global timer *)
-	PROCEDURE InitGlobalTimer;
-	CONST
-		TimerEnable=0;
-	BEGIN
-		(* disable first *)
-		SYSTEM.PUT32(Platform.GlobalTimerControlRegister, {});
-		(* reset global counter *)
-		SYSTEM.PUT32(Platform.GlobalTimerCounterRegister0, 0);
-		SYSTEM.PUT32(Platform.GlobalTimerCounterRegister1, 0);
-		SYSTEM.PUT32(Platform.GlobalTimerControlRegister, {TimerEnable});
-	END InitGlobalTimer;
-
-
-	(** Init private timer *)
-	PROCEDURE InitTicks;
-	CONST
-		TimerEnable=0;
-		AutoReload=1;
-		IRQEnable=2;
-	VAR
-		(* time slot in private timer counts; take into account that private timer clock frequency is equal to half of the CPU clock frequency *)
-		delay: LONGINT;
-	BEGIN
-		delay := ENTIER( ( LONGREAL(TimerPeriod) * 0.5D0 * LONGREAL(BootConfig.GetIntValue("CpuClockHz")) ) / 1.0D6 + 0.5D0 );
-		(* disable first *)
-		SYSTEM.PUT32(Platform.PrivateTimerControlRegister, {});
-
-		(*SYSTEM.PUT32(Platform.PrivateTimerCounterRegister, Delay);*)
-		SYSTEM.PUT32(Platform.PrivateLoadValueRegister, delay);
-		SYSTEM.PUT32(Platform.PrivateTimerControlRegister, {TimerEnable, AutoReload, IRQEnable});
-	END InitTicks;
-
-	PROCEDURE StopTicks;
-	BEGIN
-		SYSTEM.PUT32(Platform.PrivateTimerControlRegister, {});
-	END StopTicks;
-
-	(** Handle multiprocessor timer interrupt. *)
-	PROCEDURE HandleMPTimer*(VAR state: State);
-	BEGIN	(* {interrupts off} *)
-		timer(ID(), state); (* rarely used *)
-		(* Clear timer interrupt *)
-		SYSTEM.PUT32(Platform.GlobalTimerInterruptStatusRegister, 1);
-		EnableInterrupts;	(* enable interrupts before acquiring locks below - to avoid deadlock with StopAll. *)
-		Timeslice(state);	(* fixme: check recursive interrupt *)
-	END HandleMPTimer;
-
-	(** Handle uniprocessor timer interrupt. *)
-	PROCEDURE HandleUPTimer(VAR state: State);
-	BEGIN	(* {interrupts off} *)
-		timer(ID(), state);
-		SYSTEM.PUT32(Platform.PrivateTimerInterruptStatusRegister, 1);
-		
-		(* Shutdown if requested *)
-		IF ~(ID() IN allProcessors) THEN ShutdownSecondary END;
-		IF enableWatchdog THEN PrivateWatchdog.Feed(Second) END;
-		Timeslice(state)
-	END HandleUPTimer;
-
-	(** Install a processor timer event handler. *)
-	PROCEDURE InstallEventHandler* (h: EventHandler);
-	BEGIN
-		IF h # NIL THEN timer := h ELSE timer := DummyEvent END
-	END InstallEventHandler;
-
-	PROCEDURE DummyEvent*(id: LONGINT; CONST state: State);
-	BEGIN
-	END DummyEvent;
-
-	PROCEDURE DummyTimeslice*(VAR state: State);
-	BEGIN
-	END DummyTimeslice;
-
-	PROCEDURE DummyIRQ*;
-	BEGIN
-	END DummyIRQ;
-
-	PROCEDURE IRQBeginPrinter;
-	BEGIN
-		Trace.StringLn("IRQ BEGIN");
-	END IRQBeginPrinter;
-
-	PROCEDURE IRQEndPrinter;
-	BEGIN
-		Trace.StringLn("IRQ END");
-	END IRQEndPrinter;
-
-	(* Timer interrupt handler. *)
-	PROCEDURE TimerInterruptHandler(VAR state: State);
-	BEGIN
-		IF ID() = 0 THEN
-			INC(ticks);
-			DEC(eventCount);
-			IF eventCount = 0 THEN
-				eventCount := eventMax; event(state)
-			END;
-		END
-	END TimerInterruptHandler;
-
-	(* Set timer upcall. The handler procedure will be called at a rate of Second/divisor Hz. *)
-	PROCEDURE InstallTickHandler(handler: Handler; divisor: LONGINT);
-	BEGIN
-		eventMax := divisor; event := handler;
-		eventCount := eventMax
-	END InstallTickHandler;
-
-	(* ===== Low-Level Locks ===== *)
-	(* Initializes spinlocks. This is not exported in Intel version. *)
-	PROCEDURE InitLocks;
-	VAR
-		i: LONGINT;
-	BEGIN
-		FOR i := 0 TO MaxLock - 1 DO
-			lock[i].locked := FALSE
-		END;
-	END InitLocks;
-
-	PROCEDURE AcquirePreemption*(): LONGINT;
-	VAR
-		id: LONGINT;
-	BEGIN
-		id := ID();
-		INC(proc[id].preemptCount);
-		RETURN id
-	END AcquirePreemption;
-
-	PROCEDURE ReleasePreemption*;
-	VAR
-		id: LONGINT;
-	BEGIN
-		id := ID();
-
-		IF StrongChecks THEN
-			ASSERT(proc[id].preemptCount > 0);
-		END;
-
-		DEC(proc[id].preemptCount);
-	END ReleasePreemption;
-
-	PROCEDURE PreemptCount*(id: LONGINT): LONGINT;
-	BEGIN
-		IF StrongChecks THEN
-			ASSERT(id = ID());
-		END;
-		RETURN proc[id].preemptCount;
-	END PreemptCount;
-
-	(* Acquire spinlock 'lock'. Does not time out *)
-	PROCEDURE AcquireSpin(VAR lock: BOOLEAN); (* DEBUG: temporarily exported *)
-	CODE
-		CLREX
-		DMB
-		LDR R0, [FP, #lock]
-		MOV R1, #1
-	loop:
-		LDREXB R2, R0	; R2 := lock
-		CMP R2, #0		; if R2 != 0 => lock held, try again
-		BNE loop
-		STREXB R2, R1, R0	; lock := R1
-		CMP R2, #0		; if R2 # 0 exclusive write failed: try whole process again.
-		BNE loop
-		;DSB				; Data Memory Barrier
-	END AcquireSpin;
-
-	(* Releases spinlock 'lock'. *)
-	PROCEDURE ReleaseSpin(VAR lock: BOOLEAN); (* DEBUG: temporarily exported *)
-	BEGIN
-		CODE
-			CLREX
-			DMB
-		END;
-		lock := FALSE;
-		(*CODE
-		loop:
-			LDR R0, [FP, #lock]
-			LDREX R1, R0
-			MOV R1, #0
-			STREX R2, R1, R0
-			CMP R2, #0
-			BNE loop
-		END;*)
-		(*CODE
-			DMB
-			DSB
-			LDR R0, [FP, #lock]
-			MCR P15, 0, R0, C7, C10, 4
-		END;*)
-	END ReleaseSpin;
-
-	(* Acquire lock. Disables interrupts. *)
-	PROCEDURE Acquire*(level: LONGINT);
-	VAR
-		id: LONGINT;
-		enabled: BOOLEAN;
-	BEGIN
-		enabled := AreInterruptsEnabled();
-		DisableInterrupts();
-		id := AcquirePreemption();
-		IF proc[id].locksHeld = {} THEN
-			proc[id].intStatus := enabled
-		END;
-
-		IF StrongChecks THEN
-			ASSERT(~AreInterruptsEnabled());
-			ASSERT((~enabled) OR (proc[id].locksHeld = {}));	(* interrupts enabled => no locks held *)
-			ASSERT(~(level IN proc[id].locksHeld))	(* recursive locks not allowed *)
-		END;
-
-		AcquireSpin(lock[level].locked);
-		(* Now, we hold the lock *)
-		INCL(proc[id].locksHeld, level);
-
-		IF StrongChecks THEN	(* no lower-level locks currently held by this processor *)
-			ASSERT((level = 0) OR (proc[id].locksHeld * {0..level-1} = {}));
-		END;
-	END Acquire;
-
-	(* Release lock. Enables interrupts if last lock held. *)
-	PROCEDURE Release*(level: LONGINT);
-	VAR
-		id: LONGINT;
-	BEGIN
-		id := ID();
-
-		IF StrongChecks THEN
-			ASSERT(~AreInterruptsEnabled());
-			ASSERT(level IN proc[id].locksHeld);
-			ASSERT(lock[level].locked # FALSE)
-		END;
-
-		EXCL(proc[id].locksHeld, level);
-		ReleaseSpin(lock[level].locked);
-
-		ReleasePreemption;
-		IF (proc[id].locksHeld = {}) & proc[id].intStatus THEN
-			EnableInterrupts
-		END;
-	END Release;
-
-	PROCEDURE AcquireAll*;
-	VAR
-		i: LONGINT;
-	BEGIN
-		FOR i := MaxLock - 1 TO 0 BY -1 DO
-			Acquire(i)
-		END
-	END AcquireAll;
-
-	PROCEDURE ReleaseAll*;
-	VAR
-		i: LONGINT;
-	BEGIN
-		FOR i := 0 TO MaxLock - 1 DO
-			Release(i)
-		END
-	END ReleaseAll;
-
-	(** Acquire a fine-grained lock on an active object. *)
-	PROCEDURE AcquireObject*(VAR locked: BOOLEAN);
-	BEGIN
-		AcquireSpin(locked)
-	END AcquireObject;
-
-	(** Release an active object lock. *)
-	PROCEDURE ReleaseObject*(VAR locked: BOOLEAN);
-	BEGIN
-		ReleaseSpin(locked)
-	END ReleaseObject;
-
-	(** Break all locks held by current processor (for exception handling).  Returns levels released. *)
-	PROCEDURE BreakAll*(): SET;
-	VAR id, level: LONGINT; released: SET;
-	BEGIN
-		id := AcquirePreemption();
-		released := {};
-		FOR level := 0 TO MaxLock-1 DO
-			IF level IN proc[id].locksHeld THEN
-				lock[level].locked := FALSE;	(* break the lock *)
-				EXCL(proc[id].locksHeld, level);
-				INCL(released, level)
-			END
-		END;
-		(*IF released = {} THEN
-			ASSERT(proc[id].nestCount = 0)	(* no locks held *)
-		ELSE
-			ASSERT(proc[id].nestCount > 0);	(* some locks held *)
-			proc[id].nestCount := 0	(* interrupt state will be restored later *)
-		END;*)
-		IF proc[id].preemptCount > 1 THEN INCL(released, Preemption) END;
-		proc[id].preemptCount := 0;	(* clear preemption flag *)
-		RETURN released
-	END BreakAll; (* !!! interrupts are still off !!! *)
-
-	(* ===== Atomic Operations ===== *)
-	(* Atomic INC(x) *)
-	PROCEDURE -AtomicInc*(VAR x: LONGINT);
-	CODE
-	;loop:
-	;	ADD R0, SP, #x	; R0 := ADR(x)
-	;	LDREX R1, R0		; R1 := x
-	;	ADD R1, R1, #1	; increment x
-	;	STREX R2, R1, R0
-	;	CMP R2, #0
-	;	BEQ loop			; if store failed, try again, else exit
-	;	ADD SP, SP, #4
-
-		LDR	R0, [SP], #4
-	loop:
-		LDREX	R1, R0
-		ADD	R1, R1, #1
-		STREX	R2, R1, R0
-		CMP	R2, #0
-		BNE	loop
-	END AtomicInc;
-	
-	(* Atomic INC(x) *)
-	PROCEDURE -AtomicDec*(VAR x: LONGINT);
-	CODE
-		LDR	R0, [SP], #4
-	loop:
-		LDREX	R1, R0
-		SUB	R1, R1, #1
-		STREX	R2, R1, R0
-		CMP	R2, #0
-		BNE	loop
-	END AtomicDec;
-
-	PROCEDURE -AtomicAdd * (VAR x: LONGINT; y: LONGINT);
-	CODE
-		LDR R3, [SP, #y]	; R3 := y
-		LDR R0, [SP, #x]	; R0 := ADR(x)
-	loop:
-		LDREX R1, R0		; R1 := x
-		ADD R1, R1, R3	; increment x
-		STREX R2, R1, R0
-		CMP R2, #0
-		BNE loop			; if store failed, try again, else exit
-		ADD SP, SP, #8
-	END AtomicAdd;
-
-	(* Atomic compare-and-swap. Set x = new if x = old and return old value of x *)
-	PROCEDURE -AtomicCAS * (VAR x: LONGINT; old, new: LONGINT): LONGINT;
-	CODE
-		LDR	R3, [SP, #x]			; R0 := ADDRESSOF(x)
-		LDR	R1, [SP, #old]			; R1 := old
-		LDR	R2, [SP, #new]			; R2 := new
-		ADD	SP, SP, #12				; pop variable from stack
-
-	loop:
-		LDREX	R0, R3					; load excl x
-		CMP	R0, R1
-		BNE	exit						; x # old -> exit
-		STREX	R4, R2, R3				; x = old -> store excl new -> x
-		CMP	R4, #0
-		BNE	loop					; store exclusive failed: retry
-
-	exit:
-	END AtomicCAS;
-
-	(* ===== Virtual Memory Management ===== *)
-
-	PROCEDURE Ensure32BitAddress*(adr: ADDRESS): LONGINT;
-	BEGIN
-		RETURN adr
-	END Ensure32BitAddress;
-
-	PROCEDURE GetSecondLevelEntry(virtualAddress: ADDRESS): ADDRESS;
-	VAR
-		ptIdx, basePT, entry: ADDRESS;
-	BEGIN
-		IF (PS <= virtualAddress) & (virtualAddress < M) THEN
-			(* First 256 entries *)
-			basePT := sysSecondLvlPtStart
-		ELSIF (4 * G - M <= virtualAddress) THEN
-			(* Entries 256 to 511 *)
-			basePT := sysSecondLvlPtStart + 400H
-		ELSIF (memStackStart <= virtualAddress) & (virtualAddress < memStackStop) THEN
-			basePT := sysSecondLvlPtStart + 800H + virtualAddress DIV M * k - memStackStart DIV k
-		ELSIF (memConfigStart <= virtualAddress) & (virtualAddress < memConfigStop) THEN
-			basePT := sysSecondLvlPtStop - (memConfigStop DIV k - virtualAddress DIV M * k)
-		END;
-		ptIdx := SHR(virtualAddress MOD M, PSlog2);
-		ASSERT(basePT + 4 * ptIdx >= sysSecondLvlPtStart);
-		ASSERT(basePT + 4 * ptIdx < sysSecondLvlPtStop);
-		entry := SYSTEM.GET32(basePT + 4 * ptIdx);
-		RETURN entry
-	END GetSecondLevelEntry;
-
-	PROCEDURE SetSecondLevelEntry(virtualAddress, physicalAddress, flags: ADDRESS);
-	VAR ptIdx, basePT, entry: ADDRESS;
-		firstLvlEntry: ADDRESS;
-	BEGIN
-		IF (PS <= virtualAddress) & (virtualAddress < M) THEN
-			(* First 256 entries *)
-			basePT := sysSecondLvlPtStart
-		ELSIF (4 * G - M <= virtualAddress) THEN
-			(* Entries 256 to 511 *)
-			basePT := sysSecondLvlPtStart + 400H
-		ELSIF (memStackStart <= virtualAddress) & (virtualAddress < memStackStop) THEN
-			basePT := sysSecondLvlPtStart + 800H + virtualAddress DIV M * k - memStackStart DIV k
-		ELSIF (memConfigStart <= virtualAddress) & (virtualAddress < memConfigStop) THEN
-			basePT := sysSecondLvlPtStop - (memConfigStop DIV k - virtualAddress DIV M * k)
-		END;
-		ptIdx := SHR(virtualAddress MOD M, PSlog2);
-
-		IF physicalAddress = NilAdr THEN
-			entry := slFault
-		ELSE
-			ASSERT(physicalAddress MOD PS = 0);
-			ASSERT((flags DIV PS = 0) & (flags MOD 4 = 0));
-			entry := physicalAddress + flags + slSmall
-		END;
-		ASSERT(basePT + 4 * ptIdx >= sysSecondLvlPtStart);
-		ASSERT(basePT + 4 * ptIdx < sysSecondLvlPtStop);
-		SYSTEM.PUT32(basePT + 4 * ptIdx, entry);
-	END SetSecondLevelEntry;
-
-	PROCEDURE UnmapPhysical*(viartAdr: ADDRESS; size: SIZE);
-	BEGIN
-	END UnmapPhysical;
-
-	(* Unmap a virtual page and deallocate the corresponding physical page *)
-	PROCEDURE DeallocatePage(virtualAdr: ADDRESS);
-	VAR memoryAdr: LONGINT;
-	BEGIN
-		(* unmap the page *)
-		memoryAdr := GetSecondLevelEntry(virtualAdr);
-		ASSERT(memoryAdr MOD 4 = slSmall);	(* page must be mapped *)
-		SYSTEM.PUT32(virtualAdr, freePage); 	(* link freePage list (must be done as long as the page is still mapped !) *)
-		SetSecondLevelEntry(virtualAdr, NilAdr, 0);
-		InvalidateTLBEntry(SHRL(virtualAdr, PSlog2));
-
-		(* free the page *)
-		memoryAdr := SHRL(memoryAdr, 12);
-		freePage := memoryAdr;
-		INC(memory.free, PS)
-	END DeallocatePage;
-
-	(* AllocatePage - allocates and maps one memory page to [virtualAdr...virtualAdr+PageSize]. Returns TRUE iff successful *)
-	PROCEDURE AllocatePage(virtualAdr, accessPermissions, flags: ADDRESS): BOOLEAN;
-	VAR memoryAdr, entry: ADDRESS;
-	BEGIN
-		(* Use 1:1 Mapping for stack *)
-		(* map the page *)
-		entry := GetSecondLevelEntry(virtualAdr);
-		IF entry MOD 4 # slFault THEN
-			Acquire(TraceOutput);
-			Trace.String("Allocate Page: entry = ");
-			Trace.Address(entry);
-			Trace.String("; vadr = ");
-			Trace.Address(virtualAdr);
-			Trace.String("; CPU = ");
-			Trace.Int(ID(), 0);
-			Trace.Ln;
-			Release(TraceOutput)
-		END;
-		ASSERT(entry MOD 4 = slFault);	(* page must not be mapped *)
-		SetSecondLevelEntry(virtualAdr, (*memoryAdr*) virtualAdr, accessPermissions + flags);
-		InvalidateTLBEntry(SHRL(virtualAdr, PSlog2));
-		RETURN TRUE
-	END AllocatePage;
-
-	(** PhysicalAdr - returns the (real) physical address of the specified range of memory, or NilAdr if the range is not contiguous.
-		It is the caller's responsiblilty to assure the range remains allocated during the time it is in use.
-	*)
-	PROCEDURE PhysicalAdr*(adr, size: LONGINT): LONGINT;
-	VAR physAdr: ARRAY 400H OF Range; num, i, end: LONGINT;
-	BEGIN
-		TranslateVirtual(adr, size, num, physAdr);
-		IF (num > 0) THEN
-			FOR i := 1 TO num-1 DO
-				IF (physAdr[i].adr # (physAdr[i-1].adr + physAdr[i-1].size)) THEN
-					RETURN NilAdr
-				END
-			END;
-			RETURN physAdr[0].adr
-		ELSE
-			RETURN NilAdr
-		END
-	END PhysicalAdr;
-
-	(** TranslateVirtual - translates a virtual address range to num ranges of (real) physical addresses.  num returns 0 on error.*)
-	PROCEDURE TranslateVirtual*(virtAdr: ADDRESS; size: LONGINT; VAR num: LONGINT; VAR physAdr: ARRAY OF Range);
-	VAR entry, base, ofs, len: LONGINT; endAdr: ADDRESS; abort: BOOLEAN;
-	BEGIN
-		Acquire(Memory);
-
-		endAdr := virtAdr + size;
-		IF ((memHeapStart <= virtAdr) & (endAdr <= memHeapStop)) OR ((memStackStart <= virtAdr) & (endAdr <= memStackStop)) OR ((memIOStart <= virtAdr) & (endAdr <= memIOStop)) THEN
-			(* Optimizations: we know that heap, stacks and I/O regions are mapped 1:1. *)
-			(*! This code is very aggressive: it returns only 1 range, and not 1 range per physical page. It assumes that all stack pages of the specified region are mapped *)
-			num := 1;
-			physAdr[0].adr := virtAdr;
-			physAdr[0].size := size;
-		ELSE
-			abort := FALSE;
-			num := 0;
-			WHILE (size > 0) & (num < LEN(physAdr)) & ~abort DO
-				entry := (*SYSTEM.GET32(pageTable.virtual + 4*SHR(virtAdr, LogM));*)GetFirstLevelEntry(virtAdr - virtAdr MOD M);
-				IF (entry MOD 4 = flSection) THEN
-					ofs := virtAdr MOD M;
-					len := MIN(size, M - ofs);
-					physAdr[num].adr := SHRL(entry, LogM) + ofs;
-					physAdr[num].size := len;
-					INC(num);
-					INC(virtAdr, len); DEC(size, len)
-				ELSIF (entry MOD 4 = flCoarse) THEN
-					base := SHRL(entry, 10);
-
-					WHILE (size > 0) & (num < LEN(physAdr)) & ~abort DO
-						entry := GetSecondLevelEntry(virtAdr);
-						IF (entry MOD 4 = slSmall) THEN
-							ofs := virtAdr MOD PS;
-							len := MIN(size, PS - ofs);
-							physAdr[num].adr := SHRL(entry, 12) + ofs;
-							physAdr[num].size := len;
-							INC(num);
-							INC(virtAdr, len); DEC(size, len)
-						ELSE
-							num := 0;
-							abort := TRUE
-						END
-					END
-				ELSE
-					num := 0; abort := TRUE
-				END;
-			END;
-			IF (size > 0) & (num = LEN(physAdr)) THEN num := 0 END;	(* array 'physAdr' was too small *)
-		END;
-		Release(Memory)
-	END TranslateVirtual;
-
-	PROCEDURE SetFirstLevelEntry (virtual, physical: ADDRESS; permissions, flags, type: LONGINT);
-	VAR
-		index, entry: LONGINT;
-	BEGIN
-		index := SHR(virtual, LogM) * 4;
-		ASSERT(index >= 0);
-		ASSERT(sysFirstLvlPtStart + index < sysFirstLvlPtStop);
-		entry := physical + permissions * 400H + flags + type;
-		(*Trace.Address(virtual); Trace.String("	"); Trace.Address(physical); Trace.String("	"); Trace.Address(SysFirstLvlPtStart(*pageTable.virtual*) + index); Trace.String("	"); Trace.Address(entry); Trace.Ln;*)
-		SYSTEM.PUT32(sysFirstLvlPtStart + index, entry)
-	END SetFirstLevelEntry;
-
-	PROCEDURE GetFirstLevelEntry (virtual: ADDRESS): LONGINT;
-	VAR
-		index: LONGINT;
-	BEGIN
-		index := LSH(virtual, -(LogM)) * 4;
-		ASSERT(index >= 0);
-		ASSERT(sysFirstLvlPtStart + index < sysFirstLvlPtStop);
-		RETURN SYSTEM.GET32(sysFirstLvlPtStart + index)
-	END GetFirstLevelEntry;
-
-	(* AllocateHeap - allocates and maps [physicalAddress...physicalAddress+size] to [virtualAddress...virtualAddress+size] *)
-	PROCEDURE AllocateHeap(virtualAddress, physicalAddress, size: ADDRESS; accessPermissions, flags: LONGINT);
-	VAR i, entry: LONGINT;
-	BEGIN
-		ASSERT(size MOD M = 0);
-		FOR i := 0 TO (size DIV M) - 1 DO
-			entry := GetFirstLevelEntry(virtualAddress + i * M);
-			ASSERT(entry = 0);
-			SetFirstLevelEntry(virtualAddress + i * M, physicalAddress + i * M, accessPermissions, flags, flSection)
-		END
-	END AllocateHeap;
-
-	(** Enable Memory Management and virtual memory. *)
-	PROCEDURE EnableMM(translationBase, tbFlags, mmuFlags: ADDRESS);
-	BEGIN
-		InvalidateTLB;
-		CODE
-			; Disable AFE (special permission mode) and TRE (special memory mode)
-			ldr r0, [pc, #pattern-$-8]
-			mrc p15, 0, r1, c1, c0, 0
-			and r1, r0, r1
-			mcr p15, 0, r1, c1, c0, 0
-			isb
-
-			;mrc p15, 0, r0, c2, c0, 2
-			;ldr r1, [pc, #TLBCRPattern-$-8]
-			;and r0, r0, r1
-			;mcr p15, 0, r0, c2, c0, 2
-
-			ldr r0, [FP, #translationBase]
-			ldr	r1, [fp, #tbFlags]
-			orr r0, r0, r1
-			mcr p15, 0, r0, c2, c0, 0
-			isb
-			;mvn r0, #0 	; mmu domains: 16 x 11 = manager on all domains
-			ldr r0, [pc, #domains-$-8]
-			mcr p15, 0, r0, c3, c0, 0
-			isb
-			ldr r0, [FP, #mmuFlags]
-			ldr r1, [FP, #sctlr-$-8]
-			orr r0, r0, r1 ; 1 bits in SCTLR
-			mcr p15, 0, r0, c1, c0, 0
-			isb
-
-			;dsb
-			;isb
-
-			b exit
-		domains:	d32 55555555H		; Client on each domain
-		pattern:	d32 0CFFFFFFFH	; NOT(AFE+TRE)
-		sctlr:		d32 0C50078H
-		TLBCRPattern: d32 0FFFFFFF8H
-		exit:
-		END;
-		proc[ID()].mmu := TRUE
-	END EnableMM;
-
-	PROCEDURE InitMemory;
-	VAR
-		cr1: SET;
-		i: LONGINT;
-		base: ADDRESS;
-		coarseFlags, fineFlags, tbFlags: LONGINT;
-		trace: BOOLEAN;
-		val: ARRAY 8 OF CHAR;
-	BEGIN
-		BootConfig.GetValue("TraceMemory", val);
-		trace := val = '1';
-		IF trace THEN
-			(* Debug Tracing *)
-			Trace.String("Memory Layout");
-			IF ~enableCaching THEN Trace.String(" - WARNING: Caching Disabled") END;
-			Trace.Ln;
-			Trace.String("System Start:	"); Trace.Address(memSysLowStart); Trace.Ln;
-			Trace.String("System Stop:	"); Trace.Address(memSysLowStop); Trace.Ln;
-			Trace.String("System Size:	"); Trace.Address(memSysLowStop - memSysLowStart); Trace.Ln;
-			Trace.String("	Interrupt Stack Start:		"); Trace.Address(sysIntStackStart); Trace.Ln;
-			Trace.String("	Interrupt Stack Stop:		"); Trace.Address(sysIntStackStop); Trace.Ln;
-			Trace.String("	Interrupt Stack Size:		"); Trace.Address(sysIntStackStop - sysIntStackStart); Trace.Ln;
-			Trace.String("	First Page Table Start:	"); Trace.Address(sysFirstLvlPtStart); Trace.Ln;
-			Trace.String("	First Page Table Stop:		"); Trace.Address(sysFirstLvlPtStop); Trace.Ln;
-			Trace.String("	First Page Table Size:		"); Trace.Address(sysFirstLvlPtStop - sysFirstLvlPtStart); Trace.Ln;
-			Trace.String("	Second Page Table Start:	"); Trace.Address(sysSecondLvlPtStart); Trace.Ln;
-			Trace.String("	Second Page Table Stop:	"); Trace.Address(sysSecondLvlPtStop); Trace.Ln;
-			Trace.String("	Second Page Table Size:	"); Trace.Address(sysSecondLvlPtStop - sysSecondLvlPtStart); Trace.Ln;
-			Trace.String("Heap Start:		"); Trace.Address(memHeapStart); Trace.Ln;
-			Trace.String("Heap Stop:		"); Trace.Address(memHeapStop); Trace.Ln;
-			Trace.String("Heap Size:		"); Trace.Address(memHeapStop - memHeapStart); Trace.Ln;
-			Trace.String("Stack Start:	"); Trace.Address(memStackStart); Trace.Ln;
-			Trace.String("Stack Stop:		"); Trace.Address(memStackStop); Trace.Ln;
-			Trace.String("Stack Size:		"); Trace.Address(memStackStop - memStackStart); Trace.Ln;
-			Trace.String("Config Start:	"); Trace.Address(memConfigStart); Trace.Ln;
-			Trace.String("Config Stop:	"); Trace.Address(memConfigStop); Trace.Ln;
-			Trace.String("Config Size:	"); Trace.Address(memConfigStop - memConfigStart); Trace.Ln;
-			Trace.String("I/O Start:		"); Trace.Address(memIOStart); Trace.Ln;
-			Trace.String("I/O Stop:		"); Trace.Address(memIOStop); Trace.Ln;
-			Trace.String("I/O Size:		"); Trace.Address(memIOStop - memIOStart); Trace.Ln;
-			Trace.String("SysHigh Start:	"); Trace.Address(memSysHighStart); Trace.Ln;
-			Trace.String("SysHigh Stop:	"); Trace.Hex(memSysHighStop - 1, -8); Trace.Ln;
-			Trace.String("	Interrupt Vector Start:	"); Trace.Address(sysVectorStart); Trace.Ln;
-			Trace.String("	Interrupt Vector Stop:	"); Trace.Address(sysVectorStop); Trace.Ln;
-			Trace.String("	Interrupt Vector Size:	"); Trace.Address(sysVectorStop - sysVectorStart); Trace.Ln;
-			Trace.String("	Cache References Start:	"); Trace.Address(sysCacheRefStart); Trace.Ln;
-			Trace.String("	Cache References Stop:	"); Trace.Address(sysCacheRefStop); Trace.Ln;
-			Trace.String("	Cache References Size:	"); Trace.Address(sysCacheRefSize); Trace.Ln;
-			Trace.String("	Cache References Stack Offset:	"); Trace.Address(sysCacheStackOfs); Trace.Ln;
-		END;
-
-		(* disable caching & buffering globally *)
-		cr1 := GetControlRegister();
-		SetControlRegister(cr1 - {DCache, ICache});
-		(*InvalidateDCache(dCacheBase);*)
-		(*InvalidateDCacheRange(0, MemStackStop);*)
-		InvalidateICache;
-		DrainWriteBuffer;
-
-		(* initialize memory ranges *)
-		heapLow.physical := memHeapStart;
-		heapLow.virtual := memHeapStart;
-		heapHigh.physical := memHeapStop;
-		heapHigh.virtual := memHeapStart;
-
-		stackHigh.physical := memStackStop;
-		stackHigh.virtual := memStackStop;
-		stackLow.physical := memStackStop;
-		stackLow.virtual := memStackStart;
-
-		(* initialize global variables *)
-		pageTable.virtual := sysFirstLvlPtStart;
-		pageTable.memory := sysFirstLvlPtStart;
-		stackPT := sysSecondLvlPtStart + 2 * k;
-		freePage := NilAdr;
-
-		(* Determine global caching parameter *)
-		IF enableCaching THEN
-			coarseFlags := Cacheable + Shareable;
-			fineFlags := CB
-		ELSE
-			coarseFlags:= Shareable;
-			fineFlags := 0;
-		END;
-
-		(* Clear first level page table *)
-		Fill32(sysFirstLvlPtStart, sysFirstLvlPtStop - sysFirstLvlPtStart, 0);
-
-		(* Clear second level page table *)
-		Fill32(sysSecondLvlPtStart, sysSecondLvlPtStop - sysSecondLvlPtStart, 0);
-
-		(* Map system area *)
-		SetFirstLevelEntry(0, sysSecondLvlPtStart, 0, 0, flCoarse);
-		FOR i := 1 TO 0FFH DO
-			SetSecondLevelEntry(PS * i, PS * i, FullAccess + fineFlags);
-		END;
-
-		(* Map page for high part of OCM *)
-		AllocateHeap(memSysHighStart, memSysHighStart, MAX(M, LONGINT(memSysHighStop - memSysHighStart)), SrwUrw, coarseFlags);
-
-		(* Map heap area *)
-		AllocateHeap(memHeapStart, memHeapStart, memHeapStop - memHeapStart, SrwUrw, coarseFlags);
-
-		(* Map I/O area, device-type, shared memory *)
-		AllocateHeap(memIOStart, memIOStart, memIOStop - memIOStart, SrwUrw, Shareable + B);
-
-		(* initialize stack & config page tables (excluding the last MB that is already initalized) *)
-		base := SHR(memStackStart, LogM);
-		FOR i := memStackStart TO memConfigStop - 1 BY M DO
-			SetFirstLevelEntry(i, sysSecondLvlPtStart + 2 * k + PTSize * (SHR(i, LogM) - base), 0, 0, flCoarse)
-		END;
-
-		(* Map config region directly *)
-		FOR i := 0 TO SHR(memConfigStop - memConfigStart, PSlog2) - 1 DO
-			SetSecondLevelEntry(memConfigStart + PS * i, memConfigStart + PS * i, FullAccess + fineFlags)
-		END;
-
-		(* flush all caches & the write buffer and invalidate both TLBs *)
-		FlushDCacheRange(0, SYSTEM.VAL(ADDRESS, LastAddress));
-		InvalidateICache;
-		DrainWriteBuffer;
-		InvalidateTLB;
-
-		(* get memory size *)
-		memory.size := memHeapStop - memHeapStart;
-		memory.free := memory.size;
-
-		(* get heap size (check how many MBs are allocated) *)
-		heapLow.physical := 1*M; heapLow.virtual := memHeapStart;
-		heapHigh.physical := 1*M;
-		i := SHR(memHeapStart, LogM);
-		WHILE (SYSTEM.GET32(pageTable.virtual + i*4) MOD 4 = flSection) DO
-			INC(heapHigh.physical, M);
-			DEC(memory.free, M);
-			INC(i)
-		END;
-		heapHigh.virtual := heapLow.virtual + heapHigh.physical - heapLow.physical;
-
-		(* allocate empty memory block with enough space for at least one free block *)
-		memBlockHead := SYSTEM.VAL (MemoryBlock, ADDRESSOF (initialMemBlock));
-		memBlockTail := memBlockHead;
-		initialMemBlock.beginBlockAdr := SYSTEM.VAL (ADDRESS, LastAddress);
-		initialMemBlock.endBlockAdr := heapHigh.virtual;
-		initialMemBlock.size := initialMemBlock.endBlockAdr - initialMemBlock.beginBlockAdr;
-		initialMemBlock.next := NIL;
-		freeStackIndex := 0;
-
-		(* init stack bitmap *)
-		FOR i := 0 TO (maxUserStacks) DIV 32 - 1 DO
-			freeStack[i] := {0..31};
-		END;
-		freeStack[(maxUserStacks) DIV 32] := {0 .. (LONGINT(maxUserStacks) MOD 32) - 1};
-		freeStackIndex := 0;
-
-		(* Init cache ref counts *)
-		cacheRefs := sysCacheRefStart;
-		Fill32(sysCacheRefStart, sysCacheRefSize, 0);
-
-		IF enableCaching THEN
-			tbFlags := 7BH
-		ELSE
-			tbFlags := 0
-		END;
-
-		(* Copy interrupt vector *)
-		SYSTEM.MOVE(0, 0FFFF0000H, 4096);
-
-		EnableMM(sysFirstLvlPtStart, tbFlags, 2000H + 1007H);
-	END InitMemory;
-
-	(** GetFreeK - returns information on free memory in Kbytes.*)
-	PROCEDURE GetFreeK*(VAR total, lowFree, highFree: SIZE);
-	BEGIN
-		Acquire(Memory);
-		total := SHR(memory.size, 10);
-		lowFree := 0;
-		highFree := SHR(memory.free, 10);
-		Release(Memory)
-	END GetFreeK;
-
-	(* ===== Stack Management ===== *)
-	(** Extend stack to address. Returns TRUE iff done.
-	 * If a procedure that holds Memory needs triggers a stack extension, this procedure is called by the interrupt handler:
-	 * we get a trap because Acquire is not reentrant. To solve this, we do not acquire memory iff:
-	 *	- we are in interrupt mode
-	 *	- the current processor holds Memory already
-	 *)
-	PROCEDURE ExtendStack*(VAR s: Stack; virtAdr: ADDRESS): BOOLEAN;
-	VAR
-		ok, doLock: BOOLEAN;
-		access, psr, flags: LONGINT;
-	BEGIN
-		IF enableCaching THEN
-			flags := CB
-		ELSE
-			flags := 0
-		END;
-
-		SYSTEM.STPSR(0, psr);
-		(* Need to acquire Memory: if we are not in interrupt mode or if we do not hold this lock yet. *)
-		doLock := ~(Memory IN proc[ID()].locksHeld);
-		IF doLock THEN Acquire(Memory) END;
-		ok := FALSE;
-
-		IF (virtAdr < s.high) & (virtAdr >= s.low) THEN
-			(* Get page boundary *)
-			DEC(virtAdr, virtAdr MOD PS);
-
-			(* Check if page is mapped *)
-			(*InvalidateDCacheRange(memSysLowStart, memSysLowStop - memSysLowStart);*)
-			Initializer.InvalidateDCache;
-			IF (GetSecondLevelEntry(virtAdr) MOD 4 = slSmall) THEN
-				InvalidateTLBEntry(virtAdr);
-				Acquire(TraceOutput);
-				Trace.String("Stack address already mapped: ");
-				Trace.Address(virtAdr); Trace.Ln;
-				Release(TraceOutput)
-			ELSE
-				(* Allocate page: set different permissions for last stack page. *)
-				(*IF (virtAdr <= s.low) THEN HALT(100) ELSE access := FullAccess END;*)
-				access := FullAccess;
-
-				ok := AllocatePage(virtAdr, access, flags);
-				IF virtAdr < s.adr THEN
-					s.adr := virtAdr
-				END
-			END
-		ELSE
-			Acquire(TraceOutput);
-			Trace.StringLn("Address not in stack");Trace.Address(virtAdr); 
-			Release(TraceOutput);
-			ok := FALSE
-		END;
-		IF doLock THEN Release(Memory) END;
-		RETURN ok
-	END ExtendStack;
-
-	(** Create a new stack s, for process with the initial stack pointer initSP. *)
-	PROCEDURE NewStack*(VAR s: Stack; process: ANY; VAR initSP: ADDRESS);
-	VAR
-		old, flags: LONGINT;
-		adr: ADDRESS;
-		free: SET;
-		b: BOOLEAN;
-	BEGIN
-		Acquire(Memory);
-		old := freeStackIndex;
-		IF enableCaching THEN
-			flags := CB
-		ELSE
-			flags := 0
-		END;
-		LOOP
-			free := freeStack[freeStackIndex];
-			IF free # {} THEN
-				(* Find the free stack space in that region and mark it as allocated *)
-				adr := 0;
-				WHILE ~(adr IN free) DO INC(adr) END;
-				EXCL(freeStack[freeStackIndex], SIZE(adr));
-				adr := memStackStart + (freeStackIndex * 32 + adr) * maxUserStackSize;
-
-				EXIT
-			END;
-			INC(freeStackIndex);
-			IF freeStackIndex = LEN(freeStack) THEN freeStackIndex := 0 END;
-			IF freeStackIndex = old THEN HALT(1503) END
-		END;
-		s.high := adr + maxUserStackSize; s.low := adr + StackGuardSize;
-		s.adr := s.high - InitStackSize;	(* at the top of the virtual area *)
-		initSP := s.high;
-		b := AllocatePage(s.adr, FullAccess, flags); (* allocate one physical page first *)
-		
-		ASSERT(b);
-		FlushDCacheRange(sysSecondLvlPtStart, sysSecondLvlPtStop - sysSecondLvlPtStart);
-		Release(Memory)
-	END NewStack;
-
-	PROCEDURE DisposeStack*(s: Stack);
-	VAR
-		adr: ADDRESS;
-	BEGIN
-		Acquire(Memory);
-		adr := s.adr;
-		WHILE adr # s.high DO
-			DeallocatePage(adr);
-			INC(adr, PS)
-		END;
-
-		adr := (adr - maxUserStacks - memStackStart) DIV maxUserStackSize;
-		INCL(freeStack[adr DIV 32], SIZE(adr MOD 32));
-		Release(Memory)
-	END DisposeStack;
-
-	(** Check if the specified stack is valid. *)
-	PROCEDURE ValidStack*(CONST s: Stack; sp: ADDRESS): BOOLEAN;
-	VAR valid: BOOLEAN;
-	BEGIN
-		Acquire(Memory);
-		valid := (sp MOD 4 = 0) & (sp >= s.adr) & (sp <= s.high);
-		WHILE valid & (sp < s.high) DO
-			valid := GetSecondLevelEntry(sp) MOD 4 = slSmall;
-			INC(sp, PS)
-		END;
-		Release(Memory);
-		RETURN valid
-	END ValidStack;
-
-	PROCEDURE GetStack(adr: ADDRESS; VAR s: Stack): BOOLEAN;
-	BEGIN
-		IF (adr < memStackStart) OR (adr > memStackStop) THEN
-			RETURN FALSE
-		END;
-		s.high := adr - PS;
-		s.low := adr - 4;
-		s.adr := adr;
-		RETURN TRUE
-	END GetStack;
-
-	(* ===== Heap ===== *)
-	PROCEDURE ValidHeapAddress*(p: ADDRESS): BOOLEAN;
-	BEGIN
-		RETURN (memHeapStart <= p) & (p < memHeapStop) & (p MOD 4 = 0)
-	END ValidHeapAddress;
-
-	(* Free unused memory block *)
-	PROCEDURE FreeMemBlock*(memBlock: MemoryBlock);
-	BEGIN
-		HALT(515) (* impossible to free heap *)
-	END FreeMemBlock;
-
-	(** Set memory block end address *)
-	PROCEDURE SetMemoryBlockEndAddress*(memBlock: MemoryBlock; endBlockAdr: ADDRESS);
-	BEGIN
-		ASSERT(endBlockAdr >= memBlock.beginBlockAdr);
-		memBlock.endBlockAdr := endBlockAdr
-	END SetMemoryBlockEndAddress;
-
-	(* Policy decision for heap expansion. NewBlock for the same block has failed try times. *)
-	(*PROCEDURE ExpandNow(try: LONGINT): BOOLEAN;
-	VAR size: SIZE;
-	BEGIN
-		size := LSH(memBlockTail.endBlockAdr - memBlockHead.beginBlockAdr, -10);	(* heap size in KB *)
-		RETURN (~ODD(try) OR (size < heapMinKB)) & (size < heapMaxKB)
-	END ExpandNow;*)
-
-	(** Attempt to set the heap end address to the specified address. The returned value is the actual new end address (never smaller than previous value). *)
-	(*PROCEDURE SetHeapEndAdr(VAR endAdr: ADDRESS);
-	VAR n, m: SIZE;
-	BEGIN
-		HALT(100);
-		Acquire(Memory);
-		(*
-		n := LSH(endAdr+(PS-1), -PSlog2) - LSH(heapEndAdr, -PSlog2);	(* pages requested *)
-		m := LSH(pageHeapAdr, -PSlog2) - LSH(heapEndAdr, -PSlog2) - ReservedPages;	(* max pages *)
-		IF n > m THEN n := m END;
-		IF n > 0 THEN INC(heapEndAdr, n*PS); DEC(freeHighPages, n) END;
-		endAdr := heapEndAdr;
-		*)
-		Release(Memory)
-	END SetHeapEndAdr;*)
-
-	(* Try to expand the heap by at least "size" bytes *)
-	PROCEDURE ExpandHeap*(try: LONGINT; size: SIZE; VAR memBlock: MemoryBlock; VAR beginBlockAdr, endBlockAdr: ADDRESS);
-	BEGIN
-		(*IF ExpandNow(try) THEN
-			IF size < expandMin THEN size := expandMin END;
-			beginBlockAdr := memBlockHead.endBlockAdr;
-			endBlockAdr := beginBlockAdr;
-			INC(endBlockAdr, size);
-			SetHeapEndAdr(endBlockAdr);	(* in/out parameter *)
-			memBlock := memBlockHead;
-			(* endBlockAdr of memory block is set by caller after free block has been set in memory block - this process is part of lock-free heap expansion *)
-		ELSE*)
-			beginBlockAdr := memBlockHead.endBlockAdr;
-			endBlockAdr := memBlockHead.endBlockAdr;
-			memBlock := NIL
-		(*END*)
-	END ExpandHeap;
-
-	(** GetStaticHeap - get page range (beginAdr..endAdr-1) and first and last block of static heap.*)
-	PROCEDURE GetStaticHeap*(VAR beginBlockAdr, endBlockAdr, freeBlockAdr: ADDRESS);
-	BEGIN
-		beginBlockAdr := initialMemBlock.beginBlockAdr;
-		endBlockAdr := initialMemBlock.endBlockAdr;
-		freeBlockAdr := beginBlockAdr;
-	END GetStaticHeap;
-
-	(* ===== Caches, TLB & other ===== *)
-	(** SHR - logical shift right *)
-	PROCEDURE SHR(value, shift: ADDRESS): LONGINT;
-	CODE
-		LDR R0, [FP, #value]
-		LDR R1, [FP, #shift]
-
-		MOV R0, R0, LSR R1
-	END SHR;
-
-	(** SHRL - shift right and left. Mask out 'shift' lowest bits *)
-	PROCEDURE SHRL(value, shift: LONGINT): LONGINT;
-	(*CODE
-		LDR R0, [FP, #value]
-		LDR R1, [FP, #shift]
-
-		MOV R0, R0, LSR R1
-		MOV R0, R0, LSL R1*)
-	BEGIN
-		value := LSH(value, -shift);
-		value := LSH(value, shift);
-		RETURN value
-	END SHRL;
-
-	(** Fills 'size' bytes with 'filler', from 'destAdr' on. size must be multiple of 4 *)
-	PROCEDURE Fill32*(destAdr: ADDRESS; size: SIZE; filler: LONGINT);
-	CODE
-		LDR	R0, [FP, #filler]
-		LDR	R1, [FP, #size]
-		LDR	R3, [FP, #destAdr]
-		ADD	R4, R1, R3				; R4 = size + destAdr
-
-		AND	R5, R3, #3				; R5 := R3 MOD 4
-		CMP	R5, #0					; ASSERT(R5 = 0)
-		BEQ	CheckSize
-		SWI	#8
-
-	CheckSize:
-		AND	R5, R1, #3				; R5 := R1 MOD 4
-		CMP	R5, #0					; ASSERT(R5 = 0)
-		BEQ	Loop
-		SWI	#8
-
-	Loop:
-		CMP	R4, R3
-		BLS		Exit
-		STR	R0, [R3, #0]			; put(destAdr + counter, filler)
-		ADD	R3, R3, #4				; R3 := R3 + 4
-		B		Loop
-	Exit:
-	END Fill32;
-
-	(* GetPageTableBase - returns the memory address of the first level page table *)
-	PROCEDURE -GetPageTableBase(): LONGINT;
-	CODE
-		MRC p15, 0, R0, c2, c0, 0
-		MOV R0, R0, LSR #14	; clear bits 13..0
-		MOV R0, R0, LSL #14
-	END GetPageTableBase;
-
-	(** GC Initialization -- Set machine-dependent parameters gcThreshold, expandMin, heapMinKB and heapMaxKB *)
-	PROCEDURE SetGCParams*;
-	VAR size, t: SIZE;
-	BEGIN
-		GetFreeK(size, t, t);	(* size is total memory size in KB *)
-		heapMinKB := size * HeapMin DIV 100;
-		heapMaxKB := size * HeapMax DIV 100;
-		expandMin := size * ExpandRate DIV 100 * 1024;
-		IF expandMin < 0 THEN expandMin := MAX(LONGINT) END;
-		gcThreshold := size * Threshold DIV 100 * 1024;
-		IF gcThreshold < 0 THEN gcThreshold := MAX(LONGINT) END
-	END SetGCParams;
-
-	(** Called when spinning, just does a NOP *)
-	PROCEDURE -SpinHint*;
-	CODE
-		MOV R0, R0
-	END SpinHint;
-
-	(** Convert a string to an integer. Parameter i specifies where in the string scanning should begin (usually 0 in the first call). Scanning stops at the first non-valid character, and i returns the updated position. Parameter s is the string to be scanned. The value is returned as result, or 0 if not valid. Syntax: number = ["-"] digit {digit} ["H" | "h"] . digit = "0" | ... "9" | "A" .. "F" | "a" .. "f" . If the number contains any hexdecimal letter, or if it ends in "H" or "h", it is interpreted as hexadecimal. *)
-	PROCEDURE StrToInt* (VAR i: LONGINT; CONST s: ARRAY OF CHAR): LONGINT;
-	VAR vd, vh, sgn, d: LONGINT; hex: BOOLEAN;
-	BEGIN
-		vd := 0; vh := 0; hex := FALSE;
-		IF s[i] = "-" THEN sgn := -1; INC (i) ELSE sgn := 1 END;
-		LOOP
-			IF (s[i] >= "0") & (s[i] <= "9") THEN d := ORD (s[i])-ORD ("0")
-			ELSIF (CAP (s[i]) >= "A") & (CAP (s[i]) <= "F") THEN d := ORD (CAP (s[i]))-ORD ("A") + 10; hex := TRUE
-			ELSE EXIT
-			END;
-			vd := 10*vd + d; vh := 16*vh + d;
-			INC (i)
-		END;
-		IF CAP (s[i]) = "H" THEN hex := TRUE; INC (i) END;	(* optional H *)
-		IF hex THEN vd := vh END;
-		RETURN sgn * vd
-	END StrToInt;
-
-	(** Read Non Volatile memory. Not implemented. Required by clock. *)
-	PROCEDURE GetNVByte* (ofs: LONGINT): CHAR;
-	BEGIN
-		RETURN 10X
-	END GetNVByte;
-
-	(** Write Non Volatile memory. Not implemented. Required by clock. *)
-	PROCEDURE PutNVByte* (ofs: LONGINT; val: CHAR);
-	END PutNVByte;
-
-	(* empty section allocated at end of bootfile *)
-	PROCEDURE {NOPAF, ALIGNED(32)} LastAddress;
-	CODE
-	END LastAddress;
-
-	PROCEDURE GetConfig*(CONST name: ARRAY OF CHAR; VAR res: ARRAY OF CHAR);
-	BEGIN
-		BootConfig.GetValue(name, res)
-	END GetConfig;
-
-	PROCEDURE MulH * (x, y: HUGEINT): HUGEINT;
-	BEGIN
-		RETURN LONGINT(x) * LONGINT(y)
-	END MulH;
-
-	PROCEDURE DivH * (x, y: HUGEINT): HUGEINT;
-	BEGIN
-		RETURN x DIV y
-	END DivH;
-
-	(** Not implemented yet *)
-	PROCEDURE  Portin8*(port: LONGINT; VAR val: CHAR);
-	END Portin8;
-
-	PROCEDURE  Portout8*(port: LONGINT; val: CHAR);
-	END Portout8;
-
-	PROCEDURE TraceState * (CONST state: State);
-	BEGIN
-		Trace.StringLn("General Purpose Registers");
-		Trace.String("R0	"); Trace.Address(state.R[0]); Trace.Ln;
-		Trace.String("R1	"); Trace.Address(state.R[1]); Trace.Ln;
-		Trace.String("R2	"); Trace.Address(state.R[2]); Trace.Ln;
-		Trace.String("R3	"); Trace.Address(state.R[3]); Trace.Ln;
-		Trace.String("R4	"); Trace.Address(state.R[4]); Trace.Ln;
-		Trace.String("R5	"); Trace.Address(state.R[5]); Trace.Ln;
-		Trace.String("R6	"); Trace.Address(state.R[6]); Trace.Ln;
-		Trace.String("R7	"); Trace.Address(state.R[7]); Trace.Ln;
-		Trace.String("R8	"); Trace.Address(state.R[8]); Trace.Ln;
-		Trace.String("R9	"); Trace.Address(state.R[9]); Trace.Ln;
-		Trace.String("R10	"); Trace.Address(state.R[10]); Trace.Ln;
-		Trace.String("R11	"); Trace.Address(state.R[11]); Trace.Ln;
-
-		Trace.StringLn("Stack");
-		Trace.String("SP	"); Trace.Address(state.SP); Trace.Ln;
-		Trace.String("FP	"); Trace.Address(state.BP); Trace.Ln;
-
-		Trace.StringLn("Code");
-		Trace.String("LR	"); Trace.Address(state.LR); Trace.Ln;
-		Trace.String("PC	"); Trace.Address(state.PC); Trace.Ln;
-
-		Trace.Ln;
-		Trace.String("PSR	"); Trace.Address(state.PSR); Trace.Ln;
-
-		Trace.Ln;
-		Trace.String("int	"); Trace.Address(state.INT); Trace.Ln;
-	END TraceState;
-
-	PROCEDURE ReadMemLayout;
-	VAR
-		value: ARRAY 64 OF CHAR;
-		i: LONGINT;
-	BEGIN
-		memSysLowStart := Platform.OCMStart;
-		memSysLowStop := memSysLowStart + Platform.OCMSize;
-
-		GetConfig("KernelLoadAdr", value);
-		i := 0;
-		memHeapStart := StrToInt(i, value);
-		GetConfig("HeapSize", value);
-		i := 0;
-		memHeapStop := memHeapStart + StrToInt(i, value);
-
-		GetConfig("DDRSize", value);
-		i := 0;
-		memConfigStop := Platform.DDRStart + StrToInt(i, value);
-		GetConfig("ConfigSize", value);
-		i := 0;
-		memConfigStart := memConfigStop - StrToInt(i, value);
-
-		memStackStart := memHeapStop;
-		memStackStop := memConfigStart;
-
-		memIOStart := Platform.IOStart;
-		memIOStop := memIOStart + Platform.IOSize;
-
-		memSysHighStart := ADDRESS(4 * G - M);
-		memSysHighStop := 4 * G - 1;
-
-		(* System Parameters *)
-		sysIntStackStart := memSysLowStart + 1000H;
-		sysIntStackStop := memSysLowStart + Platform.MaxCpuNb * 4 * 4 * k;
-
-		(* The first level page table is always 16 k large, to map all 4 G of virtual memory space *)
-		sysFirstLvlPtStop := memSysLowStop;
-		sysFirstLvlPtStart := sysFirstLvlPtStop - 16 * k;
-		(*
-		 * Second Level Page Table:
-		 *		- 2 * 256 entries for the system area (first and last MB of VMem)
-		 *		- 256 entries for each MB of virtual stack space
-		 * 256 entries take 1kB memory space.
-		 *)
-		sysSecondLvlPtStop := sysFirstLvlPtStart;
-		sysSecondLvlPtStart := sysSecondLvlPtStop - (2 + (memStackStop - memStackStart + memConfigStop - memConfigStart) DIV M) * k;
-		(*
-		 * Interrupt Vector. Located at 0FFFFFFF0H
-		 *)
-		sysVectorStart := 0FFFF0000H;
-		sysVectorStop := sysVectorStart + PS;
-		sysCacheRefStart := 0FFFF1000H;
-		(*
-		 * Number of ref counters: 1 per 1st level heap page, 1 per 2nd level stack page.
-		 * This memory region is organized as follows: the first part [0 .. SysCacheStackOfs) is used for heap pages,
-		 * the second part, [SysCacheStackOfs .. SysCacheRefSize) is used for stack pages.
-		 *)
-		sysCacheRefSize := (memHeapStop - memHeapStart) DIV M + (memStackStop - memStackStart) DIV PS;
-		INC(sysCacheRefSize, 4 - sysCacheRefSize MOD 4);
-		(* Offset in the ref count table for stack pages. *)
-		sysCacheStackOfs := (memHeapStop - memHeapStart) DIV M;
-
-		sysCacheRefStop := sysCacheRefStart + sysCacheRefSize;
-
-		(* Process stack system *)
-		GetConfig("StackSize", value);
-		i := 0;
-		maxUserStackSize := StrToInt(i, value);
-		maxUserStacks := (memStackStop - memStackStart) DIV maxUserStackSize;
-
-		GetConfig("EnableCaching", value);
-		enableCaching := value[0] # '0';
-
-		traceInterrupts := BootConfig.GetBoolValue("TraceInterrupts")
-	END ReadMemLayout;
-
-	PROCEDURE GetProcessorNumber;
-	VAR
-		value: ARRAY 64 OF CHAR;
-		i: LONGINT;
-	BEGIN
-		FOR i := 0 TO 63 DO value[i] := 0X END;
-		GetConfig("CpuNb", value);
-		i := 0;
-		numProcessors := StrToInt(i, value)
-	END GetProcessorNumber;
-
-	(** Analyse reasons for reset, print and record them. *)
-	PROCEDURE ResetAnalysis;
-	CONST
-		(* We need these constants as Platform.slcr is not initialized yet *)
-		SLCR_REBOOT_STATUS = ADDRESS(0F8000258H);
-		SLCR_LOCK = ADDRESS(0F8000004H);
-		SLCR_UNLOCK = ADDRESS(0F8000008H);
-		Lock = LONGINT(767BH);
-		Unlock = LONGINT(0DF0DH);
-	VAR
-		val: SET;
-		error: LONGINT;
-	BEGIN
-		SYSTEM.GET(SLCR_REBOOT_STATUS, val);
-		IF 16 IN val THEN
-			lastReboot := RebootSystemWatchdog;
-			Trace.StringLn("Starting after system watchdog reset")
-		END;
-		IF 17 IN val THEN
-			lastReboot := RebootWatchdogCPU0;
-			Trace.StringLn("Starting after private watchdog reset on CPU0")
-		END;
-		IF 18 IN val THEN
-			lastReboot := RebootWatchdogCPU1;
-			Trace.StringLn("Starting after private watchdog reset on CPU1")
-		END;
-		IF 19 IN val THEN
-			lastReboot := RebootSoftReset;
-			Trace.StringLn("Starting after software reboot")
-		END;
-		IF 20 IN val THEN
-			lastReboot := RebootDebug;
-			Trace.StringLn("Starting after debug reset")
-		END;
-		IF 21 IN val THEN
-			lastReboot := RebootHardReset;
-			Trace.StringLn("Starting after hard reset")
-		END;
-		IF 22 IN val THEN
-			lastReboot := RebootPowerOn;
-			Trace.StringLn("Starting after power on")
-		END;
-		error := SYSTEM.VAL(INTEGER, val);
-		IF error # 0 THEN
-			Trace.String("BootROM error code: "); Trace.Int(error, 0); Trace.Ln
-		END;
-		SYSTEM.PUT(SLCR_UNLOCK, Unlock);
-		SYSTEM.PUT(SLCR_REBOOT_STATUS, LONGINT(0));
-		SYSTEM.PUT(SLCR_LOCK, Lock)
-	END ResetAnalysis;
-
-	PROCEDURE InitWatchdog;
-	VAR val: ARRAY 32 OF CHAR;
-	BEGIN
-		GetConfig("EnableKernelWatchdog", val);
-		enableWatchdog := val = '1';
-		IF enableWatchdog THEN
-			PrivateWatchdog.Init(BootConfig.GetIntValue("CpuClockHz") DIV 2);
-			PrivateWatchdog.Start(PrivateWatchdog.Reset, Second)
-		END
-	END InitWatchdog;
-
-	PROCEDURE Init;
-	BEGIN
-		BootConfig.Init;
-		ReadMemLayout;
-
-		sp := GetSP();
-		fp := GetBP();
-
-		SYSTEM.LDPSR( 0, Platform.IRQMode + Platform.FIQDisabled + Platform.IRQDisabled );
-		SYSTEM.SETSP(sysIntStackStart + 1000H);
-
-		SYSTEM.LDPSR( 0, Platform.UndefMode + Platform.FIQDisabled + Platform.IRQDisabled );
-		SYSTEM.SETSP(sysIntStackStart + 1000H * 2);
-
-		SYSTEM.LDPSR( 0, Platform.AbortMode + Platform.FIQDisabled + Platform.IRQDisabled );
-		SYSTEM.SETSP(sysIntStackStart + 1000H * 3);
-
-		SYSTEM.LDPSR( 0, Platform.SVCMode + Platform.FIQDisabled + Platform.IRQDisabled );
-		SYSTEM.SETSP(sysIntStackStart + 1000H * 4);
-
-		SYSTEM.LDPSR( 0, Platform.SystemMode + Platform.FIQDisabled + Platform.IRQDisabled );   (* Disable interrupts, init SP, FP *)
-		SYSTEM.SETSP(sp);
-		SYSTEM.SETFP(fp);
-
-		TraceDevice.Install;
-		Trace.String("Machine: "); Trace.StringLn (Version);
-		version := Version;
-		InitProcessor;
-		InstallDefaultInterrupts;
-		DisableInterrupts;
-		ResetAnalysis;
-
-		(* Ensure memory layout consistency *)
-		ASSERT(sysIntStackStart >= 4 * k);
-		ASSERT(sysIntStackStop <= sysSecondLvlPtStart);
-		ASSERT(sysFirstLvlPtStart MOD (16 * k) = 0);
-		ASSERT(memStackStop <= memIOStart);
-		ASSERT(memIOStop <= memSysHighStart);
-		ASSERT(sysVectorStop <= sysCacheRefStart);
-		ASSERT(sysCacheRefStop <= memSysHighStop);
-
-		InitMemory;
-		GetProcessorNumber;
-		InitLocks;
-		InitGlobalTimer
-	END Init;
-	
-	PROCEDURE {INITIAL} Initial;
-	BEGIN
-		Init;
-	END Initial;
-	
-END Machine.

ARM/ARM.A2/ARM.Objects.Mod

@@ -1,1882 +0,0 @@
-MODULE Objects;	(** AUTHOR "pjm"; PURPOSE "Active object runtime support"; *)
-
-IMPORT SYSTEM, Trace, Machine, Heaps, Modules;
-
-CONST
-	(** Process flags *)
-	Restart* = 0;			(* Restart/Destroy process on exception (hardcoded in compiler (OPC.CallRecBody / PCC.SysStart)) *)
-	PleaseHalt* = 10;		(* Process requested to Halt itself soon *)
-	Unbreakable*= 11;		(* FINALLY shall not catch HALT exception (PleaseHalt is also set) *)
-	SelfTermination*=12;	(* Indicates the process has requested to terminate ifself (PleaseHalt is also set) *)
-	Preempted* = 27;		(* Has been preempted. *)
-	Resistant* = 28;		(* Can only be destroyed by itself *)
-
-	(** Process modes *)
-	Unknown* = 0; Ready* = 1; Running* = 2; AwaitingLock* = 3;
-	AwaitingCond* = 4; AwaitingEvent* = 5; Suspended* = 6; (* Suspened for compatibility with WinAos, not used for native A2 *)
-	Terminated* = 7;
-
-	(** Process priorities *)
-	MinPriority = 0;							(* only system idle processes run at this priority level *)
-	Low* = 1; Normal* = 2; High* = 3;		(* "user" priorities *)
-	GCPriority* = 4;							(* priority of garbage collector *)
-	Realtime* = 5;							(* reserved for interrupt handling and realtime apps, these processes are not allowed to allocate memory *)
-	NumPriorities = Heaps.NumPriorities; 	(* number of priority levels *)
-
-	(* Process termination halt codes *)
-	halt* = 2222;
-	haltUnbreakable* = 2223;
-
-	MinIRQ = Machine.IRQ0;
-	NumIRQ = Machine.MaxIRQ-MinIRQ+1;
-
-	Stats* = FALSE;	  (* maintain statistical counters *)
-	TraceVerbose = FALSE;	(* write out verbose trace info *)
-	StrongChecks = TRUE;	(* strong sanity checks *)
-	VeryConservative = FALSE;	(* temp - be very conservative about stack-based pointers *)
-	YieldTrick = FALSE;	(* avoid yield when no ready process available *)
-
-	HandlePriorityInv = TRUE; (* enables or disables priority inversion handling. Handling of priority inversion leads to a simplified locking, see Lock, Unlock and Await *)
-
-	(* constant used in GC Process.FindPointers *)
-	InitDiff = MAX(LONGINT);
-
-	AddressSize = SIZEOF(ADDRESS);
-	ReturnStackDisplacement = 2 * AddressSize;
-	
-TYPE
-	CpuCyclesArray* = ARRAY Machine.MaxCPU OF HUGEINT;
-
-	EventHandler* = PROCEDURE {DELEGATE};
-
-	Timer* = POINTER TO RECORD
-		next*, prev* : Timer;
-		trigger: LONGINT;
-		handler: EventHandler
-	END;
-
-	ProtectedObject = POINTER TO RECORD END; (* protected object *)
-
-	ProcessQueue = Heaps.ProcessQueue;
-
-	Body = PROCEDURE (self: ProtectedObject);
-	Condition = PROCEDURE (slink: ADDRESS): BOOLEAN;
-
-	InterruptList = POINTER TO RECORD
-		next: InterruptList;
-		handler: EventHandler
-	END;
-
-TYPE
-
-	(** All exported fields and variables should be considered read-only. *)
-	Process* = OBJECT (Heaps.ProcessLink)
-	VAR
-		rootedNext : Process;	(** for rootedProcesses *)
-		obj-: ProtectedObject;	(** associated active object *)
-		state-: Machine.State;	(** processor state of suspended process *)
-		sse: Machine.NEONState;	(* fpu and sse state of preempted process (only valid if Preempted IN flag) *)
-		sseAdr: ADDRESS;
-		condition-: Condition;	(** awaited process' condition *)
-		condFP-: ADDRESS;	(** awaited process' condition's context *)
-		mode-: LONGINT;	(** process state *)	(* only changed inside Objects lock ??? *)
-		procID-: LONGINT;	(** processor ID where running *)
-		waitingOn-: ProtectedObject;	(** obj this process is waiting on (for lock or condition) *)
-		id-: LONGINT;	(** unique process ID for tracing *)
-		flags*: SET;	(** process flags *)
-		priority-, staticPriority*: LONGINT;	(** process dynamic priority (can change during priority inversion handling) and static priority *)	(* exported for AosExceptions *)
-		stack*: Machine.Stack;	(** user-level stack of process *)
-		restartPC-: ADDRESS;	(** entry point of body, for SAFE exception recovery *)
-		restartSP-: ADDRESS;	(** stack level at start of body, for SAFE exception recovery *)
-		exp*: Machine.ExceptionState;
-		oldReturnPC: ADDRESS;
-		cpuCycles-, lastCpuCycles- : CpuCyclesArray;
-		prioRequests : ARRAY NumPriorities OF LONGINT; (* priorities of processes that wait for resources locked by this process, only the highest priority per resource is stored *)
-		context: ANY;
-
-		(* set priority of process: Machine.Objects lock is taken *)
-		PROCEDURE SetPriority(p : LONGINT);
-		BEGIN
-			DEC(prioRequests[staticPriority]);
-			staticPriority := p;
-			INC(prioRequests[staticPriority]);
-			priority := MaxPrio(prioRequests)
-		END SetPriority;
-
-		PROCEDURE FindRoots; (* override *)
-		VAR pc, bp, curbp, sp: ADDRESS; d0, d1: SIZE; first : BOOLEAN;
-		BEGIN
-			IF traceProcess # NIL THEN traceProcess(SELF) END;
-
-					(* stack garbage collection *)
-			IF (priority >= Low) & (priority <= High) & (mode >= Ready) & (mode # Terminated) THEN
-			(* only processes with priority < GCPriority are preempted during GC,
-			    only those are allowed to allocate memory and their stacks are inspected.
-			    Furthermore, the process must be in a valid state, e.g. terminated processes have a disposed stack. *)
-
-				IF Heaps.GCType = Heaps.HeuristicStackInspectionGC THEN
-
-					IF VeryConservative THEN
-						Heaps.RegisterCandidates(stack.adr, stack.high-stack.adr)
-					ELSE
-						sp := state.SP;	(* cf. Enter *)
-						IF sp # 0 THEN
-							IF Machine.ValidStack(stack, sp) THEN
-								Heaps.RegisterCandidates(sp, stack.high - sp)
-							END
-						ELSE
-							Trace.String("[Objects.FindRoots sp=0]")
-						END
-					END;
-					
-					IF TraceProcessHook # NIL THEN
-						bp := state.BP; pc := state.PC; sp := state.SP;
-						TraceProcessHook(SELF,pc,bp,sp,stack.high);
-					END;
-
-				ELSIF Heaps.GCType = Heaps.MetaDataForStackGC THEN
-
-					bp := state.BP; pc := state.PC; first := TRUE;
-					IF pc # 0 THEN 	(* process is running already *)
-						WHILE (bp # Heaps.NilVal) & (stack.adr <= bp) & (bp < stack.high) DO
-							FindPointers(bp, pc, d0, d1);
- 							IF first THEN
- 								IF (d0 = 0) OR (d0 = 1) OR (d1 = 3) THEN
- 									(* 	situation where pc and bp are not synchronized: *)
- 									(* 	entry protocol of a procedure:
- 										PUSH 	EBP			-- 1 byte instruction length, if pc points to this instruction at offset 0 from the codeoffset then bp still refers to caller frame -> critical
- 										MOV	EBP, ESP	-- 2 bytes instruction length, do. for offset 1 from the codeoffset
- 										(followed by initialization of local variables)
- 										exit protocol of a procedure:
- 										MOV	ESP, EBP	-- 2 bytes instruction length
- 										POP	EBP			-- 1 byte instruction length
- 										RET		n			-- 3 bytes instruction length, if pc points to this instruction at offset 3 from the last statement then bp already refers to caller's frame -> critical
- 									*)
- 									IF (d0 = 0) OR (d1 = 3) THEN
- 										SYSTEM.GET(state.SP, pc);		(* matching pc is at position of stack pointer *)
- 									ELSE
- 										SYSTEM.GET(state.SP+AddressSize, pc);		(* matching pc is at 4 bytes after stack pointer, pushed base pointer is at stack pointer position *)
-									END;
- 								ELSE
- 									(* regular case: bp and pc were synchronized *)
- 									curbp := bp;
-									SYSTEM.GET(curbp, bp);
-									SYSTEM.GET(curbp+AddressSize, pc);
- 								END;
- 								first := FALSE;
- 							ELSE
- 								(* regular case: bp and pc were synchronized *)
- 								curbp := bp;
-								SYSTEM.GET(curbp, bp);
-								SYSTEM.GET(curbp+AddressSize, pc);
-							END
-						END
-					END
-
-				ELSE
-					HALT(900) (* wrong GCType constant *)
-				END
-
-			END
-
-		END FindRoots;
-		
-		(*!TODO: adapt the code according to the new Modules/Reflection *)
-		PROCEDURE FindPointers(bp, pc : ADDRESS; VAR diff0, diff1: SIZE);
-		(*VAR data: Modules.ProcTableEntry; startIndex, i: LONGINT; ptr : ADDRESS; success: BOOLEAN;
-		BEGIN
-			diff0 := InitDiff; diff1 := InitDiff;
-			(*Modules.FindProc(pc, data, startIndex, success);*)
-			IF success THEN
-				diff0 := pc - data.pcFrom;
-				diff1 := pc - data.pcStatementEnd;
-				IF (data.noPtr > 0) & (pc >= data.pcStatementBegin) & (pc <= data.pcStatementEnd) THEN
-					FOR i := 0 TO data.noPtr - 1 DO
-						SYSTEM.GET(bp + Modules.ptrOffsets[startIndex + i], ptr);
-						IF ptr # Heaps.NilVal THEN
-							Heaps.Mark(SYSTEM.VAL(ANY, ptr))
-						END
-					END
-				END
-			END*)
-		END FindPointers;
-
-	END Process;
-
-	TraceProcess* = PROCEDURE (p: Process);
-
-	ExceptionHandler* = PROCEDURE(p: Process; VAR int: Machine.State; VAR exc: Machine.ExceptionState; VAR return: BOOLEAN);
-
-	Idle = OBJECT
-	BEGIN {ACTIVE, SAFE, PRIORITY(-1)}	(* negative priority equivalent to MinPriority *)
-		LOOP
-			REPEAT
-				IF ProcessorHLT # NIL THEN ProcessorHLT	(* UP *)
-				ELSE
-					Machine.SpinHint; (* MP *)
-				END;
-			UNTIL maxReady >= lowestAllowedPriority;
-			Yield
-		END
-	END Idle;
-
-	Clock = OBJECT
-	VAR h: Timer;
-	BEGIN {ACTIVE, SAFE, PRIORITY(High)}
-		LOOP
-			Machine.Acquire(Machine.Objects);
-			LOOP
-				h := event.next;
-				IF (h = event) OR (h.trigger - Machine.ticks > 0) THEN EXIT END;
-				event.next := h.next; event.next.prev := event; (* unlink *)
-				h.next := NIL; h.prev := NIL;
-				Machine.Release(Machine.Objects);
-				h.handler;	(* assume handler will return promptly *)
-				Machine.Acquire(Machine.Objects)
-			END;
-			ASSERT(timer = NIL); (* temp strong check *)
-			timer := running[Machine.ID ()];
-			timer.mode := AwaitingEvent;
-			SwitchToNew
-		END
-	END Clock;
-
-	ReadyProcesses = OBJECT(Heaps.RootObject)
-		VAR q {UNTRACED}: ARRAY NumPriorities OF ProcessQueue;
-
-		PROCEDURE &Init;
-		VAR i: LONGINT;
-		BEGIN
-			FOR i := 0 TO NumPriorities - 1 DO
-				q[i].head := NIL; q[i].tail := NIL
-			END
-		END Init;
-
-		PROCEDURE FindRoots; (* override *)
-		VAR i: LONGINT;
-		BEGIN
-			(* only mark queues of user processes since these will not change during GC *)
-			FOR i := Low TO High DO
-				Heaps.Mark(q[i].head);
-				Heaps.Mark(q[i].tail)
-			END
-		END FindRoots;
-
-	END ReadyProcesses;
-
-	GCStatusExt = OBJECT(Heaps.GCStatus)
-		VAR gcOngoing: BOOLEAN;
-
-		PROCEDURE &Init;
-		BEGIN
-			gcOngoing := FALSE;
-		END Init;
-
-		(* called from Heaps.InvokeGC, i.e. this is a hidden upcall. However, it is necessary to take the Machine.Objects lock here since writing
-		    the set of variables here must not be interrupted, i.e. atomic writing of the set of variables is absolutely necessary.  They system may hang
-		    if the lock is not taken. *)
-		PROCEDURE SetgcOngoing(value: BOOLEAN);
-		VAR p: Process;
-		BEGIN
-			IF value THEN
-				Machine.Acquire(Machine.Objects);
-				IF ~gcOngoing THEN
-					gcOngoing := TRUE;
-					lowestAllowedPriority := GCPriority;
-					gcBarrier := Machine.allProcessors
-				END;
-				p := running[Machine.ID()];
-				Enter(p);
-				p.mode := Ready;
-				SwitchToNew (* this method cannot schedule the running user process with priority Low, Normal or High since
-				                            lowestAllowedPriority is set to GCPriority *)
-			ELSE
-				Machine.Acquire(Machine.Objects);
-				gcOngoing := FALSE;
-				lowestAllowedPriority := Low;
-				Machine.Release(Machine.Objects)
-			END;
-		END SetgcOngoing;
-
-		(* caller must hold Machine.Objects lock *)
-		PROCEDURE GetgcOngoing(): BOOLEAN;
-		BEGIN
-			RETURN gcOngoing
-		END GetgcOngoing;
-
-	END GCStatusExt;
-
-	GCActivity = OBJECT
-	BEGIN {ACTIVE, SAFE, PRIORITY(GCPriority)}
-		UpdateState;
-		LOOP
-			Machine.Acquire(Machine.Objects);
-
-			ASSERT(gcProcess = NIL); (* temp strong check *)
-			gcProcess := running[Machine.ID()];
-			gcProcess.mode := AwaitingEvent;
-			SwitchToNew; (* SwitchTo called by SwitchToNew will release the lock Machine.Objects *)
-
-			(* process is scheduled -> gcProcess = NIL set by scheduler (Timeslice), perform garbage collection now *)
-			Heaps.CollectGarbage(Modules.root);
-			Machine.Acquire(Machine.Objects);
-			IF finalizerProcess # NIL THEN
-			(* it is safe to move finalizerProcess to the ready queue and set the variable to NIL
-			    since the process has been marked by the GC already - marking is finished here *)
-				Enter(finalizerProcess);
-				finalizerProcess := NIL
-			END;
-			Machine.Release(Machine.Objects);
-			Heaps.gcStatus.SetgcOngoing(FALSE)
-		END
-	END GCActivity;
-
-	FinalizedCollection* = OBJECT (* base type for collection, extended in Kernel.Mod *)
-		PROCEDURE RemoveAll*(obj: ANY); (** abstract *)
-		BEGIN HALT(301) END RemoveAll;
-	END FinalizedCollection;
-
-	FinalizerNode* = POINTER TO RECORD (Heaps.FinalizerNode)
-		c*: FinalizedCollection (* base type for collection containing object *)
-	END;
-
-	FinalizerCaller = OBJECT	(* separate active object that calls finalizers *)
-		VAR n: Heaps.FinalizerNode;
-
-	BEGIN {ACTIVE, SAFE, PRIORITY(High)}
-		LOOP
-			Machine.Acquire(Machine.Objects);
-
-			ASSERT(finalizerProcess = NIL); (* temp strong check *)
-			finalizerProcess := running[Machine.ID()];
-			finalizerProcess.mode := AwaitingEvent;
-			SwitchToNew; (* SwitchTo called by SwitchToNew will release the lock Machine.Objects *)
-
-			(* process is scheduled -> finalizerProcess = NIL set by GCActivity, perform finalization now *)
-			LOOP
-				n := Heaps.GetFinalizer();
-				IF n = NIL THEN EXIT END;
-				IF n IS FinalizerNode THEN
-					n(FinalizerNode).c.RemoveAll(n.objStrong)	(* remove it if it is not removed yet *)
-				END;
-				IF n.finalizer # NIL THEN
-					n.finalizer(n.objStrong)	(* may acquire locks *)
-				END
-			END;
-		END
-	END FinalizerCaller;
-
-	Interrupter = OBJECT (ProtectedObject)	(* to do: like Timer *)
-	VAR interruptNumber: LONGINT;
-	END Interrupter;
-
-VAR
-	ready: ReadyProcesses;	(* ready queue represented as an object that contains the queues *)
-	maxReady: LONGINT;	(* for all i : MinPriority <= maxReady < i < NumPriorities : Empty(ready.q[i]) *)
-	lowestAllowedPriority: LONGINT;  (* denotes the minimal user or realtime priority greater than the idle priority that can be
-	                                                            scheduled depending on the GC status, minPriority = Low if GC is not running,
-	                                                            minPrioriy = GCPriority otherwise *)
-	running-{UNTRACED}: ARRAY Machine.MaxCPU OF Process;	(** processes currently running, exported for Traps, not traced by the GC since it may change during collection *)
-	nextProcessID: LONGINT;
-
-	gcBarrier: SET; 			(* barrier that must be passed by all processors before actual collection starts *)
-	gcActivity: GCActivity;	(* active object for GC handling *)
-	gcProcess: Process;		(* suspended GC process, is NIL when collection has started, not equal NIL when no garbage collection is in process, same behaviour as for timer *)
-	finalizerProcess: Process;	(* finalizer process, regarded as part of GC *)
-	interrupt: ARRAY NumIRQ OF RECORD
-		root: InterruptList;
-		process: Process
-	END;
-
-	processingIRQ: ARRAY NumIRQ OF BOOLEAN;
-
-	rootedProcesses: ARRAY NumPriorities OF Process; (* list of potential processes that are not traced by GC when processing the ready queues, since GC only traces processes with
-	                                                                                      priorities Low ... High in ready queues. The potentially not traced processes are rooted here and traced by the GC *)
-
-	event: Timer;	(* list of events *)
-
-	timer (*, realtimeTimer *): Process;	(* suspended timer processes *)
-	terminate: PROCEDURE;
-	trap, trapReturn: ARRAY 2 OF PROCEDURE;
-
-	ProcessorHLT*: PROCEDURE;	 (** installable procedure to halt the current processor while idle *)
-	traceProcess*: TraceProcess;	(** for debugging purposes (see Info.Active) *)
-
-	entry: ADDRESS;
-	init: Process;
-
-	initObject: ProtectedObject;	(* Active object for the init process *)
-
-	(* Performance monitoring *)
-	idlecount*: ARRAY Machine.MaxCPU OF LONGINT; (** count of idle process timeslice interrupts *)
-	idleCycles- : ARRAY Machine.MaxCPU OF HUGEINT; (** CPU cycles of idle threads *)
-	perfTsc-: ARRAY Machine.MaxCPU OF HUGEINT;
-
-	(* Statistics *)
-	Nlock-, Nunlock-, Nawait-, NawaitNoIF-, NawaitTrue-, Ncreate-, Nterminate-,
-	Ncondition-, Ncondition1True-, Ncondition2-, Ncondition2True-,
-	Ntimeslice-, NtimesliceTaken-, NtimesliceNothing-, NtimesliceIdle-,
-	NtimesliceKernel-, NtimesliceV86-, NtimesliceCritical-,
-	Npreempt-, NpreemptTaken-, NpreemptNothing-,
-	NpreemptKernel-, NpreemptV86-, NpreemptCritical-,
-	Nenter- : LONGINT;
-
-	debugCounter: LONGINT;
-
-PROCEDURE GetMaxPrio(VAR queue: ProcessQueue; VAR new: Process);
-VAR
-	t: Heaps.ProcessLink;
-	maxPriority : LONGINT;
-BEGIN
-	ASSERT(new = NIL);
-	t := queue.head;
-	maxPriority := MIN(LONGINT);
-	WHILE (t # NIL) DO
-		IF (t(Process).priority > maxPriority) THEN
-			new := t(Process); maxPriority := t(Process).priority;
-		END;
-		t := t.next;
-	END;
-	IF new = NIL THEN	(* zero elements in queue *)
-		(* skip *)
-	ELSE	(* more than one element in queue *)
-		IF new.next # NIL THEN new.next.prev := new.prev END;
-		IF new.prev # NIL THEN new.prev.next := new.next END;
-		IF queue.head = new THEN
-			queue.head := new.next
-		END;
-		IF queue.tail = new THEN
-			queue.tail := new.prev
-		END;
-		new.next := NIL; new.prev := NIL
-	END;
-END GetMaxPrio;
-
-(* Get a process from a queue (NIL if none). Caller must hold lock for specific queue. *)
-PROCEDURE Get(VAR queue: ProcessQueue; VAR new: Process);
-VAR t: Heaps.ProcessLink;
-BEGIN
-	t := queue.head;
-	IF t = NIL THEN (* zero elements in queue *)
-		(* skip *)
-	ELSIF t = queue.tail THEN (* one element in queue *)
-		queue.head := NIL; queue.tail := NIL (* {(t.next = NIL) & (t.prev = NIL)} *)
-	ELSE	(* more than one element in queue *)
-		queue.head := t.next; t.next := NIL; queue.head.prev := NIL
-	END;
-	ASSERT((t = NIL) OR (t.next = NIL) & (t.prev = NIL)); (* temp strong check *)
-	IF t = NIL THEN
-		new := NIL
-	ELSE
-		ASSERT(t IS Process);
-		new := t(Process)
-	END;
-END Get;
-
-(* Put a process in a queue. Caller must hold lock for specific queue. *)
-(* If t was running, be careful to protect Put and the subsequent SwitchTo with the ready lock. *)
-PROCEDURE Put(VAR queue: ProcessQueue; t: Process);
-BEGIN (* {t # NIL & t.next = NIL} *)
-	ASSERT((t.next = NIL) & (t.prev = NIL));
-	IF queue.head = NIL THEN (* queue empty *)
-		queue.head := t
-	ELSE (* queue not empty *)
-		queue.tail.next := t; t.prev := queue.tail
-	END;
-	queue.tail := t
-END Put;
-
-(* Select a process of at least the specified priority to run next on current processor (returns NIL if none). Caller must hold ready lock. *)
-PROCEDURE Select(VAR new: Process; priority: LONGINT);
-VAR thresholdPrio: LONGINT;
-BEGIN
-	IF Heaps.gcStatus.GetgcOngoing() THEN
-		thresholdPrio := GCPriority
-	ELSE
-		thresholdPrio := priority
-	END;
-	LOOP
-		IF maxReady < thresholdPrio THEN
-			IF priority < thresholdPrio THEN Get(ready.q[MinPriority], new) ELSE new := NIL END;
-			EXIT
-		END;
-		Get(ready.q[maxReady], new);
-		IF (new # NIL) OR (maxReady = MinPriority) THEN EXIT END;
-		DEC(maxReady)
-	END
-END Select;
-
-(* Enter a process in the ready queue. Caller must hold ready lock. *)
-(* If t was running, be careful to make Enter and the subsequent SwitchTo atomic, as the process could be grabbed by another process while it is still running. *)
-PROCEDURE Enter(t: Process);
-BEGIN
-	IF Stats THEN Machine.AtomicInc(Nenter) END;
-	t.mode := Ready;
-	Put(ready.q[t.priority], t);
-	IF t.priority > maxReady THEN
-		maxReady := t.priority (* to do: re-establish global priority invariant *)
-	END
-END Enter;
-
-(* Remove a process from a queue that contains it. Caller must hold lock for specific queue. *)
-(* Not intended for frequent use. *)
-PROCEDURE Remove(VAR queue: ProcessQueue; t: Process);
-BEGIN
-	IF t.prev # NIL THEN t.prev.next := t.next END;
-	IF t.next # NIL THEN t.next.prev := t.prev END;
-	IF t = queue.head THEN queue.head := t.next END;
-	IF t = queue.tail THEN queue.tail := t.prev END;
-	ASSERT((queue.head = NIL) OR (queue.head.prev = NIL) & (queue.tail.next = NIL));
-	t.prev := NIL;
-	t.next := NIL
-END Remove;
-
-(* Switch to the specified process. Caller must hold ready lock. Return may be on different processor! *)
-PROCEDURE SwitchTo(VAR running: Process; new: Process);	(* parameters used in SwitchToState, TerminateThis, New *)
-VAR id: LONGINT;
-BEGIN
-	id := Machine.ID ();
-	INC (running.cpuCycles[id], Machine.GetTimer () - perfTsc[id]);
-	(*TRACE(CurrentProcessTime(), perfTsc[id], Machine.GetTimer());*)
-	IF running.priority = MinPriority THEN (* Special treatment for idle threads *)
-		INC (idleCycles[id], Machine.GetTimer () - perfTsc[id]);
-	END;
-	(* save current state *)
-	running.state.PC := SYSTEM.PC();(*Machine.CurrentPC ();*)	(* for GC *) (* ug *)
-	running.state.SP := SYSTEM.SP();(*Machine.CurrentSP ();*)	(* for GC *)
-	running.state.BP := SYSTEM.FP();(*Machine.CurrentBP ();*)	(* save state *)
-	Machine.FPUSaveMin(running.sse);
-	running := new; new.mode := Running;
-	IF Preempted IN new.flags THEN
-		EXCL(new.flags, Preempted);
-		perfTsc[id] := Machine.GetTimer ();
-		(*Machine.SetSP (new.state.SP);*) (* for UpdateState - run on new stack (EBP on old) *)
-		SYSTEM.SETSP(new.state.SP);
-		Machine.PushState(new.state);
-		Machine.FPURestoreFull(new.sse);
-		Machine.Release(Machine.Objects);
-		Machine.JumpState (* pops the state parameter from the stack and returns from interrupt *)
-	ELSE
-		Machine.FPURestoreMin(new.sse);
-		perfTsc[id] := Machine.GetTimer ();
-		SYSTEM.SETSP(new.state.SP);
-		SYSTEM.SETFP(new.state.BP);
-		Machine.Release(Machine.Objects);
-	END
-END SwitchTo;
-
-(* Select a new process to run and switch to it. Caller must hold ready lock. *)
-PROCEDURE SwitchToNew;
-VAR new: Process;
-BEGIN
-	Select(new, MinPriority); (* will return at least an Idle process *)
-	new.procID := Machine.ID ();
-	SwitchTo(running[new.procID], new)
-END SwitchToNew;
-
-PROCEDURE GetProcessPtr(): Process;
-VAR
-	p: Process;
-BEGIN
-	Machine.Acquire(Machine.Objects);
-	p := GetProcessPtr0();
-	Machine.Release(Machine.Objects);
-	RETURN p
-END GetProcessPtr;
-
-PROCEDURE GetProcessPtr0(): Process;
-BEGIN
-	RETURN running[Machine.ID()]
-END GetProcessPtr0;
-
-(** Relinquish control. *)
-PROCEDURE Yield*;
-VAR r, new: Process;
-BEGIN
-	IF ~YieldTrick OR (maxReady >= lowestAllowedPriority) THEN
-		r := GetProcessPtr ();
-		Machine.Acquire(Machine.Objects);
-		Select(new, r.priority);
-		IF new # NIL THEN (* found another process *)
-			Enter(r);
-			new.procID := Machine.ID ();
-			SwitchTo(running[new.procID], new)
-		ELSE (* stay with same process *)
-			Machine.Release(Machine.Objects)
-		END
-	END
-END Yield;
-
-PROCEDURE SwitchToState(new: Process; VAR state: Machine.State);
-BEGIN
-	(* simulate return from SwitchTo - MOV ESP, EBP; POP EBP; RET 8 *)
-	state.SP := new.state.BP+AddressSize*2;	(* AddressSize*4 is effect of POP, RET AddressSize*2 *)
-	SYSTEM.GET (new.state.BP, state.BP);	(* effect of POP *)
-	SYSTEM.GET (new.state.BP + AddressSize, state.PC);	(* effect of RET *)
-END SwitchToState;
-
-(** Preempt the current process. *)
-PROCEDURE Timeslice*(VAR state: Machine.State);
-VAR id: LONGINT; new: Process;
-BEGIN
-	(* handle a timer tick *)
-	Machine.Acquire(Machine.Objects);
-	IF Stats THEN Machine.AtomicInc(Ntimeslice) END;
-	id := Machine.ID ();
-	IF id = 0 THEN (* process 0 checks event queues *)
-		IF event.next.trigger - Machine.ticks <= 0 THEN (* next normal event due *)
-			IF event.next # event THEN (* not dummy event *)
-				IF timer # NIL THEN
-					ASSERT(timer.mode = AwaitingEvent);
-					Enter(timer); timer := NIL
-				END
-			ELSE (* reset dummy event *)
-				event.trigger := Machine.ticks + MAX(LONGINT) DIV 2	(* ignore overflow *)
-			END
-		END
-	END;
-	IF Heaps.gcStatus.GetgcOngoing() & (id IN gcBarrier) THEN
-		EXCL(gcBarrier, id);
-		IF gcBarrier = {} THEN
-			ASSERT(gcProcess.mode = AwaitingEvent);
-			Enter(gcProcess); gcProcess := NIL
-		END
-	END;
-	(* pre-empt the current process *)
-	IF Machine.PreemptCount(id) = 1 THEN (* check against 1, because we are holding one lock *)
-		IF running[id].priority # MinPriority THEN	(* idle processes are not timesliced *)
-			Select(new, running[id].priority);
-			IF new # NIL THEN
-				INC (running[id].cpuCycles[id], Machine.GetTimer () - perfTsc[id]);
-				(*TRACE(CurrentProcessTime(), perfTsc[id], Machine.GetTimer());*)
-				IF Stats THEN Machine.AtomicInc(NtimesliceTaken) END;
-				INCL(running[id].flags, Preempted);
-				Machine.CopyState(state, running[id].state);
-				Machine.FPUSaveFull(running[id].sse); (* to do: floating-point exception possible / Machine.SetupFPU *)
-				Enter(running[id]);
-				running[id] := new;
-				new.mode := Running; new.procID := id;
-				IF Preempted IN new.flags THEN
-					EXCL(new.flags, Preempted);
-					Machine.CopyState(new.state, state);
-					Machine.FPURestoreFull(new.sse)
-				ELSE
-					SwitchToState(new, state);
-					Machine.FPURestoreMin(new.sse)
-				END;
-
-				perfTsc[id] := Machine.GetTimer ()
-			ELSE
-				IF Stats THEN Machine.AtomicInc(NtimesliceNothing) END;
-			END;
-
-			(* Check if the process has the PleasHalt flag and handle it. *)
-			IF PleaseHalt IN running[id].flags THEN
-				(* Simulate procedure call: Increase stack & put return PC *)
-				DEC(state.SP, AddressSize);
-				SYSTEM.PUT (state.SP, state.PC); (* Here an stack overflow could happen! *)
-
-				(* Set the right halt procedure *)
-				IF (Unbreakable IN running[id].flags) THEN
-					state.PC := SYSTEM.VAL (ADDRESS, trap[1]);
-				ELSE
-					state.PC := SYSTEM.VAL (ADDRESS, trap[0]);
-				END;
-			END;
-
-		ELSE
-			INC(idlecount[id]);
-			IF Stats THEN Machine.AtomicInc(NtimesliceIdle) END;
-		END
-	ELSE
-		IF Stats THEN Machine.AtomicInc(NtimesliceCritical) END (* not preemptable *)
-	END;
-	Machine.Release(Machine.Objects)
-END Timeslice;
-
-(** Return current process. (DEPRECATED, use ActiveObject) *)
-PROCEDURE CurrentProcess*( ): Process;
-BEGIN
-	RETURN GetProcessPtr();
-END CurrentProcess;
-
-(** Return current process' context *)
-PROCEDURE CurrentContext*(): ANY;
-VAR p: Process;
-BEGIN
-	p := CurrentProcess();
-	IF p # NIL THEN RETURN p.context
-	ELSE RETURN NIL
-	END;
-END CurrentContext;
-
-PROCEDURE SetContext*(context: ANY);
-VAR p: Process;
-BEGIN
-	p := CurrentProcess();
-	IF p # NIL THEN p.context := context END;
-END SetContext;
-
-(* Return stack bottom of process. For compatibility WinAos/UnixAos/NativeAos  *)
-PROCEDURE GetStackBottom*(p: Process): ADDRESS;
-BEGIN
-	RETURN p.stack.high
-END GetStackBottom;
-
-(** Return the active object currently executing. *)
-PROCEDURE ActiveObject* (): ANY;
-VAR r: Process;
-BEGIN
-	r := GetProcessPtr ();
-	ASSERT(r # NIL);
-	ASSERT(r.obj # NIL);
-	RETURN r.obj
-END ActiveObject;
-
-(** Return the ID of the active currently executing process. *)
-PROCEDURE GetProcessID* (): LONGINT;
-VAR r: Process;
-BEGIN
-	r := GetProcessPtr ();
-	RETURN r.id
-END GetProcessID;
-
-(** Set the current process' priority. *)
-PROCEDURE SetPriority*(priority: LONGINT);
-VAR id: LONGINT;
-BEGIN
-	ASSERT((priority >= Low) & (priority <= Realtime)); (* priority in bounds *)
-	IF HandlePriorityInv THEN
-		Machine.Acquire(Machine.Objects);
-		id := Machine.ID();
-		running[id].SetPriority(priority);
-		Machine.Release(Machine.Objects)
-	ELSE
-		id := Machine.AcquirePreemption ();
-		running[id].priority := priority;
-		Machine.ReleasePreemption
-		(* to do: re-establish global priority invariant *)
-	END
-END SetPriority;
-
-(** Return TRUE iff the specified protected object is locked exclusive to the current process. *)
-PROCEDURE LockedByCurrent*(obj: ANY): BOOLEAN;
-VAR hdr {UNTRACED}: Heaps.ProtRecBlock; id: LONGINT; res: BOOLEAN;
-BEGIN
-	SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
-	ASSERT(hdr IS Heaps.ProtRecBlock);
-	IF HandlePriorityInv THEN
-		Machine.Acquire(Machine.Objects);
-		id := Machine.ID();
-		res := (hdr.lockedBy = running[id]);
-		Machine.Release(Machine.Objects)
-	ELSE
-		id := Machine.AcquirePreemption ();
-		Machine.AcquireObject(hdr.locked);
-		res := (hdr.lockedBy = running[id]);
-		Machine.ReleaseObject(hdr.locked);
-		Machine.ReleasePreemption;
-	END;
-	RETURN res
-END LockedByCurrent;
-
-(** Return number of ready and running processes, excluding idle processes. *)
-PROCEDURE NumReady* (): LONGINT;
-VAR i, n: LONGINT; p: Heaps.ProcessLink;
-BEGIN
-	n := 0;
-	Machine.Acquire(Machine.Objects);
-	FOR i := MinPriority+1 TO NumPriorities-1 DO
-		p := ready.q[i].head; WHILE p # NIL DO INC(n); p := p.next END
-	END;
-	FOR i := 0 TO Machine.MaxCPU-1 DO
-		IF (running[i] # NIL) & (running[i].priority > MinPriority) THEN INC(n) END
-	END;
-	Machine.Release(Machine.Objects);
-	RETURN n
-END NumReady;
-
-(** Return number of CPU cycles consumed by the specified process for each processor. If all is TRUE,
-	return the number of cycles since the process has been created. If FALSE, return the number of cycles
-	consumed since the last time asked. *)
-PROCEDURE GetCpuCycles*(process : Process; VAR cpuCycles : CpuCyclesArray; all : BOOLEAN);
-VAR i : LONGINT;
-BEGIN
-	ASSERT(process # NIL);
-	FOR i := 0 TO Machine.MaxCPU-1 DO cpuCycles[i] := process.cpuCycles[i]; END;
-	IF ~all THEN
-		FOR i := 0 TO Machine.MaxCPU-1 DO
-			cpuCycles[i] := cpuCycles[i] - process.lastCpuCycles[i];
-			process.lastCpuCycles[i] := process.cpuCycles[i]; (* actually could have changed meanwhile *)
-		END;
-	END;
-END GetCpuCycles;
-
-(*! DEBUG *)
-VAR
-	currentProcessTime- : HUGEINT;
-PROCEDURE CurrentProcessTime * (): HUGEINT;
-VAR result: HUGEINT; process: Process; i: LONGINT;
-BEGIN
-	currentProcessTime := Machine.GetTimer();
-	result := currentProcessTime - perfTsc[Machine.ID()];
-	process := CurrentProcess();
-	FOR i := 0 TO Machine.MaxCPU-1 DO result := result + process.cpuCycles[i]; END;
-	RETURN result;
-END CurrentProcessTime;
-
-PROCEDURE TimerFrequency * (): HUGEINT;
-BEGIN
-	RETURN 333000000
-END TimerFrequency;
-
-(* Handle hardware interrupt and route it to an interrupt handler process. *)
-PROCEDURE FieldIRQ(VAR state: Machine.State);
-VAR t: Process; id: LONGINT; new: Process; preempt: BOOLEAN;
-BEGIN
-	Machine.DisableIRQ(state.INT);	(* do this before acknowledging irq *)
-
-	IF StrongChecks THEN
-		IF processingIRQ[state.INT-MinIRQ] THEN
-			(*Trace.String("IRQ recursion "); Trace.Address(state.INT); Trace.Ln;*)
-			RETURN
-		ELSE
-			processingIRQ[state.INT-MinIRQ] := TRUE;
-		END;
-	END;
-	
-	(* if the reenabling of interrupts cannot be circumvented, then it is REQUIRED to acknowledge interrupts
-		BEFORE reenabling. Otherwise spurious IRQs cannot be identified as such.
-		Please note that this particular problem with spurious IRQs cannot observed on many machines but IF it is observed
-		then the machine will behave unexpected. Very hard to debug and trace!
-
-		Machine.Ack(state.INT); 
-		Machine.Sti ();	(* avoid Processors.StopAll deadlock when waiting for locks below (remove this) *)
-	*)
-	
-	Machine.Acquire(Machine.Objects);
-	(*IF state.INT = 53 THEN Trace.String("|") END;*)
-	t := interrupt[state.INT-MinIRQ].process;
-	IF StrongChecks THEN ASSERT(t.mode = AwaitingEvent) END;
-	id := Machine.ID ();
-	preempt := (t.priority > maxReady) & (maxReady # MinPriority) & (t.priority > running[id].priority);
-	Enter(t);
-	IF preempt THEN
-		IF Stats THEN Machine.AtomicInc(Npreempt) END;
-		(* pre-empt the current process *)
-		IF Machine.PreemptCount(id) = 1 THEN (* check against 1, because we are holding one lock *)
-			Select(new, running[id].priority + 1);
-			IF new # NIL THEN
-				INC (running[id].cpuCycles[id], Machine.GetTimer () - perfTsc[id]);
-				IF running[id].priority = MinPriority THEN (* Special treatment for idle threads *)
-					INC (idleCycles[id], Machine.GetTimer () - perfTsc[id]);
-				END;
-				IF Stats THEN Machine.AtomicInc(NpreemptTaken) END;
-				INCL(running[id].flags, Preempted);
-				Machine.CopyState(state, running[id].state);
-				Machine.FPUSaveFull(running[id].sse); (* to do: floating-point exception possible / Machine.SetupFPU *)
-				Enter(running[id]);
-				running[id] := new;
-				new.mode := Running; new.procID := id;
-				IF Preempted IN new.flags THEN
-					EXCL(new.flags, Preempted);
-					Machine.CopyState(new.state, state);
-					Machine.FPURestoreFull(new.sse)
-				ELSE
-					SwitchToState(new, state);
-					Machine.FPURestoreMin(new.sse)
-				END;
-				perfTsc[id] := Machine.GetTimer ()
-			ELSE
-				IF Stats THEN Machine.AtomicInc(NpreemptNothing) END
-			END
-		ELSE
-			IF Stats THEN Machine.AtomicInc(NpreemptCritical) END (* not preemptable *)
-		END
-	END;
-	Machine.Release(Machine.Objects)
-END FieldIRQ;
-
-(* Process scheduled to handle an interrupt. *)
-PROCEDURE InterruptProcess(self: ProtectedObject);
-VAR h: InterruptList; t: Process; int: LONGINT;
-BEGIN
-	int := self(Interrupter).interruptNumber;
-	t := interrupt[int-MinIRQ].process;
-	LOOP
-		h := interrupt[int-MinIRQ].root;	(* concurrent updates allowed in InstallHandler and RemoveHandler *)
-		WHILE h # NIL DO h.handler (); h := h.next END;
-		Machine.Acquire(Machine.Objects);
-		ASSERT(running[Machine.ID ()] = t); (* strong check *)
-		t.mode := AwaitingEvent;
-		processingIRQ[int-MinIRQ] := FALSE;
-		Machine.EnableIRQ(int);
-		SwitchToNew
-	END
-END InterruptProcess;
-
-(** Install interrupt handler. *)
-PROCEDURE InstallHandler*(h: EventHandler; int: LONGINT);
-VAR t: Process; new: BOOLEAN; ih: Interrupter; n: InterruptList; i: LONGINT;
-BEGIN
-	ASSERT((int >= MinIRQ) & (int-MinIRQ < NumIRQ));	(* range check *)
-	IF interrupt[int-MinIRQ].process = NIL THEN	(* first handler for this irq *)
-		(* allocate process outside lock region, to avoid GC lock problems. *)
-		(* hack: use type parameter to pass int index & set obj to h, for System.ShowProcesses *)
-		NEW(ih); ih.interruptNumber := int;
-		NewProcess(InterruptProcess, {Resistant}, ih, t);
-		t.priority := High;  (* second-level interrupt handling processes have high priority, handlers may allocate memory, use exclusive locks and awaits *)
-		t.staticPriority := t.priority;
-		FOR i := 0 TO LEN(t.prioRequests) - 1 DO t.prioRequests[i] := 0 END;
-		INC(t.prioRequests[t.priority])
-	END;
-	NEW(n); n.handler := h;
-	Machine.Acquire(Machine.Objects);
-	IF interrupt[int-MinIRQ].process = NIL THEN	(* still first handler for this irq *)
-		t.id := nextProcessID; INC(nextProcessID);
-		t.mode := AwaitingEvent;
-		interrupt[int-MinIRQ].process := t;
-		new := TRUE
-	ELSE
-		new := FALSE
-	END;
-	n.next := interrupt[int-MinIRQ].root; (* can be concurrent with loop in InterruptProcess *)
-	interrupt[int-MinIRQ].root := n;
-	Machine.Release(Machine.Objects);
-	IF new THEN Machine.InstallHandler(FieldIRQ, int) END (* do outside lock region to avoid NEW/GC deadlock *)
-END InstallHandler;
-
-(** Remove interrupt handler. *)
-PROCEDURE RemoveHandler*(h: EventHandler; int: LONGINT);
-VAR p, c: InterruptList;
-BEGIN
-	ASSERT((int >= MinIRQ) & (int-MinIRQ < NumIRQ)); (* range check *)
-	Machine.Acquire(Machine.Objects);
-	p := NIL; c := interrupt[int-MinIRQ].root;
-	WHILE (c.handler # h) & (c # NIL) DO p := c; c := c.next END;
-	IF c.handler = h THEN (* handler found *)
-		IF p = NIL THEN
-			interrupt[int-MinIRQ].root := c.next;
-	(*
-			IF c.inext = NIL THEN (* this was the last handler *)
-				Machine.RemoveHandler(FieldIRQ, int)
-				(* to do: synchronize with FieldIRQ and InterruptProcess *)
-			END
-	*)
-		ELSE
-			p.next := c.next
-		END
-	ELSE
-		HALT(99); (* handler not found *)
-	END;
-	(* can not clear c.next field, because InterruptProcess may be traversing it. *)
-	Machine.Release(Machine.Objects)
-END RemoveHandler;
-
-(* local procedure *)
-PROCEDURE SetTimeoutAbsOrRel(t: Timer; h: EventHandler; ms: LONGINT; isAbsolute: BOOLEAN);
-VAR e: Timer; trigger: LONGINT;
-BEGIN
-	ASSERT(Machine.Second= 1000);	(* assume milliseconds for now *)
-	ASSERT((t # NIL) & (h # NIL));
-	IF ms < 1 THEN ms := 1 END;
-	Machine.Acquire(Machine.Objects);
-	IF isAbsolute THEN trigger := ms ELSE trigger := Machine.ticks + ms (* ignore overflow *) END;
-	IF t.next # NIL THEN (* cancel previous timeout *)
-		t.next.prev := t.prev; t.prev.next := t.next
-	END;
-	t.trigger := trigger; t.handler := h;
-	e := event.next;	(* performance: linear search! *)
-	WHILE (e # event) & (e.trigger - trigger <= 0) DO e := e.next END;
-	t.prev := e.prev; e.prev := t; t.next := e; t.prev.next := t;
-	Machine.Release(Machine.Objects)
-END SetTimeoutAbsOrRel;
-
-(** Set (or reset) an event handler object's timeout value. *)
-PROCEDURE SetTimeout*(t: Timer; h: EventHandler; ms: LONGINT);
-BEGIN
-	SetTimeoutAbsOrRel(t, h, ms, FALSE)
-END SetTimeout;
-
-(** Set (or reset) an event handler object's timeout value. Here ms is absolute *)
-PROCEDURE SetTimeoutAt*(t: Timer; h: EventHandler; ms: LONGINT);
-BEGIN
-	SetTimeoutAbsOrRel(t, h, ms, TRUE)
-END SetTimeoutAt;
-
-(** Cancel an event handler object's timeout, if any. It is possible that the timer has expired, but not yet been scheduled to run. *)
-PROCEDURE CancelTimeout*(t: Timer);
-BEGIN
-	Machine.Acquire(Machine.Objects);
-	ASSERT(t # event);
-	IF t.next # NIL THEN
-		t.next.prev := t.prev; t.prev.next := t.next;
-		t.next := NIL; t.prev := NIL
-	END;
-	Machine.Release(Machine.Objects)
-END CancelTimeout;
-
-(** Terminate the current process and switch to next process. *)
-PROCEDURE Terminate*; (* exported for Linker *)
-VAR id: LONGINT;
-BEGIN
-	IF Stats THEN Machine.AtomicInc(Nterminate) END;
-	Machine.Acquire(Machine.Objects);
-	id := Machine.ID ();
-	(*running[id].state.PC := CallerPC ();*) (* for tracing *)
-	running[id].mode := Terminated;	(* a process can also be "terminated" if the queue containing it is garbage collected *)
-	SwitchToNew;
-	HALT(2201)	(* process resurrected *)
-END Terminate;
-
-PROCEDURE Halt;
-BEGIN
-	HALT(halt); (* process halted *)
-END Halt;
-
-PROCEDURE HaltUnbreakable;
-BEGIN
-	HALT(haltUnbreakable); (* process halted *)
-END HaltUnbreakable;
-
-(* Set the return PC which is saved in the process and set it to -1 *)
-PROCEDURE HaltAltPC(haltCode: LONGINT);
-VAR bp: ADDRESS; p: Process;
-BEGIN
-	p := running[Machine.ID ()];
-	ASSERT(p.oldReturnPC # -1);
-	bp := Machine.CurrentBP ();
-	SYSTEM.PUT (bp + AddressSize, p.oldReturnPC);
-	CASE haltCode OF
-		|halt: HALT(halt);
-		|haltUnbreakable: HALT(haltUnbreakable);
-	END;
-END HaltAltPC;
-
-PROCEDURE HaltReturn;
-VAR bp: ADDRESS;
-BEGIN
-	bp := Machine.CurrentBP ();
-	SYSTEM.GET (bp, bp); (* Get the dynamic link *)
-	Machine.SetBP (bp); (* Undo the actual paf *)
-	HaltAltPC(halt);
-END HaltReturn;
-
-PROCEDURE HaltUnbreakableReturn;
-VAR bp: ADDRESS;
-BEGIN
-	bp := Machine.CurrentBP ();
-	SYSTEM.GET (bp, bp); (* Get the dynamic link *)
-	Machine.SetBP (bp); (* Undo the actual paf *)
-	HaltAltPC(haltUnbreakable);
-END HaltUnbreakableReturn;
-
-PROCEDURE TerminateThis*(t: Process; unbreakable: BOOLEAN);
-VAR hdr {UNTRACED}: Heaps.ProtRecBlock; pc, fp : ADDRESS;
-
-	(* terminates a process that is either in mode AwaitingLock or AwaitingCond *)
-	PROCEDURE TerminateAwaiting(t: Process);
-	VAR hdr {UNTRACED}: Heaps.ProtRecBlock;
-	BEGIN
-		SYSTEM.GET(SYSTEM.VAL(ADDRESS, t.waitingOn) + Heaps.HeapBlockOffset, hdr);
-		ASSERT(hdr IS Heaps.ProtRecBlock);
-		IF t.mode = AwaitingLock THEN
-			fp := t.state.BP; 		(* SwitchTo PAF *)
-			SYSTEM.GET (fp, fp);		(* SwitchToNew PAF *)
-			SYSTEM.GET (fp, fp);		(* Lock PAF*)
-			SYSTEM.GET (fp + AddressSize, pc);	(* Get the return address*)
-			IF ~Modules.IsExceptionHandled(pc, fp, FALSE) THEN
-				Remove(hdr.awaitingLock, t);
-				t.waitingOn := NIL; SYSTEM.GET (t.state.BP + AddressSize, t.oldReturnPC);
-				IF unbreakable THEN
-					SYSTEM.PUT (t.state.BP + AddressSize, SYSTEM.VAL (ADDRESS, trapReturn[1]))
-				ELSE
-					SYSTEM.PUT (t.state.BP + AddressSize, SYSTEM.VAL (ADDRESS, trapReturn[0]))
-				END;
-				Enter(t)
-			ELSE
-				Machine.Acquire (Machine.TraceOutput);
-				Trace.String(" Not allowed to kill "); Trace.Int(t.id, 1); Trace.Char(" "); Trace.Int(t.mode, 1); Trace.Ln;
-				Machine.Release (Machine.TraceOutput);
-			END
-		ELSIF t.mode = AwaitingCond THEN
-			SYSTEM.GET (t.state.BP, fp);
-			SYSTEM.GET (t.state.PC, pc);
-			IF ~Modules.IsExceptionHandled(pc, fp, TRUE) THEN
-				Remove(hdr.awaitingCond, t);
-				t.waitingOn := NIL; SYSTEM.GET (t.state.BP + AddressSize, t.oldReturnPC);
-				IF unbreakable THEN
-					SYSTEM.PUT (t.state.BP + AddressSize, SYSTEM.VAL (ADDRESS, trapReturn[1]))
-				ELSE
-					SYSTEM.PUT (t.state.BP + AddressSize, SYSTEM.VAL (ADDRESS, trapReturn[0]))
-				END;
-				Enter(t)
-			ELSE
-				Machine.Acquire (Machine.TraceOutput);
-				Trace.String(" Not allowed to kill "); Trace.Int(t.id, 1); Trace.Char(" "); Trace.Int(t.mode, 1); Trace.Ln;
-				Machine.Release (Machine.TraceOutput);
-			END
-		END
-	END TerminateAwaiting;
-
-BEGIN
-	IF PleaseHalt IN t.flags THEN
-		IF TraceVerbose THEN
-			Machine.Acquire (Machine.TraceOutput);
-			Trace.String("Process (ID="); Trace.Int(t.id, 0); Trace.StringLn (") is already halting!");
-			Machine.Release (Machine.TraceOutput);
-		END;
-		RETURN
-	ELSE
-		Machine.Acquire(Machine.Objects);
-		IF (t = running[Machine.ID ()]) THEN INCL(t.flags, SelfTermination); END;
-		IF TraceVerbose THEN
-			Machine.Acquire (Machine.TraceOutput);
-			Trace.String(" Kill "); Trace.Int(t.id, 1); Trace.Char(" "); Trace.Int(t.mode, 1); Trace.Ln;
-			Machine.Release (Machine.TraceOutput);
-		END;
-		CASE t.mode OF
-			|Running:
-				INCL(t.flags, PleaseHalt);
-				IF unbreakable THEN INCL(t.flags, Unbreakable) END
-			|Ready:
-				DEC(t.state.SP, AddressSize);	SYSTEM.PUT (t.state.SP, t.state.PC);
-				IF unbreakable THEN t.state.PC := SYSTEM.VAL (ADDRESS, trap[1])
-				ELSE t.state.PC := SYSTEM.VAL (ADDRESS, trap[0]) END
-			|AwaitingLock, AwaitingCond:
-				IF HandlePriorityInv THEN
-					TerminateAwaiting(t)
-				ELSE
-					SYSTEM.GET(SYSTEM.VAL(ADDRESS, t.waitingOn) + Heaps.HeapBlockOffset, hdr);
-					ASSERT(hdr IS Heaps.ProtRecBlock);
-					IF ~hdr.locked THEN
-						Machine.AcquireObject(hdr.locked);
-						TerminateAwaiting(t);
-						Machine.ReleaseObject(hdr.locked)
-					END
-				END
-			| AwaitingEvent, Unknown, Terminated:	(* skip *)
-		END;
-		Machine.Release(Machine.Objects)
-	END
-END TerminateThis;
-
-(* called by WMProcessInfo to obtain the current state of a running process *)
-PROCEDURE UpdateProcessState*( p: Process );	
-BEGIN
-	(*  update p.stat.{PC,BP,SP}  *)
-END UpdateProcessState;
-
-(* Finalize a process. *)
-PROCEDURE FinalizeProcess(t: ANY);
-BEGIN
-	Machine.DisposeStack(t(Process).stack)
-END FinalizeProcess;
-
-(* Allocate a new process associated with "obj". Must be outside lock region, because of potential GC. *)
-PROCEDURE NewProcess(body: Body; flags: SET; obj: ProtectedObject; VAR new: Process);
-VAR t: Process; sp: ADDRESS; id: LONGINT; fn: Heaps.FinalizerNode;
-BEGIN
-	NEW(t); NEW(fn); (* implicit call Heaps.NewRec *)
-	t.next := NIL; t.prev := NIL; t.rootedNext := NIL;
-	t.waitingOn := NIL; t.flags := flags;
-	t.obj := obj; t.mode := Unknown;
-	(* initialize the stack *)
-	Machine.NewStack(t.stack, t, sp);
-	IF VeryConservative THEN
-		Machine.Fill32(t.stack.adr, sp-t.stack.adr, LONGINT(0D0D0DEADH))
-	END;
-	SYSTEM.PUT (sp-1*AddressSize, obj); (* self parameter for body *)
-	SYSTEM.PUT (sp-2*AddressSize, terminate); (* return address for body *)
-	SYSTEM.PUT (sp-3*AddressSize, NIL); (* FP for body *)
-	(* the following two are not necessary because the compiler instruments the caller to cleanup parameters, not the callee! *)
-	(*SYSTEM.PUT (sp-3*AddressSize, NIL);*)	(* parameter for SwitchTo (ADR(running)) *)
-	(*SYSTEM.PUT (sp-4*AddressSize, NIL);*)	(* parameter for SwitchTo (new) *)
-	SYSTEM.PUT (sp-4*AddressSize, SYSTEM.VAL(ADDRESS, body) + ReturnStackDisplacement); (* return address for SwitchTo (body entry point) *)
-	SYSTEM.PUT (sp-5*AddressSize, sp-3*AddressSize);	(* end of dynamic link list (FP value at entry to body) *)
-	t.sseAdr := ADDRESSOF(t.sse) + ((-ADDRESSOF(t.sse)) MOD 16);
-	Machine.FPUSaveMin(t.sse);	(* inherit FPU state of caller *)
-	t.state.BP := sp - 5*AddressSize;
-	t.state.SP := t.state.BP;
-	t.state.PC := 0; (* indicating that process is not running yet *)
-	(* set up exception handling *)
-	IF Restart IN flags THEN	(* restart object body *)
-		t.restartPC := SYSTEM.VAL (ADDRESS, body) + ReturnStackDisplacement;
-		t.restartSP := sp-3*AddressSize	(* 1 parameter and return address of body *)
-	ELSE (* terminate process *)
-		t.restartPC := SYSTEM.VAL (ADDRESS, terminate) + ReturnStackDisplacement;
-		t.restartSP := sp-AddressSize
-	END;
-	fn.finalizer := FinalizeProcess;
-	Heaps.AddFinalizer(t, fn);
-	(* return *)
-	FOR id := 0 TO Machine.MaxCPU-1 DO t.cpuCycles[id] := 0 END;
-	new := t
-END NewProcess;
-
-(* Create the process associated with an active object (kernel call). *)
-PROCEDURE CreateProcess*(body: Body; priority: LONGINT; flags: SET; obj: ProtectedObject);
-VAR t: Process; type: ADDRESS; heapBlock {UNTRACED}: Heaps.HeapBlock; i: LONGINT;
-BEGIN
-	IF Stats THEN Machine.AtomicInc(Ncreate) END;
-
-	SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, heapBlock);
-	ASSERT(heapBlock IS Heaps.ProtRecBlock); (* protected object *)
-
-	SYSTEM.GET (SYSTEM.VAL (ADDRESS, obj) + Heaps.TypeDescOffset, type); (* type tag *)
-	IF Restart IN flags THEN INCL(flags, Resistant) END; (* SAFE => Restart & Resistant *)
-	NewProcess(body, flags, obj, t);
-	Machine.Acquire(Machine.Objects);
-	t.id := nextProcessID; INC(nextProcessID);
-	IF priority = 0 THEN	(* no priority specified *)
-		t.priority := running[Machine.ID ()].priority (* inherit priority of creator *)
-	ELSIF priority > 0 THEN (* positive priority specified *)
-		t.priority := priority
-	ELSE (* negative priority specified (only for Idle process) *)
-		t.priority := MinPriority
-	END;
-	t.staticPriority := t.priority;
-	FOR i := 0 TO LEN(t.prioRequests) - 1 DO t.prioRequests[i] := 0 END;
-	INC(t.prioRequests[t.priority]);
-	CASE t.priority OF
-		MinPriority			: t.rootedNext := rootedProcesses[t.priority]; rootedProcesses[t.priority] := t
-	|	Low, Normal, High	: (* do nothing, processes with this priority are traced by GC automatically *)
-	|	GCPriority, Realtime	: t.rootedNext := rootedProcesses[t.priority]; rootedProcesses[t.priority] := t
-	END;
-	Enter(t);
-	Machine.Release(Machine.Objects)
-END CreateProcess;
-
-(* Lock a protected object (kernel call) *)
-(* There are two different procedures for locking a protected object in case of priority inversion handling enabled or disabled due to the different
-    locking strategy. *)
-PROCEDURE Lock*(obj: ProtectedObject; exclusive: BOOLEAN);
-BEGIN
-	IF HandlePriorityInv THEN
-		LockPriorityInv(obj, exclusive)
-	ELSE
-		LockNoPriorityInv(obj, exclusive)
-	END
-END Lock;
-
-(* Lock a protected object if priority inversion handling is disabled. Header locks, preemption and Machine.Objects locks are used. *)
-PROCEDURE LockNoPriorityInv(obj: ProtectedObject; exclusive: BOOLEAN);
-VAR hdr {UNTRACED}: Heaps.ProtRecBlock; r: Process; id: LONGINT;
-BEGIN (* {called from user level} *)
-	IF Stats THEN Machine.AtomicInc(Nlock) END;
-	SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
-	IF StrongChecks THEN
-		ASSERT(hdr IS Heaps.ProtRecBlock); (* protected object *)
-		ASSERT(exclusive)	(* shared not implemented yet *)
-	END;
-	id := Machine.AcquirePreemption ();
-	Machine.AcquireObject(hdr.locked);
-	IF hdr.count = 0 THEN (* not locked *)
-		hdr.count := -1; hdr.lockedBy := GetProcessPtr (); (* set exclusive lock *)
-		Machine.ReleaseObject(hdr.locked);
-		Machine.ReleasePreemption;
-	ELSE  (* locked *)
-		r := GetProcessPtr ();
-		IF hdr.lockedBy = r THEN
-			Machine.ReleaseObject(hdr.locked);
-			Machine.ReleasePreemption;
-			ASSERT(hdr.lockedBy # r, 2203);	(* nested locks not allowed *)
-		END;
-		ASSERT(r.waitingOn = NIL);
-		r.waitingOn := obj; r.mode := AwaitingLock;
-		Machine.Acquire(Machine.Objects);
-		Put(hdr.awaitingLock, r);
-		Machine.ReleaseObject(hdr.locked);
-		Machine.ReleasePreemption;
-		SwitchToNew
-	END
-END LockNoPriorityInv;
-
-(*
-(* propagation of priorities - lock Machine.Objects is taken.
-    This is a procedure that calls itself recursively if a higher priority is propagated along a chain of resources and processes where each resource
-    is locked by a process that itself waits on a resource. The procedure can be rewritten into a non-recursive procedure if needed..
-    Remark: parameters of type Heaps.HeapBlock or extensions of it are not passed as parameters for clarity and safety reasons .
-    Instead, a ProtectedObject pointer is passed as the first parameter.   *)
-PROCEDURE PropagatePrio(obj: ProtectedObject; prevMaxWaitingPrio, waitingPrio: LONGINT);
-VAR hdr {UNTRACED}: Heaps.ProtRecBlock; p: Process;
-BEGIN
-	SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
-	IF hdr.lockedBy # NIL THEN
-		p := hdr.lockedBy(Process);
-		DEC(p.prioRequests[prevMaxWaitingPrio]);
-		INC(p.prioRequests[waitingPrio]);
-		IF (p.waitingOn # NIL) & (waitingPrio > p.priority) THEN
-			obj := p.waitingOn;
-			SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
-			prevMaxWaitingPrio := MaxPrio(hdr.waitingPriorities);
-			DEC(hdr.waitingPriorities[p.priority]);
-			INC(hdr.waitingPriorities[waitingPrio]);
-			IF waitingPrio > prevMaxWaitingPrio THEN PropagatePrio(obj, prevMaxWaitingPrio, waitingPrio) END
-		END;
-		IF waitingPrio > p.priority THEN
-			IF p.mode = Ready THEN Remove(ready.q[p.priority], p) END; (* remove p from the lower priority queue ... *)
-			p.priority := waitingPrio;
-			IF p.mode = Ready THEN Enter(p) END;  (* ... and add it to the higher priority queue *)
-		END
-	END;
-END PropagatePrio;
-*)
-
-(* propagation of priorities - lock Machine.Objects is taken.
-    This procedure is the iterative version of the above commented out recursive procedure.
-    Remark: hdr is an actually UNTRACED parameter. The GC, however, can handle this, see procedure Heaps.Mark, there is a check whether the
-    pointer to the header part is valid. In case of hdr, the pointer ot the header part is NIL. *)
-PROCEDURE PropagatePrio(hdr: Heaps.ProtRecBlock; prevMaxWaitingPrio, waitingPrio: LONGINT);
-VAR propagateFurther: BOOLEAN; p: Process; obj: ProtectedObject;
-BEGIN
-	propagateFurther := TRUE;
-	WHILE propagateFurther & (waitingPrio > prevMaxWaitingPrio) DO
-		IF hdr.lockedBy # NIL THEN
-			p := hdr.lockedBy(Process);
-			DEC(p.prioRequests[prevMaxWaitingPrio]);
-			INC(p.prioRequests[waitingPrio]);
-			IF (p.waitingOn # NIL) & (waitingPrio > p.priority) THEN
-				obj := p.waitingOn;
-				SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
-				prevMaxWaitingPrio := MaxPrio(hdr.waitingPriorities);
-				DEC(hdr.waitingPriorities[p.priority]);
-				INC(hdr.waitingPriorities[waitingPrio]);
-			ELSE (* p is not waiting for a resource or waitingPrio is less or equal to p's priority - priority propagation finishes *)
-				propagateFurther := FALSE
-			END;
-			IF waitingPrio > p.priority THEN (* independently of whether p is waiting on a resource or not the priority of p is changed if it is lower than waitingPrio *)
-				IF p.mode = Ready THEN Remove(ready.q[p.priority], p) END; (* remove p from the lower priority queue ... *)
-				p.priority := waitingPrio;
-				IF p.mode = Ready THEN Enter(p) END;  (* ... and add it to the higher priority queue *)
-			END
-		ELSE (* current resource is not locked - priority propagation finishes *)
-			propagateFurther := FALSE
-		END
-	END
-END PropagatePrio;
-
-(* TO DO: adapt priority inversion algorithm such that priority of a process is not raised higher than High, it must not become Realtime, otherwise
-    GC may be corrupted *)
-(* Lock a protected object if priority inversion handling is enabled. Machine.Objects lock is used. *)
-PROCEDURE LockPriorityInv(obj: ProtectedObject; exclusive: BOOLEAN);
-VAR hdr {UNTRACED}: Heaps.ProtRecBlock; r: Process;
-	maxWaitingPrio, prevMaxWaitingPrio: LONGINT;
-BEGIN (* {called from user level} *)
-	IF Stats THEN Machine.AtomicInc(Nlock) END;
-	SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
-	IF StrongChecks THEN
-		ASSERT(hdr IS Heaps.ProtRecBlock); (* protected object *)
-		ASSERT(exclusive)	(* shared not implemented yet *)
-	END;
-	Machine.Acquire(Machine.Objects);
-	r := (*GetProcessPtr0();*) running[Machine.ID()];
-	ASSERT(r # NIL);
-	IF hdr.count = 0 THEN (* not locked *)
-		hdr.count := -1; hdr.lockedBy := r; (* set exclusive lock *)
-		maxWaitingPrio := MaxPrio(hdr.waitingPriorities);
-		INC(r.prioRequests[maxWaitingPrio]);
-		r.priority := MaxPrio(r.prioRequests);
-		Machine.Release(Machine.Objects);
-	ELSE	(* locked (to do: on multiprocessors, perhaps spin here for a while, if lockedBy.mode = running) *)
-		IF hdr.lockedBy = NIL THEN
-			Machine.Release(Machine.Objects);
-			ASSERT(hdr.lockedBy # NIL)
-		END;
-		IF hdr.lockedBy = r THEN
-			Machine.Release(Machine.Objects);
-			ASSERT(hdr.lockedBy # r, 2203);	(* nested locks not allowed *)
-		END;
-		IF r.waitingOn # NIL THEN
-			Machine.Acquire(Machine.TraceOutput);
-			Trace.String("Objects: LockPriorityInv - hdr.count # NIL, but r.waitingOn # NIL");
-			Machine.Release(Machine.TraceOutput)
-		END;
-		ASSERT(r.waitingOn = NIL);
-		r.waitingOn := obj; r.mode := AwaitingLock;
-		prevMaxWaitingPrio := MaxPrio(hdr.waitingPriorities);
-		INC(hdr.waitingPriorities[r.priority]);
-		IF r.priority > prevMaxWaitingPrio THEN PropagatePrio(hdr, prevMaxWaitingPrio, r.priority) END;
-		Put(hdr.awaitingLock, r);
-		SwitchToNew
-	END
-END LockPriorityInv;
-
-(* Find the first true condition from the queue and remove it. Assume the object is currently locked. *)
-PROCEDURE FindCondition(VAR q: ProcessQueue): Process;
-VAR first, cand: Process;
-BEGIN
-	IF Stats THEN Machine.AtomicInc(Ncondition) END;
-	Get(q, first);
-	IF first.condition(first.condFP) THEN
-		IF Stats THEN Machine.AtomicInc(Ncondition1True) END;
-		RETURN first
-	END;
-	Put(q, first);
-	WHILE q.head # first DO
-		IF Stats THEN Machine.AtomicInc(Ncondition2) END;
-		Get(q, cand);
-		IF cand.condition(cand.condFP) THEN
-			IF Stats THEN Machine.AtomicInc(Ncondition2True) END;
-			RETURN cand
-		END;
-		Put(q, cand)
-	END;
-	RETURN NIL
-END FindCondition;
-
-(* Find highest priority in array of priority counts *)
-PROCEDURE MaxPrio(CONST priorityCounts: ARRAY OF LONGINT): LONGINT;
-VAR i: LONGINT;
-BEGIN
-	i := LEN(priorityCounts) - 1;
-	WHILE (i >= 0) & (priorityCounts[i] = 0) DO DEC(i) END;
-	IF priorityCounts[i] = 0 THEN
-		Machine.Acquire(Machine.TraceOutput);
-		Trace.StringLn("Objects: MaxPrio - SEVERE ERROR: priorityCounts contains all zeros");
-		Machine.Release(Machine.TraceOutput);
-	END;
-	RETURN i
-END MaxPrio;
-
-(* Unlock a protected object (kernel call). *)
-(* There are two different procedures for locking a protected object in case of priority inverison handling enabled or disabled due to the different
-    locking strategy. *)
-PROCEDURE Unlock*(obj: ProtectedObject; dummy: BOOLEAN);
-BEGIN
-	IF HandlePriorityInv THEN
-		UnlockPriorityInv(obj)
-	ELSE
-		UnlockNoPriorityInv(obj)
-	END
-END Unlock;
-
-(* transfer the lock from a resource to another process.
-    Remark: hdr is an actually UNTRACED parameter. The GC, however, can handle this, see procedure Heaps.Mark, there is a check whether the
-    pointer to the header part is valid. In case of hdr, the pointer ot the header part is NIL. *)
-PROCEDURE TransferLock(hdr: Heaps.ProtRecBlock; p: Process);
-VAR maxWaitingPrio: LONGINT;
-BEGIN
-	ASSERT(p # NIL);
-	p.waitingOn := NIL; hdr.lockedBy := p;
-	IF HandlePriorityInv THEN
-		DEC(hdr.waitingPriorities[p.priority]);
-		maxWaitingPrio := MaxPrio(hdr.waitingPriorities);
-		INC(p.prioRequests[maxWaitingPrio]);
-		p.priority := MaxPrio(p.prioRequests)
-	END
-END TransferLock;
-
-(* Unlock a protected object if priority inversion handling is disabled. Header locks, preemption and Machine.Objects locks are used. *)
-PROCEDURE UnlockNoPriorityInv(obj: ProtectedObject);
-VAR hdr {UNTRACED}: Heaps.ProtRecBlock; t, c, r: Process; id: LONGINT;
-BEGIN
-	IF Stats THEN Machine.AtomicInc(Nunlock) END;
-	SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
-	IF StrongChecks THEN
-		ASSERT(hdr IS Heaps.ProtRecBlock) (* protected object *)
-	END;
-	ASSERT(hdr.count = -1);	(* exclusive locked *)
-	IF hdr.awaitingCond.head # NIL THEN (* evaluate the waiting conditions *)
-			(* we are holding the lock, so the queue can not change (to do: except in TerminateThis) *)
-		c := FindCondition(hdr.awaitingCond) (* interrupts should be on during this call *)
-	ELSE
-		c := NIL
-	END;
-	id := Machine.AcquirePreemption ();
-	Machine.AcquireObject(hdr.locked);
-	r := running[Machine.ID ()];
-	ASSERT(r # NIL);
-	IF hdr.lockedBy # r THEN
-		Machine.ReleaseObject(hdr.locked);
-		Machine.ReleasePreemption;
-		ASSERT(hdr.lockedBy = r)
-	END;
-	IF c = NIL THEN (* no true condition found, check the lock queue *)
-		Get(hdr.awaitingLock, t);
-		IF t # NIL THEN
-			IF StrongChecks THEN
-				ASSERT((t.mode = AwaitingLock) & (t.waitingOn = obj))
-			END;
-			TransferLock(hdr, t)
-		ELSE
-			hdr.lockedBy := NIL; hdr.count := 0
-		END
-	ELSE (* true condition found, transfer the lock *)
-		TransferLock(hdr, c);
-		t := NIL
-	END;
-
-	Machine.ReleaseObject(hdr.locked);
-	IF (c # NIL) OR (t # NIL) THEN
-		Machine.Acquire(Machine.Objects);
-		IF c # NIL THEN Enter(c) END;
-		IF t # NIL THEN Enter(t) END;
-		Machine.Release(Machine.Objects);
-	END;
-	Machine.ReleasePreemption;
-END UnlockNoPriorityInv;
-
-(* Unlock a protected object in case priority inversion handling is enabled. Machine.Objects lock is used. *)
-PROCEDURE UnlockPriorityInv(obj: ProtectedObject);
-VAR hdr {UNTRACED}: Heaps.ProtRecBlock; t, c, r: Process; maxWaitingPrio: LONGINT;
-BEGIN
-	IF Stats THEN Machine.AtomicInc(Nunlock) END;
-	SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
-	IF StrongChecks THEN
-		ASSERT(hdr IS Heaps.ProtRecBlock) (* protected object *)
-	END;
-	ASSERT(hdr.count = -1);	(* exclusive locked *)
-	IF hdr.awaitingCond.head # NIL THEN (* evaluate the waiting conditions *)
-			(* we are holding the lock, so the queue can not change (to do: except in TerminateThis) *)
-		c := FindCondition(hdr.awaitingCond) (* interrupts should be on during this call *)
-	ELSE
-		c := NIL
-	END;
-	Machine.Acquire(Machine.Objects);
-	r := running[Machine.ID ()];
-	ASSERT(r # NIL);
-	IF hdr.lockedBy # r THEN
-		Machine.Release(Machine.Objects);
-		ASSERT(hdr.lockedBy = r)
-	END;
-	maxWaitingPrio := MaxPrio(hdr.waitingPriorities);
-	DEC(r.prioRequests[maxWaitingPrio]);
-	r.priority := MaxPrio(r.prioRequests);
-	IF c = NIL THEN (* no true condition found, check the lock queue *)
-		t := NIL;
-		GetMaxPrio(hdr.awaitingLock, t);
-		IF t = NIL THEN
-			hdr.lockedBy := NIL; hdr.count := 0
-		ELSE
-			IF StrongChecks THEN ASSERT((t.mode = AwaitingLock) & (t.waitingOn = obj)) END;
-			TransferLock(hdr, t)
-		END
-	ELSE (* true condition found, transfer the lock *)
-		TransferLock(hdr, c);
-		t := NIL
-	END;
-
-	IF (c # NIL) OR (t # NIL) THEN
-		IF c # NIL THEN Enter(c) END;
-		IF t # NIL THEN Enter(t) END;
-	END;
-	Machine.Release(Machine.Objects);
-END UnlockPriorityInv;
-
-(* Await a condition (kernel call). *)
-(* There are two different procedures for locking a protected object in case of priority inverison handling enabled or disabled due to the different
-    locking strategies, i.e. there are no header locks in case of priority inversion handling. *)
-PROCEDURE Await*(cond: Condition; slink: ADDRESS; obj: ProtectedObject; flags: SET);
-BEGIN
-	IF HandlePriorityInv THEN
-		AwaitPriorityInv(cond, slink, obj, flags)
-	ELSE
-		AwaitNoPriorityInv(cond, slink, obj, flags)
-	END
-END Await;
-
-(* Await a condition if priority inversion handling is disabled. Header locks, preemption and Machine.Objects locks are used. *)
-PROCEDURE AwaitNoPriorityInv(cond: Condition; slink: ADDRESS; obj: ProtectedObject; flags: SET);
-VAR hdr {UNTRACED}: Heaps.ProtRecBlock; r, c, t: Process; id: LONGINT;
-BEGIN
-	IF Stats THEN Machine.AtomicInc(Nawait) END;
-	IF 1 IN flags THEN (* compiler did not generate IF *)
-		IF Stats THEN Machine.AtomicInc(NawaitNoIF) END;
-		IF cond(slink) THEN
-			IF Stats THEN Machine.AtomicInc(NawaitTrue) END;
-			RETURN (* condition already true *)
-		END
-	END;
-	SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
-	IF StrongChecks THEN
-		ASSERT(hdr IS Heaps.ProtRecBlock) (* protected object *)
-	END;
-	id := Machine.AcquirePreemption ();
-	Machine.AcquireObject(hdr.locked);	(* must acquire object lock before other locks *)
-	r := running[id];
-	ASSERT(r # NIL);
-	IF hdr.lockedBy = r THEN	(* current process holds exclusive lock *)
-		IF StrongChecks THEN ASSERT(hdr.count = -1) END; (* exclusive locked *)
-		IF hdr.awaitingCond.head # NIL THEN	(* evaluate the waiting conditions *)
-			(* we are holding the lock, so the queue can not change (to do: except in TerminateThis) *)
-			c := FindCondition(hdr.awaitingCond)	(* interrupts should be on during this call *)
-		ELSE
-			c := NIL
-		END;
-
-		IF c = NIL THEN
-			Get(hdr.awaitingLock, t);
-			IF t = NIL THEN	(* none waiting - remove lock *)
-				hdr.count := 0; hdr.lockedBy := NIL;
-			ELSE	(* transfer lock to first waiting process *)
-				IF StrongChecks THEN ASSERT(t.mode = AwaitingLock) END;
-				TransferLock(hdr, t)
-			END;
-		ELSE
-			TransferLock(hdr, c);
-			t := NIL
-		END;
-	ELSE (* no lock, or some other process may hold the lock, but that's the user's indaba (may be monotonic condition) *)
-		Machine.ReleaseObject(hdr.locked);
-		Machine.ReleasePreemption;
-		HALT(2204)	(* await must be exclusive region *)
-	END;
-	Machine.Acquire(Machine.Objects); (* Put and SwitchTo must be protected *)
-	IF c # NIL THEN Enter(c)  END;
-	IF t # NIL THEN Enter(t) END;
-	IF StrongChecks THEN ASSERT(r.waitingOn = NIL) END;
-	r.condition := cond; r.condFP := slink;
-	r.waitingOn := obj; r.mode := AwaitingCond;
-	Put(hdr.awaitingCond, r);
-	Machine.ReleaseObject(hdr.locked);
-	Machine.ReleasePreemption;
-	(* reschedule *)
-	SwitchToNew;
-	IF StrongChecks THEN
-		ASSERT(cond(slink));
-		ASSERT(hdr.lockedBy = r) (* lock held again *)
-	END
-END AwaitNoPriorityInv;
-
-(* Await a condition in case priority inversion handling is enabled. Machine.Objects lock is used. *)
-PROCEDURE AwaitPriorityInv(cond: Condition; slink: ADDRESS; obj: ProtectedObject; flags: SET);
-VAR hdr {UNTRACED}: Heaps.ProtRecBlock; r, c, t: Process; id, maxWaitingPrio, prevMaxWaitingPrio: LONGINT;
-BEGIN
-	IF Stats THEN Machine.AtomicInc(Nawait) END;
-	IF 1 IN flags THEN (* compiler did not generate IF *)
-		IF Stats THEN Machine.AtomicInc(NawaitNoIF) END;
-		IF cond(slink) THEN
-			IF Stats THEN Machine.AtomicInc(NawaitTrue) END;
-			RETURN (* condition already true *)
-		END
-	END;
-	SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
-	IF StrongChecks THEN
-		ASSERT(hdr IS Heaps.ProtRecBlock) (* protected object *)
-	END;
-	Machine.Acquire(Machine.Objects);
-	id := Machine.ID();
-	r := running[id];
-	ASSERT(r # NIL);
-	IF hdr.lockedBy = r THEN	(* current process holds exclusive lock *)
-		IF StrongChecks THEN ASSERT(hdr.count = -1) END; (* exclusive locked *)
-		maxWaitingPrio := MaxPrio(hdr.waitingPriorities);
-		DEC(r.prioRequests[maxWaitingPrio]);
-		r.priority := MaxPrio(r.prioRequests);
-		IF hdr.awaitingCond.head # NIL THEN	(* evaluate the waiting conditions *)
-			(* we are holding the lock, so the queue can not change (to do: except in TerminateThis) *)
-			c := FindCondition(hdr.awaitingCond)	(* interrupts should be on during this call *)
-		ELSE
-			c := NIL
-		END;
-
-		IF c = NIL THEN
-			t := NIL;
-			GetMaxPrio(hdr.awaitingLock, t);
-			IF t = NIL THEN	(* none waiting - remove lock *)
-				hdr.count := 0; hdr.lockedBy := NIL;
-			ELSE	(* transfer lock to first waiting process *)
-				IF StrongChecks THEN ASSERT(t.mode = AwaitingLock) END;
-				TransferLock(hdr, t);
-			END;
-		ELSE  (* true condition found, transfer the lock *)
-			TransferLock(hdr, c);
-			t := NIL;
-		END;
-	ELSE (* no lock, or some other process may hold the lock, but that's the user's indaba (may be monotonic condition) *)
-		Machine.Release(Machine.Objects);
-		HALT(2204)	(* await must be exclusive region *)
-	END;
-	IF c # NIL THEN Enter(c) END;
-	IF t # NIL THEN Enter(t) END;
-	IF StrongChecks THEN ASSERT(r.waitingOn = NIL) END;
-	r.condition := cond; r.condFP := slink;
-	r.waitingOn := obj; r.mode := AwaitingCond;
-	IF hdr.lockedBy # NIL THEN
-		prevMaxWaitingPrio := MaxPrio(hdr.waitingPriorities);
-		INC(hdr.waitingPriorities[r.priority]);
-		IF r.priority > prevMaxWaitingPrio THEN PropagatePrio(hdr, prevMaxWaitingPrio, r.priority) END;
-	ELSE (* it may happen that hdr is not locked - in that case no priority propagation takes place *)
-		INC(hdr.waitingPriorities[r.priority])
-	END;
-	Put(hdr.awaitingCond, r);
-	(* reschedule *)
-	SwitchToNew;
-	IF StrongChecks THEN
-		ASSERT(cond(slink));
-		ASSERT(hdr.lockedBy = r) (* lock held again *)
-	END
-END AwaitPriorityInv;
-
-(** Update the state snapshot of the current process for GC. (for Processors) *)
-PROCEDURE UpdateState;
-VAR t: Process;
-BEGIN (* interrupts off *)
-	Machine.Acquire(Machine.Objects);
-	t := running[Machine.ID ()];
-	ASSERT(t # NIL);
-	IF t # NIL THEN
- 		t.state.PC := Machine.CurrentPC(); (* ug: required information for GC with meta data for stack inspection *)
- 		t.state.SP := Machine.CurrentSP(); (* ug: not necessarily needed for GC *)
- 		t.state.BP := Machine.CurrentBP(); (* ug: necessary information for GC with meta data for stack inspection *)
-	END;
-	Machine.Release(Machine.Objects)
-END UpdateState;
-
-(** Start executing user processes. Every processor calls this during initialization. *)
-PROCEDURE Start*;
-VAR id, ignored: LONGINT; idle: Idle; new: Process;
-BEGIN (* running at kernel level (not preemptable) *)
-	ignored := Machine.AcquirePreemption();
-	id := Machine.ID (); (* preemption not enabled yet, because we are running at kernel level *)
-	NEW(idle); (* create process with MinPriority *)
-	Machine.Acquire(Machine.Objects);
-	Get(ready.q[MinPriority], new); (* can not use Select here, as it might return a preempted process *)
-	ASSERT(~(Preempted IN new.flags)); (* will at least get the Idle process just created *)
-	Machine.Release(Machine.Objects);
-	running[id] := new; (* schedule new process *)
-	perfTsc[id] := Machine.GetTimer();
-	new.mode := Running; new.procID := id;
-	Machine.FPURestoreMin(new.sse);
-	Machine.ReleasePreemption;
-	Machine.JumpToUserLevel(new.state.BP);
-	HALT(100); (* does never return here *)
-END Start;
-
-(* Initialize module. *)
-PROCEDURE Init; (* can not use NEW *)
-VAR
-	i: LONGINT;
-BEGIN
-	ProcessorHLT := NIL;
-	maxReady := High; (* scan all queues at start *)
-	lowestAllowedPriority := Low; (* normal case, will be set to GCPriority if GC is running *)
-	gcBarrier := {};
-	FOR i := 0 TO Machine.MaxCPU - 1 DO running[i] := NIL END;
-	FOR i := 0 TO NumPriorities - 1 DO rootedProcesses[i] := NIL END;
-	FOR i := 0 TO NumIRQ-1 DO processingIRQ[i] := FALSE END;
-	nextProcessID := 0; Machine.ticks := 0;
-	traceProcess := NIL;
-	terminate := Terminate;
-	trap[0] := Halt;
-	trap[1] := HaltUnbreakable;
-	trapReturn[0] := HaltReturn;
-	trapReturn[1] := HaltUnbreakableReturn;
-END Init;
-
-PROCEDURE InitEventHandling;
-VAR i: LONGINT; clock: Clock; (* realtimeClock: RealtimeClock; *)
-BEGIN
-	FOR i := 0 TO NumIRQ-1 DO
-		interrupt[i].root := NIL; interrupt[i].process := NIL
-	END;
-	(* create normal event list *)
-	NEW(event); event.next := event; event.prev := event;
-	event.trigger := Machine.ticks + MAX(LONGINT) DIV 2;
-	(* create normal timer processes *)
-	timer := NIL; NEW(clock);
-END InitEventHandling;
-
-PROCEDURE InitGCHandling;
-VAR finalizerCaller: FinalizerCaller;
-BEGIN
-	gcProcess := NIL; NEW(gcActivity);
-	finalizerProcess := NIL; NEW(finalizerCaller);
-END InitGCHandling;
-
-PROCEDURE InitStats;
-BEGIN
-	Nlock := 0; Nunlock := 0; Nawait := 0; NawaitNoIF := 0; NawaitTrue := 0;
-	Ncreate := 0; Nterminate := 0; Ncondition := 0; Ncondition1True := 0;
-	Ncondition2 := 0; Ncondition2True := 0;
-	Ntimeslice := 0; NtimesliceTaken := 0; NtimesliceNothing := 0;
-	NtimesliceIdle := 0; NtimesliceKernel := 0; NtimesliceV86 := 0; NtimesliceCritical := 0;
-	Npreempt := 0; NpreemptTaken := 0; NpreemptNothing := 0;
-	NpreemptKernel := 0; NpreemptV86 := 0; NpreemptCritical := 0;
-	Nenter := 0;
-END InitStats;
-
-PROCEDURE GCStatusFactory(): Heaps.GCStatus;
-VAR gcStatusExt : GCStatusExt;
-BEGIN
-	ASSERT(Heaps.gcStatus = NIL);
-	NEW(gcStatusExt);
-	RETURN gcStatusExt
-END GCStatusFactory;
-
-(** Return current user stack *)
-PROCEDURE GetCurrentStack(VAR stack: Machine.Stack);
-BEGIN
-	stack := running[Machine.ID()].stack;
-END GetCurrentStack;
-
-PROCEDURE InitPrioRequest;
-VAR
-	i: LONGINT;
-BEGIN
-	FOR i := 0 TO LEN(init.prioRequests) - 1 DO init.prioRequests[i] := 0 END;
-END InitPrioRequest;
-
-VAR
-	(* for compatibility and later extension *)
-	TraceProcessHook*: PROCEDURE (prcoess: Process; pc, bp: ADDRESS; stacklow, stackhigh: ADDRESS);
-
-BEGIN
-	IF Stats THEN InitStats; END;
-	Init;
-	(* initialize memory management *)
-	Machine.UpdateState; (* for gc *)
-	Machine.getStack := GetCurrentStack;
-	Heaps.CollectGarbage(Modules.root); (* still in single-processor mode *)
-	(* now NEW can be used *)
-	NEW(ready); (* create the ready queues *)
-	Machine.InitInterrupts;
-	(*Machine.Start; initialize interrupts *)
-	InitEventHandling;
-	InitGCHandling;
-	Heaps.gcStatus := GCStatusFactory();
-	(* create a process for rest of init code, which runs at user level *)
-	entry := Machine.CurrentBP ();
-	SYSTEM.GET (entry+AddressSize, entry);	(* return address into linker-generated call table *)
-	NEW(initObject);
-	NewProcess(SYSTEM.VAL (Body, entry-ReturnStackDisplacement), {Resistant}, initObject, init); (* create init process *)
-	init.priority := High;
-	init.staticPriority := init.priority;
-	(* initialize prioRequests for init process *)
-	InitPrioRequest;
-	INC(init.prioRequests[init.priority]);
-	Machine.Acquire(Machine.Objects);
-	init.id := -1; Enter(init); init := NIL;
-	Machine.Release(Machine.Objects);
-	Start (* start it *)
-	(* linker call table will end with a call to Terminate. So after executing all module bodies,
-	the init process will terminate and other processes created during init will continue running. *)
-END Objects.
-
-(*
-24.03.1998	pjm	Started
-06.05.1998	pjm	CreateProcess init process, page fault handler
-06.08.1998	pjm	Moved exception interrupt handling here for current process
-17.08.1998	pjm	FindRoots method
-02.10.1998	pjm	Idle process
-06.11.1998	pjm	snapshot
-25.03.1999	pjm	Scope removed
-28.05.1999	pjm	EventHandler object
-01.06.1999	pjm	Fixed InterruptProcess lock error
-16.06.1999	pjm	Flat IRQ priority model to avoid GC deadlock
-23.06.1999	pjm	Flat IRQ priority experiment failed, rather do STI in FieldIRQ to avoid GC deadlock
-29.06.1999	pjm	Timeout in EventHandler object
-13.01.2000	pjm	Overed (Interrupt Objects, Event Handlers, Process ID, Process state, Process mode, Process stack, Await)
-17.10.2000	pjm	Priorities
-22.10.2003	mib	SSE2 extension
-24.10.2003	phk	Priority inversion / cycle counters
-19.06.2007	ug	Garbage Collector using meta data for stack inspection
-*)
-
-(*
-Location	Stack
-Lock	Current process
- SwitchTo.A	Current process
- SwitchTo.B
-*)

ARM/ARM.A2/ARM.Raster.Mod

@@ -1,3905 +0,0 @@
-MODULE Raster; (** non-portable *)	(* eos, TF  **)
-(** AUTHOR "eos"; PURPOSE "Raster operations"; *)
-
-	(**
-		Raster image bitmaps and basic image processing
-	**)
-
-
-	(*
-		19.9.1999 - spawned from GfxMaps
-		25.10.1999 - fixed bytes-per-row calculation in Create (need to make arguments LONG)
-		17.11.1999 - eliminated F8 format, replaced by D8 (implemented with module Colors)
-		19.11.1999 - fixed missing alpha component in computed palettes
-		16.05.2000 - module Raster as Oberon-independent part of Images
-		19.06.2000 - replaced DisplayFormat and InitDisplay by DisplayFormat()
-		25.02.2006 - raster operations with SSE2 added (student project by Myrto Zehnder)
-		28.02.2008 - added capabilities for 16-bit palette & grayscale images often used in scientific,medical imaging and professional photography (Patrick Hunziker)
-
-		To do:
-		- store in compressed format
-		- add capabilities for RGB and multiplane images with >8 bits per color as used in scientific imaging and professional photography
-	*)
-
-	IMPORT
-		SYSTEM, KernelLog, Machine, Streams, CLUTs, Displays;
-
-
-	(*
-		Interfacing with display hardware and foreign framebuffers may suffer a performance hit if their
-		bit or byte ordering can't be made compatible with that of a built-in format and has to be converted
-		manually. Predefined format A1 has the leftmost pixel in the least significant bit of a byte, and
-		all hi/true color formats have their blue component at the lowest address, followed by green,
-		red, and possibly alpha (which conforms to the specification of the transfer formats in Displays).
-
-		As SYSTEM is imported, the module is not portable and has always to be compiled to native code.
-		However, it should usually suffice to recompile the module on other platforms without changing
-		any code.
-
-		Assumptions:
-			* CHR(l) = CHR(l MOD 100H) for all l: LONGINT
-			* SIZEOF(LONGINT)=4
-	*)
-
-
-	CONST
-		b* = 0; g* = 1; r* = 2; a* = 3;	(** index of blue, green, red, and alpha components in a Pixel **)
-
-		(** format codes **)
-		custom* = 0; a1* = 1; a8* = 2; d8* = 3; p8* = 4; bgr555* = 5; bgr565* = 6; bgr466* = 7; bgr888* = 8; bgra8888* = 9; p16* =10;
-
-		(** components **)
-		color* = 0; alpha* = 1; index* = 2;
-
-		(** compositing operations (srcCopy = replace, srcOverDst = paint **)
-		clear* = 0; srcCopy* = 1; dstCopy* = 2; srcOverDst* = 3; dstOverSrc* = 4; srcInDst* = 5; dstInSrc* = 6;
-		srcWithoutDst* = 7; dstWithoutSrc* = 8; srcAtopDst* = 9; dstAtopSrc* = 10; srcXorDst* = 11; InvDst*=12;
-		InvOverDst*=13;
-
-		MAXCOL = 10000H; (*current implementation limitation for number of color indexes *)
-
-	TYPE
-		(** general pixels with red, green, blue, and alpha information in range 0..255; alpha is pre-multiplied into RGB **)
-		Pixel* = ARRAY 4 OF CHAR;
-
-		(** palette structure for indexed formats **)
-		Palette* = OBJECT
-			VAR
-			col*: POINTER TO ARRAY OF Pixel;	(** color table **)
-			used*: LONGINT;	(** number of valid entries in color table **)
-			clut: CLUTs.CLUT;	(* reverse color lookup structure *)
-			PROCEDURE &New*; BEGIN NEW(col,256); used:=256 END New; (*initialized to 256 colors; for backwards compatibility*)
-			PROCEDURE Init*(used:LONGINT); BEGIN SELF.used:=used; NEW(col,used) END Init; (*initialize to size # 256*) (*bugfix PH090122*)
-		END Palette;
-
-		(** image format **)
-		Format0* = RECORD
-			code*: SHORTINT;	(** format code for quick format checks **)
-			bpp*: SHORTINT;	(** number of bits per pixel **)
-			align*: SHORTINT;	(** bytes per row must be multiple of this **)
-			components*: SET;	(** components that are stored in a pixel **)
-			pal*: Palette;	(** optional palette for indexed formats **)
-		END;
-
-		PackProc* = PROCEDURE (VAR fmt: Format0; adr: ADDRESS; bit: LONGINT; VAR pix: Pixel);
-
-		Format* = RECORD (Format0)
-			pack*: PackProc;	(** store supported pixel components at given address **)
-			unpack*: PackProc;	(** load supported pixel components from given address **)
-		END;
-
-		(** raster image **)
-		Image* = OBJECT (* POINTER TO ImageDesc;
-		ImageDesc* = RECORD *)
-		VAR
-			width*, height*: LONGINT;	(** image dimensions **)
-			fmt*: Format;	(** pixel format **)
-			bpr*: LONGINT;	(** number of bytes per row (may be negative) **)
-			adr*: ADDRESS;	(** address of lower left pixel **)
-			mem*: POINTER TO ARRAY OF CHAR;	(** block where pixels are stored; mem#NIL implies adr=ADR(mem[0]) **)
-		END Image;
-
-		(** transfer mode **)
-		Mode0* = RECORD
-			src*, dst*: Format;	(** source and destination format **)
-			op*: LONGINT;	(** compositing operation **)
-			col*: Pixel;	(** substitute color used when transfering from pure alpha formats to colored ones **)
-			buf: Pixel;	(* constant area for special-case moving *)
-			map: POINTER TO ARRAY OF INTEGER;	(* color map for transfer between indexed formats *)
-		END;
-
-		TransferProc* = PROCEDURE (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-
-		Mode* = RECORD (Mode0)
-			transfer*: TransferProc;	(** procedure transfering pixels from source to destination **)
-		END;
-
-		PictureTransferParameters* = POINTER TO RECORD
-			img* : Image;
-			name* : ARRAY 128 OF CHAR;
-			done* : BOOLEAN
-		END;
-
-	VAR
-		A1*, A8*, D8*, BGR555*, BGR565*, BGR466*, BGR888*, BGRA8888*: Format;	(** predefined formats **)
-		PixelFormat*: Format;	(** special formats **)
-
-		Clamp*: ARRAY 500H OF CHAR;	(** Clamp[200H+i] = CHR(min(max(i, 0), 0FFH)) **)
-
-		Zero: Pixel;	(* pixel with all components cleared *)
-		Bit: ARRAY 100H, 8 OF BOOLEAN;	(* Bit[b, i] means bit i in byte b is set *)
-		Set, Clr: ARRAY 100H, 8 OF CHAR;	(* Set/Clr[b, i] is byte b with bit i set/cleared *)
-
-(*		d8display: Displays.Display;	(* only one system-wide D8 display supported *)
-		plugin: Plugins.Plugin; *)
-
-		MMXenabled*,SSE2enabled*  : BOOLEAN;
-
-	(**--- Color/Pixel conversions ---**)
-
-	(** set pixel to opaque RGB value **)
-	PROCEDURE SetRGB* (VAR pix: Pixel; red, green, blue: LONGINT);
-	CODE
-		LDR R0, [FP, #pix] ; ADDRESSOF(pix[0])
-		LDRB R1, [FP, #blue]
-		LDRB R2, [FP, #green]
-		LDRB R3, [FP, #red]
-		
-		ANDS R5, R0, #3 ; R0 MOD 4
-		BNE unaligned_store
-		
-		; aligned store
-		ORR R1, R1, R2, LSL #8
-		ORR R1, R1, R3, LSL #16
-		ORR R1, R1, #0FF000000H
-		STR R1, [R0, #0]
-		B exit
-
-	unaligned_store:
-		MOV R4, #0FFH
-		STRB R1, [R0, #0]
-		STRB R2, [R0, #1]
-		STRB R3, [R0, #2]
-		STRB R4, [R0, #3]
-	exit:
-	(*BEGIN
-		pix[b] := CHR(blue); pix[g] := CHR(green); pix[r] := CHR(red); pix[a] := 0FFX*)
-	END SetRGB;
-
-	(** set pixel to partly transparent RGB value **)
-	PROCEDURE SetRGBA* (VAR pix: Pixel; red, green, blue, alpha: LONGINT);
-	CODE
-		LDR R0, [FP, #pix] ; ADDRESSOF(pix[0])
-		LDRB R1, [FP, #blue]
-		LDRB R2, [FP, #green]
-		LDRB R3, [FP, #red]
-		LDRB R4, [FP, #alpha]
-		
-		CMP R4, #255
-		BEQ store ; if alpha =255 store colors as they are
-		
-		; apply alpha to the colors
-		MUL R1, R1, R4 ; blue * alpha 
-		MUL R2, R2, R4 ; green * alpha
-		MUL R3, R3, R4 ; red * alpha
-		LSR R1, R1, #8 ; (blue * alpha) DIV 256 
-		LSR R2, R2, #8 ; (green * alpha) DIV 256 
-		LSR R3, R3, #8 ; (red * alpha) DIV 256 
-	
-	store:
-		ANDS R5, R0, #3 ; R0 MOD 4
-		BNE unaligned_store
-		
-		; aligned store
-		ORR R1, R1, R2, LSL #8
-		ORR R1, R1, R3, LSL #16
-		ORR R1, R1, R4, LSL #24
-		STR R1, [R0, #0]
-		B exit
-
-	unaligned_store:
-		STRB R1, [R0, #0]
-		STRB R2, [R0, #1]
-		STRB R3, [R0, #2]
-		STRB R4, [R0, #3]
-	exit:
-	(*BEGIN
-		pix[b] := CHR(blue * alpha DIV 255);
-		pix[g] := CHR(green * alpha DIV 255);
-		pix[r] := CHR(red * alpha DIV 255);
-		pix[a] := CHR(alpha)*)
-	END SetRGBA;
-
-	(** retrieve RGB and alpha values from pixel **)
-	PROCEDURE GetRGBA* (pix: Pixel; VAR red, green, blue, alpha: LONGINT);
-	BEGIN
-		alpha := ORD(pix[a]);
-		IF alpha = 0 THEN	(* color has disappeared *)
-			red := 255; green := 255; blue := 255
-		ELSE
-			red := ORD(pix[r]); green := ORD(pix[g]); blue := ORD(pix[b]);
-			IF alpha # 255 THEN	(* un-multiply alpha *)
-				red := 255 * red DIV alpha; IF red > 255 THEN red := 255 END;
-				green := 255 * green DIV alpha; IF green > 255 THEN green := 255 END;
-				blue := 255 * blue DIV alpha; IF blue > 255 THEN blue := 255 END
-			END
-		END
-	END GetRGBA;
-
-
-	(**--- Palettes ---**)
-
-	(** return index of color in palette which approximates the requested color reasonably well **)
-	PROCEDURE PaletteIndex* (pal: Palette; red, green, blue: LONGINT): LONGINT;
-	BEGIN
-		IF pal.used>256 THEN
-			RETURN CLUTs.Match(pal.clut, ASH(red, 16) + ASH(green, 8) +  blue) *pal.used DIV 256 (*PH090122*)
-		ELSE RETURN CLUTs.Match(pal.clut, ASH(red, 16) + ASH(green, 8) +  blue)
-		END;
-	END PaletteIndex;
-
-	(** compute internal palette structures whenever palette colors have been modified **)
-	PROCEDURE InitPalette* (pal: Palette; used, bits: LONGINT);
-		VAR n, red, green, blue, alpha: LONGINT;
-	BEGIN
-		n := 0;
-		IF used>pal.used THEN NEW(pal.col,used);END;
-		pal.used:=used;
-		WHILE n < used DO
-			GetRGBA(pal.col[n], red, green, blue, alpha);
-			CLUTs.Set(pal.clut, (*n*) n*255 DIV used, ASH(red, 16) + ASH(green, 8) + blue);
-			INC(n)
-		END;
-		CLUTs.Init(pal.clut, MIN (used,256), bits);
-	END InitPalette;
-
-	(** (re)compute grayscale palette, typically used for pictures with >256 gray scale values**)
-	PROCEDURE InitGrayPalette* (pal: Palette; used, bits: LONGINT);
-		VAR n, gray: LONGINT;
-	BEGIN
-		n := 0;
-		IF used>pal.used THEN NEW(pal.col,used); END;
-		pal.used := used;
-		WHILE n < used DO
-			gray:= n*255 DIV used;
-			SetRGBA(pal.col[n],gray,gray,gray,255); (*PH 090122*)
-			CLUTs.Set(pal.clut, gray, ASH(gray, 16) + ASH(gray, 8) + gray);
-			INC(n)
-		END;
-		CLUTs.Init(pal.clut, MIN(used,256), bits);
-	END InitGrayPalette;
-
-	(** copy palette contents **)
-	PROCEDURE CopyPalette* (from, to: Palette);
-		VAR n: LONGINT;
-	BEGIN
-		n := 0;
-		IF to.used<from.used THEN NEW(to.col,from.used) END;
-		to.used:=from.used;
-		WHILE n < from.used DO
-			to.col[n] := from.col[n]; INC(n)
-		END;
-		CLUTs.Copy(from.clut, to.clut)
-	END CopyPalette;
-
-	(** compute and initialize a pseudo-optimal palette for an image (in hi-color or true-color format) **)
-	PROCEDURE ComputePalette* (img: Image; pal: Palette; reservedcols, maxcols, bits: LONGINT);
-		(*
-			uses octree-quantization
-		*)
-
-		TYPE
-			Node = POINTER TO RECORD	(* octree node *)
-				dsc: ARRAY 8 OF Node;	(* descendants *)
-				link: Node;	(* next reducible node on same level *)
-				leaf: BOOLEAN;
-				weight: LONGINT;	(* accumulated number of pixels represented by this node *)
-				r, g, b: LONGINT;	(* accumulated color values *)
-			END;
-
-		VAR
-			sent, root: Node; reducible: ARRAY 8 OF Node; colors, maxDepth, y, x, bb, used: LONGINT; adr, aa: ADDRESS; pix: Pixel;
-
-		PROCEDURE insert (VAR node: Node; depth: LONGINT; pix: Pixel);
-			VAR idx, bit: LONGINT;
-		BEGIN
-			IF node = NIL THEN
-				NEW(node);
-				IF depth = maxDepth THEN
-					node.leaf := TRUE;
-					INC(colors)
-				ELSE
-					node.leaf := FALSE;
-					node.link := reducible[depth]; reducible[depth] := node
-				END
-			END;
-			INC(node.weight);	(* node represents more pixels *)
-			IF node.leaf THEN
-				INC(node.r, LONG(ORD(pix[r])));
-				INC(node.g, LONG(ORD(pix[g])));
-				INC(node.b, LONG(ORD(pix[b])))
-			ELSE
-				idx := 0; bit := 7-depth;
-				IF ODD(ASH(ORD(pix[r]), -bit)) THEN INC(idx, 4) END;
-				IF ODD(ASH(ORD(pix[g]), -bit)) THEN INC(idx, 2) END;
-				IF ODD(ASH(ORD(pix[b]), -bit)) THEN INC(idx) END;
-				insert(node.dsc[idx], depth+1, pix)
-			END
-		END insert;
-
-		PROCEDURE reduce;
-			VAR d, min, n, i: LONGINT; node, prev, dsc: Node;
-		BEGIN
-			d := maxDepth-1;
-			WHILE reducible[d] = NIL DO
-				DEC(d); DEC(maxDepth)
-			END;
-			sent.link := reducible[d];
-			node := sent; min := MAX(LONGINT);
-			WHILE node.link # NIL DO
-				IF node.link.weight < min THEN
-					min := node.link.weight; prev := node
-				END;
-				node := node.link
-			END;
-			node := prev.link; prev.link := node.link;
-			reducible[d] := sent.link;
-			n := 1;	(* number of colors is initially one for the node itself *)
-			FOR i := 0 TO 7 DO
-				dsc := node.dsc[i];
-				IF dsc # NIL THEN
-					DEC(n);	(* reducing one color *)
-					INC(node.r, dsc.r); INC(node.g, dsc.g); INC(node.b, dsc.b);
-					node.dsc[i] := NIL
-				END
-			END;
-			node.leaf := TRUE;
-			INC(colors, n)
-		END reduce;
-
-		PROCEDURE traverse (node: Node);
-			VAR i: LONGINT;
-		BEGIN
-			IF node # NIL THEN
-				IF node.leaf THEN
-					pal.col[used, r] := CHR(node.r DIV node.weight);
-					pal.col[used, g] := CHR(node.g DIV node.weight);
-					pal.col[used, b] := CHR(node.b DIV node.weight);
-					pal.col[used, a] := 0FFX;
-					INC(used)
-				ELSE
-					FOR i := 0 TO 7 DO
-						traverse(node.dsc[i])
-					END
-				END
-			END
-		END traverse;
-
-	BEGIN	(* ComputePalette *)
-		ASSERT(reservedcols + maxcols <= MAXCOL, 100);
-		NEW(sent);
-		root := NIL; colors := 0; maxDepth := 8;
-		y := 0; adr := img.adr;
-		WHILE y < img.height DO
-			IF img.fmt.bpp < 8 THEN
-				x := 0; aa := adr; bb := 0;
-				WHILE x < img.width DO
-					img.fmt.unpack(img.fmt, aa, bb, pix);
-					insert(root, 0, pix);
-					WHILE colors > maxcols DO
-						reduce()
-					END;
-					INC(x); bb := bb + img.fmt.bpp; INC(aa, bb DIV 8); bb := bb MOD 8
-				END
-			ELSE
-				x := 0; aa := adr; bb := img.fmt.bpp DIV 8;
-				WHILE x < img.width DO
-					img.fmt.unpack(img.fmt, aa, 0, pix);
-					insert(root, 0, pix);
-					WHILE colors > maxcols DO
-						reduce()
-					END;
-					INC(x); INC(aa, bb)
-				END
-			END;
-			INC(y); INC(adr, img.bpr)
-		END;
-		used := reservedcols;
-		traverse(root);
-		InitPalette(pal, used, bits)
-	END ComputePalette;
-
-
-	(**--- Formats ---**)
-
-	(* A1 - one bit alpha, MSB leftmost *)
-	PROCEDURE PackA1 (VAR fmt: Format0; adr: ADDRESS; bit: LONGINT; VAR pix: Pixel);
-		VAR b: CHAR;
-	BEGIN
-		SYSTEM.GET(adr, b);
-		IF pix[a] >= 80X THEN SYSTEM.PUT(adr, Set[ORD(b), bit])
-		ELSE SYSTEM.PUT(adr, Clr[ORD(b), bit])
-		END
-	END PackA1;
-
-	PROCEDURE UnpackA1 (VAR fmt: Format0; adr: ADDRESS; bit: LONGINT; VAR pix: Pixel);
-		VAR b: CHAR;
-	BEGIN
-		SYSTEM.GET(adr, b);
-		IF Bit[ORD(b), bit] THEN pix[a] := 0FFX
-		ELSE pix := Zero
-		END
-	END UnpackA1;
-
-	(* A8 - 8 bit alpha *)
-	PROCEDURE PackA8 (VAR fmt: Format0; adr: ADDRESS; bit: LONGINT; VAR pix: Pixel);
-	BEGIN
-		SYSTEM.PUT(adr, pix[a])
-	END PackA8;
-
-	PROCEDURE UnpackA8 (VAR fmt: Format0; adr: ADDRESS; bit: LONGINT; VAR pix: Pixel);
-		VAR alpha: LONGINT;
-	BEGIN
-		SYSTEM.GET(adr, pix[a]);
-		IF pix[a] = 0X THEN
-			pix := Zero
-		ELSIF pix[a] # 0FFX THEN
-			alpha := ORD(pix[a]);
-			pix[r] := CHR(ORD(pix[r]) * alpha DIV 255);
-			pix[g] := CHR(ORD(pix[g]) * alpha DIV 255);
-			pix[b] := CHR(ORD(pix[b]) * alpha DIV 255)
-		END
-	END UnpackA8;
-
-	(* P8 - 8 bit indexed format with custom palette *)
-	PROCEDURE PackP8 (VAR fmt: Format0; adr: ADDRESS; bit: LONGINT; VAR pix: Pixel);
-	BEGIN
-		IF pix[a] # 0X THEN	(* model alpha as brightness *)
-			SYSTEM.PUT(adr, CHR(CLUTs.Match(fmt.pal.clut, ORD(pix[b]) + ASH(ORD(pix[g]), 8) + ASH(ORD(pix[r]), 16))))
-		END
-	END PackP8;
-
-	PROCEDURE UnpackP8 (VAR fmt: Format0; adr: ADDRESS; bit: LONGINT; VAR pix: Pixel);
-		VAR idx: CHAR;
-	BEGIN
-		SYSTEM.GET(adr, idx); pix := fmt.pal.col[ORD(idx)]
-	END UnpackP8;
-
-	(* D8 - 8 bit indexed format with display palette *)
-	PROCEDURE PackD8 (VAR fmt: Format0; adr: ADDRESS; bit: LONGINT; VAR pix: Pixel);
-	BEGIN
-		IF pix[a] # 0X THEN	(* model alpha as brightness *)
-			SYSTEM.PUT(adr, CHR(ColorToIndex(ORD(pix[b]) + ASH(ORD(pix[g]), 8) + ASH(ORD(pix[r]), 16))))
-		END
-	END PackD8;
-
-	PROCEDURE UnpackD8 (VAR fmt: Format0; adr: ADDRESS; bit: LONGINT; VAR pix: Pixel);
-		VAR idx: CHAR; col: LONGINT;
-	BEGIN
-		SYSTEM.GET(adr, idx); col := IndexToColor(ORD(idx));
-		pix[b] := CHR(col MOD 100H); pix[g] := CHR(ASH(col, -8) MOD 100H); pix[r] := CHR(ASH(col, -16) MOD 100H)
-	END UnpackD8;
-
-		(* P16 - 16 bit indexed format with custom palette *)
-	PROCEDURE PackP16 (VAR fmt: Format0; adr: ADDRESS; bit: LONGINT; VAR pix: Pixel);
-	VAR val:LONGINT;
-	BEGIN
-		IF pix[a] # 0X THEN	(* model alpha as brightness *)
-			(*SYSTEM.PUT16(adr, PaletteIndex(fmt.pal, ORD(pix[r]), ORD(pix[g]), ORD(pix[b])))*)
-			val:=CLUTs.Match(fmt.pal.clut, ORD(pix[b]) + ASH(ORD(pix[g]), 8) + ASH(ORD(pix[r]),16));
-			IF fmt.pal.used>256 THEN val:=val*fmt.pal.used DIV 256 END;
-			SYSTEM.PUT16(adr, SHORT(val))
-		END
-	END PackP16;
-
-	PROCEDURE UnpackP16 (VAR fmt: Format0; adr: ADDRESS; bit: LONGINT; VAR pix: Pixel);
-	BEGIN
-		pix := fmt.pal.col[SYSTEM.GET16(adr) MOD 1000H] 	(*unsigned 16 bit entity*)
-	END UnpackP16;
-
-
-	(* BGR555 - 16 hi-color with 5 bit blue, 5 bit green and 5 bit red in ascending order *)
-	PROCEDURE PackBGR555 (VAR fmt: Format0; adr: ADDRESS; bit: LONGINT; VAR pix: Pixel);
-		VAR int: LONGINT;
-	BEGIN
-		IF pix[a] # 0X THEN	(* model alpha as brightness *)
-			int := ASH(ORD(pix[b]), -3) + ASH(ASH(ORD(pix[g]), -3), 5) + ASH(ASH(ORD(pix[r]), -3), 10);
-			SYSTEM.PUT(adr, CHR(int)); SYSTEM.PUT(adr+1, CHR(ASH(int, -8)))
-		END
-	END PackBGR555;
-
-	PROCEDURE UnpackBGR555 (VAR fmt: Format0; adr: ADDRESS; bit: LONGINT; VAR pix: Pixel);
-		VAR lo, hi: CHAR; int: LONGINT;
-	BEGIN
-		SYSTEM.GET(adr, lo); SYSTEM.GET(adr+1, hi); int := ASH(ORD(hi), 8) + ORD(lo);
-		pix[b] := CHR(ASH(int MOD 20H, 3) + 4);
-		pix[g] := CHR(ASH(ASH(int, -5) MOD 20H, 3) + 4);
-		pix[r] := CHR(ASH(ASH(int, -10) MOD 20H, 3) + 4);
-		pix[a] := 0FFX
-	END UnpackBGR555;
-
-	(* BGR565 - 16 hi-color with 5 bit blue, 6 bit green and 5 bit red in ascending order *)
-	PROCEDURE PackBGR565 (VAR fmt: Format0; adr: ADDRESS; bit: LONGINT; VAR pix: Pixel);
-		VAR int: LONGINT;
-	BEGIN
-		IF pix[a] # 0X THEN	(* model alpha as brightness *)
-			int := ASH(ORD(pix[b]), -3) + ASH(ASH(ORD(pix[g]), -2), 5) + ASH(ASH(ORD(pix[r]), -3), 11);
-			SYSTEM.PUT(adr, CHR(int)); SYSTEM.PUT(adr+1, CHR(ASH(int, -8)))
-		END
-	END PackBGR565;
-
-	PROCEDURE UnpackBGR565 (VAR fmt: Format0; adr: ADDRESS; bit: LONGINT; VAR pix: Pixel);
-		VAR lo, hi: CHAR; int: LONGINT;
-	BEGIN
-		SYSTEM.GET(adr, lo); SYSTEM.GET(adr+1, hi); int := ASH(ORD(hi), 8) + ORD(lo);
-		pix[b] := CHR(ASH(int MOD 20H, 3) + 4);
-		pix[g] := CHR(ASH(ASH(int, -5) MOD 40H, 2) + 2);
-		pix[r] := CHR(ASH(ASH(int, -11) MOD 20H, 3) + 4);
-		pix[a] := 0FFX
-	END UnpackBGR565;
-
-	(* BGR466 - 16 hi-color with 4 bit blue, 6 bit green and 6 bit red in ascending order *)
-	PROCEDURE PackBGR466 (VAR fmt: Format0; adr: ADDRESS; bit: LONGINT; VAR pix: Pixel);
-		VAR int: LONGINT;
-	BEGIN
-		IF pix[a] # 0X THEN	(* model alpha as brightness *)
-			int := ASH(ORD(pix[b]), -4) + ASH(ASH(ORD(pix[g]), -2), 4) + ASH(ASH(ORD(pix[r]), -2), 10);
-			SYSTEM.PUT(adr, CHR(int)); SYSTEM.PUT(adr+1, CHR(ASH(int, -8)))
-		END
-	END PackBGR466;
-
-	PROCEDURE UnpackBGR466 (VAR fmt: Format0; adr: ADDRESS; bit: LONGINT; VAR pix: Pixel);
-		VAR lo, hi: CHAR; int: LONGINT;
-	BEGIN
-		SYSTEM.GET(adr, lo); SYSTEM.GET(adr+1, hi); int := ASH(ORD(hi), 8) + ORD(lo);
-		pix[b] := CHR(ASH(int MOD 10H, 4) + 8);
-		pix[g] := CHR(ASH(ASH(int, -4) MOD 40H, 2) + 2);
-		pix[r] := CHR(ASH(ASH(int, -10) MOD 40H, 2) + 2);
-		pix[a] := 0FFX
-	END UnpackBGR466;
-
-	(* BGR888 - 24 bit true color with blue in lower, green in middle, and red in upper byte *)
-	PROCEDURE PackBGR888 (VAR fmt: Format0; adr: ADDRESS; bit: LONGINT; VAR pix: Pixel);
-	BEGIN
-		IF pix[a] # 0X THEN	(* model alpha as brightness *)
-			SYSTEM.MOVE(ADDRESSOF(pix[0]), adr, 3)
-		END
-	END PackBGR888;
-
-	PROCEDURE UnpackBGR888 (VAR fmt: Format0; adr: ADDRESS; bit: LONGINT; VAR pix: Pixel);
-	BEGIN
-		SYSTEM.MOVE(adr, ADDRESSOF(pix[0]), 3); pix[a] := 0FFX
-	END UnpackBGR888;
-
-	(* BGRA8888 - 32 bit true color with blue in lowest, green in lower middle, red in upper middle, and alpha in top byte *)
-	PROCEDURE PackBGRA8888 (VAR fmt: Format0; adr: ADDRESS; bit: LONGINT; VAR pix: Pixel);
-	BEGIN
-		SYSTEM.MOVE(ADDRESSOF(pix[0]), adr, 4)
-	END PackBGRA8888;
-
-	PROCEDURE UnpackBGRA8888 (VAR fmt: Format0; adr: ADDRESS; bit: LONGINT; VAR pix: Pixel);
-	BEGIN
-		SYSTEM.MOVE(adr, ADDRESSOF(pix[0]), 4)
-	END UnpackBGRA8888;
-
-	(** return image format for given Displays transfer format **)
-	PROCEDURE DisplayFormat* (format: LONGINT): Format;
-	BEGIN
-		CASE format OF
-		| Displays.index8: RETURN D8
-		| Displays.color565: RETURN BGR565
-		| Displays.color888: RETURN BGR888
-		| Displays.color8888: RETURN BGRA8888
-		END
-	END DisplayFormat;
-
-	(** initialize format **)
-	PROCEDURE InitFormat* (VAR fmt: Format; code, bpp, align: SHORTINT; comps: SET; pal: Palette; pack, unpack: PackProc);
-	BEGIN
-		fmt.code := code; fmt.bpp := bpp; fmt.align := align; fmt.components := comps; fmt.pal := pal;
-		fmt.pack := pack; fmt.unpack := unpack
-	END InitFormat;
-
-	(** initialize index formats with custom palette **)
-	PROCEDURE InitPaletteFormat* (VAR fmt: Format; pal: Palette);
-	BEGIN
-		fmt.components := {index}; fmt.pal := pal;
-		IF pal.used<=256 THEN
-			fmt.align := 1;
-			fmt.code := p8; fmt.bpp := 8;
-			fmt.pack := PackP8; fmt.unpack := UnpackP8
-		ELSIF pal.used <= 10000H THEN
-			fmt.align := 2;
-			fmt.code := p16; fmt.bpp := 16;
-			fmt.pack := PackP16; fmt.unpack := UnpackP16
-		ELSE HALT(199)
-		END
-	END InitPaletteFormat;
-
-	(** return if two formats are the same **)
-	PROCEDURE Same* (VAR fmt0, fmt1: Format): BOOLEAN;
-	BEGIN
-		RETURN
-			(fmt0.pack = fmt1.pack) & (fmt0.unpack = fmt1.unpack) &
-			(~(index IN fmt0.components) OR (fmt0.pal = fmt1.pal))	(* doesn't work if palette has been re-initialized *)
-	END Same;
-
-
-	(**--- Images ---**)
-
-	(** initialize custom image **)
-	PROCEDURE Init* (img: Image; width, height: LONGINT; VAR fmt: Format; bpr: LONGINT; adr: ADDRESS);
-	BEGIN
-		ASSERT((width > 0) & (height > 0), 100);
-		img.width := width; img.height := height; img.fmt := fmt; img.bpr := bpr; img.adr := adr
-	END Init;
-
-	(** initialize custom image on byte buffer **)
-	PROCEDURE InitBuf* (img: Image; width, height: LONGINT; VAR fmt: Format; bpr, offset: LONGINT; VAR buf: ARRAY OF CHAR);
-	BEGIN
-		ASSERT((0 <= offset) & (offset + height * ABS(bpr) <= LEN(buf)), 100);
-		IF bpr >= 0 THEN Init(img, width, height, fmt, bpr, ADDRESSOF(buf[0]))
-		ELSE Init(img, width, height, fmt, bpr, ADDRESSOF(buf[offset]) + LEN(buf) - bpr)
-		END
-	END InitBuf;
-
-	(** initialize image on rectangular area within existing image (lower left corner must fall on byte boundary) **)
-	PROCEDURE InitRect* (img, base: Image; x, y, w, h: LONGINT);
-	BEGIN
-		ASSERT((0 <= x) & (x + w <= base.width) & (0 <= y) & (y + h <= base.height), 100);
-		ASSERT(x * base.fmt.bpp MOD 8 = 0, 101);
-		Init(img, w, h, base.fmt, base.bpr, base.adr + y * base.bpr + x * base.fmt.bpp DIV 8)
-	END InitRect;
-
-	(** create image in requested format (allocating or reusing necessary memory) **)
-	PROCEDURE Create* (img: Image; width, height: LONGINT; fmt: Format);
-	VAR size: LONGINT; a0, a1: ADDRESS;
-	BEGIN
-		ASSERT((width > 0) & (height > 0), 100);
-		img.width := width; img.height := height;
-		img.fmt := fmt;
-		img.bpr := (width * fmt.bpp + 7) DIV 8;
-		IF fmt.align > 1 THEN
-			img.bpr := (img.bpr + fmt.align - 1) DIV fmt.align * fmt.align
-		END;
-		size := height * img.bpr; INC(size, (-size) MOD 4);
-		IF (img.mem = NIL) OR (size < LEN(img.mem^) DIV 2) OR (LEN(img.mem^) < size) THEN
-			NEW(img.mem, size)
-		ELSE
-			a0 := ADDRESSOF(img.mem[0]); a1 := a0 + size;
-			WHILE a0 # a1 DO
-				SYSTEM.PUT32(a0,0); INC(a0, SIZEOF(LONGINT))
-			END
-		END;
-		img.adr := ADDRESSOF(img.mem[0])
-	END Create;
-
-	PROCEDURE CreateWithBuffer*(img: Image; width, height: LONGINT; fmt: Format; mem: POINTER TO ARRAY OF CHAR; VAR adr: ADDRESS);
-	VAR size: LONGINT; a0, a1: ADDRESS;
-	BEGIN
-		ASSERT((width > 0) & (height > 0), 100);
-		img.width := width; img.height := height;
-		img.fmt := fmt;
-		img.bpr := (width * fmt.bpp + 7) DIV 8;
-		IF fmt.align > 1 THEN
-			img.bpr := (img.bpr + fmt.align - 1) DIV fmt.align * fmt.align
-		END;
-		size := height * img.bpr; INC(size, (-size) MOD 4);
-		a0 := adr; a1 := adr + size;
-		ASSERT(ADDRESSOF(mem[0]) <= a0);
-		ASSERT(a1 <= ADDRESSOF(mem[LEN(mem)-1]));
-		WHILE a0 # a1 DO
-			SYSTEM.PUT32(a0,0); INC(a0, SIZEOF(LONGINT))
-		END;
-		img.adr := adr;
-		img.mem := mem;
-		adr := a1;
-	END CreateWithBuffer;
-
-	(**--- Transfer Modes ---**)
-
-	(** initialize transfer mode **)
-	PROCEDURE InitMode* (VAR mode: Mode; op: SHORTINT);
-	BEGIN
-		mode.op := op;
-		IF (mode.src.pal # NIL) & ((mode.map = NIL) OR (LEN(mode.map^) # mode.src.pal.used)) THEN
-			NEW(mode.map, mode.src.pal.used)
-		END;
-		SetRGB(mode.col, 255, 255, 255);
-		(*
-		mode.col := SYSTEM.VAL(Pixel, -1);
-		*)
-		mode.src.pack := NIL; mode.dst.pack := NIL	(* force re-evaluation of transfer procedure *)
-	END InitMode;
-
-	(** initialize transfer mode with color components for pure alpha sources **)
-	PROCEDURE InitModeColor* (VAR mode: Mode; op: SHORTINT; red, green, blue: LONGINT);
-	BEGIN
-		mode.op := op;
-		IF (mode.src.pal # NIL) & ((mode.map = NIL) OR (LEN(mode.map^) # mode.src.pal.used)) THEN
-			NEW(mode.map, mode.src.pal.used)
-		END;
-		SetRGB(mode.col, red, green, blue);
-		mode.src.pack := NIL; mode.dst.pack := NIL
-	END InitModeColor;
-
-	(** set new source color for transfer mode **)
-	PROCEDURE SetModeColor* (VAR mode: Mode; red, green, blue: LONGINT);
-	BEGIN
-		SetRGB(mode.col, red, green, blue);
-		IF (mode.src.pal # NIL) & ((mode.map = NIL) OR (LEN(mode.map^) # mode.src.pal.used)) THEN
-			NEW(mode.map, mode.src.pal.used)
-		END;
-		mode.src.pack := NIL; mode.dst.pack := NIL
-	END SetModeColor;
-
-	(** blend source pixel into destination pixel according to compositing operation **)
-	PROCEDURE Blend* (op: LONGINT; VAR src, dst: Pixel);
-		VAR fs, fd, i: LONGINT;
-	BEGIN
-		CASE op OF
-		| clear: fs := 0; fd := 0
-		| srcCopy: fs := 255; fd := 0
-		| dstCopy: fs := 0; fd := 255
-		| srcOverDst: fs := 255; fd := 255-ORD(src[a])
-		| dstOverSrc: fs := 255-ORD(dst[a]); fd := 255
-		| srcInDst: fs := ORD(dst[a]); fd := 0
-		| dstInSrc: fs := 0; fd := ORD(src[a])
-		| srcWithoutDst: fs := 255-ORD(dst[a]); fd := 0
-		| dstWithoutSrc: fs := 0; fd := 255-ORD(src[a])
-		| srcAtopDst: fs := ORD(dst[a]); fd := 255-ORD(src[a])
-		| dstAtopSrc: fs := 255-ORD(dst[a]); fd := ORD(src[a])
-		| srcXorDst: fs := 255-ORD(dst[a]); fd := 255-ORD(src[a])
-		END;
-
-		IF fs + fd = 0 THEN
-			FOR i := 0 TO 3 DO dst[i] := 0X END
-		ELSIF fs = 0 THEN
-			IF fd # 255 THEN
-				FOR i := 0 TO 3 DO
-					dst[i] := Clamp[200H + fd * ORD(dst[i]) DIV 255]
-				END
-			END
-		ELSIF fd = 0 THEN
-			IF fs = 255 THEN
-				dst := src
-			ELSE
-				FOR i := 0 TO 3 DO
-					dst[i] := Clamp[200H + fs * ORD(src[i]) DIV 255]
-				END
-			END
-		ELSE
-			dst[0] := Clamp[200H + (fs * ORD(src[0]) + fd * ORD(dst[0])) DIV 255];
-			dst[1] := Clamp[200H + (fs * ORD(src[1]) + fd * ORD(dst[1])) DIV 255];
-			dst[2] := Clamp[200H + (fs * ORD(src[2]) + fd * ORD(dst[2])) DIV 255];
-			dst[3] := Clamp[200H + (fs * ORD(src[3]) + fd * ORD(dst[3])) DIV 255]
-		END
-	END Blend;
-
-
-	(*--- General Transfer ---*)
-
-	PROCEDURE AnyBlendAny (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR spix, dpix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			spix := mode.col; dpix := mode.col;
-			mode.src.unpack(mode.src, sadr, sbit, spix);
-			mode.dst.unpack(mode.dst, dadr, dbit, dpix);
-			Blend(mode.op, spix, dpix);
-			mode.dst.pack(mode.dst, dadr, dbit, dpix);
-			sbit := sbit + mode.src.bpp; INC(sadr, sbit DIV 8); sbit := sbit MOD 8;
-			dbit := dbit + mode.dst.bpp; INC(dadr, dbit DIV 8); dbit := dbit MOD 8;
-			DEC(len)
-		END
-	END AnyBlendAny;
-
-
-	(* --- invert --- *)
-
-	PROCEDURE InvAny (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	BEGIN
-		WHILE len > 0 DO
-			mode.dst.unpack(mode.dst, dadr, dbit, mode.buf);
-			mode.buf[r]:=CHR(255-ORD(mode.buf[r]));
-			mode.buf[g]:=CHR(255-ORD(mode.buf[g]));
-			mode.buf[b]:=CHR(255-ORD(mode.buf[b]));
-			mode.dst.pack(mode.dst, dadr, dbit, mode.buf);
-			sbit := sbit + mode.src.bpp; INC(sadr, sbit DIV 8); sbit := sbit MOD 8;
-			dbit := dbit + mode.dst.bpp; INC(dadr, dbit DIV 8); dbit := dbit MOD 8;
-			DEC(len)
-		END
-	END InvAny;
-
-	(* --- alpha invert --- *)
-
-	PROCEDURE InvOverAny (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	VAR pix:Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			mode.src.unpack(mode.src, sadr, sbit, pix);
-			IF pix[a]>=80X THEN
-				mode.dst.unpack(mode.dst, dadr, dbit, mode.buf);
-				mode.buf[r]:=CHR(255-ORD(mode.buf[r]));
-				mode.buf[g]:=CHR(255-ORD(mode.buf[g]));
-				mode.buf[b]:=CHR(255-ORD(mode.buf[b]));
-				mode.dst.pack(mode.dst, dadr, dbit, mode.buf)
-			END;
-			sbit := sbit + mode.src.bpp; INC(sadr, sbit DIV 8); sbit := sbit MOD 8;
-			dbit := dbit + mode.dst.bpp; INC(dadr, dbit DIV 8); dbit := dbit MOD 8;
-			DEC(len)
-		END
-	END InvOverAny;
-
-	(*--- clear ---*)
-
-	PROCEDURE ClearAny (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR inc: LONGINT;
-	BEGIN
-		IF mode.dst.bpp MOD 8 = 0 THEN
-			inc := mode.dst.bpp DIV 8;
-			WHILE len > 0 DO
-				mode.dst.pack(mode.dst, dadr, 0, Zero);
-				INC(dadr, inc); DEC(len)
-			END
-		ELSE
-			WHILE len > 0 DO
-				mode.dst.pack(mode.dst, dadr, dbit, Zero);
-				dbit := dbit + mode.dst.bpp; INC(dadr, dbit DIV 8); dbit := dbit MOD 8;
-				DEC(len)
-			END
-		END
-	END ClearAny;
-
-	PROCEDURE Clear1 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR out: CHAR;
-	BEGIN
-		IF (dbit > 0) OR (len < 8) THEN
-			SYSTEM.GET(dadr, out);
-			WHILE (dbit < 8) & (len > 0) DO
-				out := Clr[ORD(out), dbit];
-				INC(dbit); DEC(len)
-			END;
-			SYSTEM.PUT(dadr, out)
-		END;
-		WHILE len >= 32 DO
-			SYSTEM.PUT(dadr, LONG(LONG(0))); INC(dadr, 4); DEC(len, 32)
-		END;
-		WHILE len >= 8 DO
-			SYSTEM.PUT(dadr, 0X); INC(dadr); DEC(len, 8)
-		END;
-		IF len > 0 THEN
-			SYSTEM.GET(dadr, out); dbit := 0;
-			REPEAT
-				out := Clr[ORD(out), dbit];
-				INC(dbit); DEC(len)
-			UNTIL len = 0;
-			SYSTEM.PUT(dadr, out)
-		END
-	END Clear1;
-	
-	(*
-	PROCEDURE ClearBytes (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	BEGIN
-		len := len * mode.dst.bpp DIV 8;
-		WHILE len >= 4 DO
-			SYSTEM.PUT(dadr, LONG(LONG(0))); INC(dadr, 4); DEC(len)
-		END;
-		WHILE len > 0 DO
-			SYSTEM.PUT(dadr, 0X); INC(dadr); DEC(len)
-		END
-	END ClearBytes;
-	*)
-
-	PROCEDURE ClearBytes(VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	CODE
-		LDR R0, [FP, #dadr]
-		LDR R1, [FP, #len]
-		MOV R2, #0
-	loop:
-		CMP R1, #0
-		BLE end ; exit if len <= 0
-		
-		STRB R2, [R0, #0]
-		ADD R0, R0, #1 ; INC(dadr);
-		SUB R1, R1, #1 ; DEC(len);
-		B loop
-	end:
-	END ClearBytes;
-	
-	(* len is nr of DWords*)
-	PROCEDURE Clear32(VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	CODE
-		LDR R0, [FP, #dadr]
-		LDR R1, [FP, #len]
-		MOV R2, #0
-	loop:
-		CMP R1, #0
-		BLE end ; exit if len <= 0
-		
-		STR R2, [R0, #0]
-		ADD R0, R0, #4 ; INC(dadr,4);
-		SUB R1, R1, #1 ; DEC(len);
-		B loop
-	end:
-	END Clear32;
-	
-	(*---- fill --------------*)
-	PROCEDURE Fill8(destAdr: ADDRESS; size: SIZE; filler: LONGINT);
-	CODE
-		LDR R0, [FP, #destAdr]
-		LDR R1, [FP, #size]
-		LDR R2, [FP, #filler]
-	loop:
-		CMP R1, #0
-		BEQ end ; exit if size = 0
-		
-		STRB R2, [R0, #0]
-		ADD R0, R0, #1 ; INC(destAdr);
-		SUB R1, R1, #1 ; DEC(size);
-		B loop
-	end:
-	END Fill8;
-	
-	(* size in 16bit words*)
-	PROCEDURE Fill16(destAdr: ADDRESS; size: SIZE; filler: LONGINT);
-	CODE
-		LDR R0, [FP, #destAdr]
-		LDR R1, [FP, #size]
-		LDR R2, [FP, #filler]
-	loop:
-		CMP R1, #0
-		BEQ end ; exit if size = 0
-		
-		STRH R2, [R0, #0]
-		ADD R0, R0, #2 ; INC(destAdr,2);
-		SUB R1, R1, #1 ; DEC(size);
-		B loop
-	end:
-	END Fill16;
-	
-	(* size in 24bit entities*)
-	PROCEDURE Fill24(destAdr: ADDRESS; size: SIZE; filler: LONGINT);
-	CODE
-		LDR R0, [FP, #destAdr]
-		LDR R1, [FP, #size]
-		LDR R2, [FP, #filler]
-		LSR R4, R2, #8
-		LSR R5, R2, #16
-	loop:
-		CMP R1, #0
-		BEQ end ; exit if size = 0
-		
-		STRB R2, [R0, #0]
-		STRB R4, [R0, #1]
-		STRB R5, [R0, #2]
-		ADD R0, R0, #3 ; INC(destAdr,3);
-		SUB R1, R1, #1 ; DEC(size);
-		B loop
-	end:
-	END Fill24;
-	
-	(* size in DWords*)
-	PROCEDURE Fill32(destAdr: ADDRESS; size: SIZE; filler: LONGINT); (*! to do: change interface, introduce in Blend()*)
-	CODE
-		LDR R0, [FP, #destAdr]
-		LDR R1, [FP, #size]
-		LDR R2, [FP, #filler]
-	loop:
-		CMP R1, #0
-		BEQ end ; exit if size = 0
-		
-		STR R2, [R0, #0]
-		ADD R0, R0, #4 ; INC(destAdr,4);
-		SUB R1, R1, #1 ; DEC(size);
-		B loop
-	end:
-	END Fill32;
-
-	(* len in DWords*)
-	PROCEDURE Fill32A(VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT); (*! to do: change interface, introduce in Blend()*)
-	CODE
-		LDR R0, [FP, #dadr]
-		LDR R1, [FP, #len]
-		LDR R2, [FP, #sadr]
-		LDR R2, [R2, #0]
-	loop:
-		CMP R1, #0
-		BEQ end ; exit if size = 0
-		
-		STR R2, [R0, #0]
-		ADD R0, R0, #4 ; INC(destAdr,4);
-		SUB R1, R1, #1 ; DEC(size);
-		B loop
-	end:
-	END Fill32A;
-
-	(*--- srcCopy Transfer ---*)
-
-	(* constant values *)
-	PROCEDURE Set1 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR out: CHAR;
-	BEGIN
-		IF (dbit > 0) OR (len < 8) THEN
-			SYSTEM.GET(dadr, out);
-			WHILE (dbit < 8) & (len > 0) DO
-				out := Set[ORD(out), dbit];
-				INC(dbit); DEC(len)
-			END;
-			SYSTEM.PUT(dadr, out)
-		END;
-		WHILE len >= 8 DO
-			SYSTEM.PUT(dadr, 0FFX);
-			INC(dadr); DEC(len, 8)
-		END;
-		IF len > 0 THEN
-			SYSTEM.GET(dadr, out); dbit := 0;
-			REPEAT
-				out := Set[ORD(out), dbit];
-				INC(dbit); DEC(len)
-			UNTIL len = 0;
-			SYSTEM.PUT(dadr, out)
-		END
-	END Set1;
-
-	PROCEDURE ConstCopy8 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	BEGIN
-		Fill8(dadr, len, ORD(mode.buf[0]))
-		(*WHILE len > 0 DO	SYSTEM.PUT(dadr, mode.buf[0]); INC(dadr); DEC(len) END*)
-	END ConstCopy8;
-
-	PROCEDURE ConstCopy16 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	BEGIN
-		Fill16(dadr, len, ORD(mode.buf[0])+ASH(ORD(mode.buf[1]),8))
-		(*WHILE len > 0 DO SYSTEM.MOVE(ADDRESSOF(mode.buf[0]), dadr, 2); INC(dadr, 2); DEC(len) END*)
-	END ConstCopy16;
-
-	PROCEDURE ConstCopy24 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	BEGIN
-		Fill24(dadr, len, ORD(mode.buf[0])+ASH(ORD(mode.buf[1]),8)+ASH(ORD(mode.buf[2]),16));
-		(*WHILE len > 0 DO	SYSTEM.MOVE(ADDRESSOF(mode.buf[0]), dadr, 3); INC(dadr, 3); DEC(len) END*)
-	END ConstCopy24;
-
-	(* identical formats *)
-	PROCEDURE Copy1 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR in, out: CHAR;
-	BEGIN
-		SYSTEM.GET(sadr, in);
-		WHILE (sbit = 0) & (dbit = 0) & (len >= 8) DO
-			SYSTEM.PUT(dadr, in);
-			INC(sadr); INC(dadr); DEC(len, 8);
-			SYSTEM.GET(sadr, in)
-		END;
-		IF (dbit > 0) OR (len < 8) THEN
-			SYSTEM.GET(dadr, out)
-		END;
-		WHILE len > 0 DO
-			IF Bit[ORD(in), sbit] THEN out := Set[ORD(out), dbit]
-			ELSE out := Clr[ORD(out), dbit]
-			END;
-			INC(sbit); INC(dbit); DEC(len);
-			IF sbit = 8 THEN
-				INC(sadr); sbit := 0;
-				SYSTEM.GET(sadr, in)
-			END;
-			IF dbit = 8 THEN
-				SYSTEM.PUT(dadr, out);
-				INC(dadr); dbit := 0;
-				IF len < 8 THEN
-					SYSTEM.GET(dadr, out)
-				END
-			END
-		END;
-		IF dbit > 0 THEN
-			SYSTEM.PUT(dadr, out)
-		END
-	END Copy1;
-
-	PROCEDURE Copy8 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	BEGIN
-		SYSTEM.MOVE(sadr, dadr, len)
-	END Copy8;
-
-	PROCEDURE I8CopyI8 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR byte: CHAR;
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.GET(sadr, byte); SYSTEM.PUT(dadr, mode.map[ORD(byte)]);
-			INC(sadr); INC(dadr); DEC(len)
-		END
-	END I8CopyI8;
-
-	PROCEDURE Copy16 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	BEGIN
-		SYSTEM.MOVE(sadr, dadr, 2*len)
-	END Copy16;
-
-	PROCEDURE I16CopyI16 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR val: INTEGER;
-	BEGIN
-		WHILE len > 0 DO
-			val:=SYSTEM.GET16(sadr); SYSTEM.PUT16(dadr, mode.map[val MOD 10000H]);
-			INC(sadr); INC(dadr); DEC(len)
-		END
-	END I16CopyI16;
-
-
-	PROCEDURE Copy24 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	BEGIN
-		SYSTEM.MOVE(sadr, dadr, 3*len)
-	END Copy24;
-
-	PROCEDURE Copy32(VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	CODE
-		LDR R0, [FP, #dadr]
-		LDR R1, [FP, #len]
-		LDR R2, [FP, #sadr]
-	loop:
-		CMP R1, #0
-		BLE end ; exit if len <= 0
-		
-		LDR R4, [R2, #0] ; R4 := src
-		STR R4, [R0, #0] ; dst := src
-		ADD R0, R0, #4 ; INC(dadr,4);
-		ADD R2, R2, #4 ; INC(sadr,4);
-		SUB R1, R1, #1 ; DEC(len);
-		B loop
-	end:
-	(*BEGIN
-		SYSTEM.MOVE(sadr, dadr, 4*len)*)
-	END Copy32;
-
-	(* general methods *)
-	PROCEDURE AnyCopyAny (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			pix := mode.buf;
-			mode.src.unpack(mode.src, sadr, sbit, mode.buf);
-			mode.dst.pack(mode.dst, dadr, dbit, mode.buf);
-			sbit := sbit + mode.src.bpp; INC(sadr, sbit DIV 8); sbit := sbit MOD 8;
-			dbit := dbit + mode.dst.bpp; INC(dadr, dbit DIV 8); dbit := dbit MOD 8;
-			DEC(len)
-		END
-	END AnyCopyAny;
-
-	PROCEDURE AnyBytesCopyAnyBytes (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR sinc, dinc: LONGINT; pix: Pixel;
-	BEGIN
-		sinc := mode.src.bpp DIV 8; dinc := mode.dst.bpp DIV 8;
-		WHILE len > 0 DO
-			pix := mode.buf;
-			mode.src.unpack(mode.src, sadr, sbit, mode.buf);
-			mode.dst.pack(mode.dst, dadr, dbit, mode.buf);
-			INC(sadr, sinc); INC(dadr, dinc); DEC(len)
-		END
-	END AnyBytesCopyAnyBytes;
-
-
-	(* A1 *)
-	PROCEDURE AnyCopyA1 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR out: CHAR; pix: Pixel;
-	BEGIN
-		SYSTEM.GET(dadr, out); pix[a] := 0FFX;
-		WHILE len > 0 DO
-			mode.src.unpack(mode.src, sadr, sbit, pix);
-			sbit := sbit + mode.src.bpp; INC(sadr, sbit MOD 8); sbit := sbit MOD 8;
-			IF pix[a] >= 80X THEN out := Set[ORD(out), dbit]
-			ELSE out := Clr[ORD(out), dbit]
-			END;
-			INC(dbit); DEC(len);
-			IF dbit = 8 THEN
-				SYSTEM.PUT(dadr, out); INC(dadr); SYSTEM.GET(dadr, out); dbit := 0
-			END
-		END;
-		SYSTEM.PUT(dadr, out)
-	END AnyCopyA1;
-
-	PROCEDURE A8CopyA1 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR out, in: CHAR;
-	BEGIN
-		IF (dbit > 0) OR (len < 8) THEN
-			SYSTEM.GET(dadr, out)
-		END;
-		WHILE len > 0 DO
-			SYSTEM.GET(sadr, in);
-			IF in >= 80X THEN out := Set[ORD(out), dbit]
-			ELSE out := Clr[ORD(out), dbit]
-			END;
-			INC(sadr); INC(dbit); DEC(len);
-			IF dbit = 8 THEN
-				SYSTEM.PUT(dadr, out);
-				INC(dadr); dbit := 0;
-				IF len < 8 THEN
-					SYSTEM.GET(dadr, out)
-				END
-			END
-		END;
-		IF dbit > 0 THEN
-			SYSTEM.PUT(dadr, out)
-		END
-	END A8CopyA1;
-
-	PROCEDURE BGRA8888CopyA1 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR out, in: CHAR;
-	BEGIN
-		INC(sadr, a);	(* only look at alpha component *)
-		IF (dbit > 0) OR (len < 8) THEN
-			SYSTEM.GET(dadr, out)
-		END;
-		WHILE len > 0 DO
-			SYSTEM.GET(sadr, in);
-			IF in >= 80X THEN out := Set[ORD(out), dbit]
-			ELSE out := Clr[ORD(out), dbit]
-			END;
-			INC(sadr, 4); INC(dbit); DEC(len);
-			IF dbit = 8 THEN
-				SYSTEM.PUT(dadr, out);
-				INC(dadr); dbit := 0;
-				IF len < 8 THEN
-					SYSTEM.GET(dadr, out)
-				END
-			END
-		END;
-		IF dbit > 0 THEN
-			SYSTEM.PUT(dadr, out)
-		END
-	END BGRA8888CopyA1;
-
-	PROCEDURE A1CopyAny (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR in: CHAR;
-	BEGIN
-		SYSTEM.GET(sadr, in);
-		WHILE len > 0 DO
-			IF Bit[ORD(in), sbit] THEN mode.dst.pack(mode.dst, dadr, dbit, mode.buf)
-			ELSE mode.dst.pack(mode.dst, dadr, dbit, Zero)
-			END;
-			INC(sbit); dbit := dbit + mode.dst.bpp; INC(dadr, dbit DIV 8); dbit := dbit MOD 8; DEC(len);
-			IF sbit = 8 THEN
-				INC(sadr); sbit := 0;
-				SYSTEM.GET(sadr, in)
-			END
-		END
-	END A1CopyAny;
-
-	PROCEDURE A1CopyA8 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR in: CHAR;
-	BEGIN
-		SYSTEM.GET(sadr, in);
-		WHILE len > 0 DO
-			IF Bit[ORD(in), sbit] THEN SYSTEM.PUT(dadr, 0FFX)
-			ELSE SYSTEM.PUT(dadr, 0X)
-			END;
-			INC(sbit); INC(dadr); DEC(len);
-			IF sbit = 8 THEN
-				INC(sadr); sbit := 0;
-				SYSTEM.GET(sadr, in)
-			END
-		END
-	END A1CopyA8;
-
-	PROCEDURE A1CopyBGRA8888 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel; in: CHAR;
-	BEGIN
-		pix := mode.buf;
-		SYSTEM.GET(sadr, in);
-		WHILE len > 0 DO
-			IF Bit[ORD(in), sbit] THEN pix[a] := 0FFX
-			ELSE pix[a] := 0X
-			END;
-			SYSTEM.MOVE(ADDRESSOF(pix), dadr, 4);
-			INC(sbit); INC(dadr, 4); DEC(len);
-			IF sbit = 8 THEN
-				INC(sadr); sbit := 0;
-				SYSTEM.GET(sadr, in)
-			END
-		END
-	END A1CopyBGRA8888;
-
-
-	(* A8 *)
-	PROCEDURE AnyCopyA8 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		pix[a] := 0FFX;
-		WHILE len > 0 DO
-			mode.src.unpack(mode.src, sadr, sbit, pix);
-			SYSTEM.PUT(dadr, pix[a]);
-			INC(dadr); sbit := sbit + mode.src.bpp; INC(sadr, sbit DIV 8); sbit := sbit MOD 8; DEC(len)
-		END
-	END AnyCopyA8;
-
-	PROCEDURE BGRA8888CopyA8 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR byte: CHAR;
-	BEGIN
-		INC(sadr, 3);
-		WHILE len > 0 DO
-			SYSTEM.GET(sadr, byte);
-			SYSTEM.PUT(dadr, byte);
-			INC(sadr, 4); INC(dadr); DEC(len)
-		END
-	END BGRA8888CopyA8;
-
-	PROCEDURE A8CopyBGRA8888 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		pix := mode.buf;
-		WHILE len > 0 DO
-			SYSTEM.GET(sadr, pix[a]);
-			SYSTEM.MOVE(ADDRESSOF(pix), dadr, 4);
-			INC(sadr); INC(dadr, 4); DEC(len)
-		END
-	END A8CopyBGRA8888;
-
-
-	(* P8 *)
-	PROCEDURE AnyCopyP8 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			pix := mode.buf;
-			mode.src.unpack(mode.src, sadr, sbit, pix);
-			SYSTEM.PUT(dadr, CHR(CLUTs.Match(mode.dst.pal.clut, ORD(pix[b]) + ASH(ORD(pix[g]), 8) + ASH(ORD(pix[r]), 16))));
-			INC(dadr); sbit := sbit + mode.src.bpp; INC(sadr, sbit DIV 8); sbit := sbit MOD 8; DEC(len)
-		END
-	END AnyCopyP8;
-
-	PROCEDURE Any16CopyP8 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			mode.src.unpack(mode.src, sadr, 0, pix);
-			SYSTEM.PUT(dadr, CHR(CLUTs.Match(mode.dst.pal.clut, ORD(pix[b]) + ASH(ORD(pix[g]), 8) + ASH(ORD(pix[r]), 16))));
-			INC(sadr, 2); INC(dadr); DEC(len)
-		END
-	END Any16CopyP8;
-
-	PROCEDURE BGR888CopyP8 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.MOVE(sadr, ADDRESSOF(pix[0]), 3);
-			SYSTEM.PUT(dadr, CHR(CLUTs.Match(mode.dst.pal.clut, ORD(pix[b]) + ASH(ORD(pix[g]), 8) + ASH(ORD(pix[r]), 16))));
-			INC(sadr, 3); INC(dadr); DEC(len)
-		END
-	END BGR888CopyP8;
-
-	PROCEDURE BGRA8888CopyP8 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.MOVE(sadr, ADDRESSOF(pix[0]), 4);
-			SYSTEM.PUT(dadr, CHR(CLUTs.Match(mode.dst.pal.clut, ORD(pix[b]) + ASH(ORD(pix[g]), 8) + ASH(ORD(pix[r]), 16))));
-			INC(sadr, 4); INC(dadr); DEC(len)
-		END
-	END BGRA8888CopyP8;
-
-	PROCEDURE P8CopyAny (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR b: CHAR;
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.GET(sadr, b);
-			mode.dst.pack(mode.dst, dadr, dbit, mode.src.pal.col[ORD(b)]);
-			INC(sadr); dbit := dbit + mode.dst.bpp; INC(dadr, dbit DIV 8); dbit := dbit MOD 8; DEC(len)
-		END
-	END P8CopyAny;
-
-	PROCEDURE P8CopyAny16 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR b: CHAR;
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.GET(sadr, b);
-			mode.dst.pack(mode.dst, dadr, 0, mode.src.pal.col[ORD(b)]);
-			INC(sadr); INC(dadr, 2); DEC(len)
-		END
-	END P8CopyAny16;
-
-	PROCEDURE P8CopyBGR888 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR b: CHAR;
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.GET(sadr, b);
-			SYSTEM.MOVE(ADDRESSOF(mode.src.pal.col[ORD(b)]), dadr, 3);
-			INC(sadr); INC(dadr, 3); DEC(len)
-		END
-	END P8CopyBGR888;
-
-	PROCEDURE P8CopyBGRA8888 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR b: CHAR;
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.GET(sadr, b);
-			SYSTEM.MOVE(ADDRESSOF(mode.src.pal.col[ORD(b)]), dadr, 4);
-			INC(sadr); INC(dadr, 4); DEC(len)
-		END
-	END P8CopyBGRA8888;
-
-
-	(* D8 *)
-	PROCEDURE AnyCopyD8 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			pix := mode.buf;
-			mode.src.unpack(mode.src, sadr, sbit, pix);
-			SYSTEM.PUT(dadr, CHR(ColorToIndex(ORD(pix[b]) + ASH(ORD(pix[g]), 8) + ASH(ORD(pix[r]), 16))));
-			INC(dadr); sbit := sbit + mode.src.bpp; INC(sadr, sbit DIV 8); sbit := sbit MOD 8; DEC(len)
-		END
-	END AnyCopyD8;
-
-	PROCEDURE Any16CopyD8 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			mode.src.unpack(mode.src, sadr, 0, pix);
-			SYSTEM.PUT(dadr, CHR(ColorToIndex(ORD(pix[b]) + ASH(ORD(pix[g]), 8) + ASH(ORD(pix[r]), 16))));
-			INC(sadr, 2); INC(dadr); DEC(len)
-		END
-	END Any16CopyD8;
-
-	PROCEDURE BGR888CopyD8 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.MOVE(sadr, ADDRESSOF(pix[0]), 3);
-			SYSTEM.PUT(dadr, CHR(ColorToIndex(ORD(pix[b]) + ASH(ORD(pix[g]), 8) + ASH(ORD(pix[r]), 16))));
-			INC(sadr, 3); INC(dadr); DEC(len)
-		END
-	END BGR888CopyD8;
-
-	PROCEDURE BGRA8888CopyD8 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.MOVE(sadr, ADDRESSOF(pix[0]), 4);
-			SYSTEM.PUT(dadr, CHR(ColorToIndex(ORD(pix[b]) + ASH(ORD(pix[g]), 8) + ASH(ORD(pix[r]), 16))));
-			INC(sadr, 4); INC(dadr); DEC(len)
-		END
-	END BGRA8888CopyD8;
-
-	PROCEDURE D8CopyAny (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel; byte: CHAR; col: LONGINT;
-	BEGIN
-		pix[a] := 0FFX;
-		WHILE len > 0 DO
-			SYSTEM.GET(sadr, byte); col := IndexToColor(ORD(byte));
-			pix[b] := CHR(col MOD 100H); pix[g] := CHR(ASH(col, -8) MOD 100H); pix[r] := CHR(ASH(col, -16) MOD 100H);
-			mode.dst.pack(mode.dst, dadr, dbit, pix);
-			INC(sadr); dbit := dbit + mode.dst.bpp; INC(dadr, dbit DIV 8); dbit := dbit MOD 8; DEC(len)
-		END
-	END D8CopyAny;
-
-	PROCEDURE D8CopyAny16 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel; byte: CHAR; col: LONGINT;
-	BEGIN
-		pix[a] := 0FFX;
-		WHILE len > 0 DO
-			SYSTEM.GET(sadr, byte); col := IndexToColor(ORD(byte));
-			pix[b] := CHR(col MOD 100H); pix[g] := CHR(ASH(col, -8) MOD 100H); pix[r] := CHR(ASH(col, -16) MOD 100H);
-			mode.dst.pack(mode.dst, dadr, 0, pix);
-			INC(sadr); INC(dadr, 2); DEC(len)
-		END
-	END D8CopyAny16;
-
-	PROCEDURE D8CopyBGR888 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR byte: CHAR; col: LONGINT; pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.GET(sadr, byte); col := IndexToColor(ORD(byte));
-			pix[b] := CHR(col MOD 100H); pix[g] := CHR(ASH(col, -8) MOD 100H); pix[r] := CHR(ASH(col, -16) MOD 100H);
-			SYSTEM.MOVE(ADDRESSOF(pix[0]), dadr, 3);
-			INC(sadr); INC(dadr, 3); DEC(len)
-		END
-	END D8CopyBGR888;
-
-	PROCEDURE D8CopyBGRA8888 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel; byte: CHAR; col: LONGINT;
-	BEGIN
-		pix[a] := 0FFX;
-		WHILE len > 0 DO
-			SYSTEM.GET(sadr, byte); col := IndexToColor(ORD(byte));
-			pix[b] := CHR(col MOD 100H); pix[g] := CHR(ASH(col, -8) MOD 100H); pix[r] := CHR(ASH(col, -16) MOD 100H);
-			SYSTEM.MOVE(ADDRESSOF(pix[0]), dadr, 4);
-			INC(sadr); INC(dadr, 4); DEC(len)
-		END
-	END D8CopyBGRA8888;
-
-	(*
-	(* P816*)
-	PROCEDURE AnyCopyP16 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			pix := mode.buf;
-			mode.src.unpack(mode.src, sadr, sbit, pix);
-			SYSTEM.PUT16(dadr, PaletteIndex(mode.dst.pal, ORD(pix[r]), ORD(pix[g]), ORD(pix[b])));
-			INC(dadr,2); sbit := sbit + mode.src.bpp; INC(sadr, sbit DIV 8); sbit := sbit MOD 8; DEC(len)
-		END
-	END AnyCopyP16;
-
-	PROCEDURE Any16CopyP16 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			mode.src.unpack(mode.src, sadr, 0, pix);
-			SYSTEM.PUT16(dadr, PaletteIndex(mode.dst.pal, ORD(pix[r]), ORD(pix[g]), ORD(pix[b])));
-			INC(sadr, 2); INC(dadr,2); DEC(len)
-		END
-	END Any16CopyP16;
-
-	PROCEDURE BGR888CopyP16 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.MOVE(sadr, ADDRESSOF(pix[0]), 3);
-			SYSTEM.PUT16(dadr, PaletteIndex(mode.dst.pal, ORD(pix[r]), ORD(pix[g]), ORD(pix[b])));
-			INC(sadr, 3); INC(dadr,2); DEC(len)
-		END
-	END BGR888CopyP16;
-
-	PROCEDURE BGRA8888CopyP16 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.MOVE(sadr, ADDRESSOF(pix[0]), 4);
-			SYSTEM.PUT16(dadr, PaletteIndex(mode.dst.pal, ORD(pix[r]), ORD(pix[g]), ORD(pix[b])));
-			INC(sadr, 4); INC(dadr,2); DEC(len)
-		END
-	END BGRA8888CopyP16;
-
-	PROCEDURE P16CopyAny (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	BEGIN
-		WHILE len > 0 DO
-			mode.dst.pack(mode.dst, dadr, dbit, mode.src.pal.col[LONG(SYSTEM.GET16(sadr)) MOD 10000H]);
-			INC(sadr,2); dbit := dbit + mode.dst.bpp; INC(dadr, dbit DIV 8); dbit := dbit MOD 8; DEC(len)
-		END
-	END P16CopyAny;
-
-	PROCEDURE P16CopyAny16 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	BEGIN
-		WHILE len > 0 DO
-			mode.dst.pack(mode.dst, dadr, 0, mode.src.pal.col[LONG(SYSTEM.GET16(sadr)) MOD 10000H]);
-			INC(sadr,2); INC(dadr, 2); DEC(len)
-		END
-	END P16CopyAny16;
-	*)
-
-	PROCEDURE P16CopyBGR888 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.MOVE(ADDRESSOF(mode.src.pal.col[LONG(SYSTEM.GET16(sadr)) MOD 10000H]), dadr, 3);
-			INC(sadr,2); INC(dadr, 3); DEC(len)
-		END
-	END P16CopyBGR888;
-
-	PROCEDURE P16CopyBGRA8888 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	VAR val:LONGINT;
-	BEGIN
-		WHILE len > 0 DO
-			val:=LONG(SYSTEM.GET16(sadr)) MOD 10000H;
-			SYSTEM.MOVE(ADDRESSOF(mode.src.pal.col[val]), dadr, 4);
-			INC(sadr,2); INC(dadr, 4); DEC(len)
-		END
-	END P16CopyBGRA8888;
-
-
-
-	(* BGR555, BGR565, BGR466 *)
-	PROCEDURE AnyCopyAny16 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			pix := mode.buf;
-			mode.src.unpack(mode.src, sadr, 0, pix);
-			mode.dst.pack(mode.dst, dadr, 0, pix);
-			INC(dadr, 2); sbit := sbit + mode.src.bpp; INC(sadr, sbit DIV 8); sbit := sbit MOD 8; DEC(len)
-		END
-	END AnyCopyAny16;
-
-	PROCEDURE Any16CopyAny16 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			mode.src.unpack(mode.src, sadr, 0, pix);
-			mode.dst.pack(mode.dst, dadr, 0, pix);
-			INC(sadr, 2); INC(dadr, 2); DEC(len)
-		END
-	END Any16CopyAny16;
-
-	PROCEDURE BGR888CopyAny16 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		pix[a] := 0FFX;
-		WHILE len > 0 DO
-			SYSTEM.MOVE(sadr, ADDRESSOF(pix[0]), 3);
-			mode.dst.pack(mode.dst, dadr, 0, pix);
-			INC(sadr, 3); INC(dadr, 2); DEC(len)
-		END
-	END BGR888CopyAny16;
-
-	PROCEDURE BGRA8888CopyAny16 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.MOVE(sadr, ADDRESSOF(pix[0]), 4);
-			mode.dst.pack(mode.dst, dadr, 0, pix);
-			INC(dadr, 2); sbit := sbit + mode.src.bpp; INC(sadr, sbit DIV 8); sbit := sbit MOD 8; DEC(len)
-		END
-	END BGRA8888CopyAny16;
-
-	PROCEDURE Any16CopyAny (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			mode.src.unpack(mode.src, sadr, 0, pix);
-			mode.dst.pack(mode.dst, dadr, 0, pix);
-			INC(sadr, 2); dbit := dbit + mode.dst.bpp; INC(dadr, dbit DIV 8); dbit := dbit MOD 8; DEC(len)
-		END
-	END Any16CopyAny;
-
-	PROCEDURE Any16CopyBGR888 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			mode.src.unpack(mode.src, sadr, 0, pix);
-			SYSTEM.MOVE(ADDRESSOF(pix[0]), dadr, 3);
-			INC(sadr, 2); INC(dadr, 3); DEC(len)
-		END
-	END Any16CopyBGR888;
-
-	PROCEDURE Any16CopyBGRA8888 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			mode.src.unpack(mode.src, sadr, 0, pix);
-			SYSTEM.MOVE(ADDRESSOF(pix[0]), dadr, 4);
-			INC(sadr, 2); INC(dadr, 4); DEC(len)
-		END
-	END Any16CopyBGRA8888;
-
-
-	(* BGR888 *)
-	PROCEDURE AnyCopyBGR888 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			pix := mode.buf;
-			mode.src.unpack(mode.src, sadr, sbit, pix);
-			SYSTEM.MOVE(ADDRESSOF(pix[0]), dadr, 3);
-			INC(dadr, 3); sbit := sbit + mode.src.bpp; INC(sadr, sbit DIV 8); sbit := sbit MOD 8; DEC(len)
-		END
-	END AnyCopyBGR888;
-
-	PROCEDURE BGRA8888CopyBGR888 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.MOVE(sadr, dadr, 3);
-			INC(sadr, 4); INC(dadr, 3); DEC(len)
-		END
-	END BGRA8888CopyBGR888;
-
-	(*PROCEDURE SSE2BGRA8888CopyBGR888 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	CODE {SYSTEM.i386, SYSTEM.MMX, SYSTEM.SSE, SYSTEM.SSE2, SYSTEM.Pentium}
-		PUSHFD
-		PUSH 		EBX
-		; CLI
-
-		MOV		ESI, [EBP+sadr]	; source adr
-		MOV 		EDI, [EBP+dadr]  ; source adr
-
-		MOV		ECX, [EBP+len]
-
-	loop:
-		CMP		ECX, 0
-		JLE			end
-   		CMP 		ECX, 4
-		 JL			singlepixel
-
-	fourpixel:
-		; 4pixels at the time
-		MOV 		EAX,      [ESI] ; pixel 0
-		MOV 		EBX,    [ESI+4] ; pixel 1
-
-		AND 		EAX, 0FFFFFFH
-		AND 		EBX, 0FFFFFFH
-		MOV 		EDX, EBX
-		SHL			EDX, 24
-		OR			EAX, EDX ; 1000
-		MOV		[EDI], EAX ; write back to mem
-
-		MOV 		EAX,    [ESI+8] ; pixel 2
-		AND 		EAX, 0FFFFFFH
-		SHR		EBX,8
-		MOV		EDX, EAX
-		SHL			EDX, 16
-		OR			EBX, EDX ; 2211
-		MOV		[EDI+4], EBX
-
-		MOV 		EDX, [ESI+12] ; pixel 3
-		SHL			EDX, 8
-		SHR		EAX, 16
-		OR			EAX, EDX ; 3332
-
-		MOV		[EDI], EAX
-
-		ADD 		ESI, 16
-		ADD 		EDI, 12
-		SUB 		ECX, 4
-		JG			loop
-		JMP 		end
-
-	singlepixel:
-		MOV 		EAX, [ESI]
-
-		MOV		[EDI], AX
-		SHR		EAX, 16
-		MOV		[EDI+2], AL
-
-		ADD 		ESI, 4
-		ADD		EDI, 3
-		SUB 		ECX, 1
-		JG			loop
-
-	end:
-		EMMS ; declare FPU registers free
-		POP 		EBX
-		POPFD
-	END SSE2BGRA8888CopyBGR888;*)
-
-	PROCEDURE BGR888CopyAny (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		pix[a] := 0FFX;
-		WHILE len > 0 DO
-			SYSTEM.MOVE(sadr, ADDRESSOF(pix[0]), 3);
-			mode.dst.pack(mode.dst, dadr, dbit, pix);
-			INC(sadr, 3); dbit := dbit + mode.dst.bpp; INC(dadr, dbit DIV 8); dbit := dbit MOD 8; DEC(len)
-		END
-	END BGR888CopyAny;
-
-	PROCEDURE BGR888CopyBGRA8888(VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.MOVE(sadr, dadr, 3); SYSTEM.PUT(dadr+3, 0FFX);
-			INC(sadr, 3); INC(dadr, 4); DEC(len)
-		END
-
-	END BGR888CopyBGRA8888;
-
-(*	PROCEDURE SSE2BGR888CopyBGRA8888(VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	CODE {SYSTEM.i386, SYSTEM.MMX, SYSTEM.SSE, SYSTEM.SSE2,SYSTEM.Pentium}
-		PUSHFD
-		PUSH 		EBX
-		; CLI
-
-		PXOR 		XMM0, XMM0
-
-		MOV 		EAX, 0FF00H
-		PINSRW 	XMM0, EAX, 1
-		PINSRW 	XMM0, EAX, 3
-		PINSRW 	XMM0, EAX, 5
-		PINSRW 	XMM0, EAX, 7 ; prepare for fourpixel
-
-		SHL 		EAX, 16 ; prepare for singlepixel
-
-		MOV		ESI, [EBP+sadr]	; source adr
-		MOV 		EDI, [EBP+dadr]  ; source adr
-
-		MOV		ECX, [EBP+len]
-
-	loop:
-		CMP		ECX, 0
-		JLE			end
-   		CMP 		ECX, 4
-		 JL			singlepixel
-
-	fourpixel:
-	; 4pixels at the time
-		PXOR 		XMM2,XMM2
-		PXOR 		XMM1,XMM1
-
-		MOV		EBX, [ESI+9] ; read 1st source pixel
-		MOVD 		XMM2, EBX
-
-		PSLLDQ		XMM2, 4
-		MOV		EBX, [ESI+6] ; read 2nd source pixel
-		MOVD 		XMM1, EBX
-		POR 		XMM2, XMM1
-
-		PSLLDQ		XMM2, 4
-		MOV		EBX, [ESI+3] ; read 3rd source pixel
-		MOVD 		XMM1, EBX
-		POR 		XMM2, XMM1
-
-		PSLLDQ		XMM2, 4
-		MOV		EBX, [ESI] ; read 4th source pixel
-		MOVD 		XMM1, EBX
-		POR 		XMM2, XMM1
-		ADD 		ESI, 12
-
-		POR 		XMM2, XMM0
-
-		MOVDQU 	[EDI], XMM2 ; set the pixels
-		ADD		EDI, 16	; inc adr
-		SUB 		ECX, 4
-		JG			loop
-		JMP 		end
-
-	singlepixel:
-		MOV		EBX, [ESI] ; read source pixel
-		OR 			EBX, EAX
-		ADD 		ESI, 3
-		MOV 		[EDI], EBX
-
-		ADD		EDI, 4	; inc adr
-		SUB 		ECX, 1
-		JG			loop
-	end:
-		EMMS ; declare FPU registers free
-		POP 		EBX
-		POPFD
-	END SSE2BGR888CopyBGRA8888;*)
-
-	(* BGRA8888 *)
-	PROCEDURE AnyCopyBGRA8888 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			pix := mode.buf;
-			mode.src.unpack(mode.src, sadr, sbit, pix);
-			SYSTEM.MOVE(ADDRESSOF(pix[0]), dadr, 4);
-			INC(dadr, 4); sbit := sbit + mode.src.bpp; INC(sadr, sbit DIV 8); sbit := sbit MOD 8; DEC(len)
-		END
-	END AnyCopyBGRA8888;
-
-	PROCEDURE BGRA8888CopyAny (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.MOVE(sadr, ADDRESSOF(pix[0]), 4);
-			mode.dst.pack(mode.dst, dadr, dbit, pix);
-			INC(sadr, 4); dbit := dbit + mode.dst.bpp; INC(dadr, dbit DIV 8); dbit := dbit MOD 8; DEC(len)
-		END
-	END BGRA8888CopyAny;
-
-
-	(*--- dstCopy Transfer ---*)
-
-	PROCEDURE EmptyTransfer (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	END EmptyTransfer;
-
-
-	(*--- srcOverDst Transfer ---*)
-
-	(* A1 *)
-	PROCEDURE AnyOverA1 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR out: CHAR; pix: Pixel;
-	BEGIN
-		SYSTEM.GET(dadr, out);
-		WHILE len > 0 DO
-			mode.src.unpack(mode.src, sadr, sbit, pix);
-			IF pix[a] >= 80X THEN
-				out := Set[ORD(out), dbit]
-			END;
-			sbit := sbit + mode.src.bpp; INC(sadr, sbit DIV 8); sbit := sbit MOD 8; INC(dbit); DEC(len);
-			IF dbit = 8 THEN
-				SYSTEM.PUT(dadr, out);
-				INC(dadr); dbit := 0;
-				SYSTEM.GET(dadr, out)
-			END
-		END;
-		SYSTEM.PUT(dadr, out)
-	END AnyOverA1;
-
-	PROCEDURE A1OverA1 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR in, out: CHAR;
-	BEGIN
-		SYSTEM.GET(sadr, in); SYSTEM.GET(dadr, out);
-		WHILE len > 0 DO
-			IF Bit[ORD(in), sbit] THEN
-				out := Set[ORD(out), dbit]
-			END;
-			INC(sbit); INC(dbit); DEC(len);
-			IF sbit = 8 THEN
-				INC(sadr); sbit := 0;
-				SYSTEM.GET(sadr, in)
-			END;
-			IF dbit = 8 THEN
-				SYSTEM.PUT(dadr, out);
-				INC(dadr); dbit := 0;
-				SYSTEM.GET(dadr, out)
-			END
-		END;
-		SYSTEM.PUT(dadr, out)
-	END A1OverA1;
-
-	PROCEDURE A8OverA1 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR in, out: CHAR;
-	BEGIN
-		SYSTEM.GET(dadr, out);
-		WHILE len > 0 DO
-			SYSTEM.GET(sadr, in);
-			IF in >= 80X THEN
-				out := Set[ORD(out), dbit]
-			END;
-			INC(sadr); INC(dbit); DEC(len);
-			IF dbit = 8 THEN
-				SYSTEM.PUT(dadr, out);
-				INC(dadr); dbit := 0;
-				SYSTEM.GET(dadr, out)
-			END
-		END;
-		SYSTEM.PUT(dadr, out)
-	END A8OverA1;
-
-	PROCEDURE BGRA8888OverA1 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR in, out: CHAR;
-	BEGIN
-		SYSTEM.GET(dadr, out);
-		WHILE len > 0 DO
-			SYSTEM.GET(sadr + a, in);
-			IF in >= 80X THEN
-				out := Set[ORD(out), dbit]
-			END;
-			INC(sadr, 4); INC(dbit); DEC(len);
-			IF dbit = 8 THEN
-				SYSTEM.PUT(dadr, out);
-				INC(dadr); dbit := 0;
-				SYSTEM.GET(dadr, out)
-			END
-		END;
-		SYSTEM.PUT(dadr, out)
-	END BGRA8888OverA1;
-
-	PROCEDURE A1OverAny (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR in: CHAR;
-	BEGIN
-		SYSTEM.GET(sadr, in);
-		WHILE len > 0 DO
-			IF Bit[ORD(in), sbit] THEN
-				mode.dst.pack(mode.dst, dadr, dbit, mode.buf)
-			END;
-			INC(sbit); dbit := dbit + mode.dst.bpp; INC(dadr, dbit DIV 8); dbit := dbit MOD 8; DEC(len);
-			IF sbit = 8 THEN
-				INC(sadr); sbit := 0;
-				SYSTEM.GET(sadr, in)
-			END
-		END
-	END A1OverAny;
-
-	PROCEDURE A1OverConst8 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR in: CHAR;
-	BEGIN
-		SYSTEM.GET(sadr, in);
-		WHILE len > 0 DO
-			IF Bit[ORD(in), sbit] THEN
-				SYSTEM.PUT(dadr, mode.buf[0])
-			END;
-			INC(sbit); INC(dadr); DEC(len);
-			IF sbit = 8 THEN
-				INC(sadr); sbit := 0;
-				SYSTEM.GET(sadr, in)
-			END
-		END
-	END A1OverConst8;
-
-	PROCEDURE A1OverConst16 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR in: CHAR;
-	BEGIN
-		SYSTEM.GET(sadr, in);
-		WHILE len > 0 DO
-			IF Bit[ORD(in), sbit] THEN
-				SYSTEM.MOVE(ADDRESSOF(mode.buf[0]), dadr, 2)
-			END;
-			INC(sbit); INC(dadr, 2); DEC(len);
-			IF sbit = 8 THEN
-				INC(sadr); sbit := 0;
-				SYSTEM.GET(sadr, in)
-			END
-		END
-	END A1OverConst16;
-
-	PROCEDURE A1OverConst24 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR in: CHAR;
-	BEGIN
-		SYSTEM.GET(sadr, in);
-		WHILE len > 0 DO
-			IF Bit[ORD(in), sbit] THEN
-				SYSTEM.MOVE(ADDRESSOF(mode.buf[0]), dadr, 3)
-			END;
-			INC(sbit); INC(dadr, 3); DEC(len);
-			IF sbit = 8 THEN
-				INC(sadr); sbit := 0;
-				SYSTEM.GET(sadr, in)
-			END
-		END
-	END A1OverConst24;
-
-	PROCEDURE A1OverConst32 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR in: CHAR;
-	BEGIN
-		SYSTEM.GET(sadr, in);
-		WHILE len > 0 DO
-			IF Bit[ORD(in), sbit] THEN
-				SYSTEM.MOVE(ADDRESSOF(mode.buf[0]), dadr, 4)
-			END;
-			INC(sbit); INC(dadr, 4); DEC(len);
-			IF sbit = 8 THEN
-				INC(sadr); sbit := 0;
-				SYSTEM.GET(sadr, in)
-			END
-		END
-	END A1OverConst32;
-
-
-	(* A8 *)
-	PROCEDURE AnyOverA8 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR pix: Pixel; b: CHAR;
-	BEGIN
-		WHILE len > 0 DO
-			mode.src.unpack(mode.src, sadr, sbit, pix);
-			IF pix[a] = 0FFX THEN
-				SYSTEM.PUT(dadr, 0FFX)
-			ELSIF pix[a] # 0X THEN
-				SYSTEM.GET(dadr, b);
-				SYSTEM.PUT(dadr, CHR(ORD(pix[a]) + ORD(b) * LONG(255-ORD(pix[a])) DIV 255))
-			END;
-			sbit := sbit + mode.src.bpp; INC(sadr, sbit DIV 8); sbit := sbit MOD 8; INC(dadr); DEC(len)
-		END
-	END AnyOverA8;
-
-	PROCEDURE A8OverAny (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	VAR spix, dpix: Pixel; alpha, rc,gc,bc,ac: CHAR;
-	BEGIN
-		ac := mode.col[a];
-		rc := mode.col[r];
-		gc := mode.col[g];
-		bc := mode.col[b];
-		
-		WHILE len > 0 DO
-			SYSTEM.GET(sadr, alpha);
-			alpha := CHR(ORD(ac) * ORD(alpha) DIV 255);
-			IF alpha = 0FFX THEN
-				mode.dst.pack(mode.dst, dadr, dbit, mode.buf)
-			ELSIF alpha # 0X THEN
-				spix[a] := alpha;
-				(* the following computation of the colors has to be done because the blending method seems to assume this *)
-				spix[r] := CHR(ORD(rc) * ORD(alpha) DIV 255);
-				spix[g] := CHR(ORD(gc) * ORD(alpha) DIV 255);
-				spix[b] := CHR(ORD(bc) * ORD(alpha) DIV 255);
-				mode.dst.unpack(mode.dst, dadr, dbit, dpix);
-				Blend(mode.op, spix, dpix);
-				mode.dst.pack(mode.dst, dadr, dbit, dpix);
-			END;
-			INC(sadr); DEC(len);
-			dbit := dbit + mode.dst.bpp; INC(dadr, dbit DIV 8); dbit := dbit MOD 8
-		END
-	END A8OverAny;
-	
-	
-	PROCEDURE A8OverBGRA8888Asm(CONST col: Pixel; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	CODE
-		LDR R0, [FP, #sadr]
-		LDR R1, [FP, #dadr]
-		LDR R2, [FP, #len]
-		
-		LDR R6, [FP, #col]
-		LDRB R3, [R6, #0] ; col[b]
-		LDRB R4, [R6, #1] ; col[g] 
-		LDRB R5, [R6, #2] ; col[r]
-		LDRB R10, [R6, #3] ; col[a]
-		ADD R10, R10, #1; to account for DIV 256 i/o DIV 255 below
-		
-	loop:
-		CMP R2, #0
-		BLE end ; exit if len <= 0
-		
-		LDRB R6, [R0, #0] ; src[a]
-		MUL R6, R10, R6 ; alpha := src0[a]*col[a]
-		LSR R6, R6, #8 ; alpha := alpha DIV 256
-
-		CMP R6, #255
-		BNE compute ; src[a] # 255 -> compute blended colors
-		
-		; src[a] = 255 -> just move src to dst
-		MOV R8, R3 ; dst[b] := src0[b]
-		ORR R8, R8, R4, LSL #8 ; dst[g] := src0[g]
-		ORR R8, R8, R5, LSL #16 ; dst[r] := src0[r]
-		ORR R8, R8, R6, LSL #24 ; dst[a] := src[a]
-		B store ; go to the actual data move
-		
-	compute:
-		RSB R7, R6, #255 ; fd := 255 - src[a]
-		
-		LDR R8, [R1, #0] ; R8 := dst
-		
-		; compute src[b]
-		MUL R9, R3, R6 ; src0[b]*src[a]
-		LSR R9, R9, #8 ; src[b] := (src0[b]*src[a]) DIV 256
-		; compute dst[b]
-		AND R11, R8, #0FFH ; dst[b]
-		MUL R11, R11, R7 ; dst[b]*fd
-		ADD R11, R11, R9, LSL #8 ; dst[b]*fd + src[b]*256
-		LSR R11, R11, #8 ; (dst[b]*fd + src[b]*256) DIV 256
-		CMP R11, #255
-		BLT put_b
-		MOV R11, #255
-	
-	put_b:
-		BIC R8, R8, #0FFH ; clear dst[b]
-		ORR R8, R8, R11
-		
-		; compute src[g]
-		MUL R9, R4, R6 ; src0[g]*src[a]
-		LSR R9, R9, #8 ; src[g] := (src0[g]*src[a]) DIV 256
-		; compute dst[g]
-		AND R11, R8, #0FF00H ; dst[g]*256
-		LSR R11, R11, #8 ; dst[g]
-		MUL R11, R11, R7 ; dst[g]*fd
-		ADD R11, R11, R9, LSL #8 ; dst[g]*fd + src[g]*256
-		LSR R11, R11, #8 ; (dst[g]*fd + src[g]*256) DIV 256
-		CMP R11, #255
-		BLT put_g
-		MOV R11, #255
-	
-	put_g:
-		BIC R8, R8, #0FF00H ; clear dst[g]
-		ORR R8, R8, R11, LSL #8
-		
-		; compute src[r]
-		MUL R9, R5, R6 ; src0[r]*src[a]
-		LSR R9, R9, #8 ; src[r] := (src0[r]*src[a]) DIV 256
-		; compute dst[r]
-		AND R11, R8, #0FF0000H ; dst[r]*65536
-		LSR R11, R11, #16 ; dst[r]
-		MUL R11, R11, R7 ; dst[r]*fd
-		ADD R11, R11, R9, LSL #8 ; dst[r]*fd + src[r]*256
-		LSR R11, R11, #8 ; (dst[r]*fd + src[r]*256) DIV 256
-		CMP R11, #255
-		BLT put_r
-		MOV R11, #255
-	
-	put_r:
-		BIC R8, R8, #0FF0000H ; clear dst[r]
-		ORR R8, R8, R11, LSL #16
-		
-		; compute dst[a]
-		AND R11, R8, #0FF000000H ; dst[a]*16777216
-		LSR R11, R11, #24 ; dst[a]
-		MUL R11, R11, R7 ; dst[a]*fd
-		ADD R11, R11, R6, LSL #8 ; dst[a]*fd + src[a]*256
-		LSR R11, R11, #8 ; (dstfdc[a] + src[a]*256) DIV 256
-		CMP R11, #255
-		BLT put_a
-		MOV R11, #255
-	
-	put_a:
-		BIC R8, R8, #0FF000000H ; clear dst[a]
-		ORR R8, R8, R11, LSL #24
-		
-	store:
-		STR R8, [R1, #0]
-		ADD R0, R0, #1 ; INC(sadr);
-		ADD R1, R1, #4 ; INC(dadr,4);
-		SUB R2, R2, #1 ; DEC(len);
-		B loop
-	end:
-	END A8OverBGRA8888Asm;
-	
-	PROCEDURE A8OverBGRA8888(VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	BEGIN
-		A8OverBGRA8888Asm(mode.col,sadr,sbit,dadr,dbit,len);
-	END A8OverBGRA8888;
-	
-	(*PROCEDURE A8OverBGRA8888(VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	VAR src , dst: Pixel; rc,gc,bc, fd, fs: LONGINT;
-	BEGIN
-		rc := ORD(mode.col[r]);
-		gc := ORD(mode.col[g]);
-		bc := ORD(mode.col[b]);
-		fs := 255;
-		WHILE len > 0 DO
-			SYSTEM.GET(sadr, src[a]);
-			SYSTEM.MOVE(dadr, ADDRESSOF(dst), 4);
-				(* the following computation of the colors has to be done because the blending method seems to assume this *)
-				src[r] := CHR(rc * ORD(src[a]) DIV 255);
-				src[g] := CHR(gc * ORD(src[a]) DIV 255);
-				src[b] := CHR(bc * ORD(src[a]) DIV 255);
-
-				fd := 255-ORD(src[a]);
-				
-				dst[0] := Clamp[200H + (fs * ORD(src[0]) + fd * ORD(dst[0])) DIV 255];
-				dst[1] := Clamp[200H + (fs * ORD(src[1]) + fd * ORD(dst[1])) DIV 255];
-				dst[2] := Clamp[200H + (fs * ORD(src[2]) + fd * ORD(dst[2])) DIV 255];
-				dst[3] := Clamp[200H + (fs * ORD(src[3]) + fd * ORD(dst[3])) DIV 255];
-				
-				SYSTEM.MOVE(ADDRESSOF(dst),dadr,4);
-			INC(sadr); INC(dadr,4); DEC(len);
-		END
-	END A8OverBGRA8888;*)
-
-	PROCEDURE A8OverA8 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR in, out: CHAR;
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.GET(sadr, in);
-			IF in = 0FFX THEN
-				SYSTEM.PUT(dadr, 0FFX)
-			ELSIF in # 0X THEN
-				SYSTEM.GET(dadr, out);
-				SYSTEM.PUT(dadr, CHR(ORD(in) + ORD(out) * LONG(255-ORD(in)) DIV 255))
-			END;
-			INC(sadr); INC(dadr); DEC(len)
-		END
-	END A8OverA8;
-	
-	PROCEDURE BGRA8888OverBGRA8888(VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	CODE
-		LDR R0, [FP, #sadr]
-		LDR R1, [FP, #dadr]
-		LDR R2, [FP, #len]
-
-	loop:
-		CMP R2, #0
-		BLE end ; exit if len <= 0
-		
-		LDR R8, [R0, #0] ; R8 := src
-		LSR R6, R8, #24 ; R6 := src[a]
-		
-		CMP R6, #255
-		BEQ store ; src[a] = 255 -> just move src to dst
-		
-		MOV R9, #0FFH ; LSB mask
-		AND R3, R9, R8 ; R3 := src[b]
-		AND R4, R9, R8, LSR #8 ; R4 := src[g]
-		AND R5, R9, R8, LSR #16 ; R5 := src[r]
-
-	compute:
-		RSB R7, R6, #255 ; fd := 255 - src[a]
-		
-		LDR R8, [R1, #0] ; R8 := dst
-		
-		; compute dst[b]
-		AND R11, R8, #0FFH ; dst[b]
-		MUL R11, R11, R7 ; dst[b]*fd
-		ADD R11, R11, R3, LSL #8 ; dst[b]*fd + src[b]*256
-		LSR R11, R11, #8 ; (dst[b]*fd + src[b]*256) DIV 256
-		CMP R11, #255
-		BLT put_b
-		MOV R11, #255
-	
-	put_b:
-		BIC R8, R8, #0FFH ; clear dst[b]
-		ORR R8, R8, R11
-		
-		; compute dst[g]
-		AND R11, R8, #0FF00H ; dst[g]*256
-		LSR R11, R11, #8 ; dst[g]
-		MUL R11, R11, R7 ; dst[g]*fd
-		ADD R11, R11, R4, LSL #8 ; dst[g]*fd + src[g]*256
-		LSR R11, R11, #8 ; (dst[g]*fd + src[g]*256) DIV 256
-		CMP R11, #255
-		BLT put_g
-		MOV R11, #255
-	
-	put_g:
-		BIC R8, R8, #0FF00H ; clear dst[g]
-		ORR R8, R8, R11, LSL #8
-		
-		; compute dst[r]
-		AND R11, R8, #0FF0000H ; dst[r]*65536
-		LSR R11, R11, #16 ; dst[r]
-		MUL R11, R11, R7 ; dst[r]*fd
-		ADD R11, R11, R5, LSL #8 ; dst[r]*fd + src[r]*256
-		LSR R11, R11, #8 ; (dst[r]*fd + src[r]*256) DIV 256
-		CMP R11, #255
-		BLT put_r
-		MOV R11, #255
-	
-	put_r:
-		BIC R8, R8, #0FF0000H ; clear dst[r]
-		ORR R8, R8, R11, LSL #16
-		
-		; compute dst[a]
-		AND R11, R8, #0FF000000H ; dst[a]*16777216
-		LSR R11, R11, #24 ; dst[a]
-		MUL R11, R11, R7 ; dst[a]*fd
-		ADD R11, R11, R6, LSL #8 ; dst[a]*fd + src[a]*256
-		LSR R11, R11, #8 ; (dstfdc[a] + src[a]*256) DIV 256
-		CMP R11, #255
-		BLT put_a
-		MOV R11, #255
-	
-	put_a:
-		BIC R8, R8, #0FF000000H ; clear dst[a]
-		ORR R8, R8, R11, LSL #24
-		
-	store:
-		STR R8, [R1, #0]
-		ADD R0, R0, #4 ; INC(sadr,4);
-		ADD R1, R1, #4 ; INC(dadr,4);
-		SUB R2, R2, #1 ; DEC(len);
-		B loop
-	end:
-	END BGRA8888OverBGRA8888;
-
-	(*PROCEDURE BGRA8888OverBGRA8888(VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	VAR src, dst: Pixel; fd,t: LONGINT;
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.MOVE(sadr, ADDRESSOF(src), 4);
-			IF src[a] = 0FFX THEN
-				SYSTEM.MOVE(sadr,dadr,4);
-			ELSIF src[a] # 0X THEN
-				SYSTEM.MOVE(dadr, ADDRESSOF(dst), 4);
-				fd := 256-ORD(src[a]);
-				dst[0] := CHR(MIN( (256 * ORD(src[0]) + fd * ORD(dst[0])) DIV 256, 255));
-				(*
-				IF t < 255 THEN dst[0] := CHR(t) ELSE dst[0] := CHR(255) END;
-				*)
-				dst[1] := CHR(MIN((256 * ORD(src[1]) + fd * ORD(dst[1])) DIV 256, 255));
-				(*
-				IF t < 255 THEN dst[1] := CHR(t) ELSE dst[1] := CHR(255) END;
-				*)
-				dst[2] := CHR(MIN( (256 * ORD(src[2]) + fd * ORD(dst[2])) DIV 256, 255));
-				(*
-				IF t < 255 THEN dst[2] := CHR(t) ELSE dst[2] := CHR(255) END;
-				*)
-				dst[3] := CHR(MIN( (256 * ORD(src[3]) + fd * ORD(dst[3])) DIV 256, 255));
-				(*
-				IF t < 255 THEN dst[3] := CHR(t) ELSE dst[3] := CHR(255) END;
-				*)
-				SYSTEM.MOVE(ADDRESSOF(dst),dadr,4);
-			END;
-			INC(sadr,4); INC(dadr,4); DEC(len);
-		END
-
-	END BGRA8888OverBGRA8888;*)
-
-
-	(* BGRA8888 *)
-	PROCEDURE BGRA8888OverAny (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR spix, dpix: Pixel;
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.MOVE(sadr, ADDRESSOF(spix),4);
-			(*
-			SYSTEM.GET (sadr, spix);
-			*)
-			IF spix[a] = 0FFX THEN
-				mode.dst.pack(mode.dst, dadr, dbit, spix)
-			ELSIF spix[a] # 0X THEN
-				mode.dst.unpack(mode.dst, dadr, dbit, dpix);
-				Blend(mode.op, spix, dpix);
-				mode.dst.pack(mode.dst, dadr, dbit, dpix)
-			END;
-			INC(sadr, SIZEOF (Pixel)); DEC(len);
-			dbit := dbit + mode.dst.bpp; INC(dadr, dbit DIV 8); dbit := dbit MOD 8
-		END
-	END BGRA8888OverAny;
-
-	PROCEDURE BGRA8888OverA8 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR in, out: CHAR;
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.GET(sadr + a, in);
-			IF in = 0FFX THEN
-				SYSTEM.PUT(dadr, 0FFX)
-			ELSIF in # 0X THEN
-				SYSTEM.GET(dadr, out);
-				SYSTEM.PUT(dadr, CHR(ORD(in) + ORD(out) * (255 - ORD(in)) DIV 255))
-			END;
-			INC(sadr, 4); INC(dadr); DEC(len)
-		END
-	END BGRA8888OverA8;
-
-	PROCEDURE BGRA8888OverAny16 (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR src, dst: Pixel; fd, t: LONGINT;
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.MOVE(sadr,ADDRESSOF(src),4);
-			(* SYSTEM.GET (sadr, src);*)
-			IF src[a] = 0FFX THEN
-				mode.dst.pack(mode.dst, dadr, dbit, src)
-			ELSIF src[a] # 0X THEN
-				mode.dst.unpack(mode.dst, dadr, 0, dst);
-				fd := 255-ORD(src[a]);
-				t := (256 * ORD(src[0]) + fd * ORD(dst[0])) DIV 256;
-				IF t < 255 THEN dst[0] := CHR(t) ELSE dst[0] := CHR(255) END;
-
-				t := (256 * ORD(src[1]) + fd * ORD(dst[1])) DIV 256;
-				IF t < 255 THEN dst[1] := CHR(t) ELSE dst[1] := CHR(255) END;
-				t := (256 * ORD(src[2]) + fd * ORD(dst[2])) DIV 256;
-				IF t < 255 THEN dst[2] := CHR(t) ELSE dst[2] := CHR(255) END;
-				t := (256 * ORD(src[3]) + fd * ORD(dst[3])) DIV 256;
-				IF t < 255 THEN dst[3] := CHR(t) ELSE dst[3] := CHR(255) END;
-				mode.dst.pack(mode.dst, dadr, 0, dst);
-			END;
-			INC(dadr, 2); INC(sadr, SIZEOF (Pixel)); DEC(len)
-		END
-	END BGRA8888OverAny16;
-
-	PROCEDURE BGRA8888Over565* (VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-		VAR src, dst: Pixel; fd, t: LONGINT;
-	BEGIN
-		WHILE len > 0 DO
-			SYSTEM.MOVE(sadr,ADDRESSOF(src),4);
-			(*
-			SYSTEM.GET (sadr, src);
-			*)
-			IF src[a] = 0FFX THEN
-				SYSTEM.PUT16(dadr, ASH(ORD(src[b]), -3) + ASH(ASH(ORD(src[g]), -2), 5) + ASH(ASH(ORD(src[r]), -3), 11));
-			ELSIF src[a] # 0X THEN
-				t := SYSTEM.GET16(dadr);
-				dst[b] := CHR((t MOD 32) * 8); dst[g] := CHR((t DIV 32 MOD 64) * 4); dst[r] := CHR((t DIV 2048 MOD 32) * 8);
-
-				fd := 256-ORD(src[a]);
-				t := (256 * ORD(src[0]) + fd * ORD(dst[0])) DIV 256;
-				IF t < 255 THEN dst[0] := CHR(t) ELSE dst[0] := CHR(255) END;
-
-				t := (256 * ORD(src[1]) + fd * ORD(dst[1])) DIV 256;
-				IF t < 255 THEN dst[1] := CHR(t) ELSE dst[1] := CHR(255) END;
-				t := (256 * ORD(src[2]) + fd * ORD(dst[2])) DIV 256;
-				IF t < 255 THEN dst[2] := CHR(t) ELSE dst[2] := CHR(255) END;
-				t := (256 * ORD(src[3]) + fd * ORD(dst[3])) DIV 256;
-				IF t < 255 THEN dst[3] := CHR(t) ELSE dst[3] := CHR(255) END;
-				SYSTEM.PUT16(dadr, ASH(ORD(dst[b]), -3) + ASH(ASH(ORD(dst[g]), -2), 5) + ASH(ASH(ORD(dst[r]), -3), 11));
-			END;
-			INC(dadr, 2); INC(sadr, 4); DEC(len)
-		END
-	END BGRA8888Over565;
-
-
-(*	PROCEDURE MMXBGRA8888Over565(VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	CODE {SYSTEM.i386, SYSTEM.MMX}
-		PUSHFD
-		; CLI
-		MOV 		ESI, [EBP+sadr]
-		MOV 		EDI, [EBP+dadr]
-		PXOR 		MMX0, MMX0
-		PXOR 		MMX1, MMX1
-
-		MOV		EAX, 0FFFFFFFFH
-		MOVD		MMX7, EAX
-		PUNPCKLBW MMX7, MMX0  ; 00FF00FF00FF00FF
-
-		MOV		ECX, [EBP+len]
-	loop:
-		CMP		ECX, 0
-		JE 			end
-
-		MOV		EAX, [ESI]
-		XOR		EBX, EBX
-		MOV		BX, [EDI]
-
-		; 255 - alpha
-		MOV		EDX, EAX
-		SHR		EDX, 24
-		CMP		EDX, 0
-		JE			empty
-		CMP		EDX, 255
-		JE			full
-
-	alpha:
-		NEG		EDX
-		ADD		EDX, 255
-		MOVD 		MMX6, EDX
-		PUNPCKLWD MMX6, MMX6
-		PUNPCKLDQ MMX6, MMX6
-
-		MOVD 		MMX1, EAX
-
-		; unpack dst
-		MOV		EDX, EBX ; b
-		SHL			EDX, 3
-		AND		EDX, 0F8H
-		MOV		EAX, EDX
-
-		MOV		EDX, EBX ; g
-		SHL			EDX, 5
-		AND		EDX, 0FC00H
-		OR			EAX, EDX
-
-		MOV		EDX, EBX ; r
-		SHL			EDX, 8
-		AND		EDX, 0F80000H
-		OR			EAX, EDX
-
-		MOVD		MMX2, EAX
-
-		PUNPCKLBW  MMX1, MMX0  ; 0000ARGB --> 0A0R0G0B
-		PMULLW  	MMX1, MMX7
-
-		PUNPCKLBW  MMX2, MMX0  ; 0000ARGB --> 0A0R0G0B
-		PMULLW 	MMX2, MMX6
-
-		PADDUSW 	MMX1, MMX2
-
-		;	PSRLW	MMX1, 8 ; normalize
-		DB 			0FH, 71H, 0D1H, 08H
-		PACKUSWB MMX1, MMX0
-
-		; HUGA BIMBO Muell
-		MOVD		EAX, MMX1
-
-	full:
-;			XOR EDX, EDX
-;			SHR EAX, 3
-;			MOV EDX, EAX
-;			AND EDX, 1FH
-;			SHR EAX, 2
-;			AND EAX, 0FFFFFFE0H
-;			OR EDX, EAX
-;			AND EDX, 7FFH
-;
-;			SHR EAX, 3
-;			AND EAX,
-;
-;
-;			SHR AL, 3
-;			SHR AH, 2
-;			MOV EDX, EAX
-;			SHR EAX, 3
-;			AND EAX, 01F0000H
-;			OR EDX, EAX
-;			AND EDX, 01F3F1FH
-
-
-		MOV		EBX, EAX
-		AND		EBX, 0FFH
-		SHR		EBX, 3
-		MOV		EDX, EBX
-
-		MOV		EBX, EAX
-		SHR		EBX, 8
-		AND		EBX, 0FFH
-		SHR		EBX, 2
-		SHL			EBX, 5
-		OR			EDX, EBX
-
-		MOV		EBX, EAX
-		SHR		EBX, 16
-		AND		EBX, 0FFH
-		SHR		EBX, 3
-		SHL			EBX, 11
-		OR			EDX, EBX
-
-		MOV 		[EDI], DX
-	empty:
-		ADD 		ESI, 4;
-		ADD 		EDI, 2;
-		DEC		ECX
-		JMP 		loop
-	end:
-		EMMS ; declare FPU registers free
-		POPFD
-	END MMXBGRA8888Over565;*)
-
-
-(*	PROCEDURE SSE2BGRA8888Over565(VAR mode: Mode0; sadr: ADDRESS; sbit: LONGINT; dadr: ADDRESS; dbit, len: LONGINT);
-	CODE {SYSTEM.i386, SYSTEM.MMX, SYSTEM.SSE, SYSTEM.SSE2}
-		PUSHFD
-		PUSH 		EBX
-		; CLI
-
-		PXOR 		MMX0, MMX0
-		PXOR 		MMX1, MMX1
-		PXOR 		MMX2, MMX2
-		PXOR 		MMX3, MMX3
-		PXOR 		MMX4, MMX4
-		PXOR 		MMX5, MMX5
-		PXOR 		MMX6, MMX6
-		PXOR 		MMX7, MMX7
-
-		PXOR 		XMM3, XMM3
-		PXOR 		XMM4, XMM4
-
-		MOV 		ESI, [EBP+sadr]
-		MOV 		EDI, [EBP+dadr]
-		MOV 		ECX, [EBP+len]
-
-		;  create masks
-
-		; src only FF which is rotated -> MMX3
-		MOV		EAX, 0000000FFH
-		MOVD		MMX3, EAX
-
-		; dest red -> MMX4
-		MOV		EAX, 0F800F800H
-		MOVD		MMX4, EAX
-
-		; dest green -> MMX5
-		MOV		EAX, 07E007E0H
-		MOVD		MMX5, EAX
-
-		; dest blue -> MMX6 ; moved as MMX6 is used in singlepixel
-		; MOV	 	EAX, 001F001FH
-		; MOVD		MMX6, EAX
-
-		; BEGIN
-		; 		WHILE len > 0 DO
-
-	loop:
-		CMP 		ECX,0
-		JE 			end ; jump to end if ECX = 0
-
-		; if len < 8 then do one pixel at the time
-		CMP		ECX, 8
-		JL 			singlepixel
-		; else
-		; take 8 at the time
-
-		MOV		EBX, ESI
-		AND 		EBX, 0FH
-		CMP		EBX, 0
-		JNE 		singlepixel
-
-	alleightpixels:
-		; dest blue -> MMX6
-		MOV		EAX, 001F001FH
-		MOVD		MMX6, EAX
-
-		; src := SYSTEM.VAL(Pixel, SYSTEM.GET32(sadr));
-		; Load data into memory
-		;MOV 	XMM4, 0FF000000FF000000FF000000FF000000H
-
-		MOVDQA 	XMM2, [ESI] ;src 5-8
-		MOVQ2DQ	XMM4,  MMX3     ; 000000000000000000000000000000FFH
-		MOVDQA 	XMM1, [ESI+16]  ;src 1-4
-		PREFETCHNTA		[ESI+32] ; prepare src 9-15
-
-		; get alphas
-		MOVDQU 	XMM6, XMM2
-		PSHUFD		XMM4, XMM4, 0
-		MOVDQU 	XMM5, XMM1
-		PSLLD 		XMM4, 24
-		PAND 		XMM6, XMM4 ; alpha 5-8 in XMM6
-		PAND 		XMM5, XMM4  ; alpha 1-4 in XMM5
-		PSRLD 		XMM5, 24
-		PSHUFHW 	XMM5, XMM5, 85H
-		PSRLD 		XMM6, 24
-
-		; put both alphas into 1 register
-		PSHUFHW 	XMM6, XMM6, 85H
-		PSHUFLW 	XMM5, XMM5, 85H
-		PSHUFLW 	XMM6, XMM6, 58H
-		PSHUFD		XMM5, XMM5, 0D0H  ; 0102030400000000
-		PSHUFD 	XMM6, XMM6, 5CH ; 0000000005060708
-		PXOR 		XMM0,XMM0
-		POR		XMM5, XMM6            ; XMM5 = alphas 0102030405060708
-
-		PCMPEQD 	XMM0, XMM5
-		PMOVMSKB EAX, XMM0
-		CMP 		EAX, 0FFFFH ; all alphas = zero; TEST not possible, because only 8 bits compared
-		JE      		endloop
-
-		; mask out alpha = zero
-
-		; fd := 255-ORD(src[a]); fd = XMM4
-		; MOV 	XMM4, 00FF00FF00FF00FF00FF00FF00FF00FFH
-		PXOR 		XMM4, XMM4
-		MOV	 	EAX, 00FFH
-		PINSRW	XMM4, EAX ,0
-		PSHUFLW 	XMM4, XMM4, 0
-		PSHUFD 	XMM4, XMM4, 0
-		PSUBW 		XMM4, XMM5
-		MOV 		EAX,1H
-		PINSRW	XMM3, EAX ,0
-		PSHUFLW 	XMM3, XMM3, 0
-		PSHUFD 	XMM3, XMM3, 0
-		PADDUSW 	XMM4, XMM3
-
-		; new red
-		; calculate red 2
-
-		; get source
-
-		; sred14 = src14 && (srcMask <<16)
-		; srcMask << 16
-		MOVQ2DQ 	XMM3, MMX3
-		PSHUFD 	XMM3, XMM3, 0
-		MOVDQU 	XMM5, XMM1
-		MOVDQU 	XMM6, XMM2
-		PSLLD 		XMM3, 16
-
-		; sred14 = src14 && (srcMask << 24)
-		; src14 must be copied because it mustn't be changed
-		PAND 		XMM5, XMM3 ; sred14
-		PSRLD 		XMM5, 16
-
-		; sred14s = shuffled sred14
-		PSHUFHW 	XMM5, XMM5,85H
-		PAND 		XMM6, XMM3 ; sred58
-		PSRLD 		XMM6, 16
-
-		PSHUFLW 	XMM5, XMM5,85H
-		PSHUFHW 	XMM6, XMM6,85H
-		PSHUFD  	XMM5, XMM5,0D0H ; sred14s
-		PSHUFLW 	XMM6, XMM6,58H
-		PSHUFD  	XMM6, XMM6,5CH ; sred58s
-		POR 		XMM5, XMM6 ; sred18
-
-		; sred18255 = sred18 * 256- sred18
-		MOVDQU 	XMM7, XMM5
-		PSLLW 		XMM5, 8
-		PSUBUSW 	XMM5, XMM7 ; sred18255
-
-		; src is now ready
-
-		; destination
-		; dest18 must be copied because it mustn't be changed
-		; Load data into memory
-		MOVDQU 	XMM3, [EDI]  ;dest 1-8
-		MOVQ2DQ 	XMM6, MMX4
-		PSHUFD 	XMM6, XMM6, 0
-		MOVDQU 	XMM7, XMM3
-
-		PAND 		XMM7, XMM6 ; dred18
-		PSRLW 		XMM7, 8
-		;  dred18alpha = dred18 * negalpha
-		PMULLW XMM7, XMM4 ; dred18alpha
-
-		; dest is prepared
-		; combining dest and src
-
-		; dred18big = sred18255 + dred18alpha
-		PADDUSW 	XMM7, XMM5 ; dred18big
-		; dred18f = dred18big && destMaskred128  because >> 11 and << 11 is && mask
-		PAND 		XMM7, XMM6 ; dred18f
-
- 		; dest18nr0 = dest18 && (~destMaskred128)
- 		PANDN 	XMM6, XMM3  ; dest18nr0
-
- 		; dest18nrf = dest18nr0 || dred18f
- 		POR 		XMM6, XMM7
-
-		MOVDQU 	XMM3, XMM6
-
-		; red is calculated
-
-		; calculate green:
-		; get source
-
-		; sgreen14 = src14 && (srcMask <<8)
-		; srcMask << 8
-		MOVQ2DQ 	XMM7, MMX3
-
-		PSHUFD 	XMM7, XMM7, 0
-		MOVDQU 	XMM5, XMM1
-		PSLLD 		XMM7, 8
-		PAND 		XMM5, XMM7 ; sgreen14
-		PSRLD 		XMM5, 8
-
-		; sgreen14s = shuffled sgreen14
-		PSHUFHW 	XMM5, XMM5,85H
-		MOVDQU 	XMM6, XMM2
-		PSHUFLW 	XMM5, XMM5,85H
-		PAND 		XMM6, XMM7 ; sgreen58
-		PSRLD 		XMM6, 8
-		PSHUFD  	XMM5, XMM5,0D0H ; sgreen14s
-
-		; sgreen58 = src58&& (srcMask << 8)
-		; src58 must be copied because it mustn't be changed
-
-		; sgreen58s = shuffled sgreen58
-		PSHUFHW 	XMM6, XMM6,85H
-		PSHUFLW 	XMM6, XMM6,58H
-		PSHUFD  	XMM6, XMM6,5CH ; sgreen58s
-
-		; sgreen18 = sgreen14s || sgreen58s
-		POR 		XMM5, XMM6 ; sgreen18
-
-		; sgreen18255 = sgreen18 * 256- sgreen18
-		MOVDQU 	XMM7, XMM5
-		MOVQ2DQ	XMM6, MMX5
-
-		PSLLW 		XMM5, 8
-		PSUBUSW 	XMM5, XMM7 ; sgreen18255
-		PSHUFD 	XMM6, XMM6, 0
-
-		MOVDQU 	XMM7, XMM3
-
-		PAND 		XMM7, XMM6 ; dgreen18
-		PSRLW 		XMM7,3
-		;  dgreen18alpha = dgreen18 * negalpha
-		PMULLW 	XMM7, XMM4 ; dgreen18alpha
-
-		; dest is prepared
-		; combining dest and src
-
-		; dgreen18big = sgreen18255 + dgreen18alpha
-
-	 	PADDUSW 	XMM7, XMM5 ; dgreen18big
-		PANDN 	XMM6, XMM3  ; dest18ng0
-
-		; dgreen18f = (dgreen18big >> 11) <<5
-
-		PSRLW 		XMM7, 10 ; dgreen18f
-		PSLLW 		XMM7, 5
-
- 		; dest18ng0 = dest18 && (~destMaskgreen128)
-
-  		; dest18ngf = dest18ng0 || dred18f
- 		POR 		XMM6, XMM7
-		MOVDQU 	XMM3, XMM6
-
-		; green is calculated
-
-		; calculate blue
-		; get source
-
-		; sblue14 = src14 && (srcMask)
-		; srcMask
-		MOVQ2DQ 	XMM7, MMX3
-		MOVDQU 	XMM5, XMM1
-
-		PSHUFD 	XMM7, XMM7, 0
-		MOVDQU 	XMM6, XMM2
-
-		; sblue14 = src14 && (srcMask)
-		; src14 must be copied because it mustn't be changed
-		PAND 		XMM5, XMM7 ; sblue14
-
-		; sblue14s = shuffled sblue14
-		PSHUFHW 	XMM5, XMM5,85H
-		PAND 		XMM6, XMM7 ; sblue58
-		PSHUFHW 	XMM6, XMM6,85H
-
-		PSHUFLW 	XMM5, XMM5,85H
-		PSHUFLW 	XMM6, XMM6,58H
-
-		PSHUFD  	XMM5, XMM5,0D0H ; sblue14s
-		PSHUFD  	XMM6, XMM6,5CH ; sblue58s
-
-		POR 		XMM5, XMM6 ; sblue18
-
-		; sblue18255 = sblue18 * 256- sblue18
-		MOVDQU 	XMM7, XMM5
-		PSLLW 		XMM5, 8
-		PSUBUSW 	XMM5, XMM7 ; sblue18255
-		MOVQ2DQ	XMM6, MMX6
-		PSHUFD 	XMM6, XMM6, 0
-		MOVDQU 	XMM7, XMM3
-		PAND 		XMM7, XMM6 ; dblue18
-		PSLLW 		XMM7, 3
-
-		PMULLW 	XMM7, XMM4 ; dblue18alpha
-
-		; dest is prepared
-		; combining dest and src
-
-		; dblue18big = sblue18255 + dblue18alpha
-
-	 	PADDUSW 	XMM7, XMM5 ; dblue18big
-		; dblue18f = (dblue18big >> 11)
-		PANDN 	XMM6, XMM3  ; dest18nr0
- 		PSRLW 		XMM7, 11 ; dblue18f
-
-  		; dest18nr0 = dest18 && (~destMaskblue128)
-
-  		; dest18nbf = dest18nb0 || dblue18f
- 		POR 		XMM6, XMM7
-		MOVDQU 	XMM3, XMM6
-
-		; blue is calculated
-
-		; now dest is calculated, store it
-		; get 0 stuff
-		MOVDQU	XMM5, [EDI]
-		PAND		XMM5,XMM0
-		PANDN		XMM0, XMM3
-		POR		XMM0, XMM5
-
-		MOVDQU 	[EDI],XMM0
-		PREFETCHNTA		[EDI+16] ; prepare dest 9-15
-	endloop:
-		ADD 		ESI, 32 ; num of bytes
-		ADD 		EDI, 16
-		SUB 		ECX, 8
-		JMP 		loop
-
-	singlepixel: ; original code from MMXBGRA8888Over565, adjusted to fit this procedure
-		MOV	 	EAX, 0FFFFFFFFH
-		MOVD		MMX7, EAX
-		PUNPCKLBW  MMX7, MMX0  ; 00FF00FF00FF00FF
-
-		MOV 		EAX,[ESI]
-		XOR		EBX, EBX
-		MOV 		BX,	[EDI]
-
-		; 255 - alpha
-		MOV		EDX, EAX
-		SHR		EDX, 24
-
-		CMP		EDX, 0
-		JE			empty
-		CMP		EDX, 255
-		JE			full
-
-	alpha:
-		NEG		EDX
-		ADD		EDX, 255
-
-		MOVD 		MMX6, EDX
-		PUNPCKLWD MMX6, MMX6
-		PUNPCKLDQ MMX6, MMX6
-
-		MOVD 		MMX1, EAX
-		; unpack dst
-		MOV		EDX, EBX ; b
-		SHL			EDX, 3
-		AND		EDX, 0F8H
-		MOV		EAX, EDX
-
-		MOV		EDX, EBX ; g
-		SHL			EDX, 5
-		AND		EDX, 0FC00H
-		OR			EAX, EDX
-
-		MOV		EDX, EBX ; r
-		SHL			EDX, 8
-		AND		EDX, 0F80000H
-		OR			EAX, EDX
-
-		MOVD		MMX2, EAX
-		PUNPCKLBW MMX1, MMX0  ; 0000ARGB --> 0A0R0G0B
-		PMULLW 	MMX1, MMX7
-		PUNPCKLBW MMX2, MMX0  ; 0000ARGB --> 0A0R0G0B
-		PMULLW 	MMX2, MMX6
-		PADDUSW 	MMX1, MMX2
-
-	;	PSRLW	MMX1, 8 ; normalize
-		DB 			0FH, 71H, 0D1H, 08H
-		PACKUSWB 	MMX1, MMX0
-
-		; HUGA BIMBO Muell
-		MOVD		EAX, MMX1
-
-	full:
-		MOV		EBX, EAX
-		AND		EBX, 0FFH
-		SHR		EBX, 3
-		MOV		EDX, EBX
-
-		MOV		EBX, EAX
-		SHR		EBX, 8
-		AND		EBX, 0FFH
-		SHR		EBX, 2
-		SHL			EBX, 5
-		OR			EDX, EBX
-
-		MOV		EBX, EAX
-		SHR		EBX, 16
-		AND		EBX, 0FFH
-		SHR		EBX, 3
-		SHL			EBX, 11
-		OR			EDX, EBX
-
-		MOV 		[EDI], DX
-
-	empty:
-		ADD 		ESI, 4;
-		ADD 		EDI, 2;
-		DEC		ECX
-		JMP 		loop
-
-	end:
-		EMMS ; declare FPU registers free
-		POP 		EBX
-		POPFD
-
-	END SSE2BGRA8888Over565;*)
-
-
-	(** find (optimized) pixel transfer procedure for transfer mode and given source and destination formats **)
-	PROCEDURE Bind* (VAR mode: Mode; VAR src, dst: Format);
-		VAR op: LONGINT; val,i: LONGINT;
-	BEGIN
-		IF Same(src, mode.src) & Same(dst, mode.dst) THEN
-			ASSERT(mode.transfer # NIL, 120);
-			RETURN	(* assume transfer procedure is still valid *)
-		END;
-		mode.src := src; mode.dst := dst; mode.buf := mode.col;
-		IF  (src.pal # NIL) & ((mode.map = NIL) OR (LEN(mode.map^) # src.pal.used) ) THEN
-			NEW(mode.map, src.pal.used)
-		END;
-
-
-		(* try to convert complex composite operations into simpler ones *)
-		IF alpha IN src.components * dst.components THEN	(* source and destination contain alpha information *)
-			op := mode.op
-		ELSIF alpha IN src.components THEN	(* only source contains alpha *)
-			CASE mode.op OF
-			| dstOverSrc: op := dstCopy
-			| srcInDst: op := srcCopy
-			| srcWithoutDst: op := clear
-			| srcAtopDst: op := srcOverDst
-			| dstAtopSrc: op := dstInSrc
-			| srcXorDst: op := dstWithoutSrc
-			ELSE op := mode.op
-			END
-		ELSIF alpha IN dst.components THEN	(* only destination contains alpha *)
-			CASE mode.op OF
-			| srcOverDst: op := srcCopy
-			| dstInSrc: op := dstCopy
-			| dstWithoutSrc: op := clear
-			| srcAtopDst: op := srcInDst
-			| dstAtopSrc: op := dstOverSrc
-			| srcXorDst: op := srcWithoutDst
-			ELSE op := mode.op
-			END
-		ELSE	(* no alpha in either source or destination *)
-			CASE mode.op OF
-			| srcOverDst, srcInDst, srcAtopDst: op := srcCopy
-			| dstOverSrc, dstInSrc, dstAtopSrc: op := dstCopy
-			| srcWithoutDst, dstWithoutSrc, srcXorDst: op := clear
-			ELSE op := mode.op
-			END
-		END;
-
-		IF op = InvDst THEN
-			mode.transfer:=InvAny;
-		ELSIF op = InvOverDst THEN
-			mode.transfer:=InvOverAny;
-		ELSIF op = clear THEN
-			CASE dst.code OF
-			| a1: mode.transfer := Clear1
-			| a8, bgr555, bgr565, bgr466, bgr888(*, bgra8888*): mode.transfer := ClearBytes
-			| bgra8888: mode.transfer:=Clear32;
-			| p8:
-				mode.buf[0] := CHR(CLUTs.Match(dst.pal.clut, 0));
-				IF mode.buf[0] = 0X THEN mode.transfer := ClearBytes
-				ELSE mode.transfer := ConstCopy8
-				END
-			| d8:
-				mode.buf[0] := CHR(ColorToIndex(0));
-				IF mode.buf[0] = 0X THEN mode.transfer := ClearBytes
-				ELSE mode.transfer := ConstCopy8
-				END
-			| p16:
-				val:=CLUTs.Match(dst.pal.clut, 0);
-				IF dst.pal.used>256 THEN val:=val*dst.pal.used DIV 256 END;
-				SYSTEM.PUT16(ADDRESSOF(mode.buf[0]),SHORT(val)); (*PH090122*)
-				(*mode.buf[0] := CHR(PaletteIndex(dst.pal, 0, 0, 0));*)
-				IF val = 0 THEN mode.transfer := ClearBytes
-				ELSE mode.transfer := ConstCopy16
-				END
-			ELSE mode.transfer := ClearAny
-			END
-
-		ELSIF op = srcCopy THEN
-			CASE dst.code OF
-			| a1:
-				CASE src.code OF
-				| a1: mode.transfer := Copy1
-				| a8: mode.transfer := A8CopyA1
-				| bgra8888: mode.transfer := BGRA8888CopyA1
-				ELSE
-					IF alpha IN src.components THEN mode.transfer := AnyCopyA1
-					ELSE mode.transfer := Set1
-					END
-				END
-			| a8:
-				CASE src.code OF
-				| a1: mode.transfer := A1CopyA8
-				| a8: mode.transfer := Copy8
-				| bgra8888: mode.transfer := BGRA8888CopyA8
-				ELSE
-					IF alpha IN src.components THEN mode.transfer := AnyCopyA8
-					ELSE mode.buf[0] := 0FFX; mode.transfer := ConstCopy8
-					END
-				END
-			| p8:
-				CASE src.code OF
-				| a1, a8:
-					mode.buf[0] := CHR(CLUTs.Match(dst.pal.clut, ORD(mode.col[b]) + ASH(ORD(mode.col[g]), 8) +
-						ASH(ORD(mode.col[r]), 16)));
-					mode.transfer := ConstCopy8
-				| p8:
-					IF src.pal = dst.pal THEN mode.transfer := Copy8
-					ELSE
-						FOR i := 0 TO src.pal.used-1 DO
-							mode.map[i] := SHORT(CLUTs.Match(dst.pal.clut, ORD(src.pal.col[i, b]) + ASH(ORD(src.pal.col[i, g]), 8) +
-								ASH(ORD(src.pal.col[i, r]), 16)))
-						END;
-						mode.transfer := I8CopyI8
-					END
-				| d8:
-					FOR i := 0 TO 255 DO
-						mode.map[i] := SHORT(CLUTs.Match(dst.pal.clut, IndexToColor(i) MOD 1000000H))
-					END;
-					mode.transfer := I8CopyI8
-				| bgr555, bgr565, bgr466,p16: mode.transfer := Any16CopyP8
-				| bgr888: mode.transfer := BGR888CopyP8
-				| bgra8888: mode.transfer := BGRA8888CopyP8
-				ELSE mode.transfer := AnyCopyP8
-				END
-			| d8:
-				CASE src.code OF
-				| a1, a8:
-					mode.buf[0] := CHR(ColorToIndex(
-						ORD(mode.col[b]) + ASH(ORD(mode.col[g]), 8) + ASH(ORD(mode.col[r]), 16)));
-					mode.transfer := ConstCopy8
-				| p8:
-					FOR i := 0 TO src.pal.used-1 DO
-						mode.map[i] := SHORT(ColorToIndex(
-							ORD(src.pal.col[i, b]) + ASH(ORD(src.pal.col[i, g]), 8) + ASH(ORD(src.pal.col[i, r]), 16)))
-					END;
-					mode.transfer := I8CopyI8
-				| d8: mode.transfer := Copy8
-				| bgr555, bgr565, bgr466, p16: mode.transfer := Any16CopyD8
-				| bgr888: mode.transfer := BGR888CopyD8
-				| bgra8888: mode.transfer := BGRA8888CopyD8
-				ELSE mode.transfer := AnyCopyD8
-				END
-			| p16:
-				CASE src.code OF
-				| a1, a8: dst.pack(dst, ADDRESSOF(mode.buf[0]), 0, mode.col); mode.transfer := ConstCopy16
-				| p8: mode.transfer := P8CopyAny16
-				| d8: mode.transfer := D8CopyAny16
-				| p16:
-					IF src.pal = dst.pal THEN mode.transfer := Copy16
-					ELSE
-						FOR i := 0 TO src.pal.used-1 DO
-							val:=CLUTs.Match(dst.pal.clut, ORD(src.pal.col[i, b]) + ASH(ORD(src.pal.col[i, g]), 8) +
-								ASH(ORD(src.pal.col[i, r]), 16));
-							IF dst.pal.used>256 THEN val := val * dst.pal.used DIV 256 END;
-							mode.map[i] := SHORT(val)
-						END;
-						mode.transfer := I16CopyI16
-					END
-				| bgr555, bgr565, bgr466:  mode.transfer := Any16CopyAny16
-				| bgr888: mode.transfer := BGR888CopyAny16
-				| bgra8888: mode.transfer := BGRA8888CopyAny16
-				ELSE mode.transfer := AnyCopyAny16
-				END;
-			| bgr555, bgr565, bgr466:
-				CASE src.code OF
-				| a1, a8: dst.pack(dst, ADDRESSOF(mode.buf[0]), 0, mode.col); mode.transfer := ConstCopy16
-				| p8: mode.transfer := P8CopyAny16
-				| d8: mode.transfer := D8CopyAny16
-				| bgr555, bgr565, bgr466,p16:
-					IF src.code = dst.code THEN mode.transfer := Copy16
-					ELSE mode.transfer := Any16CopyAny16
-					END
-				| bgr888: mode.transfer := BGR888CopyAny16
-				| bgra8888: mode.transfer := BGRA8888CopyAny16
-				ELSE mode.transfer := AnyCopyAny16
-				END;
-			| bgr888:
-				CASE src.code OF
-				| a1, a8: mode.buf := mode.col; mode.transfer := ConstCopy24
-				| p8: mode.transfer := P8CopyBGR888
-				| d8: mode.transfer := D8CopyBGR888
-				| p16: mode.transfer := P16CopyBGR888	(*PH090122*)
-				| bgr555, bgr565, bgr466: mode.transfer := Any16CopyBGR888
-				| bgr888: mode.transfer := Copy24
-				| bgra8888: 
-				(*	IF SSE2enabled THEN mode.transfer := SSE2BGRA8888CopyBGR888
-					ELSE *) mode.transfer := BGRA8888CopyBGR888
-				(*	END*);
-				ELSE mode.transfer := AnyCopyBGR888
-				END
-			| bgra8888:
-				CASE src.code OF
-				| a1: mode.transfer := A1CopyBGRA8888
-				| a8: mode.transfer := A8CopyBGRA8888
-				| p8: mode.transfer := P8CopyBGRA8888
-				| d8: mode.transfer := D8CopyBGRA8888
-				| p16: mode.transfer := P16CopyBGRA8888	(*PH090122*)
-				| bgr555, bgr565, bgr466: mode.transfer := Any16CopyBGRA8888
-				| bgr888:  	(*IF SSE2enabled THEN mode.transfer := SSE2BGR888CopyBGRA8888*)
-							(*ELSE*) mode.transfer :=BGR888CopyBGRA8888;
-							(*END;*)
-				| bgra8888: mode.transfer := Copy32
-				ELSE mode.transfer := AnyCopyBGRA8888
-				END
-			ELSE
-				CASE src.code OF
-				| a1: mode.transfer := A1CopyAny
-				| p8: mode.transfer := P8CopyAny
-				| d8: mode.transfer := D8CopyAny
-				| bgr555, bgr565, bgr466,p16: mode.transfer := Any16CopyAny
-				| bgr888: mode.transfer := BGR888CopyAny
-				| bgra8888: mode.transfer := BGRA8888CopyAny
-				ELSE
-					IF (src.bpp MOD 8 = 0) & (dst.bpp MOD 8 = 0) THEN mode.transfer := AnyBytesCopyAnyBytes
-					ELSE mode.transfer := AnyCopyAny
-					END
-				END
-			END
-
-		ELSIF op = dstOverSrc THEN
-			mode.transfer := EmptyTransfer
-
-		ELSIF op = srcOverDst THEN
-			CASE dst.code OF
-			| a1:
-				CASE src.code OF
-				| a1: mode.transfer := A1OverA1
-				| a8: mode.transfer := A8OverA1
-				| bgra8888: mode.transfer := BGRA8888OverA1
-				ELSE mode.transfer := AnyOverA1
-				END
-			| a8:
-				CASE src.code OF
-				| a1: mode.buf[0] := 0FFX; mode.transfer := A1OverConst8
-				| a8: mode.transfer := A8OverA8
-				| bgra8888: mode.transfer := BGRA8888OverA8
-				ELSE mode.transfer := AnyOverA8
-				END
-			| bgra8888:
-
-				CASE src.code OF
-				| a1: mode.buf := mode.col; mode.transfer := A1OverConst32
-				| a8: mode.buf := mode.col; mode.transfer := A8OverAny;
-					IF mode.op = srcOverDst THEN mode.transfer := A8OverBGRA8888 END;
-				| bgra8888: mode.transfer := BGRA8888OverBGRA8888
-				ELSE mode.transfer := BGRA8888OverAny; (* ? *)
-				END
-			ELSE
-				CASE src.code OF
-				| a1:
-					CASE dst.code OF
-					| p8:
-						mode.buf[0] := CHR(CLUTs.Match(dst.pal.clut, ORD(mode.col[b]) + ASH(ORD(mode.col[g]), 8) +
-							ASH(ORD(mode.col[r]), 16)));
-						mode.transfer := A1OverConst8
-					| d8:
-						mode.buf[0] := CHR(ColorToIndex(ORD(mode.col[b]) + ASH(ORD(mode.col[g]), 8) +
-							ASH(ORD(mode.col[r]), 16)));
-						mode.transfer := A1OverConst8
-					| p16: (* this is probably not correct ... *)
-						mode.buf[0] := CHR(PaletteIndex(dst.pal, ORD(mode.col[r]), ORD(mode.col[g]), ORD(mode.col[b])));
-						mode.transfer := A1OverConst16
-					| bgr555, bgr565, bgr466: dst.pack(dst, ADDRESSOF(mode.buf[0]), 0, mode.col); mode.transfer := A1OverConst16
-					| bgr888: mode.buf := mode.col; mode.transfer := A1OverConst24
-					ELSE mode.transfer := A1OverAny
-					END
-				| a8: mode.buf := mode.col; mode.transfer := A8OverAny
-				| bgra8888:
-					CASE dst.code OF
-					| bgr555, bgr466, p16: mode.transfer := BGRA8888OverAny16
-					| bgr565 : (*IF MMXenabled THEN
-							mode.transfer := MMXBGRA8888Over565;
-							IF SSE2enabled THEN mode.transfer := SSE2BGRA8888Over565; END;
-						ELSE*) mode.transfer := BGRA8888Over565
-						(*END*)
-					ELSE mode.transfer := BGRA8888OverAny
-					END
-				ELSE
-					mode.transfer := AnyBlendAny
-				END
-			END
-		ELSE
-			mode.transfer := AnyBlendAny
-		END;
-
-		ASSERT(mode.transfer # NIL, 120)
-	END Bind;
-
-
-	(**--- Image Operations ---**)
-
-	(** get pixel from image **)
-	PROCEDURE Get* (img: Image; x, y: LONGINT; VAR pix: Pixel; VAR mode: Mode);
-		VAR bit: LONGINT; adr: ADDRESS;
-	BEGIN
-		ASSERT((0 <= x) & (x < img.width) & (0 <= y) & (y < img.height), 100);
-		bit := x * img.fmt.bpp; adr := img.adr + y * img.bpr + bit DIV 8; bit := bit MOD 8;
-		Bind(mode, img.fmt, PixelFormat);
-		(*mode.transfer(mode, adr, bit, ADDRESSOF(pix), 0, 1)*)
-
-		mode.transfer(mode, adr, bit, ADDRESSOF(pix[0]), 0, 1) (*PH090122*)
-	END Get;
-
-	(** put pixel into image **)
-	PROCEDURE Put* (img: Image; x, y: LONGINT; CONST pix: Pixel; VAR mode: Mode);
-		VAR bit: LONGINT; adr: ADDRESS;
-	BEGIN
-		(*ASSERT((0 <= x) & (x < img.width) & (0 <= y) & (y < img.height), 100);*) (*avoid a HALT if roundoff errors from higher levels occur here*)
-		IF (0 > x) OR (x >= img.width) OR (0 > y) OR (y >= img.height) THEN RETURN END;
-		bit := x * img.fmt.bpp; adr := img.adr + y * img.bpr + bit DIV 8; bit := bit MOD 8;
-		Bind(mode, PixelFormat, img.fmt);
-		mode.transfer(mode, ADDRESSOF(pix[0]), 0, adr, bit, 1)
-	END Put;
-
-	(** fill rectangular area **)
-	PROCEDURE Fill* (img: Image; llx, lly, urx, ury: LONGINT; CONST pix: Pixel; VAR mode: Mode);
-		VAR bit, bb, x, c, t: LONGINT; m: Mode; adr, aa: ADDRESS;
-	BEGIN
-		ASSERT((0 <= llx) & (llx < urx) & (urx <= img.width) & (0 <= lly) & (lly < ury) & (ury <= img.height), 100);
-		bit := llx * img.fmt.bpp; adr := img.adr + lly * img.bpr + bit DIV 8; bit := bit MOD 8;
-
-		IF (mode.op = srcCopy) & (img.fmt.code IN {bgr565}) THEN (* shortcut for speed in important cases *)
-			c := ASH(ORD(pix[b]), -3) + ASH(ASH(ORD(pix[g]), -2), 5) + ASH(ASH(ORD(pix[r]), -3), 11);
-			t := urx - llx;
-			WHILE lly < ury DO
-				Fill16(adr, t, c);
-				INC(lly); INC(adr, img.bpr)
-			END
-		ELSIF (mode.op = srcCopy) & (img.fmt.code IN {}) THEN
-			c := ASH(ORD(pix[r]), 24) + ASH(ORD(pix[g]), 16) + ASH(ORD(pix[b]), 8) + ORD(pix[a]);
-			t := urx - llx;
-			WHILE lly < ury DO
-				Fill32(adr, t, c);
-				INC(lly); INC(adr, img.bpr)
-			END
-		ELSE
-			Bind(mode, PixelFormat, img.fmt);
-			IF (mode.op IN {clear, srcCopy}) OR (pix[a] = 0FFX) & (mode.op IN {srcOverDst, dstWithoutSrc}) THEN	(* dst is replaced *)
-				(* copy one pixel to lower left corner of rect *)
-				mode.transfer(mode, ADDRESSOF(pix[0]), 0, adr, bit, 1);
-
-				(* copy pixel to rest of bottom row *)
-				InitMode(m, srcCopy); Bind(m, img.fmt, img.fmt);
-				IF (bit = 0) & (img.fmt.bpp MOD 8 = 0) THEN	(* use simple address calculation *)
-					bb := img.fmt.bpp DIV 8; aa := adr + bb; x := llx+1;
-					WHILE x < urx DO
-						m.transfer(m, adr, 0, aa, 0, 1);
-						INC(aa, bb); INC(x)
-					END
-				ELSE
-					bb := bit + img.fmt.bpp; aa := adr + bb DIV 8; bb := bb MOD 8; x := llx+1;
-					WHILE x < urx DO
-						m.transfer(m, adr, bit, aa, bb, 1);
-						bb := bb + img.fmt.bpp; aa := aa + bb DIV 8; bb := bb MOD 8; INC(x)
-					END
-				END;
-
-				(* now copy bottom row to others *)
-				INC(lly); aa := adr + img.bpr;
-				WHILE lly < ury DO
-					m.transfer(m, adr, bit, aa, bit, urx - llx);
-					INC(lly); INC(aa, img.bpr)
-				END
-
-			ELSE	(* fill pixel by pixel *)
-				WHILE lly < ury DO
-					x := llx; aa := adr; bb := bit;
-					WHILE x < urx DO
-						mode.transfer(mode, ADDRESSOF(pix[0]), 0, aa, bb, 1);
-						bb := bb + img.fmt.bpp; aa := aa + bb DIV 8; bb := bb MOD 8; INC(x)
-					END;
-					INC(lly); INC(adr, img.bpr)
-				END
-			END
-		END
-	END Fill;
-
-	(** clear image **)
-	PROCEDURE Clear* (img: Image);
-		VAR mode: Mode;
-	BEGIN
-		InitMode(mode, clear);
-		Bind(mode, PixelFormat, img.fmt);
-		Fill(img, 0, 0, img.width, img.height, Zero, mode)
-	END Clear;
-
-	(** get several pixels and store them in array in requested format **)
-	PROCEDURE GetPixels* (img: Image; x, y, w: LONGINT; VAR fmt: Format; VAR buf: ARRAY OF CHAR; ofs : LONGINT; VAR mode: Mode);
-		VAR sbit: LONGINT; sadr: ADDRESS;
-	BEGIN
-		ASSERT((0 <= x) & (x + w <= img.width) & (0 <= y) & (y <= img.height), 100);
-		ASSERT(ofs + w * fmt.bpp DIV 8 <= LEN(buf), 101);
-		Bind(mode, img.fmt, fmt);
-		sbit := x * img.fmt.bpp; sadr := img.adr + y * img.bpr + sbit DIV 8; sbit := sbit MOD 8;
-		mode.transfer(mode, sadr, sbit, ADDRESSOF(buf[ofs]), 0, w)
-	END GetPixels;
-
-	(** put several pixels from array in given format into image **)
-	PROCEDURE PutPixels* (img: Image; x, y, w: LONGINT; VAR fmt: Format; VAR buf: ARRAY OF CHAR; ofs : LONGINT; VAR mode: Mode);
-		VAR dbit: LONGINT; dadr: ADDRESS;
-	BEGIN
-		ASSERT((0 <= x) & (x + w <= img.width) & (0 <= y) & (y <= img.height), 100);
-		ASSERT(ofs + w * fmt.bpp DIV 8 <= LEN(buf), 101);
-		dbit := x * img.fmt.bpp; dadr := img.adr + y * img.bpr + dbit DIV 8; dbit := dbit MOD 8;
-		Bind(mode, fmt, img.fmt);
-		mode.transfer(mode, ADDRESSOF(buf[ofs]), 0, dadr, dbit, w)
-	END PutPixels;
-
-	(** copy rectangular area to the same or another image in specified mode **)
-	PROCEDURE Copy* (src, dst: Image; llx, lly, urx, ury, dx, dy: LONGINT; VAR mode: Mode);
-		VAR w, h, sbit, dbit, slen, sb, db, len, l: LONGINT; sadr, dadr, sa, da: ADDRESS;
-	BEGIN
-		ASSERT((0 <= llx) & (llx <= urx) & (urx <= src.width) & (0 <= lly) & (lly <= ury) & (ury <= src.height), 100);
-		ASSERT((0 <= dx) & (dx + urx - llx <= dst.width) & (0 <= dy) & (dy + ury - lly <= dst.height), 101);
-		Bind(mode, src.fmt, dst.fmt);
-		w := urx - llx; h := ury - lly;
-		IF (src # dst) OR (lly > dy) OR (lly = dy) & ((llx > dx) OR (urx <= dx)) THEN	(* copy lines bottom-up *)
-			sbit := llx * src.fmt.bpp;  sadr := src.adr + lly * src.bpr + sbit DIV 8; sbit := sbit MOD 8;
-			dbit := dx * dst.fmt.bpp; dadr := dst.adr + dy * dst.bpr + dbit DIV 8; dbit := dbit MOD 8;
-			WHILE h > 0 DO
-				mode.transfer(mode, sadr, sbit, dadr, dbit, w);
-				INC(sadr, src.bpr); INC(dadr, dst.bpr); DEC(h)
-			END
-		ELSIF lly < dy THEN	(* copy lines top-down *)
-			sbit := llx * src.fmt.bpp; sadr := src.adr + ury * src.bpr + sbit DIV 8;  sbit := sbit MOD 8;
-			dbit := dx * dst.fmt.bpp; dadr := dst.adr + (dy + h) * dst.bpr + dbit DIV 8; dbit := dbit MOD 8;
-			WHILE h > 0 DO
-				DEC(sadr, src.bpr); DEC(dadr, dst.bpr); DEC(h);
-				mode.transfer(mode, sadr, sbit, dadr, dbit, w)
-			END
-		ELSIF llx # dx THEN	(* uh oh! overlapping spans *)
-			slen := dx + w - urx;	(* maximal span length guaranteeing non-overlapping spans *)
-			sbit := urx * src.fmt.bpp; sadr := src.adr + lly * src.bpr + sbit DIV 8; sbit := sbit MOD 8;
-			dbit := (dx + w) * dst.fmt.bpp; dadr := dst.adr + dy * dst.bpr + dbit DIV 8; dbit := dbit MOD 8;
-			WHILE h > 0 DO
-				sa := sadr; sb := sbit; da := dadr; db := dbit; len := w;
-				WHILE len > 0 DO
-					l := slen;
-					IF l > len THEN l := len END;
-					DEC(sb, l * src.fmt.bpp); INC(sa, sb DIV 8); sb := sb MOD 8;
-					DEC(db, l * dst.fmt.bpp); INC(da, db DIV 8); db := db MOD 8;
-					mode.transfer(mode, sa, sb, da, db, l);
-					DEC(len, l)
-				END;
-				INC(sadr, src.bpr); INC(dadr, dst.bpr); DEC(h)
-			END
-		END
-	END Copy;
-
-	(** replicate pattern within rectangular area of image using given mode **)
-	PROCEDURE FillPattern* (pat, dst: Image; llx, lly, urx, ury, px, py: LONGINT; VAR mode: Mode);
-		VAR pw, ph, olx, oby, ilx, olw, irw, dy, sy, dx, sx, ty: LONGINT;
-	BEGIN
-		ASSERT((0 <= llx) & (llx <= urx) & (urx <= dst.width) & (0 <= lly) & (lly <= ury) & (ury <= dst.height), 100);
-		pw := pat.width; ph := pat.height;
-		olx := px + (llx - px) DIV pw * pw;
-		oby := py + (lly - py) DIV ph * ph;
-		ilx := olx + pw; olw := llx - olx;
-		irw := (urx - px) MOD pw;
-		IF urx - irw < ilx THEN irw := olw + urx - llx END;
-		dy := lly; sy := lly - oby;
-		IF (oby < lly) & (oby + ph <= ury) THEN
-			dx := llx; sx := olw;
-			IF (olx < llx) & (ilx <= urx) THEN
-				Copy(pat, dst, sx, sy, pw, ph, llx, lly, mode);
-				dx := ilx; sx := 0
-			END;
-			WHILE dx + pw <= urx DO
-				Copy(pat, dst, 0, sy, pw, ph, dx, lly, mode);
-				INC(dx, pw)
-			END;
-			IF dx < urx THEN
-				Copy(pat, dst, sx, sy, irw, ph, dx, lly, mode)
-			END;
-			dy := oby + ph; sy := 0
-		END;
-		WHILE dy + ph <= ury DO
-			dx := llx; sx := olw;
-			IF (olx < llx) & (ilx <= urx) THEN
-				Copy(pat, dst, sx, 0, pw, ph, llx, dy, mode);
-				dx := ilx; sx := 0
-			END;
-			WHILE dx + pw <= urx DO
-				Copy(pat, dst, 0, 0, pw, ph, dx, dy, mode);
-				INC(dx, pw)
-			END;
-			IF dx < urx THEN
-				Copy(pat, dst, sx, 0, irw, ph, dx, dy, mode)
-			END;
-			INC(dy, ph)
-		END;
-		IF dy < ury THEN
-			ty := sy + ury - dy;
-			dx := llx; sx := olw;
-			IF (olx < llx) & (ilx <= urx) THEN
-				Copy(pat, dst, sx, sy, pw, ty, llx, dy, mode);
-				dx := ilx; sx := 0
-			END;
-			WHILE dx + pw <= urx DO
-				Copy(pat, dst, 0, sy, pw, ty, dx, dy, mode);
-				INC(dx, pw)
-			END;
-			IF dx < urx THEN
-				Copy(pat, dst, sx, sy, irw, ty, dx, dy, mode)
-			END
-		END
-	END FillPattern;
-
-	(** darken image while maintaining coverage **)
-	PROCEDURE Darken* (img: Image; factor: REAL);
-		VAR s, i, j, k, y, x, bit: LONGINT; adr: ADDRESS; clamp: ARRAY 256 OF CHAR; pix: Pixel;
-	BEGIN
-		s := ABS(ENTIER(255*factor + 0.5));
-		IF (s # 255) & (img.fmt.components # {alpha}) THEN
-			i := 256; j := 256*s;
-			REPEAT
-				DEC(i); DEC(j, s); k := j DIV 255;
-				IF k <= 255 THEN clamp[i] := CHR(k) ELSE clamp[i] := 0FFX END
-			UNTIL i = 0;
-			y := 0;
-			WHILE y < img.height DO
-				x := 0; adr := img.adr + y * img.bpr; bit := 0;
-				WHILE x < img.width DO
-					img.fmt.unpack(img.fmt, adr, bit, pix);
-					pix[r] := clamp[ORD(pix[r])]; pix[g] := clamp[ORD(pix[g])]; pix[b] := clamp[ORD(pix[b])];
-					img.fmt.pack(img.fmt, adr, bit, pix);
-					bit := bit + img.fmt.bpp; INC(adr, bit); bit := bit MOD 8;
-					INC(x)
-				END;
-				INC(y)
-			END
-		END
-	END Darken;
-
-	(** fade image **)
-	PROCEDURE Fade* (img: Image; factor: REAL);
-		VAR s, i, j, k, y, x, bit: LONGINT; adr: ADDRESS; clamp: ARRAY 256 OF CHAR; pix: Pixel;
-	BEGIN
-		s := ABS(ENTIER(255*factor + 0.5));
-		IF s = 0 THEN
-			Clear(img)
-		ELSIF s # 255 THEN
-			i := 256; j := 256*s;
-			REPEAT
-				DEC(i); DEC(j, s); k := j DIV 255;
-				IF k <= 255 THEN clamp[i] := CHR(k) ELSE clamp[i] := 0FFX END
-			UNTIL i = 0;
-			y := 0;
-			WHILE y < img.height DO
-				x := 0; adr := img.adr + y * img.bpr; bit := 0;
-				WHILE x < img.width DO
-					img.fmt.unpack(img.fmt, adr, bit, pix);
-					pix[r] := clamp[ORD(pix[r])]; pix[g] := clamp[ORD(pix[g])];
-					pix[b] := clamp[ORD(pix[b])]; pix[a] := clamp[ORD(pix[a])];
-					img.fmt.pack(img.fmt, adr, bit, pix);
-					bit := bit + img.fmt.bpp; INC(adr, bit); bit := bit MOD 8;
-					INC(x)
-				END;
-				INC(y)
-			END
-		END
-	END Fade;
-
-	(** make image brighter and more transparent; Opaque(I, f) = Darken(Fade(I, f), 1/f) **)
-	PROCEDURE Opaque* (img: Image; factor: REAL);
-		VAR s, i, j, k, y, x, bit: LONGINT; adr: ADDRESS; clamp: ARRAY 256 OF CHAR; pix: Pixel;
-	BEGIN
-		s := ABS(ENTIER(255*factor + 0.5));
-		IF s = 0 THEN
-			Clear(img)
-		ELSIF s # 255 THEN
-			i := 256; j := 256*s;
-			REPEAT
-				DEC(i); DEC(j, s); k := j DIV 255;
-				IF k <= 255 THEN clamp[i] := CHR(k) ELSE clamp[i] := 0FFX END
-			UNTIL i = 0;
-			y := 0;
-			WHILE y < img.height DO
-				x := 0; adr := img.adr + y * img.bpr; bit := 0;
-				WHILE x < img.width DO
-					img.fmt.unpack(img.fmt, adr, bit, pix);
-					pix[a] := clamp[ORD(pix[a])];
-					img.fmt.pack(img.fmt, adr, bit, pix);
-					bit := bit + img.fmt.bpp; INC(adr, bit); bit := bit MOD 8;
-					INC(x)
-				END;
-				INC(y)
-			END
-		END
-	END Opaque;
-
-	(** add components of two (faded) images **)
-	PROCEDURE Add* (i, j, res: Image);
-		VAR y, x, ibit, jbit, rbit, k: LONGINT; iadr, jadr, radr: ADDRESS; ipix, jpix, rpix: Pixel;
-	BEGIN
-		ASSERT((i.width = j.width) & (i.height = j.height) & (i.width <= res.width) & (i.height <= res.height), 100);
-		y := 0;
-		WHILE y < i.height DO
-			x := 0; iadr := i.adr + y * i.bpr; ibit := 0; jadr := j.adr + y * j.bpr; jbit := 0; radr := res.adr + y * res.bpr; rbit := 0;
-			WHILE x < i.width DO
-				i.fmt.unpack(i.fmt, iadr, ibit, ipix); j.fmt.unpack(j.fmt, jadr, jbit, jpix);
-				FOR k := 0 TO 3 DO
-					rpix[k] := Clamp[ORD(ipix[k]) + ORD(jpix[k])]
-				END;
-				res.fmt.pack(res.fmt, radr, rbit, rpix);
-				ibit := ibit + i.fmt.bpp; INC(iadr, ibit); ibit := ibit MOD 8;
-				jbit := jbit + j.fmt.bpp; INC(jadr, jbit); jbit := jbit MOD 8;
-				rbit := rbit + res.fmt.bpp; INC(radr, rbit); rbit := rbit MOD 8;
-				INC(x)
-			END;
-			INC(y)
-		END
-	END Add;
-
-	(** copy image to another using error diffusion dithering (Floyd-Steinberg) **)
-	PROCEDURE Dither* (src, dst: Image);
-		TYPE
-			error = RECORD r, g, b: LONGINT END;
-		VAR
-			e351: POINTER TO ARRAY OF error;
-			y, x, sb, db, ex, e, e3, e5: LONGINT;
-			sadr, dadr, sa, da: ADDRESS;
-			e7, e51, e1: error;
-			spix, dpix: Pixel;
-	BEGIN
-		ASSERT((src.width <= dst.width) & (src.height <= dst.height), 100);
-		NEW(e351, src.width+2);	(* accumulated error for next row *)
-		y := 0; sadr := src.adr; dadr := dst.adr;
-		WHILE y < src.height DO 	(* scan from left to right *)
-			e7.r := 0; e7.g := 0; e7.b := 0;
-			e51.r := 0; e51.g := 0; e51.b := 0;
-			e1.r := 0; e1.g := 0; e1.b := 0;
-			x := 0; sa := sadr; sb := 0; da := dadr; db := 0;
-			WHILE x < src.width DO
-				ex := x+1;
-				src.fmt.unpack(src.fmt, sa, sb, spix);
-				spix[r] := Clamp[200H + ORD(spix[r]) + e351[ex].r + e7.r];
-				spix[g] := Clamp[200H + ORD(spix[g]) + e351[ex].g + e7.g];
-				spix[b] := Clamp[200H + ORD(spix[b]) + e351[ex].b + e7.b];
-				dst.fmt.pack(dst.fmt, da, db, spix);
-				dst.fmt.unpack(dst.fmt, da, db, dpix);
-				e := ORD(spix[r]) - ORD(dpix[r]); e3 := 3*e DIV 16; e5 := 5*e DIV 16;
-				e7.r := 7*e DIV 16; e351[x].r := e3 + e51.r; e51.r := e5 + e1.r; e1.r := e - e3 - e5 - e7.r;
-				e := ORD(spix[g]) - ORD(dpix[g]); e3 := 3*e DIV 16; e5 := 5*e DIV 16;
-				e7.g := 7*e DIV 16; e351[x].g := e3 + e51.g; e51.g := e5 + e1.g; e1.g := e - e3 - e5 - e7.g;
-				e := ORD(spix[b]) - ORD(dpix[b]); e3 := 3*e DIV 16; e5 := 5*e DIV 16;
-				e7.b := 7*e DIV 16; e351[x].b := e3 + e51.b; e51.b := e5 + e1.b; e1.b := e - e3 - e5 - e7.b;
-				sb := sb + src.fmt.bpp; INC(sa, sb DIV 8); sb := sb MOD 8;
-				db := db + dst.fmt.bpp; INC(da, db DIV 8); db := db MOD 8;
-				x := ex
-			END;
-			INC(y); INC(sadr, src.bpr); INC(dadr, dst.bpr);
-			IF y < src.height THEN	(* scan from right to left *)
-				e351[x] := e51;
-				e7.r := 0; e7.g := 0; e7.b := 0;
-				e51.r := 0; e51.g := 0; e51.b := 0;
-				e1.r := 0; e1.g := 0; e1.b := 0;
-				INC(sa, src.bpr); INC(da, dst.bpr);
-				WHILE x > 0 DO
-					ex := x; DEC(x);
-					sb := sb - src.fmt.bpp; INC(sa, sb DIV 8); sb := sb MOD 8;
-					db := db - dst.fmt.bpp; INC(da, db DIV 8); db := db MOD 8;
-					src.fmt.unpack(src.fmt, sa, sb, spix);
-					spix[r] := Clamp[200H + ORD(spix[r]) + e351[ex].r + e7.r];
-					spix[g] := Clamp[200H + ORD(spix[g]) + e351[ex].g + e7.g];
-					spix[b] := Clamp[200H + ORD(spix[b]) + e351[ex].b + e7.b];
-					dst.fmt.pack(dst.fmt, da, db, spix);
-					dst.fmt.unpack(dst.fmt, da, db, dpix);
-					INC(ex);
-					e := ORD(spix[r]) - ORD(dpix[r]); e3 := 3*e DIV 16; e5 := 5*e DIV 16;
-					e7.r := 7*e DIV 16; e351[x].r := e3 + e51.r; e51.r := e5 + e1.r; e1.r := e - e3 - e5 - e7.r;
-					e := ORD(spix[g]) - ORD(dpix[g]); e3 := 3*e DIV 16; e5 := 5*e DIV 16;
-					e7.g := 7*e DIV 16; e351[x].g := e3 + e51.g; e51.g := e5 + e1.g; e1.g := e - e3 - e5 - e7.g;
-					e := ORD(spix[b]) - ORD(dpix[b]); e3 := 3*e DIV 16; e5 := 5*e DIV 16;
-					e7.b := 7*e DIV 16; e351[x].b := e3 + e51.b; e51.b := e5 + e1.b; e1.b := e - e3 - e5 - e7.b
-				END;
-				e351[1] := e51;
-				INC(y); INC(sadr, src.bpr); INC(dadr, dst.bpr)
-			END
-		END
-	END Dither;
-
-
-	(**--- File I/O ---**)
-
-	(** write image to file rider **)
-	PROCEDURE Write* (VAR fr: Streams.Writer; img: Image);
-	VAR m: Image; h, w, len: LONGINT; adr, aa: ADDRESS; buf: ARRAY 256 OF CHAR;
-			SrcCopy:Mode;
-	BEGIN
-		InitMode(SrcCopy, srcCopy);
-		IF ~(img.fmt.code IN {a1..bgra8888,p16}) THEN
-			NEW(m);
-			IF img.fmt.components = {color} THEN Create(m, img.width, img.height, BGR888)
-			ELSIF img.fmt.components = {alpha} THEN Create(m, img.width, img.height, A8)
-			ELSIF img.fmt.components = {index} THEN Create(m, img.width, img.height, D8)
-			ELSE Create(m, img.width, img.height, BGRA8888)
-			END;
-			Copy(img, m, 0, 0, img.width, img.height, 0, 0, SrcCopy);
-			img := m
-		END;
-		fr.RawNum(2);	(* version *)
-		fr.RawNum(img.fmt.code);
-		fr.RawNum(img.width); fr.RawNum(img.height);
-		fr.RawNum(ABS(img.bpr));
-		h := img.height; adr := img.adr;
-		WHILE h > 0 DO
-			w := ABS(img.bpr); aa := adr;
-			WHILE w > 0 DO
-				len := 256;
-				IF len > w THEN len := w END;
-				SYSTEM.MOVE(aa, ADDRESSOF(buf[0]), len);
-				fr.Bytes(buf, 0, len);
-				DEC(w, len); INC(aa, len)
-			END;
-			DEC(h); INC(adr, img.bpr)
-		END;
-		IF img.fmt.code IN {p8,p16} THEN
-			fr.RawNum(img.fmt.pal.used);
-			len := 0;
-			WHILE len < img.fmt.pal.used DO
-				fr.Char(img.fmt.pal.col[len, r]);
-				fr.Char(img.fmt.pal.col[len, g]);
-				fr.Char(img.fmt.pal.col[len, b]);
-				INC(len)
-			END
-		END;
-		fr.Update	(* optional *)
-	END Write;
-
-	(** read image from file rider **)
-	PROCEDURE Read* (VAR fr: Streams.Reader; img: Image);
-		VAR ver, code, w, h, bpr, len, bytesRead: LONGINT; adr, aa: ADDRESS; fmt: Format; buf: ARRAY 256 OF CHAR; used: LONGINT;
-	BEGIN
-		ASSERT(img#NIL,100);
-		fr.RawNum(ver);	(* know version 1&2*)
-		ASSERT(ver IN {1,2},101);
-		fr.RawNum(code);
-		CASE code OF
-		| a1: fmt := A1
-		| a8: fmt := A8
-		| p8: InitFormat(fmt, p8, 8, 1, {index}, NIL, PackP8, UnpackP8)
-		| d8: fmt := D8
-		| p16: InitFormat(fmt, p16, 16, 2, {index}, NIL, PackP16, UnpackP16);
-		| bgr555: fmt := BGR555
-		| bgr565: fmt := BGR565
-		| bgr466: fmt := BGR466
-		| bgr888: fmt := BGR888
-		| bgra8888: fmt := BGRA8888
-		END;
-		fr.RawNum(w); fr.RawNum(h);
-		Create(img, SHORT(w), SHORT(h), fmt);
-		fr.RawNum(bpr);
-		ASSERT(bpr <= img.bpr);
-		adr := img.adr;
-		WHILE h > 0 DO
-			w := bpr; aa := adr;
-			WHILE w > 0 DO
-				len := 256;
-				IF len > w THEN len := w END;
-				fr.Bytes(buf, 0, len, bytesRead);	(* ignore bytesRead *)
-				SYSTEM.MOVE(ADDRESSOF(buf[0]), aa, len);
-				DEC(w, len); INC(aa, len)
-			END;
-			DEC(h); INC(adr, img.bpr)
-		END;
-		IF code IN {p8,p16} THEN
-			fr.RawNum(used);
-			len := 0;
-			NEW(img.fmt.pal); img.fmt.pal.Init(used);
-			WHILE len < used DO
-				fr.Char(img.fmt.pal.col[len, r]);
-				fr.Char(img.fmt.pal.col[len, g]);
-				fr.Char(img.fmt.pal.col[len, b]);
-				img.fmt.pal.col[len, a] := 0FFX;
-				INC(len)
-			END;
-			InitPalette(img.fmt.pal, used, 4)
-		END
-	END Read;
-
-	(*--- Initialization ---*)
-
-	PROCEDURE InitBitTables;
-		VAR b, i: LONGINT;
-	BEGIN
-		FOR b := 0 TO 0FFH DO
-			FOR i := 0 TO 7 DO
-				IF ODD(ASH(b, -i)) THEN
-					Bit[b, i] := TRUE; Set[b, i] := CHR(b); Clr[b, i] := CHR(b - ASH(1, i))
-				ELSE
-					Bit[b, i] := FALSE; Set[b, i] := CHR(b + ASH(1, i)); Clr[b, i] := CHR(b)
-				END
-			END
-		END
-	END InitBitTables;
-
-	PROCEDURE InitClamp;
-		VAR i: LONGINT;
-	BEGIN
-		FOR i := 0 TO 1FFH DO Clamp[i] := 0X END;
-		FOR i := 0 TO 0FFH DO Clamp[200H+i] := CHR(i) END;
-		FOR i := 300H TO 4FFH DO Clamp[i] := 0FFX END
-	END InitClamp;
-
-	PROCEDURE ToggleMMX*;
-	BEGIN
-		MMXenabled := ~MMXenabled
-	END ToggleMMX;
-
-	PROCEDURE ToggleSSE2*;
-	BEGIN
-		SSE2enabled := ~SSE2enabled;
-		KernelLog.String("SSE2 toggled! Is now: ");  KernelLog.Boolean(SSE2enabled);KernelLog.Ln;
-	END ToggleSSE2;
-
-	(** Map a color value to an 8-bit CLUT index.  Only used if format = index8. *)
-	PROCEDURE ColorToIndex*(col: LONGINT): LONGINT;
-	BEGIN
-			(* default implementation is not very useful and should be overridden. *)
-		RETURN SYSTEM.VAL(LONGINT,
-				SYSTEM.VAL(SET, ASH(col, 7-23)) * {5..7} +
-				SYSTEM.VAL(SET, ASH(col, 4-15)) * {2..4} +
-				SYSTEM.VAL(SET, ASH(col, 1-7)) * {0..1})
-	END ColorToIndex;
-
-	(** Map an 8-bit CLUT index to a color value.  Only used if format = index8. *)
-	PROCEDURE IndexToColor*(index: LONGINT): LONGINT;
-	BEGIN
-			(* default implementation is not very useful and should be overridden. *)
-		RETURN
-				ASH(SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, index) * {5..7}), 23-7) +
-				ASH(SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, index) * {2..4}), 15-4) +
-				ASH(SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, index) * {0..1}), 7-1)
-	END IndexToColor;
-
-BEGIN
-	(*MMXenabled := 23 IN Machine.features;
-	SSE2enabled := Machine.SSE2Support;*)
-(*	plugin := Displays.registry.Await("");	(* assume only one system-wide D8 display driver *)
-	d8display := plugin(Displays.Display); *)
-	InitFormat(A1, a1, 1, 1, {alpha}, NIL, PackA1, UnpackA1);
-	InitFormat(A8, a8, 8, 1, {alpha}, NIL, PackA8, UnpackA8);
-	InitFormat(D8, d8, 8, 1, {index}, NIL, PackD8, UnpackD8);
-	InitFormat(BGR555, bgr555, 16, 2, {color}, NIL, PackBGR555, UnpackBGR555);
-	InitFormat(BGR565, bgr565, 16, 2, {color}, NIL, PackBGR565, UnpackBGR565);
-	InitFormat(BGR466, bgr466, 16, 2, {color}, NIL, PackBGR466, UnpackBGR466);
-	InitFormat(BGR888, bgr888, 24, 4, {color}, NIL, PackBGR888, UnpackBGR888);
-	InitFormat(BGRA8888, bgra8888, 32, 4, {color, alpha}, NIL, PackBGRA8888, UnpackBGRA8888);
-	PixelFormat := BGRA8888;
-	Zero[0] := 0X; Zero[1] := 0X; Zero[2] := 0X; Zero[3] := 0X;
-	InitBitTables; InitClamp
-END Raster.
-
-(**
-Remarks
-
-1. Images
-While many applications wish to handle images of any kind without having to care about details, other applications need low-level access to image interna for maximum effiency. With this in mind, the Images module provides an abstract procedural interface but also discloses low-level information to those clients needing it:
-	* an image references a contiguous block of memory holding pixel data
-	* the point of reference is the address of the pixel in the lower-left corner
-	* pixels are organized in rows (either bottom-up or top-down)
-	* rows can be aligned to an arbitrary number of bytes
-	* the leftmost pixel in a row has the lowest address of all pixels in that row
-	* every pixel uses the same number of bits
-Memory for images can be automatically allocated by using Create(). Alternatively, an image can be initialized on an existing memory block (Init(), InitBuf()) or even on part of an other image (InitRect()).
-
-2. Pixels
-A general pixel pix[] contains four components (in range 0X..255X), specifying red, green, blue, and alpha value of the pixel and accessable as pix[r], pix[g], pix[b] and pix[a]. Note that in order to speed up compositing operations, the alpha value is premultiplied into the color components. Example: a red pixel with 50% coverage can be initialized with SetRGBA(pix, 255, 0, 0, 127), after which pix[r]=pix[a]=7FX and pix[g]=pix[b]=0X. Use GetRGBA() to recover the original color and alpha values.
-
-3. Palettes
-Many bitmap images and Oberon display drivers use some kind of indexed format to store colors, i.e. the value stored in the bitmap serves as an index into an array of colors. A Palette stores up to 256 colors as an array of pixels, making the mapping of an index to the corresponding color straightforward. To speed up the inverse mapping from an RGB triple to an index with PaletteIndex(), additional data is initialized when InitPalette() is called. Use ComputePalette() to compute a palette that best approximates the colors in a given image (e.g. before quantizing it to indexed format).
-
-4. Formats
-While general pixels accurately describe color and alpha information, they use a lot of memory (32 bits). Most images therefore only store part of that information. A Format record describes how pixels are represented within an image. It contains
-	* the number of bits used per pixel (must be 1, 2, 4, 8, 16, 24 or 32)
-	* the set of components stored in a pixel (color, index and/or alpha)
-	* a palette if the format uses one
-	* procedures for storing (packing) and loading (unpacking) a general pixel
-The pack and unpack procedures are given an address and a bit number specifying where the pixel is located in memory, with bit numbers ascending from left to right (although a format is free to choose any bit ordering within a pixel).
-
-5. Predefined Formats
-The following global variables contain formats which are special and have a unique code number identifying them. Besides, most operations have better performance if acting on images using them.
-	* A1 (code a1): one bit alpha, MSB leftmost (corresponds to Oberon display patterns)
-	* A8 (code a8): 8 bit alpha (mainly for anti-aliased character patterns)
-	* - (code p8): 8 bit indexed with custom palette (Oberon pictures, use InitPaletteFormat to initialize)
-	* D8 (code d8): 8 bit indexed with display palette (no palette structure attached)
-	* - (code p16): 16 bit indexed with 16bit Palette. This type is, e.g.,  often used in medical imaging (DICOM-3 standard) (* PH 2004 *)
-	* BGR555 (code bgr555), BGR565 (code bgr565), BGR466 (code bgr466): 16 bit hi-color
-	* BGR888 (code bgr888): 24 bit true-color
-	* BGRA8888 (code bgra8888), PixelFormat: 32 bit true-color with alpha channel (general pixel format)
-Procedure DisplayFormat() returns the format that best matches the supplied kind of display transfer format. The returned image format is preferably used for allocating shadow bitmaps.
-
-6. Compositing
-Most operations require a transfer mode for specifying how source and destination pixels should be combined when alpha information is present. The following compositing operations are supported:
-	* clear: destination becomes black and completely transparent
-	* srcCopy: source completely replaces destination (cf. Display.replace)
-	* dstCopy: no effect
-	* srcOverDst: source replaces destination where source is opaque (cf. Display.paint)
-	* dstOverSrc: destination replaces source where destination is opaque
-	* srcInDst: source where destination is opaque
-	* dstInSrc: destination where source is opaque
-	* srcWithoutDest*: source is cleared where destination is opaque
-	* dstWithoutSrc*: destination is cleared where source is opaque
-	* srcAtopDst*: source replaces destination where destination is opaque
-	* dstAtopSrc*: destination replaces source where source is opaque
-	* srcXorDst*: destination is cleared where both source and destination are opaque (cf. Display.invert)
-A transfer mode is initialized with a compositing operation and optionally with a color. (The color is used when the source is a pure alpha format which doesn't contain any color of its own.) An initialized mode can be bound to a source and destination format by calling Bind(), by which the mode's transfer procedure is set appropriately. A transfer procedure unpacks pixels from source and destination, blends them according to the compositing operation, and packs the resulting pixel in the destination. Bind() chooses an optimal transfer procedure for the given combination of compositing operation, source format, and destination format.
-
-7. Internalization and Externalization
-Images can be loaded from file and stored to file using one of many popular image file formats. The Load() and Store() procedures rely on a section 'ImageFormats' in the Aos registry. This section contains a list of file types that are associated with command procedures. When one of these commands is called, it should initialize the global 'LoadProc' and 'StoreProc' variables. These, when called, should read an image from or write an image to the file and set 'done' to TRUE if successful.
-**)
-

ARM/ARM.A2/ARM.Runtime.Mod

@@ -1,12 +0,0 @@
-MODULE Runtime;
-VAR
-	kernelModule-: ARRAY 32 OF ADDRESS;
-	modules-: LONGINT;
-
-	PROCEDURE InsertModule*(a: ADDRESS): BOOLEAN;
-	BEGIN
-		kernelModule[modules] := a;
-		INC(modules);
-		RETURN TRUE
-	END InsertModule;
-END Runtime.

ARM/ARM.A2/ARM.UsbKeyboard.Mod

@@ -1,758 +0,0 @@
-MODULE UsbKeyboard; (** AUTHOR "cplattner; staubesv"; PURPOSE "Bluebottle USB Keyboard Driver" *) (** non-portable **)
-(**
- * Bluebottle USB Keyboard Driver (HID boot protocol)
- *
- * Usage:
- *
- *	UsbKeyboard.Install ~ loads this driver		SystemTools.Free UsbKeyboard ~ unloads it
- *
- *	UsbKeyboard.SetLayout dev file ~ sets the keyboard layout
- * 	UsbKeyboard.SetLayout UsbKeyboard00 KeyCH.Bin ~ sets the CH keyboard layout, for example
- *
- * References:
- *
- *	Device Class Definition for Human Interface Devices (HID), version 1.11
- *	HID Usage Tables, version 1.11
- *
- *	References are available at http://www.usb.org
- *
- * History:
- *
- *	30.09.2000 	cp first release
- *	18.10.2000 	cp fix size of interrupt endpoint and add warning message if keyboard fails
- *	27.02.2006	Correct handling for modifier keys (also generate event if only a modifier key is pressed) (staubesv)
- *	01.03.2006	Added SetLayout & KeyboardDriver.SetLayout (staubesv)
- *	22.01.2007	Splitted up Keyboard Driver for HID compatibility (ottigerm)
- *	26.06.2014	Basic port to ARM (tmartiel)
- *)
-
-IMPORT SYSTEM, Machine, Files, Inputs, Commands, KernelLog, Streams, Plugins, Modules, Usb, Usbdi, UsbHid;
-
-CONST
-
-	Name = "UsbKeyboard";
-	Description = "USB Keyboard Driver";
-	Priority = 10;
-
-	NumLock* = 0;
-	CapsLock* = 1;
-	ScrollLock* = 2;
-	(* Compose & kana not yet implemented *)
-	Compose = 3;
-	Kana = 4;
-
-	(* If you press a key and hold it down, the following will happen:					*)
-	(* 1. A Inputs.KeyboardMsg is sent											*)
-	(* 2. No further messages are sent until the period KeyDeadTime expires			*)
-	(* 3. Further messages are sent with the interval KeyDeadTimeRepeat				*)
-	(*																				*)
-	(* A release event is sent when you release the key.								*)
-	(* The values KeyDeadTime and KeyDeadTimeRepeat are set in milliseconds. 		*)
-	(*																				*)
-	KeyDeadTime* = 100;
-	KeyDeadTimeRepeat* = 0;  (* 10 <= value < infinity  && value mod 10 = 0 *)
-
-	TraceKeys* = FALSE; (* Displays scan code of pressed key on KernelLog if TRUE *)
-	Debug* = TRUE;
-
-TYPE
-
-	Key* = RECORD
-		ch* : CHAR;
-		keysym* : LONGINT;
-		counter* : LONGINT;
-		repeat* : BOOLEAN;
-		updated* : BOOLEAN;
-	END;
-
-TYPE
-
-	KeyboardBase*=OBJECT
-	VAR
-		msg*, lastMsg : Inputs.KeyboardMsg;
-		lastFlags : SET;
-
-		numKeyVal : LONGINT;
-		deadKey* : LONGINT;
-		dkHack* : LONGINT;  (* deadKey value should persist Release events ... *)
-
-		(* Status of NumLock,ScrollLock,CapsLock,Compose & Kana *)
-		leds*, lastLeds* : SET;
-		ledBuffer* : Usbdi.BufferPtr;
-
-		keyboardFileTable : POINTER TO ARRAY OF CHAR;
-		keytable* : ADDRESS; (* used as pointer to keyboardFileTable[0] *)
-
-		keyDeadTime*, keyDeadTimeRepeat* : LONGINT;
-
-
-		PROCEDURE HandleKey*(c : CHAR);
-		VAR k : LONGINT;
-		BEGIN
-			(* map USB Usage ID to keysym: Only non-alphanumeric keys are mapped by Keysym()  *)
-			msg.keysym := KeySym(c, leds);
-			IF TraceKeys THEN KernelLog.String("USB Usage ID: "); KernelLog.Hex(ORD(c), -3); END;
-			(* map USB Usage ID to Oberon key code *)
-			SYSTEM.GET(UsbScanTab() + ORD(c), c);
-			IF TraceKeys THEN KernelLog.String(" -> Oberon key code: "); KernelLog.Hex(ORD(c), -3) END;
-
-			IF c = CHR(58) THEN  leds := leds / {CapsLock};
-			ELSIF c = CHR(69) THEN leds := leds / {NumLock};
-			ELSIF c = CHR(70) THEN leds := leds / {ScrollLock};
-			ELSE
-				k := Translate(msg.flags, leds, c, keytable, deadKey, numKeyVal);
-				IF TraceKeys THEN KernelLog.String(" translated into: "); KernelLog.Char(CHR(k)); END;
-				(* if c is an ASCII character, then map c to keysym *)
-				IF (k  >= 1) & (k  <= 126) & (msg.keysym = Inputs.KsNil)  THEN msg.keysym := k; END;
-				IF k >= 0 THEN msg.ch := CHR(k) ELSE msg.ch := 0X END;
-				IF TraceKeys THEN
-					KernelLog.String(" Aos Keysym: "); IF msg.keysym = Inputs.KsNil THEN KernelLog.String("No Key"); ELSE KernelLog.Hex(msg.keysym, 9); END;
-					KernelLog.Ln; ShowFlags(msg.flags, leds); KernelLog.Ln;
-				END;
-				(* build up message for this event *)
-				IF (msg.flags # lastMsg.flags) OR (msg.ch # 0X) OR (msg.keysym # Inputs.KsNil) THEN
-					Inputs.keyboard.Handle(msg);
-				END;
-				lastMsg := msg;
-			END;
-		END HandleKey;
-
-		PROCEDURE HandleModifiers*(flags : SET);
-		VAR i : LONGINT;
-		BEGIN
-			IF flags # lastFlags THEN
-				msg.flags := {}; msg.ch := 0X; msg.keysym := Inputs.KsNil;
-				FOR i := 0 TO MAX(SET) DO
-					IF (i IN flags) & ~(i IN lastFlags) THEN (* modifier key pressed for the first time *)
-						msg.flags := {i}; msg.keysym := GetModifierKeysym(i);
-						Inputs.keyboard.Handle(msg);
-					ELSIF ~(i IN flags) & (i IN lastFlags) THEN (* modifier key released *)
-						msg.flags := {Inputs.Release}; msg.keysym := GetModifierKeysym(i);
-						Inputs.keyboard.Handle(msg);
-					END;
-				END;
-			END;
-			lastFlags := flags;
-		END HandleModifiers;
-
-		PROCEDURE TableFromFile*(CONST name: ARRAY OF CHAR): ADDRESS;
-		VAR f: Files.File; r: Files.Rider; len: LONGINT;
-		BEGIN
-			KernelLog.String("UsbKeyboard: "); KernelLog.String(" Loading layout "); KernelLog.String(name); KernelLog.Ln;
-			f := Files.Old(name);
-			IF f # NIL THEN
-				len := f.Length();
-				IF len MOD 4 = 0 THEN
-					NEW(keyboardFileTable, len+1);
-					f.Set(r, 0); f.ReadBytes(r, keyboardFileTable^, 0, len);
-					IF r.res = 0 THEN
-						keyboardFileTable[len] := 0FFX;
-						RETURN ADDRESSOF(keyboardFileTable[0])
-					ELSIF Debug THEN KernelLog.String("UsbKeyboard: TableFromFile: Error: res="); KernelLog.Int(r.res, 1); KernelLog.Ln;
-					END
-				ELSIF Debug THEN KernelLog.String("UsbKeyboard: TableFromFile: Error: len="); KernelLog.Int(len, 1); KernelLog.Ln;
-				END
-			ELSIF Debug THEN KernelLog.String("UsbKeyboard: TableFromFile: Error: File not found."); KernelLog.Ln;
-			END;
-			RETURN -1;
-		END TableFromFile;
-
-		PROCEDURE SetLayout*(CONST name : ARRAY OF CHAR);
-		VAR adr : ADDRESS;
-		BEGIN
-			IF name = "KeyUS.Bin" THEN adr := TableUS();
-			ELSE adr := TableFromFile(name);
-			END;
-			IF adr = -1 THEN (* Leave the current setting *)
-			ELSE SYSTEM.PUT(ADDRESSOF(keytable), adr);
-			END;
-		END SetLayout;
-
-	END KeyboardBase;
-
-	KeyboardDriver = OBJECT (UsbHid.HidDriver)
-	VAR
-		pipe : Usbdi.Pipe;
-
- 		(* buffer[0] : modifier byte					*)
-		(* buffer[1] : reserved						*)
-		(* buffer[2]-buffer[7] : 6 one byte key codes  	*)
-		buffer : Usbdi.BufferPtr;
-
-		base : KeyboardBase;
-
-		(*for keeing the pressed keys in mind*)
-		pressed* : ARRAY 6 OF Key;
-
-		PROCEDURE &Init*;
-		BEGIN
-			NEW(base);
-		END Init;
-
-		PROCEDURE EventHandler(status : Usbdi.Status; actLen : LONGINT);
-		VAR
-			i, j : LONGINT;
-			c : CHAR;
-			modifiers, flags : SET;
-			res : BOOLEAN;
-			tempPressed : ARRAY 6 OF Key;
-			found, kill : BOOLEAN;
-		BEGIN
-			IF (status=Usbdi.Ok) OR ((status = Usbdi.ShortPacket) & (actLen >= 8)) THEN
-
-				(* evaluate modifier keys *)
-				base.msg.flags := {};
-				modifiers := SYSTEM.VAL(SET, buffer[0]);
-				IF modifiers * {0} # {} THEN INCL(base.msg.flags, Inputs.LeftCtrl) END;
-				IF modifiers * {1} # {} THEN INCL(base.msg.flags, Inputs.LeftShift) END;
-				IF modifiers * {2} # {} THEN INCL(base.msg.flags, Inputs.LeftAlt) END;
-				IF modifiers * {3} # {} THEN INCL(base.msg.flags, Inputs.LeftMeta) END;
-				IF modifiers * {4} # {} THEN INCL(base.msg.flags, Inputs.RightCtrl) END;
-				IF modifiers * {5} # {} THEN INCL(base.msg.flags, Inputs.RightShift) END;
-				IF modifiers * {6} # {} THEN INCL(base.msg.flags, Inputs.RightAlt) END;
-				IF modifiers * {7} # {} THEN INCL(base.msg.flags, Inputs.RightMeta) END;
-				flags := base.msg.flags;
-
-				(* evaluate the six keycodes *)
-				FOR i := 2 TO 7 DO
-					c := buffer[i];
-					IF c # CHR(0) THEN (* buffer[i] contains key code *)
-
-						(* check whether the key is pressed for the first time, is still being pressed or has been released *)
-						FOR j := 0 TO 5 DO
-
-							IF pressed[j].ch = c THEN (* key is still pressed *)
-								found := TRUE;
-								pressed[j].updated := TRUE;
-
-								tempPressed[i-2].counter := pressed[j].counter + 1;
-								tempPressed[i-2].ch := pressed[j].ch;
-								tempPressed[i-2].keysym := pressed[j].keysym;
-								tempPressed[i-2].updated := FALSE;
-								tempPressed[i-2].repeat := pressed[j].repeat;
-
-								IF pressed[j].repeat THEN
-									IF (base.keyDeadTimeRepeat # 0) & (tempPressed[i-2].counter MOD base.keyDeadTimeRepeat # 0) THEN (* don't send key event *) kill := TRUE; END;
-								ELSE
-									IF tempPressed[i-2].counter MOD base.keyDeadTime # 0 THEN (* don't send key event *)
-										kill := TRUE;
-									ELSE
-										tempPressed[i-2].repeat := TRUE;
-									END;
-								END;
-							END;
-					    	END;
-					 END;
-
-					IF ~found THEN (* the key has not been pressed down before *)
-						tempPressed[i-2].ch := c;
-						tempPressed[i-2].repeat := FALSE;
-						tempPressed[i-2].updated := FALSE;
-						tempPressed[i-2].counter := 1;
-					END;
-
-				    (* kill : Key is pressed but do not generate key event this time -> repeat rate ... *)
-				    IF (c # CHR(0)) & ~kill THEN
-				    	base.HandleKey(c);
-				    	tempPressed[i-2].keysym := base.msg.keysym; (* base.msg.keysym asigned by HandleKey() ... *)
-				    END;
-				END; (* FOR LOOP *)
-
-				(* update pressed array. generate keyboard.base.msg's for released keys *)
-				FOR i := 0 TO 5 DO
-					IF (pressed[i].updated = FALSE) & (pressed[i].ch # CHR(0)) THEN (* this key has been released *)
-						base.msg.flags := {};
-						INCL(base.msg.flags, Inputs.Release);
-						base.msg.ch := pressed[i].ch;
-						base.msg.keysym := pressed[i].keysym;
-						base.dkHack := base.deadKey;  (* value of deadKey should persist the key release event *)
-						base.HandleKey(c);
-						base.deadKey := base.dkHack;
-					END;
-					pressed[i].counter := tempPressed[i].counter;
-					pressed[i].ch := tempPressed[i].ch;
-					pressed[i].keysym := tempPressed[i].keysym;
-					pressed[i].repeat := tempPressed[i].repeat;
-					pressed[i].updated := FALSE;
-				END;
-
-				(* Generate events for modifiers *)
-				base.HandleModifiers(flags);
-
-				(* update status of the LEDs  of the keyboad if necessary *)
-				IF base.lastLeds # base.leds THEN (* LED status has changed *)
-					base.ledBuffer[0] := SYSTEM.VAL(CHAR, base.leds); base.lastLeds := base.leds;
-					res := SetReport(UsbHid.ReportOutput, 0, base.ledBuffer, 1); (* ignore res *)
-				END;
-				status := pipe.Transfer(pipe.maxPacketSize, 0, buffer);
-			ELSE
-				IF Debug THEN KernelLog.String("UsbKeyboard: Error. Disabling keyboard "); KernelLog.String(name); KernelLog.Ln; END;
-			END;
-		END EventHandler;
-
-		PROCEDURE Connect*(): BOOLEAN;
-		VAR status : Usbdi.Status; endpoint: LONGINT; i: ADDRESS; k : ARRAY 32 OF CHAR;
-		BEGIN
-			IF ~SetProtocol(0) THEN
-				IF Debug THEN KernelLog.String("UsbKeyboard: Error: Cannot set keyboard into boot protocol mode."); KernelLog.Ln; END;
-				RETURN FALSE
-			END;
-
-			IF ~SetIdle(0,10) THEN
-				IF Debug THEN KernelLog.String("UsbKeyboard: Error: Cannot set idle the keyboard."); KernelLog.Ln; END;
-				RETURN FALSE
-			END;
-
-			endpoint := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, interface.endpoints[0].bEndpointAddress) * {0,1,2,3,7});
-
-			pipe := device.GetPipe(endpoint);
-			IF pipe = NIL THEN
-				IF Debug THEN KernelLog.String("UsbKeyboard: Could not get pipe."); KernelLog.Ln; END;
-				RETURN FALSE;
-			END;
-
-			(* Get  *)
-			Machine.GetConfig("Keyboard", k);
-			i := -1;
-			IF k # "" THEN i := base.TableFromFile(k); END;
-			IF i = -1 THEN (* Fallback to default *) i := TableUS(); END;
-			SYSTEM.PUT(ADDRESSOF(base.keytable), i);
-
-			(* Apply Numlock boot up state *)
-			Machine.GetConfig("NumLock", k);
-			IF k[0] = "1" THEN INCL(base.leds, NumLock) END;
-
-			base.keyDeadTime := KeyDeadTime DIV 10;
-			base.keyDeadTimeRepeat := KeyDeadTimeRepeat DIV 10;
-
-			NEW(base.ledBuffer, 1);
-
-			NEW(buffer, pipe.maxPacketSize);
-			pipe.SetTimeout(0);
-			pipe.SetCompletionHandler(EventHandler);
-			status := pipe.Transfer(pipe.maxPacketSize, 0, buffer); (* ignore status *)
-
-			RETURN TRUE;
-		END Connect;
-
-		PROCEDURE Disconnect*;
-		BEGIN
-			KernelLog.String("UsbKeyboard: USB Keyboard disconnected."); KernelLog.Ln;
-		END Disconnect;
-
-	END KeyboardDriver;
-
-VAR
-
-(* Translation table format:
- *
- *	table = { scancode unshifted-code shifted-code flags }  0FFX .
- *	scancode = <scancode byte from keyboard, bit 7 set for "grey" extended keys>
- *	unshifted-code = <CHAR produced by this scancode, without shift>
- *	shifted-code = <CHAR produced by this scancode, with shift>
- *	flags = <bit-mapped flag byte indicating special behaviour>
- *
- *	flag bit	function
- *		0	01	DeadKey: Set dead key flag according to translated key code (1-7)
- *		1	02	NumLock: if set, the state of NumLock will reverse the action of shift (for num keypad)
- *		2	04	CapsLock: if set, the state of CapsLock will reverse the action of shift (for alpha keys)
- *		3	08	LAlt:  \ the state of these two flags in the table and the current state of the two...
- *		4	10	RAlt: / ...Alt keys must match exactly, otherwise the search is continued.
- *		5	20	\
- *		6	40	 >  dead key number (0-7), must match current dead key flag
- *		7	80	/
- *
- *	The table is scanned sequentially (speed not critical).  Ctrl-Break, Ctrl-F10 and Ctrl-Alt-Del
- *	are always defined and are not in the table.   The control keys are also always defined.
- *)
-
-(* TableUS - US keyboard translation table (dead keys: ^=1, '=2, `=3, ~=4, "=5) *)
-PROCEDURE TableUS*(): ADDRESS;
-CODE
-	; Return address of first table element
-	ADD	R0, PC, #Base-8-$
-	MOV	SP, FP
-	LDR	FP, [SP], #4
-	LDR	LR, [SP], #4
-	BX		LR
-	; Table
-Base:
-		; alphabet
-	DB 1EH, 61H, 41H, 4H,		30H, 62H, 42H, 4H,		2EH, 63H, 43H, 4H,		20H, 64H, 44H, 4H
-	DB 12H, 65H, 45H, 4H,		21H, 66H, 46H, 4H,		22H, 67H, 47H, 4H,		23H, 68H, 48H, 4H
-	DB 17H, 69H, 49H, 4H,		24H, 6AH, 4AH, 4H,	25H, 6BH, 4BH, 4H,	26H, 6CH, 4CH, 4H
-	DB 32H, 6DH, 4DH, 4H,	31H, 6EH, 4EH, 4H,	18H, 6FH, 4FH, 4H,		19H, 70H, 50H, 4H
-	DB 10H, 71H, 51H, 4H,		13H, 72H, 52H, 4H,		1FH, 73H, 53H, 4H,		14H, 74H, 54H, 4H
-	DB 16H, 75H, 55H, 4H,		2FH, 76H, 56H, 4H,		11H, 77H, 57H, 4H,		2DH, 78H, 58H, 4H
-	DB 15H, 79H, 59H, 4H,		2CH, 7AH, 5AH, 4H
-
-		; dead keys (LAlt & RAlt)
-	DB 07H, 0FFH, 1H, 9H,		28H, 2H, 5H, 9H,	29H, 3H, 4H, 9H
-	DB 07H, 0FFH, 1H, 11H,	28H, 2H, 5H, 11H,	29H, 3H, 4H, 11H
-
-		; numbers at top
-	DB 0BH, 30H, 29H, 0H,		02H, 31H, 21H, 0H,		03H, 32H, 40H, 0H,		04H, 33H, 23H, 0H
-	DB 05H, 34H, 24H, 0H,		06H, 35H, 25H, 0H,		07H, 36H, 5EH, 0H,		08H, 37H, 26H, 0H
-	DB 09H, 38H, 2AH, 0H,		0AH, 39H, 28H, 0H
-		; symbol keys
-	DB 28H, 27H, 22H, 0H,		33H, 2CH, 3CH, 0H,	0CH, 2DH, 5FH, 0H,	34H, 2EH, 3EH, 0H
-	DB 35H, 2FH, 3FH, 0H,		27H, 3BH, 3AH, 0H,	0DH, 3DH, 2BH, 0H,	1AH, 5BH, 7BH, 0H
-	DB 2BH, 5CH, 7CH, 0H,	1BH, 5DH, 7DH, 0H,	29H, 60H, 7EH, 0H
-		; control keys
-	DB 0EH, 7FH, 7FH, 0H ; backspace
-	DB 0FH, 09H, 09H, 0H ; tab
-	DB 1CH, 0DH, 0DH, 0H ; enter
-	DB 39H, 20H, 20H, 0H ; space
-	DB 01H, 0FEH, 1BH, 0H ; esc
-		; keypad
-	DB 4FH, 0A9H, 31H, 2H ; end/1
-	DB 50H, 0C2H, 32H, 2H ; down/2
-	DB 51H, 0A3H, 33H, 2H ; pgdn/3
-	DB 4BH, 0C4H, 34H, 2H ; left/4
-	DB 4CH, 0FFH, 35H, 2H ; center/5
-	DB 4DH, 0C3H, 36H, 2H ; right/6
-	DB 47H, 0A8H, 37H, 2H ; home/7
-	DB 48H, 0C1H, 38H, 2H ; up/8
-	DB 49H, 0A2H, 39H, 2H ; pgup/9
-	DB 52H, 0A0H, 30H, 2H ; insert/0
-	DB 53H, 0A1H, 2EH, 2H ; del/.
-		; gray keys
-	DB 4AH, 2DH, 2DH, 0H ; gray -
-	DB 4EH, 2BH, 2BH, 0H ; gray +
-	DB 0B5H, 2FH, 2FH, 0H ; gray /
-	DB 37H, 2AH, 2AH, 0H ; gray *
-	DB 0D0H, 0C2H, 0C2H, 0H ; gray down
-	DB 0CBH, 0C4H, 0C4H, 0H ; gray left
-	DB 0CDH, 0C3H, 0C3H, 0H ; gray right
-	DB 0C8H, 0C1H, 0C1H, 0H ; gray up
-	DB 09CH, 0DH, 0DH, 0H ; gray enter
-	DB 0D2H, 0A0H, 0A0H, 0H ; gray ins
-	DB 0D3H, 0A1H, 0A1H, 0H ; gray del
-	DB 0C9H, 0A2H, 0A2H, 0H ; gray pgup
-	DB 0D1H, 0A3H, 0A3H, 0H ; gray pgdn
-	DB 0C7H, 0A8H, 0A8H, 0H ; gray home
-	DB 0CFH, 0A9H, 0A9H, 0H ; gray end
-		; function keys
-	DB 3BH, 0A4H, 0FFH, 0H ; F1
-	DB 3CH, 0A5H, 0FFH, 0H ; F2
-	DB 3DH, 1BH, 0FFH, 0H ; F3
-	DB 3EH, 0A7H, 0FFH, 0H ; F4
-	DB 3FH, 0F5H, 0FFH, 0H ; F5
-	DB 40H, 0F6H, 0FFH, 0H ; F6
-	DB 41H, 0F7H, 0FFH, 0H ; F7
-	DB 42H, 0F8H, 0FFH, 0H ; F8
-	DB 43H, 0F9H, 0FFH, 0H ; F9
-	DB 44H, 0FAH, 0FFH, 0H ; F10
-	DB 57H, 0FBH, 0FFH, 0H ; F11
-	DB 58H, 0FCH, 0FFH, 0H ; F12
-	DB 0FFH
-END TableUS;
-
-(* maps USB usage ID's to Oberon character code *)
-PROCEDURE UsbScanTab*() : ADDRESS;
-CODE
-	; Return address of first table element
-	ADD	R0, PC, #Base-8-$
-	MOV	SP, FP
-	LDR	FP, [SP], #4
-	LDR	LR, [SP], #4
-	BX		LR
-	; Table
-Base:
-	DB 000, 000, 000, 000, 030, 048, 046, 032, 018, 033, 034, 035, 023, 036, 037, 038
-	DB 050, 049, 024, 025, 016, 019, 031, 020, 022, 047, 017, 045, 021 ,044, 002, 003
-	DB 004, 005, 006, 007, 008, 009, 010, 011, 028, 001, 014, 015 ,057, 012, 013, 026
-	DB 027, 043, 043, 039, 040, 041, 051, 052, 053, 058, 059, 060, 061, 062, 063, 064
-	DB 065, 066, 067, 068, 087, 088, 099, 070, 119, 210, 199, 201, 211, 207, 209, 205
-	DB 203, 208, 200, 069, 181, 055, 074, 078, 156, 079, 080, 081, 075, 076, 077, 071
-	DB 072, 073, 082, 083, 086, 127, 116, 117, 085, 089, 090, 091, 092, 093, 094, 095
-	DB 120, 121, 122, 123, 134, 138, 130, 132, 128, 129, 131, 137, 133, 135, 136, 113
-	DB 115, 114, 000, 000, 000, 000, 000, 124, 000, 000, 000, 000, 000, 000, 000, 000
-	DB 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000
-	DB 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000
-	DB 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000
-	DB 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000
-	DB 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000, 000
-	DB 029, 042, 056, 125, 097, 054, 100, 126, 164, 166, 165, 163, 161, 115, 114, 113
-	DB 150, 158, 159, 128, 136, 177, 178, 176, 142, 152, 173, 140, 000, 000, 000, 000
-END UsbScanTab;
-
-(* Maps USB key code to X11 keysym (/usr/include/X11/keysymdef.h). *)
-PROCEDURE KeySym*(VAR ch : CHAR; VAR leds : SET): LONGINT;
-VAR res: LONGINT;
-BEGIN
-	CASE ch OF
-		028X: res := Inputs.KsReturn (* Return *)
-	    	|029X: res := Inputs.KsEscape (* Escape *)
-	    	|02AX: res := Inputs.KsBackSpace (* Delete (Backspace) *)
-	   	|02BX: res := Inputs.KsTab (* Tab *)
-		|03AX: res := Inputs.KsF1 (* f1 *)
-		|03BX: res := Inputs.KsF2 (* f2 *)
-		|03CX: res := Inputs.KsF3 (* f3 *)
-		|03DX: res := Inputs.KsF4 (* f4 *)
-		|03EX: res := Inputs.KsF5 (* f5 *)
-		|03FX: res := Inputs.KsF6 (* f6 *)
-		|040X: res := Inputs.KsF7 (* f7 *)
-		|041X: res := Inputs.KsF8 (* f8 *)
-		|042X: res := Inputs.KsF9 (* f9 *)
-		|043X: res := Inputs.KsF10 (* f10 *)
-		|044X: res := Inputs.KsF11 (* f11 *)
-		|045X: res := Inputs.KsF12 (* f12 *)
-		|046X: res := Inputs.KsPrint (* Printscreen *)
-		|047X: res := Inputs.KsScrollLock (* ScrollLock *)
-		|048X: res := Inputs.KsPause (* Pause *)
-		|049X: res := Inputs.KsInsert (* insert *)
-		|04AX: res := Inputs.KsHome (* home *)
-		|04BX: res := Inputs.KsPageUp (* pgup *)
-		|04CX: res := Inputs.KsDelete (* delete *)
-		|04DX: res := Inputs.KsEnd (* end *)
-		|04EX: res := Inputs.KsPageDown (* pgdn *)
-		|04FX: res := Inputs.KsRight (* right *)
-		|050X: res := Inputs.KsLeft (* left *)
-		|051X: res := Inputs.KsDown (* down *)
-		|052X: res := Inputs.KsUp (* up *)
-		|053X: res := Inputs.KsNumLock; (* Keypad NumLock *)
-		|054X: res := Inputs.KsKPDivide (* Keypad / *)
-		|055X: res := Inputs.KsKPMultiply (* Keypad * *)
-		|056X: res := Inputs.KsKPSubtract (* Keypad - *)
-		|057X: res := Inputs.KsKPAdd (* Keypad + *)
-		|058X: res := Inputs.KsReturn (* Keypad Enter: Should be KsKPEnter *)
-		|059X: IF ~(NumLock IN leds) THEN res := Inputs.KsEnd; ELSE res := Inputs.KsNil END;  (* Keypad 1 and End *)
-		|05AX: IF ~(NumLock IN leds) THEN res := Inputs.KsDown; ELSE res := Inputs.KsNil END;  (* Keypad 2 and Down Arrow *)
-		|05BX: IF ~(NumLock IN leds) THEN res := Inputs.KsPageDown; ELSE res := Inputs.KsNil END;  (* Keypad 3 and PageDown *)
-		|05CX: IF ~(NumLock IN leds) THEN res := Inputs.KsLeft; ELSE res := Inputs.KsNil END;  (* Keypad 4 and Left Arrow *)
-		|05DX: IF ~(NumLock IN leds) THEN ch := 0X; res := Inputs.KsNil; ELSE res := Inputs.KsNil END; (* don't report key event !! *)
-		|05EX: IF ~(NumLock IN leds) THEN res := Inputs.KsRight; ELSE res := Inputs.KsNil END;  (* Keypad 6 and Right Arrow *)
-		|05FX: IF ~(NumLock IN leds) THEN res := Inputs.KsHome; ELSE res := Inputs.KsNil END;  (* Keypad 7 and Home *)
-		|060X: IF ~(NumLock IN leds) THEN res := Inputs.KsUp; ELSE res := Inputs.KsNil END;  (* Keypad 8 and Up Arrow *)
-		|061X: IF ~(NumLock IN leds) THEN res := Inputs.KsPageUp; ELSE res := Inputs.KsNil END;  (* Keypad 9 and Page Up *)
-		|062X: IF ~(NumLock IN leds) THEN res := Inputs.KsInsert; ELSE res := Inputs.KsNil END;  (* Keypad 0 and Insert *)
-		|063X: IF ~(NumLock IN leds) THEN res := Inputs.KsDelete; ELSE res := Inputs.KsNil END;  (* Keypad . and Delete *)
-		|067X:  IF ~(NumLock IN leds) THEN ch := 028X; res := Inputs.KsKPEnter; ELSE res := Inputs.KsNil END;  (* Keypad =; remap to KpEnter *)
-		|0B0X: ch := 0X; res := Inputs.KsNil;  (* Keypad 00; don't map *)
-		|0B1X: ch := 0X; res := Inputs.KsNil;  (* Keypad 000; don't map *)
-		|09AX: res := Inputs.KsSysReq (* SysReq / Attention *)
-		|0E0X: res := Inputs.KsControlL (* Left Control *)
-		|0E1X: res := Inputs.KsShiftL (* Left Shift *)
-		|0E2X: res := Inputs.KsAltL (* Left Alt *)
-		|0E3X: res := Inputs.KsMetaL (* Left GUI *)
-		|0E4X: res := Inputs.KsControlR (* Right Control *)
-		|0E5X: res := Inputs.KsShiftR (* Right Shift *)
-		|0E6X: res := Inputs.KsAltR (* Right Alt *)
-		|0E7X: res := Inputs.KsMetaR (* Right GUI *)
-		|076X: res := Inputs.KsMenu (* Windows Menu *)
-		|0FFX: res := Inputs.KsBreak (* Break *)
-	ELSE
-		(* if res=Inputs.KsNil, the KeySym will be assigned later (see HandleKey) *)
-		res := Inputs.KsNil (* no key *)
-	END;
-	RETURN res
-END KeySym;
-
-PROCEDURE GetModifierKeysym(modifier : LONGINT) : LONGINT;
-VAR res : LONGINT;
-BEGIN
-	CASE modifier OF
-		|Inputs.LeftCtrl: res := Inputs.KsControlL;
-		|Inputs.LeftShift: res := Inputs.KsShiftL;
-		|Inputs.LeftAlt: res := Inputs.KsAltL;
-		|Inputs.LeftMeta: res := Inputs.KsMetaL;
-		|Inputs.RightCtrl: res := Inputs.KsControlR;
-		|Inputs.RightShift: res := Inputs.KsShiftR;
-		|Inputs.RightAlt: res := Inputs.KsAltR;
-		|Inputs.RightMeta: res := Inputs.KsMetaR;
-	ELSE
-		res := Inputs.KsNil;
-	END;
-	RETURN res;
-END GetModifierKeysym;
-
-(* Translate - Translate scan code "c" to key. *)
-PROCEDURE Translate(flags, leds: SET;  c: CHAR; keyboardTable : ADDRESS; VAR keyboardDeadKey, keyboardKeyVal : LONGINT): LONGINT;
-CONST
-	(* The flags stored in the keytable are not the same as the ones defined in Inputs.
-		The parameter flags and leds use the Inputs constants.
-		The constants below are for the use of the flags stored in the keytable (variable s) *)
-	OScrollLock = 0;
-	ONumLock = 1;
-	OCapsLock = 2;
-	LAlt = 3;
-	RAlt = 4;
-	LCtrl = 5;
-	RCtrl = 6;
-	LShift = 7;
-	RShift = 8;
-	GreyEsc = 9;
-	LMeta = 13;
-	RMeta = 14;
-	Alt = {LAlt, RAlt};
-	Ctrl = {LCtrl, RCtrl};
-	Shift = {LShift, RShift};
-	DeadKey = 0;
-VAR
-	a: ADDRESS;
-	s1: CHAR;
-	s : SET;
-	k: INTEGER;
-	dkn: SHORTINT;
-BEGIN
-	IF (c = 46X) & (flags * Inputs.Ctrl # {}) THEN RETURN -2 END;  (* Ctrl-Break - break *)
-	IF (c = 44X) & (flags * Inputs.Ctrl # {}) THEN RETURN 0FFH END;	(* Ctrl-F10 - exit *)
-	IF (c = 53X) & (flags * Inputs.Ctrl # {}) & (flags * Inputs.Alt # {}) THEN RETURN 0FFH END; (* Ctrl-Alt-Del - exit *)
-
-	a := keyboardTable;
-
-	(* this loop linearly searches the keytable for an entry for the character c *)
-	LOOP
-		SYSTEM.GET(a, s1);
-
-		IF s1 = 0FFX THEN (* end of table -> unmapped key *)
-
-			(* reset key and dead key state *)
-			k := -1;  keyboardDeadKey := 0;  EXIT;
-
-		ELSIF s1 = c THEN (* found scan code in table *)
-
-			k := 0;
-
-			SYSTEM.GET(a+3, SYSTEM.VAL(CHAR, s)); (* flags from table *)
-			dkn := SHORT(SHORT(SYSTEM.VAL(LONGINT, LSH(s * {5..7}, -5))));
-
-			s := s * {DeadKey, ONumLock, OCapsLock, LAlt, RAlt, LCtrl, RCtrl};
-
-			IF ((s * Alt = LSH(flags * Inputs.Alt,-2)) OR (ONumLock IN s) OR (s1>03BX))  & (dkn = keyboardDeadKey) THEN	(* Alt & dead keys match exactly *)
-
-				(* check if shift pressed *)
-				IF flags * Inputs.Shift # {} THEN INCL(s, LShift) END;
-
-				(* handle CapsLock *)
-				IF (OCapsLock IN s) & (CapsLock IN leds) THEN s := s / {LShift} END;
-
-				(* handle NumLock *)
-				IF ONumLock IN s THEN
-					IF flags * Inputs.Alt # {} THEN INCL(s, LShift)
-					ELSIF NumLock IN leds THEN s := s / {LShift}
-					END
-				END;
-
-				(* get key code *)
-				IF LShift IN s THEN SYSTEM.GET(a+2, SYSTEM.VAL(CHAR, k))	(* shifted value *)
-				ELSE SYSTEM.GET(a+1, SYSTEM.VAL(CHAR, k))	(* unshifted value *)
-				END;
-
-				IF (DeadKey IN s) & (k <= 7) THEN (* dead key *)
-					keyboardDeadKey := SHORT(k);  k := -1	(* set new dead key state *)
-				ELSIF k = 0FFH THEN	(* unmapped key *)
-					k := -1;  keyboardDeadKey := 0	(* reset dead key state *)
-				ELSE	(* mapped key *)
-					IF flags * Inputs.Ctrl # {} THEN
-						IF ((k >= 64) & (k <= 95)) OR ((k >= 97) & (k <= 122)) THEN
-							k := SHORT(SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, ADDRESS(k)) * {0..4}))	(* control *)
-						ELSIF k = 13 THEN	(* Ctrl-Enter *)
-							k := 10
-						END
-					END;
-					IF flags * Inputs.Alt # {} THEN	(* Alt-keypad *)
-						IF (k >= ORD("0")) & (k <= ORD("9")) & (NumLock IN s) THEN	(* keypad num *)
-							IF keyboardKeyVal = -1 THEN keyboardKeyVal := k-ORD("0")
-							ELSE keyboardKeyVal := (10*keyboardKeyVal + (k-ORD("0"))) MOD 1000;
-							END;
-							k := -1
-						END
-					END;
-					keyboardDeadKey := 0	(* reset dead key state *)
-				END;
-				EXIT
-			END
-		END;
-		INC(a, 4)
-	END; (* LOOP *)
-	RETURN k
-END Translate;
-
-(* Displays textual representation of the set flags to KernelLog *)
-PROCEDURE ShowFlags(flags, leds : SET);
-BEGIN
-	KernelLog.String("Flags: ");
-	IF Inputs.LeftAlt IN flags THEN KernelLog.String("[Left Alt]"); END;
-	IF Inputs.RightAlt IN flags THEN KernelLog.String("[Right Alt]"); END;
-	IF Inputs.LeftCtrl IN flags THEN KernelLog.String("[Left Ctrl]"); END;
-	IF Inputs.RightCtrl IN flags THEN KernelLog.String("[Rigth Ctrl]"); END;
-	IF Inputs.LeftShift IN flags THEN KernelLog.String("[Left Shift]"); END;
-	IF Inputs.RightShift IN flags THEN KernelLog.String("[Right Shift]"); END;
-	IF Inputs.LeftMeta IN flags THEN KernelLog.String("[Left Meta]"); END;
-	IF Inputs.RightMeta IN flags THEN KernelLog.String("[Rigth Meta]"); END;
-	IF Inputs.Release IN flags THEN KernelLog.String("[Released]"); END;
-	IF ScrollLock IN leds THEN KernelLog.String("[ScrollLock]"); END;
-	IF NumLock IN leds THEN KernelLog.String("[NumLock]"); END;
-	IF CapsLock IN leds THEN KernelLog.String("[CapsLock]"); END;
-	IF Compose IN leds THEN KernelLog.String("[Compose]"); END;
-	IF Kana IN leds THEN KernelLog.String("[Kana]"); END;
-END ShowFlags;
-
-PROCEDURE Probe(dev : Usbdi.UsbDevice; if : Usbdi.InterfaceDescriptor) : Usbdi.Driver;
-VAR driver : KeyboardDriver;
-BEGIN
-	IF if.bInterfaceClass # 3 THEN RETURN NIL END; (* HID class *)
-	IF if.bInterfaceSubClass # 1 THEN RETURN NIL END; (* Boot protocol subclass *)
-	IF if.bInterfaceProtocol # 1 THEN RETURN NIL END; (* Keyboard *)
-	IF if.bNumEndpoints # 1 THEN RETURN NIL END;
-	KernelLog.String("UsbKeyboard: USB Keyboard found."); KernelLog.Ln;
-	NEW(driver);
-	RETURN driver;
-END Probe;
-
-PROCEDURE SetLayout*(context : Commands.Context); (** dev file ~ *)
-VAR
-	string : ARRAY 64 OF CHAR;
-	plugin : Plugins.Plugin; kd : KeyboardDriver;
-BEGIN
-	IF context.arg.GetString(string) THEN
-		plugin := Usb.usbDrivers.Get(string);
-		IF plugin # NIL THEN
-			IF plugin IS KeyboardDriver THEN
-				kd := plugin (KeyboardDriver);
-			ELSE context.error.String("UsbKeyboard: Device "); context.error.String(string); context.error.String(" is not a keyboard."); context.error.Ln;
-			END;
-		ELSE context.error.String("UsbKeyboard: Device "); context.error.String(string); context.error.String(" not found."); context.error.Ln;
-		END;
-	ELSE context.error.String("UsbKeyboard: Expected <dev> parameter."); context.error.Ln;
-	END;
-	IF kd # NIL THEN
-		IF context.arg.GetString(string) THEN
-			kd.base.SetLayout(string);
-			context.out.String("Layout set to "); context.out.String(string); context.out.Ln;
-		END;
-	END;
-END SetLayout;
-
-PROCEDURE Install*;
-END Install;
-
-PROCEDURE Cleanup;
-BEGIN
-	Usbdi.drivers.Remove(Name);
-END Cleanup;
-
-BEGIN
-	Modules.InstallTermHandler(Cleanup);
-	Usbdi.drivers.Add(Probe, Name, Description, Priority);
-END UsbKeyboard.
-
-UsbKeyboard.Install ~ SystemTools.Free UsbKeyboard ~
-
-UsbKeyboard.SetLayout UsbKeyboard00 KeyBE.Bin ~
-UsbKeyboard.SetLayout UsbKeyboard00 KeyCA.Bin ~
-UsbKeyboard.SetLayout UsbKeyboard00 KeyCH.Bin ~
-UsbKeyboard.SetLayout UsbKeyboard00 KeyD.Bin ~
-UsbKeyboard.SetLayout UsbKeyboard00 KeyDV.Bin ~
-UsbKeyboard.SetLayout UsbKeyboard00 KeyFR.Bin ~
-UsbKeyboard.SetLayout UsbKeyboard00 KeyIT.Bin ~
-UsbKeyboard.SetLayout UsbKeyboard00 KeyN.Bin ~
-UsbKeyboard.SetLayout UsbKeyboard00 KeyPL.Bin ~
-UsbKeyboard.SetLayout UsbKeyboard00 KeySF.Bin ~
-UsbKeyboard.SetLayout UsbKeyboard00 KeyTR.Bin ~
-UsbKeyboard.SetLayout UsbKeyboard00 KeyUK.Bin ~
-UsbKeyboard.SetLayout UsbKeyboard00 KeyUS.Bin ~
-
-WMKeyCode.Open ~	SystemTools.Free WMKeyCode ~

ARM/ARM.A2/ARM.WMRasterScale.Mod

@@ -1,1876 +0,0 @@
-MODULE WMRasterScale;	(** AUTHOR "TF"; PURPOSE "Support scaling of images"; *)
-(** AUTHOR "MZ"; PURPOSE "Speedup rasterops with SSE2"; *)
-
-IMPORT
-	SYSTEM, Raster, Rect := WMRectangles;
-
-CONST
-	(** Copy Modes *)
-	ModeCopy* = 0; ModeSrcOverDst* = 1;
-
-	(** Scale Modes *)
-	ScaleBox* = 0; ScaleBilinear* = 1;
-
-TYPE
-	Rectangle = Rect.Rectangle;
-	Image = Raster.Image;
-	ScalerProc = PROCEDURE (src, dst : Image; VAR dr : Rectangle; sx, sy, sdx, sdy : LONGINT);
-	XScalerProc = PROCEDURE (srcadr, dstadr: ADDRESS; srcbpr, dstbpr, dl, dt, dr, db, sx, sy, sdx, sdy, sw, sh : LONGINT);
-
-(* copy sr in 16.16 fix rectangle  from src to dr integer rectangle in dst *)
-PROCEDURE Q0GenericCopy(src, dst : Image; VAR dr : Rectangle; sx, sy, sdx, sdy : LONGINT);
-VAR x, y : LONGINT; col : Raster.Pixel;
-	getMode, putMode : Raster.Mode;
-	fx, fy : LONGINT;
-BEGIN
-	Raster.InitMode(getMode, Raster.srcCopy);
-	Raster.InitMode(putMode, Raster.srcCopy);
-	fy := sy;
-	FOR y := dr.t TO dr.b - 1 DO
-		fx := sx;
-		FOR x := dr.l TO dr.r - 1 DO
-			Raster.Get(src, fx DIV 65536, fy DIV 65536, col, getMode);
-			INC(fx, sdx);
-			Raster.Put(dst, x, y, col, putMode)
-		END;
-		INC(fy, sdy)
-	END
-END Q0GenericCopy;
-
-PROCEDURE Q0GenericSrcOverDst(src, dst : Image; VAR dr : Rectangle; sx, sy, sdx, sdy : LONGINT);
-VAR x, y : LONGINT; col : Raster.Pixel;
-	getMode, putMode : Raster.Mode;
-	fx, fy : LONGINT;
-BEGIN
-	Raster.InitMode(getMode, Raster.srcCopy);
-	Raster.InitMode(putMode, Raster.srcOverDst);
-	fy := sy;
-	FOR y := dr.t TO dr.b - 1 DO
-		fx := sx;
-		FOR x := dr.l TO dr.r - 1 DO
-			Raster.Get(src, fx DIV 65536, fy DIV 65536, col, getMode);
-			INC(fx, sdx);
-			Raster.Put(dst, x, y, col, putMode)
-		END;
-		INC(fy, sdy)
-	END
-END Q0GenericSrcOverDst;
-
-(* copy sr in 16.16 fix rectangle  from src to dr integer rectangle in dst *)
-PROCEDURE Q1GenericCopy(src, dst : Image; VAR dr : Rectangle; sx, sy, sdx, sdy : LONGINT);
-VAR x, y, xfleft, xfright, yftop, yfbottom : LONGINT; col, col0, col1, col2, col3 : Raster.Pixel;
-	b0, g0, r0, a0, b1, g1, r1, a1, cb, cg, cr, ca : LONGINT;
-	getMode, putMode : Raster.Mode;
-	fx, fy : LONGINT; x0, x1, y0, y1 : LONGINT;
-BEGIN
-	Raster.InitMode(getMode, Raster.srcCopy);
-	Raster.InitMode(putMode, Raster.srcCopy);
-	fy := sy - 8000H; sx := sx - 8000H;
-	FOR y := dr.t TO dr.b - 1 DO
-		fx := sx; y0 := Bounds(fy DIV 65536, 0, src.height - 1); y1 := Bounds(fy DIV 65536 + 1, 0, src.height - 1);
-		FOR x := dr.l TO dr.r - 1 DO
-			x0 := Bounds(fx DIV 65536, 0, src.width - 1); x1 := Bounds(fx DIV 65536 + 1, 0, src.width - 1);
-			Raster.Get(src, x0, y0, col0, getMode);
-			Raster.Get(src, x1, y0, col1, getMode);
-			Raster.Get(src, x0, y1, col2, getMode);
-			Raster.Get(src, x1, y1, col3, getMode);
-
-			xfleft := (65536 - fx MOD 65536);
-			xfright := (fx MOD 65536);
-
-			b0 := (ORD(col0[Raster.b]) * xfleft + ORD(col1[Raster.b]) * xfright) DIV 65536;
-			g0 := (ORD(col0[Raster.g]) * xfleft + ORD(col1[Raster.g]) * xfright) DIV 65536;
-			r0 := (ORD(col0[Raster.r]) * xfleft + ORD(col1[Raster.r]) * xfright) DIV 65536;
-			a0 := (ORD(col0[Raster.a]) * xfleft + ORD(col1[Raster.a]) * xfright) DIV 65536;
-
-			b1 := (ORD(col2[Raster.b]) * xfleft + ORD(col3[Raster.b]) * xfright) DIV 65536;
-			g1 := (ORD(col2[Raster.g]) * xfleft + ORD(col3[Raster.g]) * xfright) DIV 65536;
-			r1 := (ORD(col2[Raster.r]) * xfleft + ORD(col3[Raster.r]) * xfright) DIV 65536;
-			a1 := (ORD(col2[Raster.a]) * xfleft + ORD(col3[Raster.a]) * xfright) DIV 65536;
-
-			yftop := (65536 - fy MOD 65536);
-			yfbottom := (fy MOD 65536);
-			cb := (b0 * yftop + b1 * yfbottom) DIV 65536;
-			cg := (g0 * yftop + g1 * yfbottom) DIV 65536;
-			cr := (r0 * yftop + r1 * yfbottom) DIV 65536;
-			ca := (a0 * yftop + a1 * yfbottom) DIV 65536;
-
-			col[Raster.b] := CHR(cb);
-			col[Raster.g] := CHR(cg);
-			col[Raster.r] := CHR(cr);
-			col[Raster.a] := CHR(ca);
-			INC(fx, sdx);
-			Raster.Put(dst, x, y, col, putMode)
-		END;
-		INC(fy, sdy)
-	END
-END Q1GenericCopy;
-
-(* copy sr in 16.16 fix rectangle  from src to dr integer rectangle in dst *)
-PROCEDURE Q1GenericSrcOverDst(src, dst : Image; VAR dr : Rectangle; sx, sy, sdx, sdy : LONGINT);
-VAR x, y, xfleft, xfright, yftop, yfbottom : LONGINT; col, col0, col1, col2, col3 : Raster.Pixel;
-	b0, g0, r0, a0, b1, g1, r1, a1, cb, cg, cr, ca : LONGINT;
-	getMode, putMode : Raster.Mode;
-	fx, fy : LONGINT; x0, x1, y0, y1 : LONGINT;
-BEGIN
-	Raster.InitMode(getMode, Raster.srcCopy);
-	Raster.InitMode(putMode, Raster.srcOverDst);
-	fy := sy - 8000H; sx := sx - 8000H;
-	FOR y := dr.t TO dr.b - 1 DO
-		fx := sx; y0 := Bounds(fy DIV 65536, 0, src.height - 1); y1 := Bounds(fy DIV 65536 + 1, 0, src.height - 1);
-		FOR x := dr.l TO dr.r - 1 DO
-			x0 := Bounds(fx DIV 65536, 0, src.width - 1); x1 := Bounds(fx DIV 65536 + 1, 0, src.width - 1);
-			Raster.Get(src, x0, y0, col0, getMode);
-			Raster.Get(src, x1, y0, col1, getMode);
-			Raster.Get(src, x0, y1, col2, getMode);
-			Raster.Get(src, x1, y1, col3, getMode);
-
-			xfleft := (65536 - fx MOD 65536);
-			xfright := (fx MOD 65536);
-
-			b0 := (ORD(col0[Raster.b]) * xfleft + ORD(col1[Raster.b]) * xfright) DIV 65536;
-			g0 := (ORD(col0[Raster.g]) * xfleft + ORD(col1[Raster.g]) * xfright) DIV 65536;
-			r0 := (ORD(col0[Raster.r]) * xfleft + ORD(col1[Raster.r]) * xfright) DIV 65536;
-			a0 := (ORD(col0[Raster.a]) * xfleft + ORD(col1[Raster.a]) * xfright) DIV 65536;
-
-			b1 := (ORD(col2[Raster.b]) * xfleft + ORD(col3[Raster.b]) * xfright) DIV 65536;
-			g1 := (ORD(col2[Raster.g]) * xfleft + ORD(col3[Raster.g]) * xfright) DIV 65536;
-			r1 := (ORD(col2[Raster.r]) * xfleft + ORD(col3[Raster.r]) * xfright) DIV 65536;
-			a1 := (ORD(col2[Raster.a]) * xfleft + ORD(col3[Raster.a]) * xfright) DIV 65536;
-
-			yftop := (65536 - fy MOD 65536);
-			yfbottom := (fy MOD 65536);
-			cb := (b0 * yftop + b1 * yfbottom) DIV 65536;
-			cg := (g0 * yftop + g1 * yfbottom) DIV 65536;
-			cr := (r0 * yftop + r1 * yfbottom) DIV 65536;
-			ca := (a0 * yftop + a1 * yfbottom) DIV 65536;
-
-			col[Raster.b] := CHR(cb);
-			col[Raster.g] := CHR(cg);
-			col[Raster.r] := CHR(cr);
-			col[Raster.a] := CHR(ca);
-			INC(fx, sdx);
-			Raster.Put(dst, x, y, col, putMode)
-		END;
-		INC(fy, sdy)
-	END
-END Q1GenericSrcOverDst;
-
-
-PROCEDURE XQ0BGR565BGR565(srcadr,dstadr: ADDRESS; srcbpr, dstbpr, dl, dt, dr, db, sx, sy, sdx, sdy, sw, sh : LONGINT);
-VAR x, y : LONGINT; yadr, adr, sa, col : LONGINT;
-	fx, fy : LONGINT;
-BEGIN
-	fy := sy;
-	yadr := dstadr + dl * 2 + dt * dstbpr;
-	FOR y := dt TO db - 1 DO
-		fx := sx;
-		adr := yadr;
-		sa := srcadr + (fy DIV 65536) * srcbpr;
-		FOR x := dl TO dr - 1 DO
-			col := SYSTEM.GET16(sa + (fx DIV 65536) * 2);
-			INC(fx, sdx);
-			SYSTEM.PUT16(adr, col);
-			INC(adr, 2);
-		END;
-		INC(fy, sdy);
-		INC(yadr, dstbpr)
-	END
-END XQ0BGR565BGR565;
-
-(*
-(* this asm version is 2.3 times faster than the portable version. (P3/600/Dell precision 420 (dual)) *)
-PROCEDURE XQ0BGR565BGR565(srcadr, dstadr: ADDRESS; srcbpr, dstbpr, dl, dt, dr, db, sx, sy, sdx, sdy, sw, sh : LONGINT);
-VAR yadr : LONGINT;
-CODE {SYSTEM.i386}
-	MOV	EDX, [EBP+dstadr]
-	MOV	EBX, [EBP+dl]
-	SHL	EBX, 1
-	ADD	EDX, EBX
-	MOV	EBX, [EBP+dt]
-	IMUL	EBX, [EBP+dstbpr]
-	ADD	EDX, EBX	; edx = dstadr + 2 * dl + dt * dstbpr
-	MOV	[EBP+yadr], EDX
-	; init first EDI
-	MOV	EDI, EDX
-
-	MOV	ECX, [EBP+dt]
-	SUB	[EBP+db], ECX	; counter in db
-
-	MOV	EDX, [EBP+sdx]	; keep EDX
-
-	; init first ESI
-	MOV	ESI, [EBP+srcadr]	; calc new source adr
-	MOV	EAX, [EBP+sy]
-	SHR	EAX, 16	; integer part of sy
-	IMUL 	EAX, [EBP+srcbpr]	; sy * srcbpr
-	ADD	ESI, EAX	; first source adr in ESI
-
-outerloop:
-	MOV	EBX, [EBP+sx]
-	MOV	ECX, [EBP+dr]	; FOR x := dl TO dr - 1 DO
-	SUB	ECX, [EBP+dl]
-innerloop:
-	MOV	EAX, EBX
-	SHR	EAX, 16
-	MOV	AX, WORD [ESI + EAX * 2]	; read the pixel
-	ADD	EBX, EDX	; INC fx, sdx
-	MOV	[EDI], AX	; set the pixel
-	ADD	EDI, 2	; inc adr
-	LOOP	innerloop
-
-	; free : EAX, EBX, ECX
-	MOV	EAX, [EBP+sy]	; sy := sy + sdy
-	ADD	EAX, [EBP+sdy]
-	MOV	[EBP+sy], EAX	; keep sy in EAX
-
-	MOV	ESI, [EBP+srcadr]	; calc new source adr
-	SHR	EAX, 16	; integer part of sy
-	IMUL 	EAX, [EBP+srcbpr]	; sy * srcbpr
-	ADD	ESI, EAX	; new source adr in ESI
-
-	; new dst address
-	MOV	ECX, [EBP+dstbpr]
-	MOV	EAX, [EBP+yadr]
-	ADD	EAX, ECX
-	MOV	EDI, EAX
-	MOV	[EBP+yadr], EAX
-
-	DEC	DWORD [EBP+db]
-	JNLE	outerloop
-END XQ0BGR565BGR565;
-*)
-
-(*PROCEDURE SSE2Q0BGR565BGR565(srcadr, dstadr: ADDRESS; srcbpr, dstbpr, dl, dt, dr, db, sx, sy, sdx, sdy, sw, sh : LONGINT (*; VAR  mysrc, mydest, myres: ARRAY OF LONGINT*));
-VAR yadr : LONGINT;
-CODE {SYSTEM.i386, SYSTEM.MMX, SYSTEM.SSE, SYSTEM.SSE2}
-	PUSHFD
-	PUSH 		EBX
-	; CLI
-
-	MOV		EDX, [EBP+dstadr]
-	MOV		EBX, [EBP+dl]
-	SHL			EBX, 1
-	ADD		EDX, EBX
-	MOV		EBX, [EBP+dt]
-	IMUL		EBX, [EBP+dstbpr]
-	ADD		EDX, EBX	; edx = dstadr + 2 * dl + dt * dstbpr
-	MOV		[EBP+yadr], EDX
-
-	; init first EDI
-	MOV		EDI, EDX
-
-	MOV		ECX, [EBP+dt]
-	SUB		[EBP+db], ECX	; counter in db
-	JLE			endyloop
-	MOV		EDX, [EBP+sdx]	; keep EDX
-
-	; init first ESI
-	MOV		ESI, [EBP+srcadr]	; calc new source adr
-	MOV		EAX, [EBP+sy]
-	SHR		EAX, 16			; integer part of sy
-	IMUL 		EAX, [EBP+srcbpr]	; sy * srcbpr
-	ADD		ESI, EAX		; first source adr in ESI
-
-outerloop:
-	MOV		EBX, [EBP+sx]
-	MOV		ECX, [EBP+dr]	; FOR x := dl TO dr - 1 DO
-	SUB		ECX, [EBP+dl]
-	JLE			endyloop
-
-innerloop:
-	CMP 		ECX, 8
-	 JLE			singlepixel
-
-	PXOR 		XMM0, XMM0
-
-	; 8pixels at the time
-	MOV		EAX, EBX
-	SHR		EAX, 16
-	MOV		AX, WORD [ESI + EAX * 2] ; read the pixel
-	PINSRW  	XMM0, EAX,0
-	ADD		EBX, EDX			; INC fx, sdx
-
-	MOV		EAX, EBX
-	SHR		EAX, 16
-	MOV		AX, WORD [ESI + EAX * 2] ; read the pixel
-	PINSRW  	XMM0, EAX,1
-	ADD		EBX, EDX			; INC fx, sdx
-
-	MOV		EAX, EBX
-	SHR		EAX, 16
-	MOV		AX, WORD [ESI + EAX * 2] ; read the pixel
-	PINSRW  	XMM0, EAX,2
-	ADD		EBX, EDX			; INC fx, sdx
-
-	MOV		EAX, EBX
-	SHR		EAX, 16
-	MOV		AX, WORD [ESI + EAX * 2] ; read the pixel
-	PINSRW  	XMM0, EAX,3
-	ADD		EBX, EDX			; INC fx, sdx
-
-	MOV		EAX, EBX
-	SHR		EAX, 16
-	MOV		AX, WORD [ESI + EAX * 2] ; read the pixel
-	PINSRW  	XMM0, EAX,4
-	ADD		EBX, EDX			; INC fx, sdx
-
-	MOV		EAX, EBX
-	SHR		EAX, 16
-	MOV		AX, WORD [ESI + EAX * 2] ; read the pixel
-	PINSRW  	XMM0, EAX,5
-	ADD		EBX, EDX			; INC fx, sdx
-
-	MOV		EAX, EBX
-	SHR		EAX, 16
-	MOV		AX, WORD [ESI + EAX * 2] ; read the pixel
-	PINSRW  	XMM0, EAX,6
-	ADD		EBX, EDX			; INC fx, sdx
-
-	MOV		EAX, EBX
-	SHR		EAX, 16
-	MOV		AX, WORD [ESI + EAX * 2] ; read the pixel
-	PINSRW  	XMM0, EAX,7
-	ADD		EBX, EDX			; INC fx, sdx
-
-	MOVDQU 	[EDI], XMM0 		;	MOV	[EDI], AX							; set the pixels
-	ADD		EDI, 16				; inc adr
-	SUB 		ECX, 8
-	CMP 		ECX, 0
-	JE			outside2
-	; LOOP 	innerloop
-	JMP 		innerloop
-
-singlepixel:
-	MOV		EAX, EBX
-	SHR		EAX, 16
-	MOV		AX, WORD [ESI + EAX * 2]	; read the pixel
-	ADD		EBX, EDX			; INC fx, sdx
-	MOV		[EDI], AX			; set the pixel
-	ADD		EDI, 2				; inc adr
-	SUB 		ECX, 1
-	CMP 		ECX, 0
-	JE			outside2
-	; LOOP 	innerloop
-	JMP 		innerloop
-
-outside2:
-	; free : EAX, EBX, ECX
-	MOV		EAX, [EBP+sy]		; sy := sy + sdy
-	ADD		EAX, [EBP+sdy]
-	MOV		[EBP+sy], EAX		; keep sy in EAX
-
-	MOV		ESI, [EBP+srcadr]		; calc new source adr
-	SHR		EAX, 16				; integer part of sy
-	IMUL 		EAX, [EBP+srcbpr]	; sy * srcbpr
-	ADD		ESI, EAX			; new source adr in ESI
-
-	; new dst address
-	MOV		ECX, [EBP+dstbpr]
-	MOV		EAX, [EBP+yadr]
-	ADD		EAX, ECX
-	MOV		EDI, EAX
-	MOV		[EBP+yadr], EAX
-
-	DEC		DWORD [EBP+db]
-	JNLE		outerloop
-
-endyloop:
-	EMMS 							; declare FPU registers free
-	POP 		EBX
-	POPFD
-END SSE2Q0BGR565BGR565;
-*)
-
-PROCEDURE Q1BGR565BGR565(srcadr,dstadr: ADDRESS; srcbpr, dstbpr, dl, dt, dr, db, sx, sy, sdx, sdy, sw, sh : LONGINT);
-VAR x, y, xfleft, xfright, yftop, yfbottom : LONGINT; yadr, adr: ADDRESS; col0, col1, col2, col3  : LONGINT;
-	b0, g0, r0, b1, g1, r1, cb, cg, cr : LONGINT;
-	fx, fy, xadd1, xadd2 : LONGINT; yadd1, yadd2: ADDRESS;
-BEGIN
-
-	yadr := dstadr + dl * 2 + dt * dstbpr;
-	fy := sy - 8000H; sx := sx - 8000H;
-	FOR y := dt TO db - 1 DO
-		fx := sx;
-		adr := yadr;
-		yadd1 := srcadr + Bounds(fy DIV 65536, 0, sh - 1) * srcbpr;
-		yadd2 := srcadr + Bounds(fy DIV 65536 + 1, 0, sh - 1) * srcbpr;
-		FOR x := dl TO dr - 1 DO
-			xadd1 := Bounds(fx DIV 65536, 0, sw - 1) * 2;
-			xadd2 := Bounds(fx DIV 65536 + 1, 0, sw - 1) * 2;
-			col0 := SYSTEM.GET16(yadd1 + xadd1);
-			col1 := SYSTEM.GET16(yadd1 + xadd2);
-			col2 := SYSTEM.GET16(yadd2 + xadd1);
-			col3 := SYSTEM.GET16(yadd2 + xadd2);
-
-			xfleft := (65536 - fx MOD 65536);
-			xfright := (fx MOD 65536);
-
-			b0 := ((col0 MOD 32) * 8 * xfleft + (col1 MOD 32) * 8 * xfright) DIV 65536;
-			g0 := ((col0 DIV 32 MOD 64) * 4 * xfleft + (col1 DIV 32 MOD 64) * 4 * xfright) DIV 65536;
-			r0 := ((col0 DIV 2048 MOD 32) * 8 * xfleft + (col1 DIV 2048 MOD 32) * 8 * xfright) DIV 65536;
-
-			b1 := ((col2 MOD 32) * 8 * xfleft + (col3 MOD 32) * 8 * xfright) DIV 65536;
-			g1 := ((col2 DIV 32 MOD 64) * 4 * xfleft + (col3 DIV 32 MOD 64) * 4 * xfright) DIV 65536;
-			r1 := ((col2 DIV 2048 MOD 32) * 8 * xfleft + (col3 DIV 2048 MOD 32) * 8 * xfright) DIV 65536;
-
-
-			yftop := (65536 - fy MOD 65536);
-			yfbottom := (fy MOD 65536);
-			cb := (b0 * yftop + b1 * yfbottom) DIV 65536;
-			cg := (g0 * yftop + g1 * yfbottom) DIV 65536;
-			cr := (r0 * yftop + r1 * yfbottom) DIV 65536;
-			INC(fx, sdx);
-			SYSTEM.PUT16(adr, ASH(cb, -3) + ASH(ASH(cg, -2), 5) + ASH(ASH(cr, -3), 11));
-			INC(adr, 2);
-		END;
-		INC(fy, sdy);
-		INC(yadr, dstbpr)
-	END
-END Q1BGR565BGR565;
-
-PROCEDURE SSE2Q1BGR565BGR565(srcadr, dstadr: ADDRESS; srcbpr, dstbpr, dl, dt, dr, db, sx, sy, sdx, sdy, sw, sh : LONGINT);
-VAR x, y, xfleft, xfright, yftop, yfbottom : LONGINT; yadr, adr, col, col0, col1, col2, col3 : LONGINT;
-	b0, g0, r0, b1, g1, r1, cb, cg, cr : LONGINT;
-	fx, fy, yadd1, yadd2, xadd1, xadd2 : LONGINT;
-END SSE2Q1BGR565BGR565;
-
-PROCEDURE Q1BGRA8888BGR565(srcadr, dstadr: ADDRESS; srcbpr, dstbpr, dl, dt, dr, db, sx, sy, sdx, sdy, sw, sh : LONGINT);
-VAR x, y, xfleft, xfright, yftop, yfbottom : LONGINT; yadr: ADDRESS; col, col0, col1, col2, col3 : LONGINT;
-	b0, g0, r0, a0, b1, g1, r1, a1, cb, cg, cr, ca, dstb, dstg, dstr : LONGINT;
-	fx, fy, xadd0, xadd1: LONGINT; yadd0, yadd1: ADDRESS;
-BEGIN
-	yadr := dstadr + dl * 2 + dt * dstbpr;
-	fy := sy - 8000H; sx := sx - 8000H;
-	FOR y := dt TO db - 1 DO
-		fx := sx;
-		dstadr := yadr;
-		yadd0 := srcadr + Bounds(fy DIV 65536, 0, sh - 1) * srcbpr;
-		yadd1 := srcadr + Bounds(fy DIV 65536 + 1, 0, sh - 1) * srcbpr;
-		FOR x := dl TO dr - 1 DO
-			(* destination color *)
-			col := SYSTEM.GET16(dstadr);
-			dstb := (col MOD 32) * 8; dstg := (col DIV 32 MOD 64) * 4; dstr := (col DIV 2048 MOD 32) * 8;
-			xadd0 := Bounds(fx DIV 65536, 0, sw - 1) * 4;
-			xadd1 := Bounds(fx DIV 65536 + 1, 0, sw - 1) * 4;
-			col0 := SYSTEM.GET32(yadd0 + xadd0);
-			col1 := SYSTEM.GET32(yadd0 + xadd1);
-			col2 := SYSTEM.GET32(yadd1 + xadd0);
-			col3 := SYSTEM.GET32(yadd1 + xadd1);
-
-			xfleft := (65536 - fx MOD 65536);
-			xfright := (fx MOD 65536);
-			yftop := (65536 - fy MOD 65536);
-			yfbottom := (fy MOD 65536);
-			a0 := ((col0 DIV 1000000H MOD 100H) * xfleft + (col1 DIV 1000000H MOD 100H) * xfright) DIV 65536;
-			a1 := ((col2 DIV 1000000H MOD 100H) * xfleft + (col3 DIV 1000000H MOD 100H) * xfright) DIV 65536;
-			ca := (a0 * yftop + a1 * yfbottom) DIV 65536;
-
-			IF ca # 0 THEN
-				b0 := ((col0 MOD 100H) * xfleft + (col1 MOD 100H) * xfright) DIV 65536;
-				g0 := ((col0 DIV 100H MOD 100H) * xfleft + (col1 DIV 100H MOD 100H) * xfright) DIV 65536;
-				r0 := ((col0 DIV 10000H MOD 100H) * xfleft + (col1 DIV 10000H MOD 100H) * xfright) DIV 65536;
-
-				b1 := ((col2 MOD 100H) * xfleft + (col3 MOD 100H) * xfright) DIV 65536;
-				g1 := ((col2 DIV 100H MOD 100H) * xfleft + (col3 DIV 100H MOD 100H) * xfright) DIV 65536;
-				r1 := ((col2 DIV 10000H MOD 100H) * xfleft + (col3 DIV 10000H MOD 100H) * xfright) DIV 65536;
-
-				cb := (b0 * yftop + b1 * yfbottom) DIV 65536;
-				cg := (g0 * yftop + g1 * yfbottom) DIV 65536;
-				cr := (r0 * yftop + r1 * yfbottom) DIV 65536;
-				IF ca # 255 THEN
-					cb := (cb * 256 + (256 - ca) * dstb) DIV 256; IF cb > 256 THEN cb := 256 END;
-					cg := (cg * 256 + (256 - ca) * dstg) DIV 256; IF cg > 256 THEN cg := 256 END;
-					cr := (cr * 256 + (256 - ca) * dstr) DIV 256; IF cr > 256 THEN cr := 256 END
-				END;
-				SYSTEM.PUT16(dstadr, ASH(cb, -3) + ASH(ASH(cg, -2), 5) + ASH(ASH(cr, -3), 11))
-			END;
-			INC(fx, sdx);
-			INC(dstadr, 2);
-		END;
-		INC(fy, sdy);
-		INC(yadr, dstbpr)
-	END
-END Q1BGRA8888BGR565;
-
-(*
-PROCEDURE SSE2Q1BGRA8888BGR565(srcadr, dstadr: ADDRESS; srcbpr, dstbpr, dl, dt, dr, db, sx, sy, sdx, sdy, sw, sh:LONGINT);
-	VAR x, y, z,xfleft, xfright, yftop, yfbottom : LONGINT; yadr, adr, col, col0, col1, col2, col3 : LONGINT;
-	b0, g0, r0, a0, a01,b1, g1, r1, a1, cb, cg, cr,cb2, cg2, cr2, ca, ca2,dstb, dstg, dstr,res : LONGINT;
-	fx, fy, yadd1, yadd2, xadd1, xadd2: LONGINT;
-
-CODE {SYSTEM.i386, SYSTEM.MMX, SYSTEM.SSE, SYSTEM.SSE2}
-	PUSHFD
-	PUSH 		EBX
-	; CLI
-	PXOR		MMX3,MMX3
-	PXOR		MMX4,MMX4
-	PXOR		MMX5, MMX5
-	PXOR		MMX6, MMX6
-	PXOR		XMM1, XMM1
-	PXOR		XMM3, XMM3
-	PXOR		XMM4, XMM4
-	PXOR		XMM6, XMM6
-	PXOR		XMM7, XMM7
-
-	MOV		EDX, [EBP+dstadr]
-	MOV		EBX, [EBP+dl]
-	SHL			EBX, 1
-	ADD		EDX, EBX
-	MOV		EBX, [EBP+dt]
-	IMUL		EBX, [EBP+dstbpr]
-	ADD		EDX, EBX
-	MOV		[EBP+yadr], EDX
-
-	MOV		EDX, [EBP+sy]
-	SUB		EDX, 8000H 			;edx = sy-8000H
-	MOV	 	[EBP+fy], EDX
-
-	; sx := sx - 8000H;
-	MOV		EDX, [EBP+sx]
-	SUB		EDX, 8000H 			;sx = sx-8000H
-	MOV		[EBP+sx] , EDX
-
-	MOV		ECX, [EBP+db]
-	SUB		ECX, [EBP+dt]			; counter in y
-	JLE			endyloop				;exit
-	MOV		[EBP+y], ECX
-
-outerloop:
-	MOV		EDX, [EBP+yadr]
-	MOV		EDI, EDX ; adr in EDI
-
-	MOV		[EBP+adr], EDX
-
-	MOV		EDX, [EBP+sx]			; keep EDX
-	MOV		[EBP+fx], EDX
-
-	MOV 		EAX, [EBP+fy]
-	MOVD		XMM3, EAX 			; prepare for top, bottom
-	SAR 		EAX, 16
-	CMP 		EAX, 0
-	JE			zero
-	JL			negativ
-	MOV		EBX, [EBP+sh]
-	SUB		EBX, 1
-	CMP		EAX, EBX
-	JGE			bigger
-
-ok:
-	MOV		EBX, EAX
-	ADD		EBX, 1
-	JMP 		different
-
-zero:
-	MOV 		EAX, 0
-	MOV		EBX, 1
-	JMP 		different
-
-negativ:
-	MOV 		EAX, 0
-	MOV		EBX, 0
-	JMP			samepixel
-
-bigger:
-	MOV		EAX, EBX
-	JMP			samepixel
-
-different:
-	MOV		ECX, [EBP+srcbpr]
-	MUL		EAX, ECX
-	MOV		EBX, EAX
-	ADD		EBX, ECX
-	MOV		ECX, [EBP+srcadr]
-	ADD		EAX, ECX
-	ADD		EBX, ECX
-	JMP			endyadd
-
-samepixel:
-	MOV		ECX, [EBP+srcbpr]
-	MUL		EAX, ECX
-	MOV		ECX, [EBP+srcadr]
-	ADD		EAX, ECX
-	MOV		EBX, EAX
-
-endyadd:
-	MOV		[EBP+yadd1], EAX
-	MOV		[EBP+yadd2], EBX
-
-	; yfbottom := (fy MOD 65536);
-	; yftop := (65536 - fy MOD 65536);
-
-	MOVD		ECX, XMM3
-	AND		ECX, 0FFFFH
-	MOV		[EBP+yfbottom],ECX
-	PINSRW 	XMM3, ECX, 1
-
-	NEG		ECX
-	ADD		ECX, 65535
-	MOV		[EBP+yftop],ECX
-	PINSRW 	XMM3, ECX, 0
-
-	PSRLW		XMM3, 1
-
-	MOV		ECX, [EBP+dr]
-	SUB		ECX, [EBP+dl]			; counter in x
-	JLE			endyloop				;exit
-	MOV		[EBP+x], ECX
-
-innerloop:
-	MOV 		ECX, [EBP+x]
-	; if x < 8 then do one pixel at the time
-	CMP		ECX, 8
-	JL 			singlepixel
-	; else
-	; take 8 at the time
-
-	MOV		EBX, EDI
-	AND 		EBX, 0FH
-	CMP		EBX, 0
-	JNE	 		singlepixel
-
-alleightpixels:
-	MOV	 	EAX, 0000000FFH
-	MOVD		MMX3, EAX
-
-	; dest red -> MMX4
-	MOV	 	EAX, 0F800F800H
-	MOVD		MMX4, EAX
-
-	; dest green -> MMX5
-	MOV	 	EAX, 07E007E0H
-	MOVD		MMX5, EAX
-
-	; dest blue -> MMX6 ; moved as MMX6 is used in singlepixel
-	; MOV	 EAX, 001F001FH
-	; MOVD		MMX6, EAX
-
-	MOV		ECX, [EBP+yfbottom]
-	PINSRW 	XMM3, ECX, 1
-	MOV		ECX, [EBP+yftop]
-	PINSRW 	XMM3, ECX, 0
-	PSRLW 		XMM3,1
-
-	PXOR		XMM5, XMM5
-	PXOR 		XMM2,XMM2
-	MOV		DWORD [EBP+z], 4
-
-loop03:
-	; shift everything left
-	MOV 		ECX, [EBP+fx]
-	PSLLDQ		XMM5, 4
-
-	PINSRW	XMM7, ECX,0 ; prepare for l,r
-
-	SAR 		ECX, 16
-	CMP 		ECX, 0
-	JE			zerox03
-	JL			negativx03
-	MOV		EDX, [EBP+sw]
-	SUB		EDX, 1
-	CMP		ECX, EDX
-	JGE			biggerx03
-
-okx03:
-	MOV		EDX, ECX
-	ADD		EDX, 1
-	JMP			endbound203
-zerox03:
-	MOV 		ECX, 0
-	MOV		EDX, 1
-	JMP 		endbound203
-
-negativx03:
-	MOV 		ECX, 0
-	MOV		EDX, 0
-	JMP			endbound203
-
-biggerx03:
-	MOV		ECX, EDX
-endbound203:
-	SHL			ECX, 2 					; xadd1
-	SHL			EDX, 2 					; xadd2
-
-	MOV		EAX, [EBP+yadd1]
-	MOV		EBX, [EBP+yadd2]
-
-	MOVD		XMM2, [EBX+EDX]
-	PSLLDQ   	XMM2,4
-	MOVD		XMM1, [EBX+ECX]
-	POR		XMM2,XMM1
-	PSLLDQ   	XMM2,4
-	MOVD		XMM1, [EAX+EDX]
-	POR		XMM2,XMM1
-	PSLLDQ		XMM2,4
-	MOVD		XMM1, [EAX+ECX]
-	POR		XMM2,XMM1
-
-	PEXTRW	EAX,XMM7,0
-	AND		EAX, 0FFFFH
-	PINSRW 	XMM7, EAX,1
-	PINSRW	XMM7, EAX, 3 			;xfright
-
-	NEG		AX
-	ADD		EAX, 65535
-	PINSRW 	XMM7, EAX, 0
-	PINSRW	XMM7, EAX, 2 			;xfleft
-
-	PSRLW 		XMM7, 1
-
-	MOVDQU	XMM0, XMM2
-	PSRLD		XMM0, 24
-	PXOR		XMM1, XMM1
-
-	MOV		ECX, 0FFH 				; ECX locked for ca
-
-	PINSRW	XMM1, ECX,0
-	PINSRW	XMM1, ECX,2
-	PINSRW	XMM1, ECX,4
-	PINSRW	XMM1, ECX,6
-
-	PCMPEQW	XMM1, XMM0
-
-	PMOVMSKB	EAX, XMM1
-	CMP		EAX, 0FFFFH
-	JE 			endofalpha03
-
-	PSHUFLW	XMM0, XMM0,58H
-	PSHUFHW	XMM0, XMM0,58H
-	PSHUFD		XMM0,XMM0,58H
-	PMADDWD XMM0,XMM7
-	PSRLD		XMM0, 15 				; XMM7 already shifted by 1
-	PSHUFLW	XMM0, XMM0, 58H
-	PMADDWD	XMM0, XMM3
-	PSRLD		XMM0,15   				; XMM3 already shifted by 1
-	PEXTRW	ECX, XMM0, 0
-
-endofalpha03:
-	; alpha done
-
-	CMP		ECX,0
-	JE			alphazero03
-
-	SHL			ECX, 24
-
-	; calculate red
-
-	MOVDQU	XMM0, XMM2
-	PSLLD		XMM0, 8
-	PSRLD		XMM0, 24
-
-	PSHUFLW	XMM0, XMM0,58H
-	PSHUFHW	XMM0, XMM0,58H
-	PSHUFD		XMM0,XMM0,58H
-
-	PMADDWD XMM0,XMM7
-	PSRLD		XMM0, 15 				; XMM7 already shifted by 1
-	PSHUFLW	XMM0, XMM0, 58H
-	PMADDWD	XMM0, XMM3
-	PSRLD		XMM0,15   				; XMM3 already shifted by 1
-	PEXTRW 	EBX, XMM0,0
-
-	SHL	EBX,16
-	OR	ECX,EBX
-
-	; red done
-
-	; calculate green
-	MOVDQU	XMM0, XMM2
-	PSLLD		XMM0, 16
-	PSRLD		XMM0, 24
-
-	PSHUFLW	XMM0, XMM0,58H
-	PSHUFHW	XMM0, XMM0,58H
-	PSHUFD		XMM0,XMM0,58H
-
-	PMADDWD XMM0,XMM7
-	PSRLD		XMM0, 15 				; XMM7 already shifted by 1
-	PSHUFLW	XMM0, XMM0, 58H
-	PMADDWD	XMM0, XMM3
-	PSRLD		XMM0,15   				; XMM3 already shifted by 1
-	PEXTRW 	EBX, XMM0,0
-	SHL 		EBX,8
-	OR 			ECX,EBX
-
-	; green done
-
-	; calculate blue
-	MOVDQU	XMM0, XMM2
-	PSLLD		XMM0,24
-	PSRLD		XMM0, 24
-
-	PSHUFLW	XMM0, XMM0,58H
-	PSHUFHW	XMM0, XMM0,58H
-	PSHUFD		XMM0, XMM0,58H
-
-	PMADDWD XMM0,XMM7
-	PSRLD		XMM0, 15 				; XMM7 already shifted by 1
-	PSHUFLW	XMM0, XMM0, 58H
-	PMADDWD	XMM0, XMM3
-	PSRLD		XMM0,15   				; XMM3 already shifted by 1
-	PEXTRW 	EBX, XMM0,0
-
-	OR			ECX,EBX
-	; blue done
-
-	; put color in correct position
-	MOVD		XMM4,ECX
-	POR		XMM5, XMM4 ; results in XMM5
-
-	; prepared source
-
-alphazero03: ; set mask is done later
-	MOV		ECX,[EBP+fx]
-	ADD		ECX, [EBP+sdx]
-	MOV		[EBP+fx],ECX
-
-	SUB 		DWORD [EBP+z], 1
-	JNZ 		loop03
-
-endofloop03:
-	MOV		DWORD [EBP+z], 4
-
-loop47:
-	; shift everything left
-	PSLLDQ		XMM6, 4
-
-	PINSRW	XMM7, ECX,0 ; prepare for l,r
-
-	SAR 		ECX, 16
-	CMP 		ECX, 0
-	JE			zerox47
-	JL			negativx47
-	MOV		EDX, [EBP+sw]
-	SUB		EDX, 1
-	CMP		ECX, EDX
-	JGE			biggerx47
-
-okx47:
-	MOV		EDX, ECX
-	ADD		EDX, 1
-	JMP			endbound247
-zerox47:
-	MOV 		ECX, 0
-	MOV		EDX, 1
-	JMP 		endbound247
-
-negativx47:
-	MOV 		ECX, 0
-	MOV		EDX, 0
-	JMP			endbound247
-
-biggerx47:
-	MOV		ECX, EDX
-endbound247:
-	SHL			ECX, 2 						; xadd1
-	SHL			EDX, 2 						; xadd2
-
-	MOV		EAX, [EBP+yadd1]
-	MOV		EBX, [EBP+yadd2]
-
-	MOVD		XMM2, [EBX+EDX]
-	PSLLDQ   	XMM2,4
-	MOVD		XMM1, [EBX+ECX]
-	POR		XMM2,XMM1
-	PSLLDQ   	XMM2,4
-	MOVD		XMM1, [EAX+EDX]
-	POR		XMM2,XMM1
-	PSLLDQ		XMM2,4
-	MOVD		XMM1, [EAX+ECX]
-	POR		XMM2,XMM1
-
-	PEXTRW	EAX,XMM7,0
-	AND		EAX, 0FFFFH
-	PINSRW 	XMM7, EAX,1
-	PINSRW	XMM7, EAX, 3 				;xfright
-
-	NEG		EAX
-	ADD		EAX, 65535
-	PINSRW 	XMM7, EAX, 0
-	PINSRW	XMM7, EAX, 2 				;xfleft
-
-	PSRLW 		XMM7, 1
-
-	MOVDQU	XMM0, XMM2
-	PSRLD		XMM0, 24
-	PXOR		XMM1, XMM1
-
-	MOV		ECX, 0FFH 					; ECX locked for ca
-
-	PINSRW	XMM1, ECX,0
-	PINSRW	XMM1, ECX,2
-	PINSRW	XMM1, ECX,4
-	PINSRW	XMM1, ECX,6
-
-	PCMPEQW	XMM1, XMM0
-
-	PMOVMSKB	EAX, XMM1
-	CMP		EAX, 0FFFFH
-	JE 			endofalpha47
-
-	PSHUFLW	XMM0, XMM0,58H
-	PSHUFHW	XMM0, XMM0,58H
-	PSHUFD		XMM0,XMM0,58H
-	PMADDWD XMM0,XMM7
-	PSRLD		XMM0, 15 				; XMM7 already shifted by 1
-	PSHUFLW	XMM0, XMM0, 58H
-	PMADDWD	XMM0, XMM3
-	PSRLD		XMM0,15   				; XMM3 already shifted by 1
-	PEXTRW	ECX, XMM0, 0
-
-endofalpha47:
-	; alpha done
-	CMP		ECX,0
-	JE			alphazero47
-
-	SHL			ECX, 24
-
-	; calculate red
-
-	MOVDQU	XMM0, XMM2
-	PSLLD		XMM0, 8
-	PSRLD		XMM0, 24
-
-	PSHUFLW	XMM0, XMM0,58H
-	PSHUFHW	XMM0, XMM0,58H
-	PSHUFD		XMM0,XMM0,58H
-
-	PMADDWD XMM0,XMM7
-	PSRLD		XMM0, 15 				; XMM7 already shifted by 1
-	PSHUFLW	XMM0, XMM0, 58H
-	PMADDWD	XMM0, XMM3
-	PSRLD		XMM0,15   				; XMM3 already shifted by 1
-	PEXTRW 	EBX, XMM0,0
-
-	SHL			EBX,16
-	OR			ECX,EBX
-
-	; red done
-
-	; calculate green
-	MOVDQU	XMM0, XMM2
-	PSLLD		XMM0, 16
-	PSRLD		XMM0, 24
-
-	PSHUFLW	XMM0, XMM0,58H
-	PSHUFHW	XMM0, XMM0,58H
-	PSHUFD		XMM0,XMM0,58H
-
-	PMADDWD XMM0,XMM7
-	PSRLD		XMM0, 15 				; XMM7 already shifted by 1
-	PSHUFLW	XMM0, XMM0, 58H
-	PMADDWD	XMM0, XMM3
-	PSRLD		XMM0,15   				; XMM3 already shifted by 1
-	PEXTRW 	EBX, XMM0,0
-	SHL 		EBX,8
-	OR 			ECX,EBX
-
-	; green done
-
-	; calculate blue
-	MOVDQU	XMM0, XMM2
-	PSLLD		XMM0,24
-	PSRLD		XMM0, 24
-
-	PSHUFLW	XMM0, XMM0,58H
-	PSHUFHW	XMM0, XMM0,58H
-	PSHUFD		XMM0,XMM0,58H
-
-	PMADDWD XMM0,XMM7
-	PSRLD		XMM0, 15 				; XMM7 already shifted by 1
-	PSHUFLW	XMM0, XMM0, 58H
-	PMADDWD	XMM0, XMM3
-	PSRLD		XMM0,15   				; XMM3 already shifted by 1
-	PEXTRW 	EBX, XMM0,0
-
-	OR			ECX,EBX
-
-	; blue done
-
-	; put color in correct position
-	MOVD		XMM4,ECX
-	POR		XMM6, XMM4 			; results in XMM6
-
-	; prepared source
-
-alphazero47: ; set mask is done later
-	MOV		ECX,[EBP+fx]
-	ADD		ECX, [EBP+sdx]
-	MOV		[EBP+fx],ECX
-
-	SUB		 DWORD [EBP+z], 1
-	JNZ 		loop47
-
-endofloop47:
-	; all sources calculated, but in reversed order
-	PSHUFD 	XMM2,XMM5, 1AH
-	PSHUFD 	XMM1,XMM6, 1AH
-
-	; now sources ready for further calculation with destination
-	; get alphas
-	MOVQ2DQ	XMM4,  MMX3
-	MOVDQU 	XMM6, XMM2
-	PSHUFD		XMM4, XMM4, 0
-	MOVDQU 	XMM5, XMM1
-	PSLLD 		XMM4, 24
-	PAND 		XMM6, XMM4 			; alpha 5-8 in XMM6
-	PAND 		XMM5, XMM4  			; alpha 1-4 in XMM5
-	PSRLD 		XMM5, 24
-	PSHUFHW 	XMM5, XMM5, 85H
-	PSRLD 		XMM6, 24
-
-	; put both alphas into 1 register
-	PSHUFHW 	XMM6, XMM6, 85H
-	PSHUFLW 	XMM5, XMM5, 85H
-	PSHUFLW 	XMM6, XMM6, 58H
-	PSHUFD		XMM5, XMM5, 0D0H  	; 0102030400000000
-	PSHUFD 	XMM6, XMM6, 5CH 		; 0000000005060708
-	PXOR 		XMM0,XMM0
-	POR		XMM5, XMM6            	; XMM5 = alphas 0102030405060708
-
-	PCMPEQD 	XMM0, XMM5
-	PMOVMSKB EAX, XMM0
-	CMP 		EAX, 0FFFFH				; all alphas = zero; TEST not possible, because only 8 bits compared
-	JE      		endloop
-
-	; mask out alpha = zero
-
-	; fd := 255-ORD(src[a]); fd = XMM4
-	; MOV 	XMM4, 00FF00FF00FF00FF00FF00FF00FF00FFH
-	PXOR 		XMM4, XMM4
-	MOV	 	EAX, 00FFH
-	PINSRW	XMM4, EAX ,0
-	PSHUFLW 	XMM4, XMM4, 0
-	PSHUFD 	XMM4, XMM4, 0
-	PSUBW 		XMM4, XMM5
-	MOV 		EAX,1H
-	PINSRW	XMM3, EAX ,0
-	PSHUFLW 	XMM3, XMM3, 0
-	PSHUFD 	XMM3, XMM3, 0
-	PADDUSW 	XMM4, XMM3
-
-	; new red
-	; calculate red 2
-
-	; get source
-
-	; sred14 = src14 && (srcMask <<16)
-	; srcMask << 16
-	MOVQ2DQ 	XMM3, MMX3
-	PSHUFD 	XMM3, XMM3, 0
-	MOVDQU 	XMM5, XMM1
-	MOVDQU 	XMM6, XMM2
-	PSLLD 		XMM3, 16
-
-	; sred14 = src14 && (srcMask << 24)
-	; src14 must be copied because it mustn't be changed
-	PAND 		XMM5, XMM3 				; sred14
-	PSRLD 		XMM5, 16
-
-	; sred14s = shuffled sred14
-	PSHUFHW 	XMM5, XMM5,85H
-	PAND 		XMM6, XMM3 				; sred58
-	PSRLD 		XMM6, 16
-
-	PSHUFLW 	XMM5, XMM5,85H
-	PSHUFHW 	XMM6, XMM6,85H
-	PSHUFD  	XMM5, XMM5,0D0H 		; sred14s
-	PSHUFLW 	XMM6, XMM6,58H
-	PSHUFD  	XMM6, XMM6,5CH 			; sred58s
-	POR 		XMM5, XMM6 				; sred18
-
-	; sred18255 = sred18 * 256- sred18
-	MOVDQU 	XMM7, XMM5
-	PSLLW 		XMM5, 8
-	PSUBUSW 	XMM5, XMM7 				; sred18255
-
-	; src is now ready
-
-	; destination
-	; dest18 must be copied because it mustn't be changed
-	; Load data into memory
-	MOV 		EDI, [EBP+adr]
-	MOVDQU 	XMM3, [EDI]  				;dest 1-8
-	MOVQ2DQ  XMM6, MMX4
-	PSHUFD 	XMM6, XMM6, 0
-	MOVDQU 	XMM7, XMM3
-
-	PAND 		XMM7, XMM6 				; dred18
-	PSRLW 		XMM7, 8
-	;  dred18alpha = dred18 * negalpha
-	PMULLW 	XMM7, XMM4 				; dred18alpha
-
-	; dest is prepared
-	; combining dest and src
-
-	; dred18big = sred18255 + dred18alpha
-
-	PADDUSW 	XMM7, XMM5 ; dred18big
-	; dred18f = dred18big && destMaskred128  because >> 11 and << 11 is && mask
-	PAND 		XMM7, XMM6 ; dred18f
-
- 	; dest18nr0 = dest18 && (~destMaskred128)
- 	PANDN 	XMM6, XMM3  				; dest18nr0
-
- 	; dest18nrf = dest18nr0 || dred18f
- 	POR 		XMM6, XMM7
-
-	MOVDQU 	XMM3, XMM6
-
-	; red is calculated
-
-	; calculate green:
-	; get source
-
-	; sgreen14 = src14 && (srcMask <<8)
-	; srcMask << 8
-	MOVQ2DQ 	XMM7, MMX3
-
-	PSHUFD 	XMM7, XMM7, 0
-	MOVDQU 	XMM5, XMM1
-	PSLLD 		XMM7, 8
-	PAND 		XMM5, XMM7 				; sgreen14
-	PSRLD 		XMM5, 8
-
-	; sgreen14s = shuffled sgreen14
-	PSHUFHW 	XMM5, XMM5,85H
-	MOVDQU 	XMM6, XMM2
-	PSHUFLW 	XMM5, XMM5,85H
-	PAND 		XMM6, XMM7 				; sgreen58
-	PSRLD 		XMM6, 8
-	PSHUFD  	XMM5, XMM5,0D0H 		; sgreen14s
-
-	; sgreen58 = src58&& (srcMask << 8)
-	; src58 must be copied because it mustn't be changed
-
-	; sgreen58s = shuffled sgreen58
-	PSHUFHW 	XMM6, XMM6,85H
-	PSHUFLW	XMM6, XMM6,58H
-	PSHUFD  	XMM6, XMM6,5CH 			; sgreen58s
-
-	; sgreen18 = sgreen14s || sgreen58s
-	POR 		XMM5, XMM6 ; sgreen18
-
-	; sgreen18255 = sgreen18 * 256- sgreen18
-	MOVDQU 	XMM7, XMM5
-	MOVQ2DQ	XMM6, MMX5
-
-	PSLLW 		XMM5, 8
-	PSUBUSW 	XMM5, XMM7 				; sgreen18255
-	PSHUFD 	XMM6, XMM6, 0
-
-	MOVDQU 	XMM7, XMM3
-
-	PAND 		XMM7, XMM6 ; dgreen18
-	PSRLW 		XMM7,3
-	;  dgreen18alpha = dgreen18 * negalpha
-	PMULLW 	XMM7, XMM4 				; dgreen18alpha
-
-	; dest is prepared
-	; combining dest and src
-
-	; dgreen18big = sgreen18255 + dgreen18alpha
-	PADDUSW 	XMM7, XMM5 				; dgreen18big
-	PANDN 	XMM6, XMM3  ; dest18ng0
-
-	; dgreen18f = (dgreen18big >> 11) <<5
-	PSRLW 		XMM7, 10 					; dgreen18f
-	PSLLW 		XMM7, 5
-
- 	; dest18ng0 = dest18 && (~destMaskgreen128)
-
- 	; dest18ngf = dest18ng0 || dred18f
- 	POR 		XMM6, XMM7
-	MOVDQU 	XMM3, XMM6
-	; green is calculated
-
-	; calculate blue
-
-	MOV	 	EAX, 001F001FH
-	MOVD		MMX6, EAX
-
-	; get source
-
-	; sblue14 = src14 && (srcMask)
-	; srcMask
-	MOVQ2DQ 	XMM7, MMX3
-	MOVDQU 	XMM5, XMM1
-
-	PSHUFD 	XMM7, XMM7, 0
-	MOVDQU 	XMM6, XMM2
-
-	; sblue14 = src14 && (srcMask)
-	; src14 must be copied because it mustn't be changed
-	PAND 		XMM5, XMM7 				; sblue14
-
-	; sblue14s = shuffled sblue14
-	PSHUFHW 	XMM5, XMM5,85H
-	PAND 		XMM6, XMM7 ; sblue58
-	PSHUFHW 	XMM6, XMM6,85H
-
-	PSHUFLW 	XMM5, XMM5,85H
-	PSHUFLW 	XMM6, XMM6,58H
-
-	PSHUFD  	XMM5, XMM5,0D0H 		; sblue14s
-	PSHUFD  	XMM6, XMM6,5CH 			; sblue58s
-
-	POR 		XMM5, XMM6 				; sblue18
-
-	; sblue18255 = sblue18 * 256- sblue18
-	MOVDQU 	XMM7, XMM5
-	PSLLW 		XMM5, 8
-	PSUBUSW 	XMM5, XMM7 				; sblue18255
-	MOVQ2DQ	XMM6, MMX6
-	PSHUFD 	XMM6, XMM6, 0
-	MOVDQU 	XMM7, XMM3
-	PAND 		XMM7, XMM6 				; dblue18
-	PSLLW 		XMM7, 3
-
-	PMULLW 	XMM7, XMM4 				; dblue18alpha
-
-	; dest is prepared
-	; combining dest and src
-
-	; dblue18big = sblue18255 + dblue18alpha
-
-	PADDUSW 	XMM7, XMM5 				; dblue18big
-	; dblue18f = (dblue18big >> 11)
-	PANDN 	XMM6, XMM3  				; dest18nr0
- 	PSRLW 		XMM7, 11 					; dblue18f
-
-  	; dest18nr0 = dest18 && (~destMaskblue128)
-
- 	; dest18nbf = dest18nb0 || dblue18f
- 	POR 		XMM6, XMM7
-	MOVDQU 	XMM3, XMM6
-
-	; blue is calculated
-
-	; now dest is calculated, store it
-	; get 0 stuff
-
-	MOVDQU	XMM5, [EDI]
-	PAND		XMM5,XMM0
-	PANDN		XMM0, XMM3
-	POR		XMM0, XMM5
-
-	MOVDQU [EDI],XMM0
-
-endloop:
-	;fx already inc  ; by sdx
-	ADD 		EDI, 16
-	MOV 		[EBP+adr],EDI
-	SUB 		DWORD [EBP+x], 8
-	JNZ 		innerloop 					; x>=0
-	JZ 			endxloop
-
-singlepixel: 									; original code from MMXBGRA8888Over565, adjusted to fit this procedure
-	MOV 		EDI, [EBP+adr]
-	MOV	 	EAX, 0000000FFH
-	MOVD		MMX3, EAX
-
-	; dest red -> MMX4
-	MOV	 	EAX, 0F800F800H
-	MOVD		MMX4, EAX
-
-	; dest green -> MMX5
-	MOV	 	EAX, 07E007E0H
-	MOVD		MMX5, EAX
-
-	; dest blue -> MMX6 ; moved as MMX6 is used in singlepixel
-	; MOV	 EAX, 001F001FH
-	; MOVD		MMX6, EAX
-
-	MOV		ECX, [EBP+yfbottom]
-	PINSRW 	XMM3, ECX, 1
-	MOV		ECX, [EBP+yftop]
-	PINSRW 	XMM3, ECX, 0
-	PSRLW 		XMM3,1
-
-	MOV 		ECX, [EBP+fx]
-
-	PINSRW	XMM7, ECX,0 				; prepare for l,r
-
-	SAR 		ECX, 16
-	CMP 		ECX, 0
-	JE			zerox
-	JL			negativx
-	MOV		EDX, [EBP+sw]
-	SUB		EDX, 1
-	CMP		ECX, EDX
-	JGE			biggerx
-
-okx:
-	MOV		EDX, ECX
-	ADD		EDX, 1
-	JMP			endbound2
-zerox:
-	MOV 		ECX, 0
-	MOV		EDX, 1
-	JMP 		endbound2
-
-negativx:
-	MOV 		ECX, 0
-	MOV		EDX, 0
-	JMP			endbound2
-
-biggerx:
-	MOV		ECX, EDX
-endbound2:
-	SHL			ECX, 2 						; xadd1
-	SHL			EDX, 2 						; xadd2
-
-	MOV		EAX, [EBP+yadd1]
-	MOV		EBX, [EBP+yadd2]
-
-	MOVD		XMM2, [EBX+EDX]
-	PSLLDQ   	XMM2,4
-	MOVD		XMM1, [EBX+ECX]
-	POR		XMM2,XMM1
-	PSLLDQ  	XMM2,4
-	MOVD		XMM1, [EAX+EDX]
-	POR		XMM2,XMM1
-	PSLLDQ		XMM2,4
-	MOVD		XMM1, [EAX+ECX]
-	POR		XMM2,XMM1
-
-	PEXTRW	EAX,XMM7,0
-	AND		EAX, 0FFFFH
-	PINSRW 	XMM7, EAX,1
-	PINSRW	XMM7, EAX, 3 				;xfright
-
-	NEG		EAX
-	ADD		EAX, 65535
-	PINSRW 	XMM7, EAX, 0
-	PINSRW	XMM7, EAX, 2 				;xfleft
-
-	PSRLW 		XMM7, 1
-
-	MOVDQU	XMM0, XMM2
-	PSRLD		XMM0, 24
-	PXOR		XMM1, XMM1
-
-	MOV		ECX, 0FFH 					; ECX locked for ca
-
-	PINSRW	XMM1, ECX,0
-	PINSRW	XMM1, ECX,2
-	PINSRW	XMM1, ECX,4
-	PINSRW	XMM1, ECX,6
-
-	PCMPEQW	XMM1, XMM0
-
-	PMOVMSKB	EAX, XMM1
-	CMP		EAX, 0FFFFH
-	JE 			endofalpha
-
-	PSHUFLW	XMM0, XMM0,58H
-	PSHUFHW	XMM0, XMM0,58H
-	PSHUFD		XMM0,XMM0,58H
-	PMADDWD XMM0,XMM7
-	PSRLD		XMM0, 15 					; XMM7 already shifted by 1
-	PSHUFLW	XMM0, XMM0, 58H
-	PMADDWD	XMM0, XMM3
-	PSRLD		XMM0,15   					; XMM3 already shifted by 1
-	PEXTRW	ECX, XMM0, 0
-
-endofalpha:
-	; alpha done
-	CMP		ECX,0
-	JE			alphazero
-
-	; calculate red
-	MOVDQU	XMM0, XMM2
-	PSLLD		XMM0, 8
-	PSRLD		XMM0, 24
-
-	PSHUFLW	XMM0, XMM0,58H
-	PSHUFHW	XMM0, XMM0,58H
-	PSHUFD		XMM0,XMM0,58H
-
-	PMADDWD XMM0,XMM7
-	PSRLD		XMM0, 15 					; XMM7 already shifted by 1
-	PSHUFLW	XMM0, XMM0, 58H
-	PMADDWD	XMM0, XMM3
-	PSRLD		XMM0,15   					; XMM3 already shifted by 1
-	PEXTRW 	EBX, XMM0,0
-	PINSRW	XMM4, EBX, 4
-	; red done
-
-	; calculate green
-	MOVDQU	XMM0, XMM2
-	PSLLD		XMM0, 16
-	PSRLD		XMM0, 24
-
-	PSHUFLW	XMM0, XMM0,58H
-	PSHUFHW	XMM0, XMM0,58H
-	PSHUFD		XMM0,XMM0,58H
-
-	PMADDWD XMM0,XMM7
-	PSRLD		XMM0, 15 					; XMM7 already shifted by 1
-	PSHUFLW	XMM0, XMM0, 58H
-	PMADDWD	XMM0, XMM3
-	PSRLD		XMM0,15   					; XMM3 already shifted by 1
-	PEXTRW 	EBX, XMM0,0
-	PINSRW	XMM4, EBX, 2
-
-	; green done
-
-	; calculate blue
-	MOVDQU	XMM0, XMM2
-	PSLLD		XMM0,24
-	PSRLD		XMM0, 24
-
-	PSHUFLW	XMM0, XMM0,58H
-	PSHUFHW	XMM0, XMM0,58H
-	PSHUFD		XMM0,XMM0,58H
-
-	PMADDWD XMM0,XMM7
-	PSRLD		XMM0, 15 					; XMM7 already shifted by 1
-	PSHUFLW	XMM0, XMM0, 58H
-	PMADDWD	XMM0, XMM3
-	PSRLD		XMM0,15   					; XMM3 already shifted by 1
-	PEXTRW 	EBX, XMM0,0
-	PINSRW	XMM4, EBX, 0
-
-	; blue done
-
-	; prepared source
-	CMP		ECX, 0FFH   					; ECX released
-	JE			alpha255
-
-	NEG		ECX
-	ADD		ECX, 0FFH
-	PINSRW	XMM1, ECX, 1  				; 255-ca
-	PINSRW	XMM1, ECX, 3  				; 255-ca
-	PINSRW	XMM1, ECX, 5 				; 255-ca
-
-	MOV		EAX, 0FFH
-	PINSRW	XMM1, EAX, 0 				; 255
-	PINSRW	XMM1, EAX, 2  				; 255
-	PINSRW	XMM1, EAX, 4  				; 255
-
-	;prepare destination
-	MOV		EBX, [EBP+adr]
-
-	MOV		EBX, [EBX]
-
-	MOV		EAX, EBX
-	AND 		EAX, 01FH
-	SHL			EAX,3
-	PINSRW	XMM4, EAX, 1  				; dstb
-
-	MOV		EAX, EBX
-	AND 		EAX, 07E0H
-	SHR		EAX, 3
-	PINSRW	XMM4, EAX, 3  				; dstg
-
-	AND 		EBX, 0F800H
-	SHR		EBX,8
-	PINSRW	XMM4, EBX, 5  				; dstr
-
-	PMADDWD	XMM4, XMM1
-
-	PSRLD		XMM4, 8
-	PXOR		XMM1,XMM1
-	PACKUSWB	XMM4,XMM1
-
-	; put results into their words
-	PEXTRW	EAX, XMM4, 2 				; end red
-	PINSRW	XMM4,  EAX, 4
-
-	PEXTRW	EAX, XMM4, 1 				; end green
-	PINSRW	XMM4,  EAX, 2
-
-alpha255:
-	; red in XMM4,4; green in XMM4, 2; blue in XMM4,0
-	;SYSTEM.PUT16(adr, ASH(cb, -3) + ASH(ASH(cg, -2), 5) + ASH(ASH(cr, -3), 11))
-	PEXTRW	EAX, XMM4, 0 				; end blue
-	SHR		EAX,3
-	AND		EAX, 001FH
-
-	PEXTRW	EBX, XMM4, 2 				; end green
-	SHL			EBX,3
-	AND		EBX, 07E0H
-	OR			EAX, EBX
-
-	PEXTRW	EBX, XMM4, 4				; end red
-	SHL			EBX,8
-	AND		EBX, 0F800H
-	OR			EAX, EBX
-
-	MOV		EDI,[EBP+adr]
-	MOV		[EDI], AX
-
-alphazero: 									; alpha = 0, no writeback
-	MOV		ECX,[EBP+fx]
-	ADD		ECX, [EBP+sdx]
-	MOV		[EBP+fx],ECX
-
-	MOV		EDI,[EBP+adr]
-	ADD		EDI, 2						; inc adr
-	MOV		[EBP+adr],EDI
-
-
-	SUB		DWORD [EBP+x], 1
-	JNZ			innerloop
-
-endxloop:
-	MOV		EAX,[EBP+fy]					; fy := fy + sdy
-	ADD		EAX, [EBP+sdy]
-	MOV		[EBP+fy], EAX
-
-	MOV		EAX,[EBP+yadr]
-	ADD		EAX, [EBP+dstbpr]
-	;MOV	EDI, EAX
-	MOV		[EBP+yadr], EAX
-
-	SUB		DWORD [EBP+y], 1
-	JNZ			outerloop
-
-endyloop:
-	EMMS									; declare FPU registers free
-	POP 		EBX
-	POPFD
-END SSE2Q1BGRA8888BGR565;
-*)
-
-PROCEDURE Q0BGRA8888BGR565(srcadr, dstadr: ADDRESS; srcbpr, dstbpr, dl, dt, dr, db, sx, sy, sdx, sdy, sw, sh : LONGINT);
-VAR x, y : LONGINT; yadr, adr: ADDRESS; col, col0 : LONGINT;
-	cb, cg, cr, ca, dstb, dstg, dstr: LONGINT; yadd: ADDRESS;
-	fx, fy : LONGINT;
-BEGIN
-	fy := sy;
-	yadr := dstadr + dl * 2 + dt * dstbpr;
-	FOR y := dt TO db - 1 DO
-		fx := sx;
-		adr := yadr;
-		yadd := srcadr + (fy DIV 65536) * srcbpr;
-		FOR x := dl TO dr - 1 DO
-			(* destination color *)
-			col := SYSTEM.GET16(adr);
-			dstb := (col MOD 32) * 8; dstg := (col DIV 32 MOD 64) * 4; dstr := (col DIV 2048 MOD 32) * 8;
-
-			col0 := SYSTEM.GET32(yadd + (fx DIV 65536) * 4);
-
-			ca := (col0 DIV 1000000H MOD 100H);
-			IF ca # 0 THEN
-				cb := (col0 MOD 100H);
-				cg := (col0 DIV 100H MOD 100H);
-				cr := (col0 DIV 10000H MOD 100H);
-
-				IF ca # 255 THEN
-					cb := (cb * 256 + (256 - ca) * dstb) DIV 256; IF cb > 256 THEN cb := 256 END;
-					cg := (cg * 256 + (256 - ca) * dstg) DIV 256; IF cg > 256 THEN cg := 256 END;
-					cr := (cr * 256 + (256 - ca) * dstr) DIV 256; IF cr > 256 THEN cr := 256 END
-				END;
-				SYSTEM.PUT16(adr, ASH(cb, -3) + ASH(ASH(cg, -2), 5) + ASH(ASH(cr, -3), 11))
-			END;
-			INC(fx, sdx);
-			INC(adr, 2)
-		END;
-		INC(fy, sdy);
-		INC(yadr, dstbpr)
-	END
-END Q0BGRA8888BGR565;
-
-PROCEDURE Q0BGRA8888BGRA8888(srcadr, dstadr: ADDRESS; srcbpr, dstbpr, dl, dt, dr, db, sx, sy, sdx, sdy, sw, sh : LONGINT);
-VAR x, y : LONGINT; yadr, adr: ADDRESS; col, col0 : LONGINT;
-	cb, cg, cr, ca, dstb, dstg, dstr, dsta : LONGINT; yadd: ADDRESS;
-	fx, fy : LONGINT;
-BEGIN
-	fy := sy;
-	yadr := dstadr + dl * 4 + dt * dstbpr;
-	FOR y := dt TO db - 1 DO
-		fx := sx;
-		adr := yadr;
-		yadd := srcadr + (fy DIV 65536) * srcbpr;
-		FOR x := dl TO dr - 1 DO
-			(* destination color *)
-			col := SYSTEM.GET32(adr);
-			dstb := (col MOD 100H);
-			dstg := (col DIV 100H) MOD 100H;
-			dstr := (col DIV 10000H) MOD 100H;
-			dsta := (col DIV 1000000H) MOD 100H;
-
-			col0 := SYSTEM.GET32(yadd + (fx DIV 65536) * 4);
-
-			ca := (col0 DIV 1000000H MOD 100H);
-			IF ca # 0 THEN
-				cb := (col0 MOD 100H);
-				cg := (col0 DIV 100H MOD 100H);
-				cr := (col0 DIV 10000H MOD 100H);
-
-				IF ca # 255 THEN
-					cb := (cb * 256 + (256 - ca) * dstb) DIV 256; IF cb > 256 THEN cb := 256 END;
-					cg := (cg * 256 + (256 - ca) * dstg) DIV 256; IF cg > 255 THEN cg := 256 END;
-					cr := (cr * 256 + (256 - ca) * dstr) DIV 256; IF cr > 256 THEN cr := 256 END;
-					ca := (ca * 256 + (256 - ca) * dsta) DIV 256; IF ca > 256 THEN ca := 256; END;
-				END;
-
-				SYSTEM.PUT32(adr, cb + LSH(cg, 8) + LSH(cr, 16) + LSH(ca, 24));
-			END;
-			INC(fx, sdx);
-			INC(adr, 4)
-		END;
-		INC(fy, sdy);
-		INC(yadr, dstbpr)
-	END
-END Q0BGRA8888BGRA8888;
-
-PROCEDURE Q0BGRA8888BGRA8888Copy(srcadr, dstadr: ADDRESS; srcbpr, dstbpr, dl, dt, dr, db, sx, sy, sdx, sdy, sw, sh : LONGINT);
-VAR x, y  : LONGINT; yadr, adr: ADDRESS; col, col0 : LONGINT; yadd : ADDRESS;
-	fx, fy : LONGINT;
-BEGIN
-	fy := sy;
-	yadr := dstadr + dl * 4 + dt * dstbpr;
-	FOR y := dt TO db - 1 DO
-		fx := sx;
-		adr := yadr;
-		yadd := srcadr + (fy DIV 65536) * srcbpr;
-		FOR x := dl TO dr - 1 DO
-			col0 := SYSTEM.GET32(yadd + (fx DIV 65536) * 4);
-			SYSTEM.PUT32(adr, col0);
-			INC(fx, sdx);
-			INC(adr, 4)
-		END;
-		INC(fy, sdy);
-		INC(yadr, dstbpr)
-	END
-END Q0BGRA8888BGRA8888Copy;
-
-PROCEDURE Q1BGRA8888BGRA8888(srcadr, dstadr: ADDRESS; srcbpr, dstbpr, dl, dt, dr, db, sx, sy, sdx, sdy, sw, sh : LONGINT);
-VAR x, y, xfleft, xfright, yftop, yfbottom : LONGINT; yadr: ADDRESS; col, col0, col1, col2, col3 : LONGINT;
-	b0, g0, r0, a0, b1, g1, r1, a1, cb, cg, cr, ca, dstb, dstg, dstr, dsta : LONGINT;
-	fx, fy, xadd0, xadd1: LONGINT; yadd0, yadd1: ADDRESS;
-BEGIN
-	yadr := dstadr + dl * 4 + dt * dstbpr;
-	fy := sy - 8000H; sx := sx - 8000H;
-	FOR y := dt TO db - 1 DO
-		fx := sx;
-		dstadr := yadr;
-		yadd0 := srcadr + Bounds(fy DIV 65536, 0, sh - 1) * srcbpr;
-		yadd1 := srcadr + Bounds(fy DIV 65536 + 1, 0, sh - 1) * srcbpr;
-		FOR x := dl TO dr - 1 DO
-			(* destination color *)
-			col := SYSTEM.GET32(dstadr);
-			dstb := col MOD 100H;
-			dstg := col DIV 100H MOD 100H;
-			dstr := col DIV 10000H MOD 100H;
-			dsta := col DIV 1000000H MOD 100H;
-			xadd0 := Bounds(fx DIV 65536, 0, sw - 1) * 4;
-			xadd1 := Bounds(fx DIV 65536 + 1, 0, sw - 1) * 4;
-			col0 := SYSTEM.GET32(yadd0 + xadd0);
-			col1 := SYSTEM.GET32(yadd0 + xadd1);
-			col2 := SYSTEM.GET32(yadd1 + xadd0);
-			col3 := SYSTEM.GET32(yadd1 + xadd1);
-
-			xfleft := (65536 - fx MOD 65536);
-			xfright := (fx MOD 65536);
-			yftop := (65536 - fy MOD 65536);
-			yfbottom := (fy MOD 65536);
-			a0 := ((col0 DIV 1000000H MOD 100H) * xfleft + (col1 DIV 1000000H MOD 100H) * xfright) DIV 65536;
-			a1 := ((col2 DIV 1000000H MOD 100H) * xfleft + (col3 DIV 1000000H MOD 100H) * xfright) DIV 65536;
-			ca := (a0 * yftop + a1 * yfbottom) DIV 65536;
-
-			IF ca # 0 THEN
-				b0 := ((col0 MOD 100H) * xfleft + (col1 MOD 100H) * xfright) DIV 65536;
-				g0 := ((col0 DIV 100H MOD 100H) * xfleft + (col1 DIV 100H MOD 100H) * xfright) DIV 65536;
-				r0 := ((col0 DIV 10000H MOD 100H) * xfleft + (col1 DIV 10000H MOD 100H) * xfright) DIV 65536;
-				a0 := ((col0 DIV 1000000H MOD 100H) * xfleft + (col1 DIV 1000000H MOD 100H) * xfright) DIV 65536;
-
-				b1 := ((col2 MOD 100H) * xfleft + (col3 MOD 100H) * xfright) DIV 65536;
-				g1 := ((col2 DIV 100H MOD 100H) * xfleft + (col3 DIV 100H MOD 100H) * xfright) DIV 65536;
-				r1 := ((col2 DIV 10000H MOD 100H) * xfleft + (col3 DIV 10000H MOD 100H) * xfright) DIV 65536;
-				a1 := ((col2 DIV 1000000H MOD 100H) * xfleft + (col3 DIV 1000000H MOD 100H) * xfright) DIV 65536;
-
-				cb := (b0 * yftop + b1 * yfbottom) DIV 65536;
-				cg := (g0 * yftop + g1 * yfbottom) DIV 65536;
-				cr := (r0 * yftop + r1 * yfbottom) DIV 65536;
-				ca := (a0 * yftop + a1 * yfbottom) DIV 65536;
-				IF ca # 255 THEN
-					cb := (cb * 256 + (256 - ca) * dstb) DIV 256; IF cb > 256 THEN cb := 256 END;
-					cg := (cg * 256 + (256 - ca) * dstg) DIV 256; IF cg > 256 THEN cg := 256 END;
-					cr := (cr * 256 + (256 - ca) * dstr) DIV 256; IF cr > 256 THEN cr := 256 END;
-					ca := (ca * 256 + (256 - ca) * dsta) DIV 256; IF ca > 256 THEN ca := 256; END;
-				END;
-				SYSTEM.PUT32(dstadr, cb + LSH(cg, 8) + LSH(cr, 16) + LSH(ca, 24));
-			END;
-			INC(fx, sdx);
-			INC(dstadr, 4);
-		END;
-		INC(fy, sdy);
-		INC(yadr, dstbpr)
-	END
-END Q1BGRA8888BGRA8888;
-
-PROCEDURE Q1BGRA8888BGRA8888Copy(srcadr, dstadr: ADDRESS; srcbpr, dstbpr, dl, dt, dr, db, sx, sy, sdx, sdy, sw, sh : LONGINT);
-VAR x, y, xfleft, xfright, yftop, yfbottom : LONGINT; yadr: ADDRESS; col, col0, col1, col2, col3 : LONGINT;
-	b0, g0, r0, a0, b1, g1, r1, a1, cb, cg, cr, ca : LONGINT;
-	fx, fy, xadd0, xadd1: LONGINT; yadd0, yadd1: ADDRESS;
-BEGIN
-	yadr := dstadr + dl * 4 + dt * dstbpr;
-	fy := sy - 8000H; sx := sx - 8000H;
-	FOR y := dt TO db - 1 DO
-		fx := sx;
-		dstadr := yadr;
-		yadd0 := srcadr + Bounds(fy DIV 65536, 0, sh - 1) * srcbpr;
-		yadd1 := srcadr + Bounds(fy DIV 65536 + 1, 0, sh - 1) * srcbpr;
-		FOR x := dl TO dr - 1 DO
-			(* destination color *)
-			xadd0 := Bounds(fx DIV 65536, 0, sw - 1) * 4;
-			xadd1 := Bounds(fx DIV 65536 + 1, 0, sw - 1) * 4;
-			col0 := SYSTEM.GET32(yadd0 + xadd0);
-			col1 := SYSTEM.GET32(yadd0 + xadd1);
-			col2 := SYSTEM.GET32(yadd1 + xadd0);
-			col3 := SYSTEM.GET32(yadd1 + xadd1);
-
-			xfleft := (65536 - fx MOD 65536);
-			xfright := (fx MOD 65536);
-			yftop := (65536 - fy MOD 65536);
-			yfbottom := (fy MOD 65536);
-			a0 := ((col0 DIV 1000000H MOD 100H) * xfleft + (col1 DIV 1000000H MOD 100H) * xfright) DIV 65536;
-			a1 := ((col2 DIV 1000000H MOD 100H) * xfleft + (col3 DIV 1000000H MOD 100H) * xfright) DIV 65536;
-			ca := (a0 * yftop + a1 * yfbottom) DIV 65536;
-
-			IF ca # 0 THEN
-				b0 := ((col0 MOD 100H) * xfleft + (col1 MOD 100H) * xfright) DIV 65536;
-				g0 := ((col0 DIV 100H MOD 100H) * xfleft + (col1 DIV 100H MOD 100H) * xfright) DIV 65536;
-				r0 := ((col0 DIV 10000H MOD 100H) * xfleft + (col1 DIV 10000H MOD 100H) * xfright) DIV 65536;
-
-				b1 := ((col2 MOD 100H) * xfleft + (col3 MOD 100H) * xfright) DIV 65536;
-				g1 := ((col2 DIV 100H MOD 100H) * xfleft + (col3 DIV 100H MOD 100H) * xfright) DIV 65536;
-				r1 := ((col2 DIV 10000H MOD 100H) * xfleft + (col3 DIV 10000H MOD 100H) * xfright) DIV 65536;
-
-				cb := (b0 * yftop + b1 * yfbottom) DIV 65536;
-				cg := (g0 * yftop + g1 * yfbottom) DIV 65536;
-				cr := (r0 * yftop + r1 * yfbottom) DIV 65536;
-				SYSTEM.PUT32(dstadr, cb + LSH(cg, 8) + LSH(cr, 16) + LSH(ca, 24));
-			END;
-			INC(fx, sdx);
-			INC(dstadr, 4);
-		END;
-		INC(fy, sdy);
-		INC(yadr, dstbpr)
-	END
-END Q1BGRA8888BGRA8888Copy;
-
-PROCEDURE SSE2Q0BGRA8888BGR565(srcadr, dstadr: ADDRESS; srcbpr, dstbpr, dl, dt, dr, db, sx, sy, sdx, sdy, sw, sh : LONGINT);
-VAR x, y, xfleft, xfright, yftop, yfbottom : LONGINT; yadr, adr, col, col0, col1, col2, col3 : LONGINT;
-	cb, cg, cr, ca, dstb, dstg, dstr, yadd : LONGINT;
-	fx, fy : LONGINT;
-	w : LONGINT;
-END SSE2Q0BGRA8888BGR565;
-
-
-PROCEDURE Scale*(src : Image; sr : Rectangle; dst : Image; dr : Rectangle; clip : Rectangle; copyMode, scaleMode : LONGINT);
-VAR dw, dh, sw, sh : LONGINT;
-	fw, fh : LONGREAL; sx, sy : LONGINT;
-	scaler : ScalerProc; xscaler : XScalerProc;
-	mode : Raster.Mode;
-	SSE2enabled : BOOLEAN;
-BEGIN
-	ASSERT((clip.l >= 0) & (clip.t >= 0) & (clip.r <= dst.width) & (clip.b <= dst.height));
-	ASSERT((sr.l >= 0) & (sr.t >= 0) & (sr.r <= src.width) & (sr.b <= src.height));
-	dw := dr.r - dr.l; dh := dr.b - dr.t;
-	sw := sr.r - sr.l; sh := sr.b - sr.t;
-
-	IF (sw = dw) & (sh = dh) THEN (* optimize special case *)
-		IF ~Rect.IsContained(clip, dr) THEN
-			IF dr.l < clip.l THEN DEC(dw, (clip.l - dr.l)); INC(sr.l, (clip.l - dr.l)); dr.l := clip.l END;
-			IF dr.t < clip.t THEN DEC(dh, (clip.t - dr.t)); INC(sr.t, (clip.t - dr.t)); dr.t := clip.t END;
-			IF dr.r > clip.r THEN DEC(dw, (dr.r - clip.r)) END;
-			IF dr.b > clip.b THEN DEC(dh, (dr.b - clip.b)) END;
-		END;
-		IF (dw > 0) & (dh > 0) THEN
-			IF copyMode = ModeCopy THEN Raster.InitMode(mode, Raster.srcCopy)
-			ELSE Raster.InitMode(mode, Raster.srcOverDst)
-			END;
-			Raster.Copy(src, dst, sr.l, sr.t, sr.l + dw, sr.t + dh, dr.l, dr.t, mode)
-		END;
-		RETURN
-	END;
-
-	fw := sw / dw;
-	fh := sh / dh;
-	sx := sr.l * 65536;
-	sy := sr.t * 65536;
-	(* clipping *)
-	IF ~Rect.IsContained(clip, dr) THEN
-		sw := sr.r - sr.l; sh := sr.b - sr.t;
-		dw := dr.r - dr.l; dh := dr.b - dr.t;
-		IF dr.r > clip.r THEN dr.r := clip.r END;
-		IF dr.b > clip.b THEN dr.b := clip.b END;
-		IF dr.l < clip.l THEN sx := ENTIER(65536 * (sr.l +  sw * (clip.l - dr.l) / dw)); dr.l := clip.l END;
-		IF dr.t < clip.t THEN sy := ENTIER(65536 * (sr.t + sh * (clip.t - dr.t) / dh)); dr.t := clip.t END;
-	END;
-	IF Rect.RectEmpty(dr) THEN RETURN END;
-	xscaler := NIL;
-	SSE2enabled :=Raster.SSE2enabled; (*Machine.SSE2Support; *)
-	(*IF SSE2enabled THEN
-		IF (src.fmt.code = Raster.bgr565) & (dst.fmt.code = Raster.bgr565) THEN
-			IF copyMode = ModeCopy THEN
-				IF scaleMode = 0 THEN xscaler := SSE2Q0BGR565BGR565;
-				ELSIF scaleMode = 1 THEN xscaler:= SSE2Q1BGR565BGR565;
-				END;
-			END;
-		ELSIF (src.fmt.code = Raster.bgra8888) & (dst.fmt.code = Raster.bgr565) THEN
-			IF copyMode = ModeSrcOverDst THEN
-				IF scaleMode = 0 THEN xscaler :=  SSE2Q0BGRA8888BGR565;
-				ELSIF scaleMode = 1 THEN xscaler := SSE2Q1BGRA8888BGR565;
-				END;
-			END;
-		END;
-	END;*)
-	IF (xscaler = NIL) THEN
-		IF (src.fmt.code = Raster.bgr565) & (dst.fmt.code = Raster.bgr565) THEN
-			IF copyMode = ModeCopy THEN
-				IF scaleMode = 0 THEN xscaler := XQ0BGR565BGR565;
-				ELSIF scaleMode = 1 THEN xscaler := Q1BGR565BGR565;
-		 		END;
-			END;
-		ELSIF (src.fmt.code = Raster.bgra8888) & (dst.fmt.code = Raster.bgr565) THEN
-			IF copyMode = ModeSrcOverDst THEN
-				IF scaleMode = 0 THEN xscaler := Q0BGRA8888BGR565;
-				ELSIF scaleMode = 1 THEN xscaler := Q1BGRA8888BGR565;
-				END;
-			END;
-		ELSIF (src.fmt.code = Raster.bgra8888) & (dst.fmt.code = Raster.bgra8888) THEN
-			IF (copyMode = ModeSrcOverDst) THEN
-				IF (scaleMode = 0) THEN xscaler := Q0BGRA8888BGRA8888;
-				ELSIF (scaleMode = 1) THEN xscaler := Q1BGRA8888BGRA8888;
-				END;
-			ELSIF (copyMode = ModeCopy) THEN
-				IF (scaleMode = 0) THEN xscaler := Q0BGRA8888BGRA8888Copy;
-				ELSIF (scaleMode = 1) THEN xscaler := Q1BGRA8888BGRA8888Copy;
-				END;
-			END;
-		END;
-	END;
-
-	IF xscaler # NIL THEN
-		xscaler(src.adr, dst.adr, src.bpr, dst.bpr, dr.l, dr.t, dr.r, dr.b, sx, sy,
-			ENTIER(fw * 65536), ENTIER(fh * 65536), src.width, src.height)
-	ELSE
-		scaler := Q0GenericSrcOverDst; (* fallback case *)
-		IF copyMode = ModeCopy THEN
-			IF scaleMode = 0 THEN scaler := Q0GenericCopy
-			ELSIF scaleMode = 1 THEN scaler := Q1GenericCopy
-			END
-		ELSIF copyMode = ModeSrcOverDst THEN
-			IF scaleMode = 0 THEN scaler := Q0GenericSrcOverDst
-			ELSIF scaleMode = 1 THEN scaler := Q1GenericSrcOverDst
-			END;
-		END;
-		scaler(src, dst, dr, sx, sy, ENTIER(fw * 65536), ENTIER(fh * 65536));
-	END;
-END Scale;
-
-PROCEDURE Bounds(val, min, max : LONGINT) : LONGINT;
-BEGIN
-	IF val < min THEN RETURN min ELSIF val > max THEN RETURN max ELSE RETURN val END
-END Bounds;
-
-END WMRasterScale.
-
-
-SpeedTest.Mod

ARM/ARM.A2/Clock.Mod

@@ -1,123 +0,0 @@
-(**
-	AUTHOR: Alexey Morozov, HighDim GmbH, 2018
-	PURPOSE: A2 clock with a plugable RTC get/set interface
-*)
-
-(* Aos, Copyright 2001, Pieter Muller, ETH Zurich *)
-
-MODULE Clock;
-
-TYPE
-	
-	(*
-		Function for getting time from an RTC device
-		
-		second: seconds \in [0,59]
-		minute: minutes \in [0,59]
-		hour: hours \in [0,23]
-		day: days \in [1,31]
-		month: months \in [1,12]
-		year: the actual year minus 1900
-	*)
-	GetRtcTimeFunc = PROCEDURE{DELEGATE}(VAR second, minute, hour, day, month: SHORTINT; VAR year: INTEGER): BOOLEAN;
-	
-	(*
-		Function for setting up time on an RTC device
-		
-		second: seconds \in [0,59]
-		minute: minutes \in [0,59]
-		hour: hours \in [0,23]
-		day: days \in [1,31]
-		month: months \in [1,12]
-		year: the actual year minus 1900
-	*)
-	SetRtcTimeFunc =PROCEDURE{DELEGATE}(second, minute, hour, day, month: SHORTINT; year: INTEGER): BOOLEAN;
-
-VAR
-	getRtcTime: GetRtcTimeFunc;
-	setRtcTime: SetRtcTimeFunc;
-
-	tz*: LONGINT;	(** system time zone offset in minutes (from -720 to 720) *)
-	starttime*, startdate*: LONGINT;	(** time this module was loaded (usually boot time) *)
-
-(** Return the current time and date in Oberon format. *)
-
-PROCEDURE Get*(VAR time, date: LONGINT);
-VAR
-	second, minute, hour, day, month: SHORTINT;
-	year: INTEGER;
-BEGIN{EXCLUSIVE}
-	IF getRtcTime # NIL THEN
-		IF getRtcTime(second, minute, hour, day, month, year) THEN
-			time := LONGINT(hour)*4096 + LONGINT(minute)*64 + second;
-			date := LONGINT(year)*512 + LONGINT(month)*32 + day;
-			RETURN;
-		END;
-	END;
-	time := 0;
-	date := 0;
-END Get;
-
-(** Set the current time and date in Oberon format. *)
-
-PROCEDURE Set*(time, date: LONGINT);
-VAR
-	second, minute, hour, day, month: SHORTINT;
-	year: INTEGER;
-BEGIN{EXCLUSIVE}
-	IF setRtcTime # NIL THEN
-		second := SHORTINT(time MOD 64);
-		minute := SHORTINT(time DIV 64 MOD 64);
-		hour := SHORTINT(time DIV 4096 MOD 32);
-		day := SHORTINT(date MOD 32);
-		month := SHORTINT(date DIV 32 MOD 16);
-		year := INTEGER(date DIV 512);
-		IF setRtcTime(second, minute, hour, day, month, year) THEN
-		END;
-	END;
-END Set;
-
-PROCEDURE Install*(get: GetRtcTimeFunc; set: SetRtcTimeFunc);
-BEGIN
-	BEGIN{EXCLUSIVE}
-		getRtcTime := get;
-		setRtcTime := set;
-	END;
-	Get(starttime, startdate);
-END Install;
-
-BEGIN
-	tz := 2*60;	(* fixme: configurable *)
-END Clock.
-
-(*
-23.08.1999	pjm	Split from Aos.Kernel
-*)
-
-(**
-Notes
-
-The time and date are that of the real-time clock of the system, which may be set to universal time, or to some local time zone.
-
-The tz variable indicates the system time zone offset from universal time in minutes.  It may be updated at any time due to daylight savings time.  E.g. MET DST is 2 * 60 = 120.
-
-The time and date are each represented in an encoded LONGINT.
-
-Converting from year, month, day, hour, minute, second to time, date:
-	time := hour*4096 + minute*64 + second;
-	date := (year-1900)*512 + month*32 + day;
-
-Converting from time to hour, minute, second:
-	hour := time DIV 4096 MOD 32;
-	minute := time DIV 64 MOD 64;
-	second := time MOD 64;
-
-Converting from date to year, month, day:
-	year = 1900+date DIV 512;
-	month = date DIV 32 MOD 16;
-	day = date MOD 32;
-
-All years in the current millenium can be represented.  The 1900 offset is a historical artefact from the Oberon system.
-
-Time and date values (respectively) can be compared with the normal Oberon operators <, <=, =, >=, >, #.  Overflow at midnight has to be handled separately.
-*)

ARM/ARM.A2/DiskCaches.Mod

@@ -1,102 +0,0 @@
-MODULE DiskCaches; (* Simple (disk) cache, fof 2018 *)
-IMPORT SYSTEM, Disks;
-
-	TYPE TransferProcedure = PROCEDURE {DELEGATE} (op,block,num: LONGINT; VAR data: ARRAY OF CHAR; ofs: LONGINT; VAR res: WORD);
-
-	CONST BlockSize = 512;
-	CONST NumberCacheLines = 128;
-
-	TYPE
-		CacheLine = RECORD
-			globalIndex: SIZE;
-			data: POINTER TO ARRAY OF CHAR;
-		END;
-
-	TYPE
-	
-	(* Yet very simple disk cache. 
-		- synchronous
-		- One-way associative
-		- Write-through
-	*)
-	Cache* = OBJECT
-	VAR
-		lines: ARRAY NumberCacheLines OF CacheLine;
-		blocksPerCacheLine: LONGINT;
-		transfer: TransferProcedure;
-
-		PROCEDURE &Init*(transfer: TransferProcedure; blocksPerCacheLine = 32: LONGINT);
-		VAR i: SIZE;
-		BEGIN
-			SELF.transfer := transfer;
-			SELF.blocksPerCacheLine := blocksPerCacheLine;
-			FOR i := 0 TO LEN(lines)-1 DO
-				lines[i].globalIndex := -1;
-				NEW(lines[i].data,blocksPerCacheLine * BlockSize );
-			END;
-		END Init;
-
-		(* LONGINTs for compatibility -- should be largely replaced by SIZEs ! *)
-		PROCEDURE Transfer* (op: LONGINT; block, num: LONGINT; VAR data: ARRAY OF CHAR; ofs: LONGINT; VAR res: LONGINT);
-		VAR globalIndex, lineIndex, lineOfs, lineFirstBlock, lineBlocks: LONGINT;
-		BEGIN
-			WHILE num > 0 DO
-				globalIndex := block DIV blocksPerCacheLine; (* global index *)
-				lineIndex := globalIndex MOD NumberCacheLines; (* (local) line index *)
-				lineOfs := block MOD blocksPerCacheLine; (* line offset in blocks *)
-				lineFirstBlock := block - lineOfs;
-				lineBlocks := MIN(num, blocksPerCacheLine - lineOfs); (* chunk size in bytes *)
-
-				IF (lines[lineIndex].globalIndex # globalIndex) THEN (* cacheline present *)
-					IF op = Disks.Read THEN (* read to cache *)
-						transfer(op, lineFirstBlock, blocksPerCacheLine, lines[lineIndex].data^, 0, res); (* assumes that lineFirstBlock is a valid block *)
-						lines[lineIndex].globalIndex := globalIndex;
-					END;
-				ELSIF op = Disks.Write THEN (* write to present cacheline *)
-					SYSTEM.MOVE(ADDRESS OF data[ofs], ADDRESS OF lines[lineIndex].data[lineOfs*BlockSize], lineBlocks*BlockSize);
-				END;
-
-				IF op = Disks.Write THEN (* always write through*)
-					transfer(op, block, lineBlocks, data, ofs, res);
-				ELSE (* read from cache *)
-					SYSTEM.MOVE(ADDRESS OF lines[lineIndex].data[lineOfs*BlockSize], ADDRESS OF data[ofs], lineBlocks*BlockSize);
-				END;
-				DEC(num, lineBlocks);
-				INC(block, lineBlocks);
-				INC(ofs, lineBlocks*BlockSize);
-			END;
-
-		END Transfer;
-
-	END Cache;
-
-END DiskCaches.
-
-(** USAGE PATTERN: 
-
-	VirtualDisk = OBJECT(Disks.Device)
-	VAR
-		...
-		cache: DiskCaches.Cache;
-
-		PROCEDURE TransferX*(op, block, num: LONGINT; VAR data: ARRAY OF CHAR; ofs: LONGINT; VAR res: WORD);
-		BEGIN
-			.... OLD TRANSFER CODE
-		END TransferX;
-		
-		PROCEDURE Transfer(op, block, num: LONGINT; VAR data: ARRAY OF CHAR; ofs: LONGINT; VAR res: WORD);
-		BEGIN{EXCLUSIVE}
-			cache.Transfer(op,block,num,data,ofs,res) 
-		END Transfer;
-
-		....		
-
-		PROCEDURE &Init(CONST name : ARRAY OF CHAR; blockSize, cyls, hds, spt : LONGINT);
-		BEGIN
-			NEW(cache, TransferX);
-			....
-		END Init;
-
-	END VirtualDisk;
-
-**)

ARM/ARM.A2/Dynamic.BootConfig.Mod

@@ -1,170 +0,0 @@
-MODULE (*Dyn*)BootConfig; (** AUTHOR "Timothée Martiel"; PURPOSE "Boot configuration from memory area"; *)
-
-IMPORT
-	SYSTEM,
-	Initializer(*,
-	Commands*);
-
-CONST
-	ConfigSize = 4096;
-	CR = 0DX;
-	LF = 0AX;
-
-VAR
-	config: POINTER {UNSAFE,UNTRACED} TO ARRAY ConfigSize OF CHAR;
-	size: LONGINT;
-
-	PROCEDURE GetValue * (CONST key: ARRAY OF CHAR; VAR value: ARRAY OF CHAR);
-	VAR
-		i, len: LONGINT;
-	BEGIN
-		i := 0;
-		len := 0;
-		LOOP
-			IF i = size THEN EXIT END;
-			(* is that the key? *)
-			IF MatchKey(config^, i, key) THEN
-				REPEAT INC(i) UNTIL config[i] = '=';
-				INC(i);
-				WHILE (config[i + len] # CR) & (config[i + len] # LF) DO INC(len) END;
-				ASSERT(len <= LEN(value), 7);
-				SYSTEM.MOVE(ADDRESSOF(config[i]), ADDRESSOF(value[0]), len);
-				EXIT
-			ELSE
-				REPEAT INC(i) UNTIL (i = size) OR (config[i] = LF);
-				IF i = size THEN EXIT END;
-				INC(i)
-			END;
-		END;
-		value[len] := 0X;
-	END GetValue;
-
-	PROCEDURE GetIntValue * (CONST key: ARRAY OF CHAR): LONGINT;
-	VAR
-		str: ARRAY 128 OF CHAR;
-	BEGIN
-		GetValue(key, str);
-		RETURN StrToInt(str)
-	END GetIntValue;
-
-	PROCEDURE GetBoolValue * (CONST key: ARRAY OF CHAR): BOOLEAN;
-	VAR
-		str: ARRAY 128 OF CHAR;
-	BEGIN
-		GetValue(key, str);
-		RETURN StrToBool(str)
-	END GetBoolValue;
-
-	PROCEDURE Init *;
-	BEGIN
-		SYSTEM.MOVE(Initializer.configBase, 1FFFF000H, Initializer.configSize);
-		Initializer.configBase := 1FFFF000H;
-		config := Initializer.configBase;
-		size := Initializer.configSize;
-		IF size >= ConfigSize THEN size := ConfigSize-1; END;
-		config[size] := CR;
-	END Init;
-
-	PROCEDURE StrToInt (CONST str: ARRAY OF CHAR): LONGINT;
-	VAR
-		i, value: LONGINT;
-	BEGIN
-		i := 0;
-		value := 0;
-		LOOP
-			IF (i = LEN(str)) OR (str[i] = 0X) THEN RETURN value END;
-			IF (str[i] > '9') OR (str[i] < '0') THEN RETURN 0 END;
-			value := value * 10;
-			INC(value, ORD(str[i]) - ORD('0'));
-			INC(i)
-		END
-	END StrToInt;
-
-	PROCEDURE StrToBool (CONST str: ARRAY OF CHAR): BOOLEAN;
-	BEGIN
-		IF str = '1' THEN RETURN TRUE END;
-		RETURN FALSE
-	END StrToBool;
-
-	(** return TRUE if str1 from ofs1 until the first '=' (excluded) matches str2 *)
-	PROCEDURE MatchKey (CONST str1: ARRAY OF CHAR; ofs1: LONGINT; CONST str2: ARRAY OF CHAR): BOOLEAN;
-	VAR
-		i: LONGINT;
-	BEGIN
-		i := 0;
-		WHILE (str1[ofs1 + i] # '=') & (str2[i] # 0X) & (str1[ofs1 + i] = str2[i]) DO INC(i) END;
-		RETURN (str1[ofs1 + i] = '=') & (str2[i] = 0X)
-	END MatchKey;
-
-(*	PROCEDURE Get * (context: Commands.Context);
-	VAR
-		key, val: ARRAY 128 OF CHAR;
-	BEGIN
-		IF ~context.arg.GetString(key) THEN RETURN END;
-		context.out.String(key);
-		context.out.String(": ");
-		IF context.arg.GetString(val) THEN
-			IF val = "int" THEN
-				context.out.Int(GetIntValue(key), 0)
-			ELSIF val = "bool" THEN
-				IF GetBoolValue(key) THEN
-					context.out.String("TRUE")
-				ELSE
-					context.out.String("FALSE")
-				END
-			ELSE
-				GetValue(key, val);
-				context.out.String("'");
-				context.out.String(val);
-				context.out.String("'");
-			END
-		ELSE
-			GetValue(key, val);
-			context.out.String("'");
-			context.out.String(val);
-			context.out.String("'");
-		END;
-		context.out.Ln
-	END Get;
-
-	PROCEDURE Print * (context: Commands.Context);
-	VAR
-		i: LONGINT;
-	BEGIN
-		FOR i := 0 TO size - 1 DO
-			context.out.Char(config[i])
-		END
-	END Print;*)
-(*BEGIN
-	cfg := "CpuClockHz=666666666
-UartInputClockHz=50000000
-KernelOutputUart=1
-PsRefClockHz=50000000
-KernelOutputUart=1
-CpuNb=2
-UsbPhyRstGpio0=46
-UsbPhyRstGpio1=-1
-UsbEnable0=1
-UsbEnable1=0
-UsbViewportInit=1
-SdClock0=50000000
-SdClock1=50000000
-SdEnable0=1
-SdEnable1=0
-CpuNb=2
-DDRSize=536870912
-ConfigSize=4096;
-HeapSize=469762048
-KernelLoadAdr=1048576
-StackSize=262144
-EnableCaching=1
-EnableKernelWatchdog=1
-EnableFreeLists=0
-EnableReturnBlocks=0
-TraceHeaps=0
-TraceModules=0
-TraceInterrupts=0
-";
-config := ADDRESSOF(cfg[0]);
-size := Strings.Length(cfg)*)
-END (*Dyn*)BootConfig.

ARM/ARM.A2/Sd.Mod

@@ -1,3067 +0,0 @@
-MODULE Sd;
-(**
-	AUTHOR Timothée Martiel, 2015
-	PURPOSE SD Card Host Controller Driver
-*)
-
-IMPORT
-	SYSTEM, SdEnvironment, Log := SdEnvironment;
-
-CONST
-	BlockSize * = 512;
-	InitialClockFrequency * = 400000; (* Hz *)
-
-	(* Commands *) (*! Do not change values *)
-	CMD_GO_IDLE_STATE * = 0; (** CMD0 bc [31:0] stuff bits - *)
-	CMD_ALL_SEND_CID * = 2; (** CMD2 bcr [31:0] stuff bits R2 *)
-	CMD_SEND_RELATIVE_ADDR * = 3; (** CMD3 bcr [31:0] stuff bits R6 *)
-	CMD_SET_DSR * = 4; (** CMD4 bc [31:16] DSR [15:0] stuff bits - *)
-	CMD_IO_SEND_OP_COND * = 5; (** CMD5 ?? [31:25] stuff bits [24] switch 1.8V request [23:0] I/O OCR R4 *)
-	CMD_SWITCH_FUNC * = 6; (** CMD6 adtc [31] Mode 0:Check function 1:Switch function [30:24] reserved (All '0') [23:20] reserved for function group 6 (0h or Fh) [19:16] reserved for function group 5 (0h or Fh) [15:12] function group 4 for current limit [11:8] funciton group 3 for drive strength [7:4] function group 2 for command system [3:0] function group 1 for access mode R1 *)
-	CMD_SELECT_DESELECT_CARD * = 7; (** CMD7 ac [31:16] RCA [15:0] stuff bits R1b (only from the selected card) *)
-	CMD_SEND_IF_COND * = 8; (** CMD8 bcr [31:12] reserved bits [11:8] supply voltage(VHS) [7:0]check pattern R7 *)
-	CMD_SEND_CSD * = 9; (** CMD9 ac [31:16] RCA [15:0] stuff bits R2 *)
-	CMD_SEND_CID * = 10; (** CMD10 ac [31:16] RCA [15:0] stuff bits R2 *)
-	CMD_VOLTAGE_SWITCH * = 11; (** CMD11 ac [31:0] reserved bits (all 0) R1 *)
-	CMD_STOP_TRANSMISSION * = 12; (** CMD12 ac [31:0] stuff bits R1b *)
-	CMD_SEND_STATUS * = 13; (** CMD13 ac [31:16] RCA [15:0] stuff bits R1 *)
-	CMD_GO_INACTIVE_STATE * = 15; (** CMD15 ac [31:16] RCA [15:0] reserved bits - *)
-	CMD_SET_BLOCKLEN * = 16; (** CMD16 ac [31:0] block length R1 *)
-	CMD_READ_SINGLE_BLOCK * = 17; (** CMD17 adtc [31:0] data address2 R1 *)
-	CMD_READ_MULTIPLE_BLOCK * = 18; (** CMD18 adtc [31:0] data address2 R1 *)
-	CMD_SEND_TUNING_BLOCK * = 19; (** CMD19 adtc [31:0] reserved bits (all 0) R1 *)
-	CMD_SPEED_CLASS_CONTROL * = 20; (** CMD20 ac [31:28]Speed Class Control [27:0] Reserved (all-0) R1b *)
-	CMD_SET_BLOCK_COUNT * = 23; (** CMD23 ac [31:0] Block Count R1 *)
-	CMD_WRITE_BLOCK * = 24; (** CMD24 adtc [31:0] data address2 R1 *)
-	CMD_WRITE_MULTIPLE_BLOCK * = 25; (** CMD25 adtc [31:0] data address2 R1 *)
-	CMD_PROGRAM_CSD * = 27; (** CMD27 adtc [31:0] stuff bits R1 *)
-	CMD_SET_WRITE_PROT * = 28; (** CMD28 ac [31:0] data address2 R1b *)
-	CMD_CLR_WRITE_PROT * = 29; (** CMD29 ac [31:0] data address2 R1b *)
-	CMD_SEND_WRITE_PROT * = 30; (** CMD30 adtc [31:0] write protect data address2 R1 *)
-	CMD_ERASE_WR_BLK_START * = 32; (** CMD32 ac [31:0] data address1 R1 *)
-	CMD_ERASE_WR_BLK_END * = 33; (** CMD33 ac [31:0] data address1 R1 *)
-	CMD_ERASE * = 38; (** CMD38 ac [31:0] stuff bits R1b *)
-	CMD_LOCK_UNLOCK * = 42; (** CMD42 adtc [31:0] Reserved bits (Set all 0) R1 *)
-	CMD_APP_CMD * = 55; (** CMD55 ac [31:16] RCA [15:0] stuff bits R1 *)
-	CMD_GEN_CMD * = 56; (** CMD56 adtc [31:1] stuff bits. [0] RD/WR R1 *)
-
-	(** Application Commands *) (*! Do Not Change Values *)
-	ACMD_SET_BUS_WIDTH * = 6; (** ACMD6 ac [31:2] stuff bits [1:0] bus width R1 *)
-	ACMD_SD_STATUS * = 13; (** ACMD13 adtc [31:0] stuff bits R1 *)
-	ACMD_SEND_NUM_WR_BLOCKS * = 22; (** ACMD22 adtc [31:0] stuff bits R1 *)
-	ACMD_SET_WR_BLK_ERASE_COUNT * = 23; (** ACMD23 ac [31:23] stuff bits [22:0] Number of blocks R1 *)
-	ACMD_SD_SEND_OP_COND * = 41; (** ACMD41 bcr [31]reserved bit [30] HCS(OCR[30]) [29] reserved for eSD [28] XPC [27:25] reserved bits [24] S18R [23:0] VDD Voltage Window(OCR[23:0]) R3 *)
-	ACMD_SET_CLR_CARD_DETECT * = 42; (** ACMD42 ac [31:1] stuff bits [0] set_cd R1 *)
-	ACMD_SEND_SCR * = 51; (** ACMD51 adtc [31:0] stuff bits R1 *)
-
-	(** Errors *)
-	ErrorNone * = 0; (** No error *)
-	ErrorCmdTimeout * = 1; (** Timeout on command line *)
-	ErrorCmdCrc * = 2; (** CRC error on command line *)
-	ErrorDatTimeout * = 3; (** Timeout on data line *)
-	ErrorDatCrc * = 4; (** CRC error on data line *)
-	ErrorNoCard * = 5; (** No card present *)
-	ErrorCard * = 6; (** Card failed to perform operation *)
-	ErrorUnrecoverable * = 7; (** Host controller in an unrecoverable state *)
-	ErrorInvalidParameters * = 8; (** Invalid parameters *)
-
-	(** Card Versions: maximal SD physical layer specifications version supported by the card *)
-	Version1 * = 0; (** v1.00 or v1.01 *)
-	Version1p1 * = 1; (** v1.10 *)
-	Version2 * = 2; (** v2.00 *)
-	Version3 * = 3; (** v3.01 *)
-	Version4 * = 4; (** v4.10 *)
-	Version5 * = 5; (** v5.10 *)
-	Version6 * =6; (** v6.0 *)
-
-	(** Card Type *)
-	TypeNone * = 0; (** Unknow *)
-	TypeSDSC * = 1; (** SD standard capacity - physical specs v1.0 or v1.1, limited to 2 GB *)
-	TypeSDHC * = 2; (** SD High Capacity - 2 GB to 32 GB *)
-	TypeSDXC * = 3; (** SD Extended Capacity - 32 GB to 2 TB *)
-
-	(** Card Events *)
-	OnInitialization * = 0;
-	OnRemoval * = 1;
-	OnReadComplete * = 2;
-	OnWriteComplete * = 3;
-
-	(** Command Record Flags *)
-	FlagData * = 0;
-	FlagRead * = 1;
-	FlagAutoCmd12 * = 2;
-	FlagAutoCmd23 * = 3;
-	FlagMultipleBlockTx * = 4;
-	FlagCountBlocks * = 5;
-	FlagAbort * = 7;
-	FlagApplicationCmd * = 8;
-	FlagIgnoreIllegalCmd * = 9;
-
-	(** Response Types *) (*! Do not change values *)
-	ResponseNone	 * = -1;
-	ResponseR1 * = 0;
-	ResponseR1b * = 1;
-	ResponseR2 * = 2;
-	ResponseR3 * = 3;
-	ResponseR4 * = 4;
-	ResponseR5 * = 5;
-	ResponseR5b * = 6;
-	ResponseR6 * = 7;
-	ResponseR7 * = 8;
-
-	(** Host Controller States *)
-	HcOperational * = 0; (** Host controller is operational *)
-	HcConfiguring * = 1; (** Host controller is waiting for configuration input *)
-	HcError * = 2; (** Error occurred *)
-
-	(** Card States *)
-	CardIdle = 0;
-	CardReady = 1;
-	CardIdentification = 2;
-	CardStandby = 3;
-	CardTransfer = 4;
-	CardData = 5;
-	CardReceive = 6;
-	CardProgram = 7;
-	CardDisabled = 8;
-
-	(** Operation modes *)
-	OpCpu = 0;
-	OpSdma = 1;
-	OpAdma = 2;
-
-	(* Present State bits *)
-	PresentState_CommandInhibitCmd = 0;
-	PresentState_CommandInhibitDat = 1;
-	PresentState_DatLineActive = 2;
-	PresentState_RetuningRequest = 3;
-	PresentState_WriteTransferActive = 8;
-	PresentState_ReadTransferActive = 9;
-	PresentState_BufferWriteEnable = 10;
-	PresentState_BufferReadEnable = 11;
-	PresentState_CardInserted = 16;
-	PresentState_CardStateStable = 17;
-	PresentState_CardDetectPinLevel = 18;
-	PresentState_WriteProtectSwitchPinLevel = 19;
-	PresentState_CmdLineSignalLevel = 24;
-	PresentState_DatLineSignalLevelOfs = 20;
-	PresentState_DatLineSignalLevelMask = {20 .. 23};
-
-	(* Interrupt Status, Status Enable, Signal Enable bits *)
-	Interrupt_Normal_CommandComplete = 0;
-	Interrupt_Normal_TransferComplete = 1;
-	Interrupt_Normal_BlockGapEvent = 2;
-	Interrupt_Normal_DmaInterrupt = 3;
-	Interrupt_Normal_BufferWriteReady = 4;
-	Interrupt_Normal_BufferReadReady = 5;
-	Interrupt_Normal_CardInsertion = 6;
-	Interrupt_Normal_CardRemoval = 7;
-	Interrupt_Normal_CardInterrupt = 8;
-	Interrupt_Normal_IntA = 9;
-	Interrupt_Normal_IntB = 10;
-	Interrupt_Normal_IntC = 11;
-	Interrupt_Normal_RetuningEvent = 12;
-	Interrupt_Normal_ErrorInterrupt = 15;
-	Interrupt_Error_CommandTimeout = 16;
-	Interrupt_Error_CommandCrc = 17;
-	Interrupt_Error_CommandEndBit = 18;
-	Interrupt_Error_CommandIndex = 19;
-	Interrupt_Error_DataTimeout = 20;
-	Interrupt_Error_DataCrc = 21;
-	Interrupt_Error_DataEndBit = 22;
-	Interrupt_Error_CurrentLimit = 23;
-	Interrupt_Error_AutoCmd12 = 24;
-	Interrupt_Error_Adma = 25;
-	Interrupt_Error_Tuning = 26;
-	Interrupt_Normal_All = {Interrupt_Normal_CommandComplete, Interrupt_Normal_TransferComplete, Interrupt_Normal_BlockGapEvent, Interrupt_Normal_DmaInterrupt,
-									Interrupt_Normal_BufferWriteReady, Interrupt_Normal_BufferReadReady, Interrupt_Normal_CardInsertion, Interrupt_Normal_CardRemoval,
-									Interrupt_Normal_CardInterrupt, Interrupt_Normal_IntA, Interrupt_Normal_IntB, Interrupt_Normal_IntC, Interrupt_Normal_RetuningEvent,
-									Interrupt_Normal_ErrorInterrupt};
-	Interrupt_Error_All = {Interrupt_Error_CommandTimeout, Interrupt_Error_CommandCrc, Interrupt_Error_CommandEndBit,
-									Interrupt_Error_CommandIndex, Interrupt_Error_DataTimeout, Interrupt_Error_DataCrc, Interrupt_Error_DataEndBit, Interrupt_Error_CurrentLimit,
-									Interrupt_Error_AutoCmd12, Interrupt_Error_Adma, Interrupt_Error_Tuning};
-	Interrupt_All = Interrupt_Normal_All + Interrupt_Error_All;
-
-	(* Transfer Mode Register bits *)
-	TransferMode_DmaEnable = 0;
-	TransferMode_BlockCountEnable = 1;
-	TransferMode_AutoCmdOfs = 2;
-	TransferMode_AutoCmdMask = {2 .. 3};
-	TransferMode_DataTxDirection = 4;
-	TransferMode_MultipleBlocks = 5;
-	TransferMode_AutoCmd_None = {};
-	TransferMode_AutoCmd_Cmd12 = {2};
-	TransferMode_AutoCmd_Cmd23 = {3};
-
-	(* Command Register bits *)
-	Command_ResponseTypeOffset = 0;
-	Command_CrcCheckEnable = 3;
-	Command_IndexCheckEnable = 4;
-	Command_DataPresent = 5;
-	Command_CommandTypeOffset = 6;
-	Command_CommandTypeMask = {6 .. 7};
-	Command_CommandIndexOffset = 8;
-	Command_CommandIndexMask = {8 .. 13};
-
-	Command_ResponseType_None = 0;
-	Command_ResponseType_136b = 1;
-	Command_ResponseType_48b = 2;
-	Command_ResponseType_48bBusy = 3;
-
-	(* Capabilities Register *)
-	(* Low Word *)
-	Capabilities_TimeoutClockFrequencyOfs = 0;
-	Capabilities_TimeoutClockFrequencyMask = {0 .. 5};
-	Capabilities_TimeoutClockUnit = 7;
-	Capabilities_BaseClockFreqSdOfs = 8;
-	Capabilities_BaseClockFreqSdMask = {8 .. 15};
-	Capabilities_MaxBlockLenOfs = 16;
-	Capabilities_MaxBlockLenMask = {16 .. 17};
-	Capabilities_8BitEmbedded = 18;
-	Capabilities_ADMA2 = 19;
-	Capabilities_HighSpeed = 21;
-	Capabilities_SDMA = 22;
-	Capabilities_SuspendResume = 23;
-	Capabilities_Voltage33 = 24;
-	Capabilities_Voltage30 = 25;
-	Capabilities_Voltage18 = 26;
-	Capabilities_64BitBus = 28;
-	Capabilities_AsyncInterrupt = 29;
-	Capabilities_SlotTypeOfs = 30;
-	Capabilities_SlotTypeMask = {30 .. 31};
-	(* High Word *)
-	Capabilities_SDR50 = 0;
-	Capabilities_SDR104 = 1;
-	Capabilities_DDR50 = 2;
-	Capabilities_DriverTypeA = 4;
-	Capabilities_DriverTypeC = 5;
-	Capabilities_DriverTypeD = 6;
-	Capabilities_TimerCountRetuningOfs = 8;
-	Capabilities_TimerCountRetuningMask = {8 .. 11};
-	Capabilities_TuningSDR50 = 13;
-	Capabilities_RetuningModesOfs = 14;
-	Capabilities_RetuningModesMask = {14 .. 15};
-	Capabilities_ClockMultiplierOfs = 16;
-	Capabilities_ClockMultiplierMask = {16 .. 23};
-	(* Patterns *)
-	Capabilities_SlotType_Removable = {};
-	Capabilities_SlotType_Embedded = {30};
-	Capabilities_SlotType_SharedBus = {31};
-
-	(* Host Control 1 register values *)
-	HostControl1_LedControl = 0;
-	HostControl1_DataTransferWidth = 1;
-	HostControl1_HighSpeedEnable = 2;
-	HostControl1_DmaSelectOfs = 3;
-	HostControl1_DmaSelectMask = {3 .. 4};
-	HostControl1_ExtendedDataTxWidth = 5;
-	HostControl1_CardDetectTestLevel = 6;
-	HostControl1_CardDetectSignalSelection = 7;
-	HostControl1_DmaSelect_Sdma = {};
-	HostControl1_DmaSelect_32Adma = {4};
-
-	(* SoftwareReset register values *)
-	SoftwareResetAll = 1;
-	SoftwareResetCmd = 2;
-	SoftwareResetDat = 4;
-
-	(* Clock Control register values *)
-	ClockControl_InternalClockEnable = 0;
-	ClockControl_InternalClockState = 1;
-	ClockControl_SdClockEnable = 2;
-	ClockControl_ClockGeneratorSelect = 5;
-	ClockControl_SdClockFreqUpperOfs = 6;
-	ClockControl_SdClockFreqUpperMask = {6, 7};
-	ClockControl_SdClockFreqOfs = 8;
-	ClockControl_SdClockFreqMask = {8 .. 15};
-
-	(* Power Control register values *)
-	PowerControl_SDBusPower* = 0;
-	PowerControl_SDBusVoltageOfs = 1;
-	PowerControl_SDBusVoltageMask = {1 .. 3};
-	PowerControl_SDBusVoltage_18 = {1, 3};
-	PowerControl_SDBusVoltage_30 = {2, 3};
-	PowerControl_SDBusVoltage_33 = {1, 2, 3};
-
-	(* Host Controller Version *)
-	HostControllerVersion_SpecificationMask = {0 .. 7};
-	HostControllerVersion_VendorOfs = 8;
-	HostControllerVersion_VendorMask = {8 .. 15};
-
-
-	(* SD Status fields *)
-	SdStatus_FuleSupport = 312;
-	SdStatus_DiscardSupport = 313;
-	SdStatus_PerformanceEnhanceOfs = 335;
-	SdStatus_PerformanceEnhanceWidth = 8;
-	SdStatus_AppPerfClassOfs = 336;
-	SdStatus_AppPerfClassWidth = 4;
-	SdStatus_SusAddrOfs = 346;
-	SdStatus_SusAddrWidth = 22;
-	SdStatus_VscAuSizeOfs = 368;
-	SdStatus_VscAuSizeWidth = 10;
-	SdStatus_VideoSpeedClassOfs = 384;
-	SdStatus_VideoSpeedClassWidth = 8;
-	SdStatus_UhsAuSizeOfs =  392;
-	SdStatus_UhsAuSizeWidth = 4;
-	SdStatus_UhsSpeedGradeOfs = 396;
-	SdStatus_UhsSpeedGradeWidth = 4;
-	SdStatus_EraseOffsetOfs = 400;
-	SdStatus_EraseOffsetWidth = 2;
-	SdStatus_EraseTimeoutOfs = 402;
-	SdStatus_EraseTimeoutWidth = 6;
-	SdStatus_EraseSizeOfs = 408;
-	SdStatus_EraseSizeWidth = 16;
-	SdStatus_AuSizeOfs = 428;
-	SdStatus_AuSizeWidth = 4;
-	SdStatus_PerformanceMoveOfs = 432;
-	SdStatus_PerformanceMoveWidth = 8;
-	SdStatus_SpeedClassOfs = 440;
-	SdStatus_SpeedClassWidth = 8; 
-	SdStatus_SizeOfProtectedAreaOfs = 448;
-	SdStatus_SizeOfProtectedAreaWidth = 32;
-	SdStatus_SdCardTypeOfs = 480;
-	SdStatus_SdCardTypeWidth = 16;
-	SdStatus_SecuredMode = 509;
-	SdStatus_DatBusWidthOfs = 510;
-	SdStatus_DatBusWidthWidth = 2;
-
-	(* Card Status register -- R1 *)
-	CardStatus_AkeSpecError = 3;
-	CardStatus_AppCmd = 5;
-	CardStatus_ReadyForData = 8;
-	CardStatus_CurrentStateOffset = 9;
-	CardStatus_CurrentStateMask = {9 .. 12};
-	CardStatus_EraseReset = 13;
-	CardStatus_CardEccDisable = 14;
-	CardStatus_WpEraseSkip = 15;
-	CardStatus_CsdOverwrite = 16;
-	CardStatus_Error = 19;
-	CardStatus_CcError = 20;
-	CardStatus_CardEccFailed = 21;
-	CardStatus_IllegalCommand = 22;
-	CardStatus_ComCrcError = 23;
-	CardStatus_LockUnlockFailed = 24;
-	CardStatus_CardIsLocked = 25;
-	CardStatus_WpViolation = 26;
-	CardStatus_EraseParam = 27;
-	CardStatus_EraseSeqError = 28;
-	CardStatus_BlockLenError = 29;
-	CardStatus_AddressError = 30;
-	CardStatus_OutOfRange = 31;
-
-	(* OCR Registers *)
-	CardOcr_Vdd27_28 = 15;
-	CardOcr_Vdd28_29 = 16;
-	CardOcr_Vdd29_30 = 17;
-	CardOcr_Vdd30_31 = 18;
-	CardOcr_Vdd31_32 = 19;
-	CardOcr_Vdd32_33 = 20;
-	CardOcr_Vdd33_34 = 21;
-	CardOcr_Vdd34_35 = 22;
-	CardOcr_Vdd35_36 = 23;
-	CardOcr_S18A = 24;
-	CardOcr_UHS2CardStatus = 29;
-	CardOcr_CardCapacityStatus = 30;
-	CardOcr_PowerUpStatus = 31;
-
-	(* CID Register *)
-	CardCid_ManufacturerIdOfs = 112;
-	CardCid_ManufacturerIdWidth = 8;
-	CardCid_OEM_ApplicationIdOfs = 96;
-	CardCid_OEM_ApplicationIdWidth = 16;
-	CardCid_ProductNameOfs = 56;
-	CardCid_ProductNameWidth = 40;
-	CardCid_ProductRevisionOfs = 48;
-	CardCid_ProductRevisionWidth = 8;
-	CardCid_ProductSerialNbOfs = 16;
-	CardCid_ProductSerialNbWidth = 32;
-	CardCid_ProductManufacturingDateOfs = 0;
-	CardCid_ProductManufacturingDateWidth = 12;
-
-	(* CSD Register. This excludes the CRC7 of the specifications. *)
-	CardCsd_FileFormatOfs = 2;
-	CardCsd_FileFormatWidth = 2;
-	CardCsd_TmpWriteProtect = 4;
-	CardCsd_PermWriteProtect = 5;
-	CardCsd_Copy = 6;
-	CardCsd_FileFormatGrp = 7;
-	CardCsd_WriteBlPartial = 13;
-	CardCsd_WriteBlLenOfs = 14;
-	CardCsd_WriteBlLenWidth = 4;
-	CardCsd_R2wFactorOfs = 18;
-	CardCsd_R2wFactorWidth = 3;
-	CardCsd_WpGrpEnable = 23;
-	CardCsd_WpGrpSizeOfs = 24;
-	CardCsd_WpGrpSizeWidth = 7;
-	CardCsd_SectorSizeOfs = 31;
-	CardCsd_SectorSizeWidth = 7;
-	CardCsd_EraseBlkEn = 38;
-	CardCsd_CSizeMultOfs1 = 39; (** V1 *)
-	CardCsd_CSizeMultWidth1 = 3; (** V1 *)
-	CardCsd_VddWCurrMaxOfs1 = 42; (** V1 *)
-	CardCsd_VddWCurrMaxWidth1 = 3; (** V1 *)
-	CardCsd_VddWCurrMinOfs1 = 45; (** V1 *)
-	CardCsd_VddWCurrMinWidth1 = 3; (** V1 *)
-	CardCsd_VddRCurrMaxOfs1 = 48; (** V1 *)
-	CardCsd_VddRCurrMaxWidth1 = 3; (** V1 *)
-	CardCsd_VddRCurrMinOfs1 = 51; (** V1 *)
-	CardCsd_VdddRCurrMaxWidth1 = 3; (** V1 *)
-	CardCsd_CSizeOfs1 = 54; (** V1 *)
-	CardCsd_CSizeWidth1 = 12; (** V1 *)
-	CardCsd_CSizeOfs2 = 40; (** V2 *)
-	CardCsd_CSizeWidth2 = 22; (** V2 *)
-	CardCsd_DsrImp = 68;
-	CardCsd_ReadBlkMisalign = 69;
-	CardCsd_WriteBlkMisalign = 70;
-	CardCsd_ReadBlPartial = 71;
-	CardCsd_ReadBlLenOfs = 72;
-	CardCsd_ReadBlLenWidth = 4;
-	CardCsd_CccOfs = 76;
-	CardCsd_CccWidth = 12;
-	CardCsd_TranSpeedOfs = 88;
-	CardCsd_TranSpeedWidth = 8;
-	CardCsd_NsacOfs = 96;
-	CardCsd_NsacWidth = 8;
-	CardCsd_TaacOfs = 104;
-	CardCsd_TaacWidth = 8;
-	CardCsd_CsdStructureOfs = 118;
-	CardCsd_CsdStructureWidth = 2;
-
-	(* SCR Register *)
-	CardScr_CommandSupportOfs = 32;
-	CardScr_CommandSupportWidth = 4;
-	CardScr_SpecVXOfs = 38;
-	CardScr_SpecVXWidth = 4;
-	CardScr_SpecV4 = 42;
-	CardScr_ExtendedSecurityOfs = 43;
-	CardScr_ExtendedSecurityWidth = 4;
-	CardScr_SpecV3 = 47;
-	CardScr_BusWidthsOfs = 48;
-	CardScr_BusWidthsWidth = 4;
-	CardScr_SecurityOfs = 52;
-	CardScr_SecurityWidth = 3;
-	CardScr_DataStateAfterErase = 55;
-	CardScr_SpecVersionOfs = 56;
-	CardScr_SpecVersionWidth = 4;
-	CardScr_StructureOfs = 60;
-	CardScr_StructureWidth = 4;
-
-	(* SCR register fields values *)
-	CardScr_SpecVX_v5 = 1;
-	CardScr_SpecVX_v6 = 2;
-
-	(* Card categories, used in SD status card type *)
-	CategoryRW * = 0;
-	CategoryRO * = 1;
-	CategoryOTP * = 2;
-
-	(* Performance enhancing features, used in perfEnhance in SD status *)
-	PerformanceCardMaintenance * = 0; (** Card supports card-initiated maintenance *)
-	PerformanceHostMaintenance * = 1; (** Card supports host-initiated maintenance *)
-	PerformanceCache * = 2; (** Card supports internal caching *)
-	PerformanceQueue * =3; (** Card supports command queue *)
-
-	(* Transfer options *)
-	TxDma = TRUE; (** Use DMA for transfers on all hosts that support it *)
-	TxBufferSize = 4096; (** Buffer size used for DMA transfers *)
-	TxBufferAlign = 32; (** Alignment requirement on DMA buffer: here cache line size of ARM *)
-
-	(* ADMA2 flags *) (*! Do not change values *)
-	Adma2Valid = 0; (** Valid entry *)
-	Adma2End = 1; (** Last entry *)
-	Adma2Int = 2; (** Entry generates interrupt on completion *)
-	Adma2Nop = {}; (** No-operation, just continue to next *)
-	Adma2Trans = {5}; (** Transfer descriptor *)
-	Adma2Link = {4, 5}; (** Link descriptor *)
-	Adma2ActMask = {4, 5}; (** Mask for Nop, Trans and Link *)
-
-	(* Timeout values *)
-	TimeoutCardInit = 100; (** Timeout used in card initialization, ms *)
-	TimeoutReadFactor = 100; (** Timeout factor on typical read time (according to CSD) *)
-	TimeoutReadFix = 100; (** Maximal read timeout in ms. To be used unconditionally with SDHC *)
-	TimeoutWriteFactor = 100; (** Timeout factor on typical write time (according to CSD) *)
-	TimeoutWriteFix = 250; (** Maximal write timeout in ms. To be used unconditionally with SDHC *)
-	TimeoutErase = 250; (** Typical timeout per erased block, ms *)
-
-	DefaultTimeout = 1000; (* Default timeout for blocking, in ms *)
-
-	(* Multi-threading *)
-	Synchronize * = FALSE (*TRUE*); (** Do we need to take care of concurrency? *)
-
-	(* Tracing options for debugging *)
-	EnableTraceCmd* = FALSE;
-	EnableTrace* = FALSE;
-
-TYPE
-	(** Command execution procedure *)
-	CommandProcedure * = PROCEDURE (VAR command: Command; VAR result: LONGINT): BOOLEAN;
-	(** Data command execution procedure *)
-	TransferProcedure * = PROCEDURE (VAR command: Command; VAR data: ARRAY OF SYSTEM.BYTE; ofs, len: LONGINT; VAR result: LONGINT): BOOLEAN;
-	(** Procedure called to wait for interrupt. mask specifies which interrupts are expected, timeout is in ms. Returns FALSE if timeout occurred *)
-	Blocker * = PROCEDURE {DELEGATE} (hc: HostController; mask: SET; timeout: LONGINT): BOOLEAN;
-
-	(**
-		SD Host controller descriptor.
-	*)
-	HostController * = POINTER TO HostControllerDesc;
-	HostControllerDesc * = RECORD
-		state -, (** HC state *)
-		version -: LONGINT; (** Specifications version *)
-
-		execute -: CommandProcedure; (** Method to execute commands *)
-		transfer -: TransferProcedure; (** Method to execute data commands *)
-		acquire *, release *: PROCEDURE {DELEGATE}; (** Procedures used for locking *)
-
-		baseFrequency, (** Base hc clock frequency *)
-		frequency, (** Bus frequency *)
-		timeoutFrequency: HUGEINT; (** Timeout clock frequency *)
-		lastRca: LONGINT; (** Last RCA selected by the controller. *)
-
-		handle: EventHandler; (** Card event handler *)
-		handlerParam: ANY; (** Parameter of the eventHandler *)
-		block: Blocker; (** Procedure called to wait for interrupts *)
-
-		regs-: HcRegisters; (** Memory-mapped I/O registers *)
-		cards: Card; (** List of cards on this HC *)
-		next: HostController; (** Linked list of controllers for interrupt handling *)
-		desc{ALIGNED(32)}: ARRAY 32 OF HUGEINT; (** DMA descriptor *)
-	END;
-
-	(**
-		Command record.
-		This record type is used to describe a command and its result.
-		To execute a command, fill in the fields 'hc', 'command', 'argument', 'responseType'.
-		If the command uses the DAT line or is an application command, setup then necessary flags.
-		If the command is an application command, you also need to specify the RCA for CMD55.
-		After command execution, you can read the command response in the 'response' field. Use the
-		'GetR*' procedures to extract all information from this field in a convenient way.
-	*)
-	Command * = RECORD
-		hc *: HostController; (** Host controller on which the command is executed *)
-		rca *, (** Optional RCA parameter. Required only for ACMDs *)
-		command *, (** Command number *)
-		argument *, (** Command argument *)
-		responseType *, (** Response type *)
-		blockSize *, (** Block size for read, write or erase *)
-		dataTimeout *: LONGINT; (** Timeout value used for data line *)
-		flags *: SET; (** Command flags *)
-		response *: ARRAY 4 OF LONGINT; (** Response *)
-	END;
-
-	(** SWITCH_FUNC returned status *)
-	SwitchFuncStatus * = RECORD
-		current -: LONGINT; (** Current for specified config *)
-		functionGroups -: ARRAY 6 OF SET; (** Supported function in each group *)
-		functionStatus -: ARRAY 6 OF LONGINT; (** Function status *)
-	END;
-
-	(** Card event handler. 'card' is the card for which an event is reported (can be a new card object) and 'event' is one of 'On*' constants *)
-	EventHandler * = PROCEDURE {DELEGATE} (card: Card; event: LONGINT; param: ANY);
-
-	(** Host controller registers *)
-	HcRegisters * = POINTER {UNSAFE,UNTRACED} TO RECORD
-		SDMASystemAddress * {ALIGNED(1)}: LONGINT; (** offset = 0H *)
-		BlockSize * {ALIGNED(1)}, (** offset = 4H *)
-		BlockCount * {ALIGNED(1)}: INTEGER; (** offset = 6H *)
-		Argument1 * {ALIGNED(1)}: LONGINT; (** offset = 8H *)
-		TransferMode * {ALIGNED(1)}, (** offset = 0CH *)
-		Command * {ALIGNED(1)}: INTEGER; (** offset = 0EH *)
-		Response * {ALIGNED(1)}: ARRAY 4 OF LONGINT; (** offset = 10H *)
-		BufferData * {ALIGNED(1)}: LONGINT;
-		PresentState * {ALIGNED(1)}: SET;
-		HostControl1 * {ALIGNED(1)},
-		PowerControl * {ALIGNED(1)},
-		BlockGapControl * {ALIGNED(1)},
-		WakeupControl * {ALIGNED(1)}: SHORTINT;
-		ClockControl * {ALIGNED(1)}: INTEGER;
-		TimeoutControl * {ALIGNED(1)},
-		SoftwareReset * {ALIGNED(1)}: SHORTINT;
-		InterruptStatus * {ALIGNED(1)},
-		InterruptStatusEnable * {ALIGNED(1)},
-		InterruptSignalEnable * {ALIGNED(1)}: SET;
-		AutoCmdErrorStatus * {ALIGNED(1)},
-		HostControl2 * {ALIGNED(1)}: INTEGER;
-		Capabilities * {ALIGNED(1)}: ARRAY 2 OF SET;
-		MaximumCurrentCapabilities * {ALIGNED(1)}: HUGEINT;
-		ForceEventAutoCmdErrorStatus * {ALIGNED(1)},
-		ForceEventErrorInterruptStatus * {ALIGNED(1)}: INTEGER;
-		AdmaErrorStatus * {ALIGNED(1)}: SHORTINT;
-		padding0 * {ALIGNED(1)}: ARRAY 3 OF SHORTINT;
-		AdmaSystemAddress * {ALIGNED(1)}: HUGEINT;
-		PresetValues * {ALIGNED(1)}: ARRAY 8 OF INTEGER;
-		padding1 * {ALIGNED(1)}: ARRAY 28 OF LONGINT;
-		SharedBusControl * {ALIGNED(1)}: LONGINT;
-		padding2 * {ALIGNED(1)}: ARRAY 6 OF LONGINT;
-		SlotInterruptStatus * {ALIGNED(1)},
-		HostControllerVersion * {ALIGNED(1)}: INTEGER;
-	END;
-
-VAR
-	(** List of all host controllers *)
-	hcs: HostController;
-
-	(** Statistics *)
-	NbyteRead -,
-	NbyteWritten -,
-	Nread -,
-	Nwrite -: HUGEINT;
-	Tread -,
-	Twrite -: HUGEINT;
-	start, stop: HUGEINT;
-
-	(* ==================== Host Controller (Low-Level) Interface ==================== *)
-	(**
-		Create an host controller descriptor and initializes it with the given info.
-		'baseAddress' is the base address of the IO registers.
-		'extClockFreq' is an optional external clock frequency. It is used iff the host controller has no information about its clock frequency.
-		'handler' is the event handler and 'param' is user parameter.
-	*)
-	PROCEDURE InitHostController * (hc: HostController; baseAddress: ADDRESS)(*: HostController*);
-	VAR
-		val: LONGINT;
-	BEGIN
-		hc.regs := baseAddress;
-		IF ~Reset(hc, TRUE, TRUE) THEN (*RETURN NIL*) END;
-		hc.baseFrequency := LSH(SYSTEM.VAL(LONGINT, hc.regs.Capabilities[0] * Capabilities_BaseClockFreqSdMask), -Capabilities_BaseClockFreqSdOfs);
-		hc.timeoutFrequency := LSH(SYSTEM.VAL(LONGINT, hc.regs.Capabilities[0] * Capabilities_TimeoutClockFrequencyMask), -Capabilities_TimeoutClockFrequencyOfs) * 1000;
-		IF Capabilities_TimeoutClockUnit IN hc.regs.Capabilities[0] THEN hc.timeoutFrequency := hc.timeoutFrequency * 1000 END;
-		(*SetBusClock(hc, InitialClockFrequency);
-		SetTimeout(hc, 100);*)
-
-		(* Power select 3.3V bus voltage *)
-		hc.regs.PowerControl :=  SYSTEM.VAL(SHORTINT, PowerControl_SDBusVoltage_33 + {PowerControl_SDBusPower});
-
-		(* Enable All Interrupts *)
-		hc.regs.InterruptStatusEnable := Interrupt_All;
-		hc.regs.InterruptSignalEnable := {Interrupt_Normal_CardInsertion, Interrupt_Normal_CardRemoval};
-		hc.regs.BlockGapControl := 0;
-
-		val := LONGINT(hc.regs.HostControllerVersion);
-		hc.version := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, val) * HostControllerVersion_SpecificationMask) + 1;
-
-		IF EnableTrace THEN
-			Log.String("[SD] New Host Controller v");
-			Log.Int(hc.version, 0);
-			Log.String(" at ");
-			Log.Address(baseAddress);
-			Log.Ln;
-			PrintCapabilities(hc);
-		END;
-
-		IF Synchronize THEN SdEnvironment.GetLock(hc.acquire, hc.release) END;
-
-		(* Select method according to DMA support *)
-		IF TxDma THEN
-			IF (Capabilities_ADMA2 IN hc.regs.Capabilities[0]) THEN
-				hc.transfer := ExecuteAdmaCommand;
-				hc.regs.HostControl1 := SYSTEM.VAL(SHORTINT, SYSTEM.VAL(SET, LONGINT(hc.regs.HostControl1)) + HostControl1_DmaSelect_32Adma);
-			ELSE
-				(*! ADMA1 and SDMA are not implemented yet *)
-				hc.transfer := ExecuteDataCommand
-			END
-		ELSE
-			hc.transfer := ExecuteDataCommand
-		END;
-		hc.execute := ExecuteCommand;
-		hc.block := SpinBlock; (* Use spin block by default *)
-
-		IF (hc.baseFrequency = 0) OR (hc.timeoutFrequency = 0) THEN
-			hc.state := HcConfiguring
-		ELSE
-			hc.state := HcOperational
-		END;
-
-		(* If there is a card already, initialize it *)
-		(*IF (PresentState_CardInserted IN hc.regs.PresentState) & (PresentState_CardStateStable IN hc.regs.PresentState) THEN
-			NEW(hc.cards);
-			IF InitCard(hc, hc.cards, result) & (hc.handle # NIL) THEN
-				hc.handle(hc.cards, OnInitialization, hc.handlerParam)
-			ELSIF hc.handle # NIL THEN
-				Log.String("[SD] Could not initialize inserted card: error ");
-				Log.Int(result, 0);
-				Log.Ln;
-			END
-		END;*)
-
-		hc.next := hcs;
-		hcs := hc;
-	END InitHostController;
-
-	(** Set external clock for a host controller. Host state must be HcConfiguring. bus is the SD bus clock frequency, timeout is the timeout clock frequency. *)
-	PROCEDURE SetExternalClock * (hc: HostController; bus, timeout: HUGEINT; VAR result: LONGINT): BOOLEAN;
-	BEGIN
-		IF hc.state # HcConfiguring THEN
-			result := ErrorInvalidParameters;
-			RETURN FALSE
-		END;
-		hc.baseFrequency := bus;
-		hc.timeoutFrequency := timeout;
-		hc.state := HcOperational;
-		RETURN TRUE
-	END SetExternalClock;
-
-	(** Set an event handler for a host controller *)
-	PROCEDURE SetEventHandler * (hc: HostController; handler: EventHandler; param: ANY);
-	VAR
-		result: LONGINT;
-	BEGIN
-		hc.handle := handler;
-		hc.handlerParam := param;
-
-		(* Handle events if necessary *)
-		IF (PresentState_CardInserted IN hc.regs.PresentState) & (PresentState_CardStateStable IN hc.regs.PresentState) THEN
-			NEW(hc.cards);
-			IF InitCard(hc, hc.cards, result) & (hc.handle # NIL) THEN
-				hc.handle(hc.cards, OnInitialization, hc.handlerParam)
-			ELSIF hc.handle # NIL THEN
-				Log.String("[SD] Could not initialize inserted card: error ");
-				Log.Int(result, 0);
-				Log.Ln;
-			END
-		END;
-	END SetEventHandler;
-
-	(** Change the wait for interrupt method *)
-	PROCEDURE SetBlocker * (hc: HostController; blocker: Blocker);
-	BEGIN
-		hc.block := blocker
-	END SetBlocker;
-
-	(** Turns the busy LED on or off *)
-	PROCEDURE SetLedState * (hc: HostController; on: BOOLEAN);
-	VAR
-		reg: SET;
-	BEGIN
-		reg := SYSTEM.VAL(SET, hc.regs.HostControl1);
-		IF on THEN
-			INCL(reg, HostControl1_LedControl)
-		ELSE
-			EXCL(reg, HostControl1_LedControl)
-		END;
-		hc.regs.HostControl1 := SYSTEM.VAL(SHORTINT, reg)
-	END SetLedState;
-
-	(** Get the state of the busy LED *)
-	PROCEDURE GetLedState * (hc: HostController): BOOLEAN;
-	BEGIN
-		RETURN HostControl1_LedControl IN SYSTEM.VAL(SET, hc.regs.HostControl1)
-	END GetLedState;
-
-	(**
-		Execute the command 'command', without data transfer. If you need data transfer, use 'ExecuteDataCommand'.
-		Performs all necessary steps for executing a command:
-			o Runs CMD55 if command is an application command
-			o Execute the command
-			o Wait for response
-	*)
-	PROCEDURE ExecuteCommand (VAR command: Command; VAR result: LONGINT): BOOLEAN;
-	VAR
-		status, r1: SET;
-	BEGIN
-		IF Synchronize THEN command.hc.acquire END;
-		result := ErrorNone;
-		(* Check Parameters *)
-		IF {FlagData, FlagRead, FlagAutoCmd12, FlagAutoCmd23, FlagMultipleBlockTx, FlagCountBlocks} * command.flags # {} THEN
-			result := ErrorInvalidParameters;
-			IF Synchronize THEN command.hc.release END;
-			RETURN FALSE
-		END;
-
-		IF (FlagApplicationCmd IN command.flags) THEN
-			IF ~StartCommand(command.hc, CMD_APP_CMD, LSH(command.rca, 16), ResponseR1, FlagRead IN command.flags, FALSE, FALSE, FALSE, status, result) THEN
-				IF Synchronize THEN command.hc.release END;
-				RETURN FALSE
-			END;
-			r1 := GetR1(command);
-			IF EnableTrace THEN PrintCardStatus(r1) END;
-			IF ~(FlagIgnoreIllegalCmd IN command.flags) & (CardStatus_Error IN r1) THEN
-				result := ErrorCard;
-				IF Synchronize THEN command.hc.release END;
-				RETURN FALSE
-			END
-		END;
-
-		IF ~StartCommand(
-				command.hc, command.command, command.argument, command.responseType, FlagRead IN command.flags, FALSE,
-				FALSE (*command.responseType = ResponseR1b*), FlagAbort IN command.flags, status, result) THEN
-			IF Synchronize THEN command.hc.release END;
-			RETURN FALSE
-		END;
-		GetResponse(command.hc, command.responseType, command.response);
-		IF command.command = CMD_SELECT_DESELECT_CARD THEN
-			command.hc.lastRca := LSH(command.argument, -16)
-		ELSIF command.command = CMD_GO_IDLE_STATE THEN
-			command.hc.lastRca := 0
-		END;
-		IF Synchronize THEN command.hc.release END;
-		RETURN TRUE
-	END ExecuteCommand;
-
-	(**
-		Execute command with data transfer using CPU.
-		Data is read from/written to [data[ofs], data[ofs + len]).
-	*)
-	PROCEDURE ExecuteDataCommand (VAR command: Command; VAR data: ARRAY OF SYSTEM.BYTE; ofs, len: LONGINT; VAR result: LONGINT): BOOLEAN;
-	TYPE
-		DataBytes = ARRAY 4 OF CHAR;
-	VAR
-		tmp: DataBytes;
-		i, stepLen: LONGINT;
-		hc: HostController;
-		r1, status, mask: SET;
-	BEGIN
-		ASSERT(ofs + len <= LEN(data), 7);
-		result := ErrorNone;
-		IF ~(FlagData IN command.flags) THEN
-			result := ErrorInvalidParameters;
-			RETURN FALSE
-		END;
-		hc := command.hc;
-
-		IF Synchronize THEN hc.acquire END;
-		(* Set timeout *)
-		SetTimeout(hc, command.dataTimeout);
-		(*IF (*~Reset(hc, TRUE, FALSE) OR*) ~Reset(hc, FALSE, TRUE) THEN
-			result := ErrorCard;
-			IF Synchronize THEN hc.release END;
-			RETURN FALSE
-		END;*)
-
-		IF (FlagApplicationCmd IN command.flags) THEN
-			IF ~StartCommand(hc, CMD_APP_CMD, LSH(command.rca, 16), ResponseR1, FlagRead IN command.flags, FALSE, FALSE, FALSE, status, result) THEN
-				IF Synchronize THEN hc.release END;
-				RETURN FALSE
-			END;
-			r1 := SYSTEM.VAL(SET, command.response[0]);
-			IF CardStatus_Error IN r1 THEN
-				IF Synchronize THEN hc.release END;
-				RETURN FALSE
-			END;
-			IF EnableTrace THEN
-				Log.String("[SD] CMD55 Status:");
-				Log.Ln;
-				PrintCardStatus(r1)
-			END
-		END;
-
-		(* 1 *)
-		IF ~(FlagApplicationCmd IN command.flags) &
-				((command.command = CMD_READ_SINGLE_BLOCK) OR (command.command = CMD_READ_MULTIPLE_BLOCK) OR
-				(command.command = CMD_WRITE_BLOCK) OR (command.command = CMD_WRITE_MULTIPLE_BLOCK) OR
-				(command.command = 53)(* SDIO Command *)) THEN
-			IF len <= BlockSize THEN
-				hc.regs.BlockSize := INTEGER(len);
-				hc.regs.BlockCount := 1
-			ELSE
-				hc.regs.BlockSize := BlockSize;
-				hc.regs.BlockCount := INTEGER(len DIV BlockSize)
-			END;
-
-			IF EnableTrace THEN
-				Log.String("[SD] ");
-				IF FlagRead IN command.flags THEN Log.String("Read")
-				ELSE Log.String("Write") END;
-				Log.String(" parameters:"); Log.Ln;
-				Log.String("[SD] 	Block Size = "); Log.Int(hc.regs.BlockSize, 0); Log.Ln;
-				Log.String("[SD] 	Block Count = "); Log.Int(hc.regs.BlockCount, 0); Log.Ln;
-				Log.String("[SD] 	CMD"); Log.Int(command.command, 0); Log.Ln;
-				Log.String("[SD] 	Argument = "); Log.Address(command.argument); Log.Ln
-			END
-		END;
-
-		(* 3 - 8 *)
-		IF FlagRead IN command.flags THEN
-			(*REPEAT UNTIL (Interrupt_Normal_BufferReadReady IN hc.regs.InterruptStatus) OR (Interrupt_Normal_ErrorInterrupt IN hc.regs.InterruptStatus)*)
-			mask := {Interrupt_Normal_BufferReadReady, Interrupt_Normal_ErrorInterrupt}
-		ELSE
-			(*REPEAT UNTIL (Interrupt_Normal_BufferWriteReady IN hc.regs.InterruptStatus) OR (Interrupt_Normal_ErrorInterrupt IN hc.regs.InterruptStatus)*)
-			mask := {Interrupt_Normal_BufferWriteReady, Interrupt_Normal_ErrorInterrupt}
-		END;
-
-		IF ~StartCommand(hc, command.command, command.argument, ResponseR1, FlagRead IN command.flags, FALSE, TRUE, FALSE, status, result) THEN RETURN FALSE END;
-		r1 := SYSTEM.VAL(SET, command.response[0]);
-		IF CardStatus_Error IN r1 THEN
-			IF Synchronize THEN hc.release END;
-			RETURN FALSE
-		END;
-		IF EnableTrace THEN PrintCardStatus(r1) END;
-		WHILE len > 0 DO
-			(* 14 *)
-			IF ~hc.block(hc, mask, command.dataTimeout * 1000) THEN
-				Log.String("[SD] Error: interrupt timeout");
-				Log.Ln;
-				RETURN FALSE
-			END;
-			status := hc.regs.InterruptStatus;
-
-			IF Interrupt_Normal_ErrorInterrupt IN hc.regs.InterruptStatus THEN
-				IF ErrorRecovery(hc, result, status) THEN END;
-				IF Interrupt_Error_DataTimeout IN status THEN
-					result := ErrorDatTimeout
-				ELSIF Interrupt_Error_DataCrc IN status THEN
-					result := ErrorDatCrc
-				ELSIF Interrupt_Error_DataEndBit IN status THEN
-					result := ErrorCard
-				END;
-				IF Synchronize THEN hc.release END;
-				RETURN FALSE
-			END;
-			(* 15 *)
-			(*INCL(hc.regs.InterruptStatus, Interrupt_Normal_BufferReadReady);*)
-			hc.regs.InterruptStatus := {Interrupt_Normal_BufferReadReady};
-
-			(* 16 *)
-			stepLen := MIN(BlockSize, len);
-			IF FlagRead IN command.flags THEN
-				FOR i := 0 TO stepLen - 1 BY 4 DO
-					SYSTEM.PUT32(ADDRESSOF(data[ofs + i]), hc.regs.BufferData);
-					(*SYSTEM.VAL(LONGINT, tmp) := hc.regs.BufferData;
-					SYSTEM.VAL(DataBytes, data[ofs + i]) := tmp*)
-				END
-			ELSE
-				FOR i := 0 TO stepLen - 1 BY 4 DO
-					tmp := SYSTEM.VAL(DataBytes, data[ofs + i]);
-					hc.regs.BufferData := SYSTEM.VAL(LONGINT, tmp);
-				END
-			END;
-			(* 17 *)
-			INC(ofs, stepLen);
-			DEC(len, stepLen)
-		END;
-
-		(* 18 -> Not infinite block *)
-		(*REPEAT UNTIL Interrupt_Normal_TransferComplete IN hc.regs.InterruptStatus;*)
-		IF ~hc.block(hc, {Interrupt_Normal_TransferComplete}, command.dataTimeout * 1000) THEN
-			Log.String("[SD] Error: timeout interrupt");
-			Log.Ln;
-			RETURN FALSE
-		END;
-		(* 19 *)
-		(*INCL(hc.regs.InterruptStatus, Interrupt_Normal_TransferComplete);*)
-		hc.regs.InterruptStatus := {Interrupt_Normal_TransferComplete};
-
-		(*DEC(hc.regs.ClockControl, LSH(1, ClockControl_SdClockEnable));
-		hc.regs.SoftwareReset := SYSTEM.VAL(SHORTINT, {SoftwareResetCmd, SoftwareResetDat});
-		REPEAT UNTIL hc.regs.SoftwareReset = 0;
-		INC(hc.regs.ClockControl, LSH(1, ClockControl_SdClockEnable));*)
-
-		IF Synchronize THEN hc.release END;
-		RETURN TRUE (*Reset(hc, TRUE, FALSE) & Reset(hc, FALSE, TRUE)*)
-	END ExecuteDataCommand;
-
-	(**
-		Execute Command with data transfers using ADMA.
-		command: ADMA command
-		data, ofs, len: Buffer
-		result: error code
-	*)
-	PROCEDURE ExecuteAdmaCommand (VAR command: Command; VAR data: ARRAY OF SYSTEM.BYTE; ofs, len: LONGINT; VAR result: LONGINT): BOOLEAN;
-	VAR
-		tt: SdEnvironment.Time;
-		hc: HostController;
-		r1, status, flags: SET;
-		address, a: ADDRESS;
-		blocks, blockSize, desc, txlen, l, tx: LONGINT;
-		padd: BOOLEAN; (* Padd transfer to next block length? *)
-
-		PROCEDURE WriteAdma2Desc (address: ADDRESS; len: LONGINT; flags: SET): HUGEINT;
-		BEGIN
-			IF EnableTrace THEN
-				Log.String("[SD] ADMA2 Entry; address = "); Log.Hex(address, -8); Log.String(", size = "); Log.Int(len, 0);
-				Log.String(", flags = ");
-				IF flags * Adma2ActMask = Adma2Nop THEN Log.String("NOP ")
-				ELSIF flags * Adma2ActMask = Adma2Trans THEN Log.String("TRANS ")
-				ELSIF flags * Adma2ActMask = Adma2Link THEN Log.String("LINK ")
-				END;
-				IF Adma2Valid IN flags THEN Log.String("VALID ") END;
-				IF Adma2End IN flags THEN Log.String("END ") END;
-				IF Adma2Int IN flags THEN Log.String("INT ") END;
-				Log.Ln
-			END;
-			ASSERT(address MOD 4 = 0);
-			ASSERT((len > 0) OR (flags * Adma2ActMask # Adma2Trans));
-			RETURN LSH(HUGEINT(address), 32) + LSH(len MOD 65536, 16) + SYSTEM.VAL(LONGINT, flags)
-		END WriteAdma2Desc;
-
-	BEGIN
-		result := ErrorNone;
-		hc := command.hc;
-		IF Synchronize THEN hc.acquire END;
-
-		(* Setup descriptors *)
-		address := ADDRESSOF(data[ofs]);
-		(*IF ~(FlagRead IN command.flags) THEN*) SdEnvironment.FlushDCacheRange(address, len); (*END;*)
-		txlen := len;
-		flags := Adma2Trans + {Adma2Valid};
-		padd := FALSE; (*(len > BlockSize) & (len MOD BlockSize # 0);*)
-		l := len;
-		a := address;
-		WHILE l > 0 DO
-			IF ~padd & (l <= 65536) THEN flags := flags + {Adma2End, Adma2Int} END;
-			tx := MIN(l, 65536);
-			hc.desc[desc] := WriteAdma2Desc(a, tx, flags);
-			DEC(l, tx);
-			INC(a, tx);
-			INC(desc);
-		END;
-		(*hc.desc[desc] := WriteAdma2Desc(0, 0, {Adma2Valid, Adma2End, Adma2Int} + Adma2Nop); INC(desc);*)
-		SdEnvironment.FlushDCacheRange(ADDRESSOF(hc.desc[0]), (desc + 1) * 8);
-
-		(* Reset command and data lines *)
-		IF (*~Reset(hc, TRUE, FALSE) OR*) ~Reset(hc, FALSE, TRUE) THEN
-			result := ErrorCard;
-			IF Synchronize THEN hc.release END;
-			RETURN FALSE
-		END;
-
-		(* 1 *)
-		hc.regs.AdmaSystemAddress := ADDRESSOF(hc.desc[0]);
-
-		IF (FlagApplicationCmd IN command.flags) THEN
-			IF ~StartCommand(command.hc, CMD_APP_CMD, LSH(command.rca, 16), ResponseR1, FlagRead IN command.flags, FALSE, FALSE, FALSE, status, result) THEN
-				IF Synchronize THEN hc.release END;
-				RETURN FALSE
-			END;
-			r1 := SYSTEM.VAL(SET, command.response[0]);
-			IF EnableTrace THEN
-				Log.String("[SD] CMD55 Status:");
-				Log.Ln;
-				PrintCardStatus(r1)
-			END;
-			IF CardStatus_Error IN r1 THEN
-				result := ErrorCard;
-				IF Synchronize THEN hc.release END;
-				RETURN FALSE
-			END
-		END;
-
-		(* 2-3 *)
-		IF command.blockSize = 0 THEN
-			blockSize := BlockSize
-		ELSE
-			blockSize := command.blockSize
-		END;
-		IF FlagData IN command.flags THEN
-			IF txlen <= blockSize THEN
-				hc.regs.BlockSize := INTEGER(txlen);
-				hc.regs.BlockCount := 1;
-				blocks := 1
-			ELSE
-				hc.regs.BlockSize := INTEGER(blockSize);
-				blocks := txlen DIV blockSize;
-				hc.regs.BlockCount := INTEGER(blocks)
-			END;
-
-			(* Set data timeout *)
-			ASSERT(command.dataTimeout > 0);
-			SetTimeout(hc, command.dataTimeout);
-
-			IF EnableTrace THEN
-				Log.String("[SD] ");
-				IF FlagRead IN command.flags THEN Log.String("Read")
-				ELSE Log.String("Write") END;
-				Log.String(" parameters:"); Log.Ln;
-				Log.String("[SD] 	Block Size = "); Log.Int(hc.regs.BlockSize, 0); Log.Ln;
-				Log.String("[SD] 	Block Count = "); Log.Int(hc.regs.BlockCount, 0); Log.Ln;
-				Log.String("[SD] 	CMD"); Log.Int(command.command, 0); Log.Ln;
-				Log.String("[SD] 	Argument = "); Log.Address(command.argument); Log.Ln
-			END
-		END;
-
-		status := hc.regs.InterruptStatus;
-		ASSERT({Interrupt_Normal_TransferComplete, Interrupt_Normal_ErrorInterrupt} * status = {});
-		(*!start := SdEnvironment.GetTimeCounter();*)
-		IF ~StartCommand(command.hc, command.command, command.argument, command.responseType, FlagRead IN command.flags, TRUE, TRUE, FALSE, status, result) THEN
-			IF Synchronize THEN hc.release END;
-			RETURN FALSE
-		END;
-		r1 := SYSTEM.VAL(SET, command.response[0]);
-		IF CardStatus_Error IN r1 THEN
-			result := ErrorCard;
-			IF Synchronize THEN hc.release END;
-			RETURN FALSE
-		END;
-		IF EnableTrace THEN PrintCardStatus(r1) END;
-
-		(*t := SdEnvironment.GetTimeCounter();
-		tt := t + SdEnvironment.FromMilli(1000);*)
-		(*WHILE ({Interrupt_Normal_TransferComplete, Interrupt_Normal_ErrorInterrupt, Interrupt_Error_Adma} * status = {}) (*& (SdEnvironment.GetTimeCounter() <= tt)*) DO
-			status := hc.regs.InterruptStatus
-		END;*)
-		(*IF SdEnvironment.GetTimeCounter() > tt(*{Interrupt_Normal_TransferComplete, Interrupt_Normal_ErrorInterrupt} * status = {}*) THEN*)
-		IF ~hc.block(hc, {Interrupt_Normal_TransferComplete, Interrupt_Normal_ErrorInterrupt}, command.dataTimeout * 1000) THEN
-			Log.String("[SD] Error: timeout has expired!"); Log.Ln;
-			PrintHcRegisters(hc.regs);
-			IF Synchronize THEN hc.release END;
-			HALT(512);
-			RETURN FALSE;
-		END;
-		(*!stop := SdEnvironment.GetTimeCounter();*)
-		status := hc.regs.InterruptStatus;
-
-		IF Interrupt_Normal_ErrorInterrupt IN status THEN
-			IF ErrorRecovery(hc, result, status) THEN END;
-			IF Interrupt_Error_DataTimeout IN status THEN
-				result := ErrorDatTimeout;
-				IF ~Reset(hc, FALSE, TRUE) THEN END
-			ELSIF Interrupt_Error_DataCrc IN status THEN
-				result := ErrorDatCrc
-			ELSIF Interrupt_Error_DataEndBit IN status THEN
-				result := ErrorCard
-			ELSIF Interrupt_Error_Adma IN status THEN
-				HALT(182)
-			END;
-			IF Synchronize THEN hc.release END;
-			RETURN FALSE
-		END;
-		hc.regs.InterruptStatus := status;
-		IF FlagRead IN command.flags THEN
-			SdEnvironment.InvalidateDCacheRange(address, len)
-		END;
-		(*!IF FlagRead IN command.flags THEN
-			INC(Tread, stop - start);
-		ELSE
-			INC(Twrite, stop - start);
-		END;*)
-		IF Synchronize THEN hc.release END;
-		RETURN TRUE
-	END ExecuteAdmaCommand;
-
-	(** Get the response registers in 'response' *)
-	PROCEDURE GetResponse (hc: HostController; responseType: LONGINT; VAR response: ARRAY 4 OF LONGINT);
-	BEGIN
-		response := hc.regs.Response
-	END GetResponse;
-
-	(** Issue an SD Card Transaction. [Simplified specs. 3.7.1.1 pp. 106-108] *)
-	PROCEDURE StartCommand (hc: HostController; cmd, argument, responseType: LONGINT; read, dma, busy, abort: BOOLEAN; VAR status: SET; VAR result: LONGINT): BOOLEAN;
-	VAR
-		t: HUGEINT;
-		reg: LONGINT;
-		flags, txFlags: SET;
-	BEGIN
-		IF EnableTraceCmd THEN
-			Log.String("[SD] Sending Command CMD"); Log.Int(cmd, 0); Log.Ln;
-			Log.String("[SD]	Argument: "); Log.Hex(argument, -8); Log.Ln
-		END;
-
-		(* 1 *)
-		t := SdEnvironment.GetTimeCounter() + SdEnvironment.FromMilli(1000);
-		WHILE (PresentState_CommandInhibitCmd IN hc.regs.PresentState) & (t > SdEnvironment.GetTimeCounter()) DO END;
-		IF t < SdEnvironment.GetTimeCounter() THEN
-			Log.String("[SD] Timeout error in StartCommand (1)");
-			Log.Ln;
-			PrintHcRegisters(hc);
-			RETURN FALSE
-		END;
-
-		(* 2 *)
-		IF busy THEN
-			(* 3 *)
-			IF ~abort THEN
-				(* 4 *)
-				t := SdEnvironment.GetTimeCounter() + SdEnvironment.FromMilli(1000);
-				WHILE (PresentState_CommandInhibitDat IN hc.regs.PresentState) & (t > SdEnvironment.GetTimeCounter()) DO END;
-				IF t < SdEnvironment.GetTimeCounter() THEN
-					Log.String("[SD] Timeout error in StartCommand (2)");
-					Log.Ln;
-					PrintHcRegisters(hc);
-					RETURN FALSE
-				END;
-			END
-		END;
-
-		(* 5 *)
-		hc.regs.Argument1 := argument;
-
-		(* 6 *)
-		(* The response type determines the response-type and CRC/Index checks enabling *)
-		CASE responseType OF
-			 ResponseNone:
-			 	reg := Command_ResponseType_None;
-			 	IF EnableTraceCmd THEN
-			 		Log.String("[SD]	No Response Expected");
-				 	Log.Ln
-				 END
-			|ResponseR1, ResponseR5, ResponseR6, ResponseR7:
-				reg := Command_ResponseType_48b;
-				flags := {Command_CrcCheckEnable, Command_IndexCheckEnable};
-				IF EnableTraceCmd THEN
-					Log.String("[SD]	48 Bit Response"); Log.Ln;
-					Log.String("[SD]	Enabling CRC Check and Index Check"); Log.Ln
-				END
-			|ResponseR3, ResponseR4:
-				reg := Command_ResponseType_48b;
-				IF EnableTraceCmd THEN Log.String("[SD]	48 Bit Response"); Log.Ln END
-			|ResponseR1b, ResponseR5b:
-				reg := Command_ResponseType_48bBusy;
-				flags := {Command_CrcCheckEnable, Command_IndexCheckEnable};
-				IF EnableTraceCmd THEN
-					Log.String("[SD]	48 Bit Response"); Log.Ln;
-					Log.String("[SD]	Enabling Index Check"); Log.Ln
-				END
-			|ResponseR2:
-				reg := Command_ResponseType_136b;
-				flags := {Command_CrcCheckEnable};
-				IF EnableTraceCmd THEN
-					Log.String("[SD]	136 Bit Response"); Log.Ln;
-					Log.String("[SD]	Enabling Command CRC Check"); Log.Ln
-				END
-		END;
-
-		(* Command determines data-enable *)
-		IF busy THEN
-			INCL(flags, Command_DataPresent);
-			IF EnableTraceCmd THEN Log.String("[SD]	Using DAT Line"); Log.Ln END;
-
-			txFlags := {};
-			IF (*(cmd = CMD_READ_SINGLE_BLOCK) OR (cmd = CMD_READ_MULTIPLE_BLOCK) OR (cmd = ACMD_SEND_SCR)*) read THEN
-				IF EnableTraceCmd THEN Log.String("[SD] 	Data Read"); Log.Ln END;
-				INCL(txFlags, TransferMode_DataTxDirection)
-			ELSIF EnableTraceCmd THEN
-				Log.String("[SD] 	Data Write");
-				Log.Ln
-			END;
-			IF (cmd = CMD_READ_MULTIPLE_BLOCK) OR (cmd = CMD_WRITE_MULTIPLE_BLOCK) THEN
-				IF EnableTraceCmd THEN Log.String("[SD] 	Multiple blocks: using Auto CMD12 & activating block count"); Log.Ln END;
-				txFlags := txFlags + TransferMode_AutoCmd_Cmd12 + {TransferMode_MultipleBlocks, TransferMode_BlockCountEnable}
-			ELSIF EnableTraceCmd THEN
-				Log.String("[SD] 	Single Block");
-				Log.Ln
-			END;
-			IF dma THEN INCL(txFlags, TransferMode_DmaEnable) END;
-			hc.regs.TransferMode := SYSTEM.VAL(INTEGER, txFlags)
-		END;
-		hc.regs.Command := SYSTEM.VAL(INTEGER, SYSTEM.VAL(SET, reg + LSH(cmd, Command_CommandIndexOffset)) + flags);
-
-		(* 7 *)
-		RETURN WaitForCompletion(hc, ~abort, status, result)
-		(* Steps 7, 8 and 9 of WaitForCompletion have to be done by caller *)
-	END StartCommand;
-
-	(**
-		Perform error recovery as specified by the triggered error interrupts.
-		Returns an error code (result) and the interrupt status register before recovery (status)
-	*)
-	PROCEDURE ErrorRecovery (hc: HostController; VAR result: LONGINT; VAR status: SET): BOOLEAN;
-	BEGIN
-		(* 1 is done *)
-		status := hc.regs.InterruptStatus;
-		hc.regs.InterruptStatusEnable := {0 .. 14};
-		EXCL(hc.regs.InterruptStatusEnable, Interrupt_Normal_ErrorInterrupt);
-		EXCL(hc.regs.InterruptStatusEnable, Interrupt_Normal_ErrorInterrupt);
-		EXCL(hc.regs.InterruptStatusEnable, Interrupt_Normal_ErrorInterrupt);
-
-		(* 2 *)
-		IF (Interrupt_Error_CommandTimeout IN status) OR (Interrupt_Error_CommandCrc IN status) OR (Interrupt_Error_CommandEndBit IN status)
-				OR (Interrupt_Error_CommandIndex IN status) THEN
-			(* 3 & 4 *)
-			IF ~Reset(hc, TRUE, FALSE) THEN
-				result := ErrorUnrecoverable;
-				RETURN FALSE
-			END
-		END;
-
-		(* 5 *)
-		IF Interrupt_Error_DataTimeout IN status THEN
-			Log.String("[SD]	Got data timeout error"); Log.Ln
-		END;
-		IF (Interrupt_Error_DataTimeout IN status) OR (Interrupt_Error_DataCrc IN status) OR (Interrupt_Error_DataEndBit IN status) THEN
-			(* 6 & 7 *)
-			IF ~Reset(hc, FALSE, TRUE) THEN
-				result := ErrorUnrecoverable;
-				RETURN FALSE
-			END
-		END;
-
-		(* 8 & 9 *)
-		hc.regs.InterruptStatus := status;
-
-		(* 10 & 11 *)
-		(*IF ~Command(hc, CMD_STOP_TRANSMISSION, 0, ResponseR1b, FALSE, TRUE, result) THEN
-			(* 12 *)
-			IF (Interrupt_Error_CommandTimeout IN status) OR (Interrupt_Error_CommandCrc IN status) OR (Interrupt_Error_CommandEndBit IN status)
-					OR (Interrupt_Error_CommandIndex IN status) THEN
-				TRACE('CMD12 CMD LINE ERROR');
-				result := ErrorUnrecoverable;
-				RETURN FALSE
-			END;
-			(* 13 *)
-			IF ~WaitForTransfer(hc, result) THEN
-				result := ErrorUnrecoverable;
-				RETURN FALSE
-			END;
-			TRACE(hc.regs.BufferData);
-		END;
-		(* 15 *)
-		IF hc.regs.PresentState * PresentState_DatLineSignalLevelMask # PresentState_DatLineSignalLevelMask THEN
-			TRACE('CMD12 DAT LINE ERROR');
-			result := ErrorUnrecoverable;
-			RETURN FALSE
-		END;*)
-		hc.regs.InterruptStatusEnable := {0 .. 31};
-		INCL(hc.regs.InterruptStatusEnable, Interrupt_Normal_ErrorInterrupt);
-		result := ErrorNone;
-		RETURN TRUE
-	END ErrorRecovery;
-
-	(** Wait for completion of an SD command [Simplified specs. 3.7.1.2 pp. 109-110 *)
-	PROCEDURE WaitForCompletion (hc: HostController; tryRecover: BOOLEAN; 	VAR status: SET; VAR result: LONGINT): BOOLEAN;
-	BEGIN
-		result := ErrorNone;
-
-		(* 1 *)
-		IF ~hc.block(hc, {Interrupt_Normal_CommandComplete, Interrupt_Normal_ErrorInterrupt}, DefaultTimeout) THEN
-			Log.String("[SD] Timeout while waiting for completion");
-			Log.Ln;
-			PrintHcRegisters(hc);
-			RETURN FALSE
-		END;
-		status := hc.regs.InterruptStatus;
-
-		IF Interrupt_Normal_ErrorInterrupt IN status THEN
-			IF ~tryRecover THEN
-				hc.regs.InterruptStatus := status;
-				result := ErrorUnrecoverable;
-				RETURN Reset(hc, TRUE, FALSE) & Reset(hc, FALSE, TRUE)
-			END;
-			IF ~ErrorRecovery(hc, result, status) THEN RETURN FALSE END;
-			IF Interrupt_Error_CommandTimeout IN status THEN
-				IF EnableTraceCmd THEN Log.String("[SD] 	Timeout in command"); Log.Ln END;
-				result := ErrorCmdTimeout;
-				IF ~Reset(hc, TRUE, FALSE) THEN END;
-			ELSIF Interrupt_Error_CommandCrc IN status THEN
-				result := ErrorCmdCrc;
-			ELSE
-				result := ErrorCard;
-			END;
-			RETURN FALSE
-		END;
-
-		(* 2 *)
-		hc.regs.InterruptStatus := {Interrupt_Normal_CommandComplete};
-
-		IF EnableTraceCmd THEN Log.String("[SD] 	Command successful"); Log.Ln END;
-		RETURN TRUE
-	END WaitForCompletion;
-
-	(** Wait for transfer complete interrupt *)
-	PROCEDURE WaitForTransfer (hc: HostController; VAR result: LONGINT): BOOLEAN;
-	VAR
-		status: SET;
-	BEGIN
-		(* 5 *)
-		IF ~hc.block(hc, {Interrupt_Normal_TransferComplete, Interrupt_Normal_ErrorInterrupt}, DefaultTimeout) THEN
-			Log.String("[SD] Timeout failed in WaitForTransfer");
-			RETURN FALSE;
-		END;
-		(*REPEAT UNTIL (Interrupt_Normal_TransferComplete IN hc.regs.InterruptStatus) OR (Interrupt_Normal_ErrorInterrupt IN hc.regs.InterruptStatus);*)
-		status := hc.regs.InterruptStatus;
-
-		IF Interrupt_Normal_ErrorInterrupt IN hc.regs.InterruptStatus THEN
-			IF ~ErrorRecovery(hc, result, status) THEN RETURN FALSE END;
-			result := ErrorCard;
-			RETURN FALSE
-		END;
-
-		(* 6 *)
-		(*INCL(hc.regs.InterruptStatus, Interrupt_Normal_TransferComplete)*)
-		hc.regs.InterruptStatus := {Interrupt_Normal_TransferComplete}
-	END WaitForTransfer;
-
-	PROCEDURE SpinBlock (hc: HostController; mask: SET; timeout: LONGINT): BOOLEAN;
-	VAR
-		deadline: SdEnvironment.Time;
-	BEGIN
-		deadline := SdEnvironment.GetTimeCounter() + SdEnvironment.FromMilli(timeout);
-		REPEAT UNTIL (mask * hc.regs.InterruptStatus # {}) OR (SdEnvironment.GetTimeCounter() > deadline);
-		RETURN mask * hc.regs.InterruptStatus # {}
-	END SpinBlock;
-
-	(** Sends CMD7 if necessary to select the given card *)
-	PROCEDURE SelectCard * (hc: HostController; card: LONGINT; VAR result: LONGINT): BOOLEAN;
-	VAR
-		command: Command;
-		status: SET;
-	BEGIN
-		result := ErrorNone;
-		IF hc.lastRca = card THEN
-			IF EnableTrace THEN
-				Log.String("[SD] Card Already Selected");
-				Log.Ln
-			END;
-			RETURN TRUE
-		END;
-
-		IF EnableTrace THEN Log.String("[SD] Selecting Card "); Log.Int(card, 0); Log.Ln END;
-		command.hc := hc;
-		command.command := CMD_SELECT_DESELECT_CARD;
-		command.argument := LSH(card, 16);
-		command.responseType := ResponseR1b;
-		IF ~hc.execute(command, result) THEN RETURN FALSE END;
-		status := GetR1(command);
-		IF CardStatus_Error IN status THEN result := ErrorCard; RETURN FALSE END;
-		RETURN TRUE
-	END SelectCard;
-
-	(** Deselects all cards *)
-	PROCEDURE DeselectCards * (hc: HostController; VAR result: LONGINT): BOOLEAN;
-	VAR
-		command: Command;
-		ignoreRes: LONGINT;
-		ignoreBool: BOOLEAN;
-	BEGIN
-		result := ErrorNone;
-		IF hc.lastRca = 0 THEN
-			IF EnableTrace THEN Log.String("[SD] No card selected"); Log.Ln END;
-			RETURN TRUE
-		END;
-
-		IF EnableTrace THEN Log.String("[SD] Deselecting cards"); Log.Ln END;
-		command.hc := hc;
-		command.command := CMD_SELECT_DESELECT_CARD;
-		command.responseType := ResponseR1b;
-		ignoreBool := hc.execute(command, ignoreRes);
-		hc.lastRca := 0;
-		RETURN TRUE
-	END DeselectCards;
-
-	(** Read response R1 or R1b from command record *)
-	PROCEDURE GetR1 * (CONST command: Command): SET;
-	VAR
-		idx: LONGINT;
-	BEGIN
-		idx := 0;
-		(*IF (FlagAutoCmd12 IN command.flags) OR (FlagAutoCmd23 IN command.flags) THEN
-			idx := 3
-		END;*)
-		RETURN SYSTEM.VAL(SET, command.response[idx])
-	END GetR1;
-
-	(** Read response R2 from command record *)
-	PROCEDURE GetR2 * (CONST command: Command; VAR response: ARRAY OF LONGINT);
-	VAR
-		i: LONGINT;
-	BEGIN
-		FOR i := 0 TO 3 DO
-			response[i] := command.response[i]
-		END
-	END GetR2;
-
-	(** Read response R3 from command record *)
-	PROCEDURE GetR3 * (CONST command: Command): LONGINT;
-	BEGIN
-		RETURN command.response[0]
-	END GetR3;
-
-	(** Read response R4 from command record *)
-	PROCEDURE GetR4 * (CONST command: Command): LONGINT;
-	BEGIN
-		RETURN command.response[0]
-	END GetR4;
-
-	(** Read response R5 from command record *)
-	PROCEDURE GetR5 * (CONST command: Command): LONGINT;
-	BEGIN
-		RETURN command.response[0]
-	END GetR5;
-
-	(** Read response R6 from command record *)
-	PROCEDURE GetR6 * (CONST command: Command): LONGINT;
-	BEGIN
-		RETURN command.response[0]
-	END GetR6;
-
-	(** Read response R7 from command record *)
-	PROCEDURE GetR7 * (CONST command: Command): LONGINT;
-	BEGIN
-		RETURN command.response[0]
-	END GetR7;
-
-	(** Reset command and/or data lines of a host controller *)
-	PROCEDURE Reset (hc: HostController; cmd, dat: BOOLEAN): BOOLEAN;
-	VAR
-		val: SHORTINT;
-	BEGIN
-		IF cmd & dat THEN
-			val := SoftwareResetAll
-		ELSIF cmd THEN
-			val := SoftwareResetCmd
-		ELSIF dat THEN
-			val := SoftwareResetDat
-		ELSE
-			RETURN FALSE
-		END;
-		hc.regs.SoftwareReset := val;
-		REPEAT
-		UNTIL hc.regs.SoftwareReset # val;
-		RETURN TRUE
-	END Reset;
-
-	(** Set host controller bust clock *)
-	PROCEDURE SetBusClock (hc: HostController; freq: LONGINT);
-	VAR
-		val: LONGINT;
-	BEGIN
-		hc.regs.ClockControl := 0;
-
-		IF freq < hc.baseFrequency THEN
-
-			val := 1;
-			WHILE (val < 8) & (LSH(hc.baseFrequency,-val) > freq) DO
-				INC(val);
-			END;
-
-			IF EnableTrace THEN
-				Log.String(" [SD] baseFreq=");
-				Log.Int(hc.baseFrequency, 0);
-				Log.String(", val=");
-				Log.Int(val, 0);
-				Log.Ln
-			END;
-
-			hc.regs.ClockControl := INTEGER(LSH(LSH(LONGINT(1), val-1), 8) + SYSTEM.VAL(INTEGER, {ClockControl_InternalClockEnable}));
-			hc.frequency := LSH(hc.baseFrequency, -val);
-		ELSE
-			hc.regs.ClockControl := SYSTEM.VAL(INTEGER, {ClockControl_InternalClockEnable});
-			hc.frequency := hc.baseFrequency;
-		END;
-
-		REPEAT val := hc.regs.ClockControl UNTIL ClockControl_InternalClockState IN SYSTEM.VAL(SET, val);
-		val := hc.regs.ClockControl;
-		hc.regs.ClockControl := SYSTEM.VAL(INTEGER, SYSTEM.VAL(SET, val) + {ClockControl_SdClockEnable});
-		IF EnableTrace THEN
-			Log.String("[SD] Selecting Bus Clock Frequency: ");
-			Log.Int(hc.frequency, 0); Log.String(" Hz");
-			Log.Ln
-		END;
-	END SetBusClock;
-
-	(** Set host controller data timeout, in ms *)
-	PROCEDURE SetTimeout (hc: HostController; timeout: LONGINT);
-	VAR
-		ratio, val: LONGINT;
-	BEGIN
-		EXCL(hc.regs.InterruptStatusEnable, Interrupt_Error_DataTimeout);
-		ratio := LSH(LONGINT(hc.timeoutFrequency * timeout DIV 1000), -13);
-		val := 0;
-		WHILE (val < 15) & (LSH(LONGINT(1), val) < ratio) DO INC(val) END;
-		ASSERT(LSH(LONGINT(1), val) >= ratio);
-		hc.regs.TimeoutControl := SYSTEM.VAL(SHORTINT, val);
-		INCL(hc.regs.InterruptStatusEnable, Interrupt_Error_DataTimeout)
-	END SetTimeout;
-
-	(** Set the data bus width for a given RCA. *)
-	PROCEDURE SetBusWidth (hc: HostController; card: Card; width: LONGINT; VAR result: LONGINT): BOOLEAN;
-	VAR
-		command: Command;
-		val: LONGINT;
-	BEGIN
-		IF ~SelectCard(card.hc, card.rca, result) THEN RETURN FALSE END;
-
-		(*command.hc := card.hc;
-		command.command := ACMD_SET_CLR_CARD_DETECT;
-		command.argument := 0;
-		command.responseType := ResponseR1;
-		command.flags := {FlagApplicationCmd};
-		command.rca := card.rca;
-		IF ~ExecuteCommand(command, result) THEN RETURN FALSE END;*)
-
-		(* 1 *)
-		EXCL(hc.regs.InterruptStatusEnable, Interrupt_Normal_CardInterrupt);
-
-		(* 2: driver supports SD cards only *)
-		(* 3: not implemented *)
-
-		(* 4 *)
-		command.command := ACMD_SET_BUS_WIDTH;
-		CASE width OF
-			 1: command.argument := 0
-			|4: command.argument := 2
-		END;
-		command.hc := hc;
-		command.rca := card.rca;
-		command.flags := {FlagApplicationCmd};
-		command.responseType := ResponseR1;
-		IF ~ExecuteCommand(command, result) THEN RETURN FALSE END;
-
-		(* 5 *)
-		val := hc.regs.HostControl1;
-		CASE width OF
-			 1: EXCL(SYSTEM.VAL(SET, val), HostControl1_DataTransferWidth)
-			|4: INCL(SYSTEM.VAL(SET, val), HostControl1_DataTransferWidth)
-		END;
-		hc.regs.HostControl1 := SHORTINT(val);
-
-		(* 6: SD card only *)
-		(* 8 *)
-		INCL(hc.regs.InterruptStatusEnable, Interrupt_Normal_CardInterrupt);
-		RETURN TRUE
-	END SetBusWidth;
-
-	(** Executes a switch function command *)
-	PROCEDURE SwitchFunc (card: Card; switch: BOOLEAN; funcs: ARRAY 6 OF LONGINT; VAR sts: SwitchFuncStatus; VAR res: LONGINT): BOOLEAN;
-	VAR
-		status: ARRAY 64 OF CHAR;
-		command: Command;
-
-		PROCEDURE GetStatus (CONST status: ARRAY OF CHAR; VAR sts: SwitchFuncStatus);
-		VAR
-			i: LONGINT;
-		BEGIN
-			sts.current := LONGINT(ORD(status[0])) * 100H + LONGINT(ORD(status[1]));
-			FOR i := 0 TO 5 DO
-				sts.functionGroups[i] := SYSTEM.VAL(SET, LONGINT(ORD(status[2 + 2 * (5 - i)])) * 100H + LONGINT(ORD(status[1 + 2 + 2 * (5 - i)])))
-			END;
-			FOR i := 0 TO 5 BY 2 DO
-				sts.functionStatus[i] := ORD(status[14 + 2 - i DIV 2]) MOD 10H;
-				sts.functionStatus[i + 1] := ORD(status[14 + 2 - i DIV 2]) DIV 10H
-			END;
-		END GetStatus;
-
-	BEGIN
-		IF ~SelectCard(card.hc, card.rca, res) THEN RETURN FALSE END;
-		command.hc := card.hc;
-		command.command := CMD_SWITCH_FUNC;
-		command.responseType := ResponseR1;
-		command.argument := (funcs[0] MOD 10H) + 10H * (funcs[1] MOD 10H) + 100H * (funcs[2] MOD 10H) + 1000H * (funcs[3] MOD 10H) + 10000H * (funcs[4] MOD 10H) + 100000H * (funcs[5] MOD 10H);
-		IF switch THEN INCL(SYSTEM.VAL(SET, command.argument), 31) END;
-		command.flags := {FlagRead, FlagData};
-		command.dataTimeout := card.readTimeout;
-		IF ~card.hc.transfer(command, status, 0, 64, res) THEN RETURN FALSE END;
-		GetStatus(status, sts);
-		RETURN TRUE
-	END SwitchFunc;
-
-	(** Outputs the switch function status on the log *)
-	PROCEDURE PrintSwitchFuncStatus(CONST status: SwitchFuncStatus);
-	VAR
-		i: LONGINT;
-	BEGIN
-		Log.String("Switch Func Status");
-		Log.Ln;
-		Log.String("Current = ");
-		IF status.current = 0 THEN
-			Log.String("ERROR")
-		ELSE
-			Log.Int(status.current, 0);
-			Log.String(" mA");
-			Log.Ln
-		END;
-		FOR i := 0 TO 5 DO
-			Log.String("Function Group #");
-			Log.Int(i, 0);
-			Log.String(": functions = ");
-			Log.Set(status.functionGroups[i]);
-			Log.String(", status = ");
-			CASE status.functionStatus[i] OF
-				 0: Log.String("switchable")
-				|1: Log.String("switched")
-				|0FH: Log.String("ERROR")
-			END;
-			Log.Ln
-		END
-	END PrintSwitchFuncStatus;
-
-	(** Interrupt handler *)
-	PROCEDURE HandleInterrupt * (hc: HostController);
-	VAR
-		card: Card;
-		result: LONGINT;
-		interruptStatus: SET;
-	BEGIN
-		interruptStatus := hc.regs.InterruptStatus;
-
-		(*IF {Interrupt_Normal_TransferComplete, Interrupt_Normal_ErrorInterrupt} * interruptStatus # {} THEN
-			BEGIN {EXCLUSIVE} continue := TRUE END;
-			RETURN
-		END;*)
-
-		(*!TODO: make interrupt handling as quick as possible - handle all events in SdControllers asynchronously! *)
-		IF Interrupt_Normal_CardInsertion IN interruptStatus THEN
-			hc.regs.InterruptStatus := {Interrupt_Normal_CardInsertion};
-			IF EnableTrace THEN Log.String("[SD] Card Insertion"); Log.Ln END;
-			NEW(card);
-			IF InitCard(hc, card, result) & (hc.handle # NIL) THEN
-				hc.handle(card, OnInitialization, hc.handlerParam)
-			ELSIF EnableTrace THEN
-				Log.String("[SD] Could not initialize card"); Log.Ln
-			END
-		ELSIF Interrupt_Normal_CardRemoval IN interruptStatus THEN
-			hc.regs.InterruptStatus := {Interrupt_Normal_CardRemoval};
-			IF EnableTrace THEN Log.String("[SD] Card Removal"); Log.Ln END;
-			card := hc.cards;
-			IF hc.handle # NIL THEN hc.handle(card, OnRemoval, hc.handlerParam) END;
-			hc.cards := hc.cards.next
-		END;
-	END HandleInterrupt;
-
-(* ==================== Card (High-Level) Interface ==================== *)
-TYPE
-	(** Card descriptor *)
-	Card * = POINTER TO CardDesc;
-	CardDesc * = RECORD
-		state -, (** Card state. Currently not used *)
-		rca -: LONGINT; (** Card RCA *)
-		cid -: Cid; (** CID *)
-		csd -: Csd; (** CSD *)
-		scr -: Scr; (** SCR *)
-		sdStatus -: SdStatus; (** Current SD status for this card *)
-		hc -: HostController; (** Host controller on which the card is attached *)
-		acquire *, release *: PROCEDURE {DELEGATE}; (** Used for synchronization *)
-		readTimeout, (** Read timeout computed for this card, in ms *)
-		writeTimeout, (** Write timeout computed for this card, in ms *)
-		eraseTimeout: LONGINT; (** Erase timeout computed for this card, in ms *)
-		next: Card; (** Internal linked list of cards attached to the same HC *)
-	END;
-
-	(** SD Status *)
-	SdStatus * = RECORD
-		dataBusWidth -: LONGINT; (** Number of DAT bus lines currently used by card *)
-		securedMode -: BOOLEAN; (** Is card in secured mode? *)
-		cardType -: LONGINT; (** Card type, one of Category* *)
-		sizeProtArea -: HUGEINT; (** Size of the protected area, in bytes *)
-		perfMove -: LONGINT; (** Performance of move, in MB/s. 0 means 'sequential write', 255 means 'infinity' *)
-		eraseSize -: LONGINT; (** Numbers of AUs erased at a time. 0 means not supported *)
-		eraseTimeout -: LONGINT; (** Erase timeout value in second, per erase unit. 0 means not supported *)
-		eraseOffset -: LONGINT; (** Fixed timeout for erase timeout, in second *)
-		speedClass -: LONGINT; (** 3.x V speed class: 0 is 'unknown', 2, 4, 6 or 10 *)
-		auSize -: LONGINT; (** AU size for 3.x V *)
-		uhsSpeedGrade -: LONGINT; (** UHS speed grade: 0 is 'not supported', 1 or 3 *)
-		uhsAuSize -: LONGINT; (** AU size in UHS mode *)
-		vscSpeedClass -: LONGINT; (** Video mode speed class: 0 is 'not supported', 6, 10, 30, 60 or 90 *)
-		vscAuSize -: LONGINT; (** AU size in video mode *)
-		suspensionAdr -: LONGINT; (** Current suspension address, in blocks. See CMD20 *)
-		appPerfClass -: LONGINT; (** Application performance class: 0 is 'not supported', 1 or 2 *)
-		perfEnhance -: SET; (** Performance enhancing features of the card. Contains Performance* *)
-		commandQueueDepth -: LONGINT; (** Command queue depth. Valid only if PerformanceCommandQueue IN perfEnhance *)
-		discardSupport -: BOOLEAN; (** Card supports discard? *)
-		fuleSupport -: BOOLEAN; (** card supports FULE? *)
-	END;
-
-	(** Card Identification register *)
-	Cid * = RECORD
-		manufacturingDate -: RECORD (** Manufacturing date, with year and month *)
-			year -,
-			month -: LONGINT
-		END;
-		productSerialNumber -: ADDRESS; (** Serial number *)
-		productRevision -: RECORD (** Revision n.m *)
-			n-, m-: LONGINT
-		END;
-		productName -: ARRAY 6 OF CHAR; (** Product name *)
-		oemId -: ARRAY 3 OF CHAR; (** OEM/Application ID *)
-		manufacturerId -: LONGINT; (** Manufacturer identifier *)
-	END;
-
-	(* Card Registers *)
-	Csd * = RECORD
-		(* Card properties *)
-		capacity -: HUGEINT; (** Card capacity in bytes *)
-		commandClasses -: SET; (** Command classes supported by the card *)
-
-		(* Timing info *)
-		r2w -: LONGINT; (** Read to write time factor = read time / write time *)
-		taac -: REAL; (** Asynchronous access time, in s *)
-		nsac -: LONGINT; (** Worst-case clock dependent access time, in clock cycles *)
-		txSpeed -: LONGINT; (** Max transfer speed in bit/s *)
-
-		(* Block read properties *)
-		partialRead -,
-		misalignedRead -: BOOLEAN;
-		readBlockSize -: LONGINT;
-
-		(* Block write properties *)
-		partialWrite -,
-		misalignedWrite -: BOOLEAN;
-		writeBlockSize -: LONGINT;
-	END;
-
-	(** SCR register *)
-	Scr * = RECORD
-		version -, (** Card physical spec. version: one of Version* *)
-		security -: LONGINT; (** Card security type: one of Type* *)
-		busWidth -: SET; (** Bus widths supported by the card *)
-		commandSupport -: SET; (** Supported commands *)
-	END;
-
-	(**
-		Initializes a new card on the host controller.
-		Executes all commands until either an error occurs or the card is ready for data transfers.
-	*)
-	PROCEDURE InitCard * (hc: HostController; card: Card; VAR result: LONGINT): BOOLEAN;
-	VAR
-		response: LONGINT;
-		status: SET;
-		f8, sdio: BOOLEAN;
-		command: Command;
-	BEGIN
-		SetBusClock(hc, InitialClockFrequency);
-
-		FOR response := 0 TO 10000000 DO END;
-		command.hc := hc;
-
-		(* 1 *)
-		command.command := CMD_GO_IDLE_STATE;
-		command.argument := 0;
-		command.responseType := ResponseNone;
-		command.flags := {};
-		IF ~ExecuteCommand(command, result) THEN RETURN FALSE END;
-		(* 2 *)
-		command.command := CMD_SEND_IF_COND;
-		command.argument := 1AAH;
-		command.responseType := ResponseR7;
-		command.flags := {};
-		IF ~ExecuteCommand(command, result) THEN RETURN FALSE END;
-		(* 3 *)
-		response := GetR7(command);
-		IF response # 1AAH THEN
-			result := ErrorCard;
-			RETURN FALSE
-		END;
-		f8 := TRUE;
-
-		(* 5 *)
-		command.command := CMD_IO_SEND_OP_COND;
-		command.argument := 0;
-		command.responseType := ResponseR4;
-		command.flags := {};
-		IF ~ExecuteCommand(command, result) & (result = ErrorCmdTimeout) THEN
-			sdio := FALSE;
-			result := ErrorNone;
-			IF ~Reset(hc ,TRUE, FALSE) THEN RETURN FALSE END;
-		ELSIF result # ErrorNone THEN
-			RETURN FALSE
-		ELSE
-			sdio := TRUE;
-		END;
-		IF EnableTrace THEN Log.String("[SD] Card is SDIO: "); Log.Boolean(sdio); Log.Ln END;
-
-		(* 6 *)
-		IF sdio THEN
-			(*! NOT IMPLEMENTED YET *)
-			HALT(100);
-			(* 7 *)
-			(*IF ~StartCommand(hc, CMD_IO_SEND_OP_COND, 800H, ResponseR4, FALSE, FALSE, res) THEN
-				RETURN FALSE
-			END;
-			RETURN TRUE*)
-		END;
-
-		(* A *)
-		(* 12 & 19 *)
-		command.command := ACMD_SD_SEND_OP_COND;
-		command.argument := 0;
-		command.responseType := ResponseR3;
-		command.flags := {FlagApplicationCmd, FlagIgnoreIllegalCmd};
-		IF ~ExecuteCommand(command, result) THEN RETURN FALSE END;
-		response := GetR3(command);
-		IF EnableTrace THEN
-			Log.String("[SD] VDD: Ranges Supported by Card:"); Log.Ln;
-			IF CardOcr_Vdd27_28 IN SYSTEM.VAL(SET, response) THEN Log.String("[SD] 	2.7 - 2.8 V"); Log.Ln END;
-			IF CardOcr_Vdd28_29 IN SYSTEM.VAL(SET, response) THEN Log.String("[SD] 	2.8 - 2.9 V"); Log.Ln END;
-			IF CardOcr_Vdd29_30 IN SYSTEM.VAL(SET, response) THEN Log.String("[SD] 	2.9 - 3.0 V"); Log.Ln END;
-			IF CardOcr_Vdd30_31 IN SYSTEM.VAL(SET, response) THEN Log.String("[SD] 	3.0 - 3.1 V"); Log.Ln END;
-			IF CardOcr_Vdd31_32 IN SYSTEM.VAL(SET, response) THEN Log.String("[SD] 	3.1 - 3.2 V"); Log.Ln END;
-			IF CardOcr_Vdd32_33 IN SYSTEM.VAL(SET, response) THEN Log.String("[SD] 	3.2 - 3.3 V"); Log.Ln END;
-			IF CardOcr_Vdd33_34 IN SYSTEM.VAL(SET, response) THEN Log.String("[SD] 	3.3 - 3.4 V"); Log.Ln END;
-			IF CardOcr_Vdd34_35 IN SYSTEM.VAL(SET, response) THEN Log.String("[SD] 	3.4 - 3.5 V"); Log.Ln END;
-			IF CardOcr_Vdd35_36 IN SYSTEM.VAL(SET, response) THEN Log.String("[SD] 	3.5 - 3.6 V"); Log.Ln END
-		END;
-
-		status := {30};
-		IF Capabilities_Voltage30 IN hc.regs.Capabilities[0] THEN
-			IF EnableTrace THEN Log.String("[SD] Selecting 3.0 V"); Log.Ln END;
-			INCL(status, CardOcr_Vdd30_31)
-		ELSIF Capabilities_Voltage33 IN hc.regs.Capabilities[0] THEN
-			IF EnableTrace THEN Log.String("[SD] Selecting 3.3 V"); Log.Ln END;
-			INCL(status, CardOcr_Vdd32_33)
-		END;
-
-		command.command := ACMD_SD_SEND_OP_COND;
-		command.argument := SYSTEM.VAL(LONGINT, status);
-		command.responseType := ResponseR3;
-		command.flags := {FlagApplicationCmd, FlagIgnoreIllegalCmd};
-		REPEAT
-			IF ~ExecuteCommand(command, result) THEN RETURN FALSE END;
-			status := SYSTEM.VAL(SET, GetR3(command));
-		UNTIL (CardOcr_PowerUpStatus IN status);
-		IF EnableTrace & (CardOcr_S18A IN status) THEN
-			Log.String("[SD] Card supports 1.8V");
-			Log.Ln
-		END;
-		IF f8 & (CardOcr_CardCapacityStatus IN status) THEN
-			IF EnableTrace THEN Log.String("[SD] Card: SDHC or SDXC") END;
-			card.scr.security := TypeSDHC
-		ELSIF f8 THEN
-			IF EnableTrace THEN Log.String("[SD] Card: SDSC v2 or v3") END;
-			card.scr.security := TypeSDSC
-		ELSE
-			IF EnableTrace THEN Log.String("[SD] Card: SDSC v1.0 or v1.1") END;
-			card.scr.security := TypeSDSC
-		END;
-		IF EnableTrace THEN Log.Ln END;
-
-		(* 32 *)
-		command.command := CMD_ALL_SEND_CID;
-		command.argument := 0;
-		command.responseType := ResponseR2;
-		command.flags := {};
-		IF ~ExecuteCommand(command, result) THEN RETURN FALSE END;
-		DecodeCid(command.response, card.cid);
-		PrintCardCid(card.cid);
-
-		(* 33 *)
-		command.command := CMD_SEND_RELATIVE_ADDR;
-		command.argument := 0;
-		command.responseType := ResponseR6;
-		command.flags := {};
-		REPEAT
-			IF ~ExecuteCommand(command, result) THEN RETURN FALSE END;
-			card.rca := LSH(GetR6(command), -16)
-		UNTIL card.rca # 0;
-		IF EnableTrace THEN Log.String("[SD] New Card with RCA: "); Log.Hex(card.rca, -4); Log.Ln END;
-		status := SYSTEM.VAL(SET, GetR6(command));
-		status := status * {0 .. 15};
-		(* status is a modified CardStatus: reform corresponding card status *)
-		IF 15 IN status THEN EXCL(status, 15); INCL(status, 23) END;
-		IF 14 IN status THEN EXCL(status, 14); INCL(status, 22) END;
-		IF 13 IN status THEN EXCL(status, 13); INCL(status, 19) END;
-		IF EnableTrace THEN PrintCardStatus(status) END;
-		card.hc := hc;
-		card.next := hc.cards;
-		hc.cards := card;
-		IF Synchronize THEN SdEnvironment.GetLock(card.acquire, card.release) END;
-
-		(* Get Additional card registers: CSD *)
-		IF ~ReadCsd(card, result) THEN RETURN FALSE END;
-
-		SetBusClock(hc, card.csd.txSpeed);
-		(* Reasonable default timeout values, later rewritten with the ones given by the card *)
-		card.readTimeout := 100;
-		card.writeTimeout := 250;
-		card.eraseTimeout := 250;
-
-		(*IF ~Reset(hc, TRUE, FALSE) OR ~Reset(hc, FALSE, TRUE) THEN RETURN FALSE END;*)
-		IF ~ReadScr(card, result) THEN RETURN FALSE END;
-		ComputeTimeouts(card);
-
-		IF (card.scr.version >= Version1p1) THEN
-			IF EnableTrace THEN
-				Log.String("[SD] Enabling high-speed mode");
-				Log.Ln
-			END;
-			IF ~SelectSpeedMode(card, TRUE, result) THEN RETURN FALSE END;
-			IF EnableTrace THEN
-				Log.String("[SD] High-speed mode enabled");
-				Log.Ln
-			END;
-
-			(* Get CSD again: transfer speed might have changed *)
-			IF ~ReadCsd(card, result) THEN RETURN FALSE END;
-			ComputeTimeouts(card);
-			SetBusClock(hc, card.csd.txSpeed)
-		END;
-
-		IF 4 IN card.scr.busWidth THEN
-
-			IF EnableTrace THEN
-				Log.String("[SD] Changing bus width to 4 bits");
-				Log.Ln
-			END;
-
-			IF ~SetBusWidth(card.hc, card, 4, result) THEN RETURN FALSE END;
-			IF EnableTrace THEN
-				Log.String("[SD] Bus width changed");
-				Log.Ln
-			END
-		END;
-		IF ~Reset(hc, TRUE, FALSE) OR ~Reset(hc, FALSE, TRUE) THEN RETURN FALSE END;
-		GetSdStatus(card);
-
-		(*ResetStatistics; NEW(testbuf);
-		FOR response := 1 TO 100 DO
-			IF ~Read(card, 33554432, LEN(testbuf), testbuf^, 0, result) THEN RETURN FALSE END;
-			IF ~Write(card, 33554432, LEN(testbuf), testbuf^, 0, result) THEN RETURN FALSE END;
-		END;
-		Statistics(Commands.GetContext());
-		HALT(512);*)
-		RETURN TRUE
-	END InitCard;
-
-	(** Write 'data[ofs, ofs + len)' to 'card', starting at block 'firstBlock'. *)
-	PROCEDURE Write * (card: Card; firstBlock, len: LONGINT; VAR data: ARRAY OF SYSTEM.BYTE; ofs: LONGINT; VAR result: LONGINT): BOOLEAN;
-	VAR
-		command: Command;
-		start, stop: HUGEINT;
-		ret: BOOLEAN;
-	BEGIN
-		result := ErrorNone;
-		IF Synchronize THEN card.acquire END;
-		start := SdEnvironment.GetTimeCounter();
-		IF ~SelectCard(card.hc, card.rca, result) THEN
-			IF Synchronize THEN card.release END;
-			RETURN FALSE
-		END;
-
-		command.hc := card.hc;
-		command.rca := card.rca;
-
-		(* Pre-erase blocks *)
-		command.command := ACMD_SET_WR_BLK_ERASE_COUNT;
-		command.flags := {FlagApplicationCmd};
-		command.responseType := ResponseR1;
-		command.argument := (len + BlockSize - 1) DIV BlockSize;
-		IF ~ExecuteCommand(command, result) THEN
-			IF Synchronize THEN card.release END;
-			RETURN FALSE
-		END;
-
-		command.argument := firstBlock;
-		command.responseType := ResponseR1;
-		command.flags := {FlagData};
-		command.dataTimeout := card.writeTimeout;
-		command.blockSize := card.csd.writeBlockSize;
-		IF len > card.csd.writeBlockSize THEN
-			INCL(command.flags, FlagMultipleBlockTx);
-			INCL(command.flags, FlagCountBlocks);
-			INCL(command.flags, FlagAutoCmd12);
-			command.command := CMD_WRITE_MULTIPLE_BLOCK;
-		ELSE
-			command.command := CMD_WRITE_BLOCK
-		END;
-		ret := command.hc.transfer(command, data, ofs, len, result);
-		stop := SdEnvironment.GetTimeCounter();
-		IF Synchronize THEN card.release END;
-		IF ret THEN
-			INC(Nwrite);
-			INC(NbyteWritten, len);
-			INC(Twrite, stop - start)
-		END;
-		RETURN ret
-	END Write;
-
-	(** Read 'len' bytes starting from 'firstBlock' of 'card' to 'data[ofs, ofs + len)' *)
-	PROCEDURE Read * (card: Card; firstBlock, len: LONGINT; VAR data: ARRAY OF SYSTEM.BYTE; ofs: LONGINT; VAR result: LONGINT): BOOLEAN;
-	VAR
-		command: Command;
-		start, stop: HUGEINT;
-		ret: BOOLEAN;
-	BEGIN
-		IF Synchronize THEN card.acquire END;
-		start := SdEnvironment.GetTimeCounter();
-		IF ~SelectCard(card.hc, card.rca, result) THEN
-			IF Synchronize THEN card.release END;
-			RETURN FALSE
-		END;
-
-		command.hc := card.hc;
-		command.argument := firstBlock;
-		command.responseType := ResponseR1;
-		(*command.flags := {FlagData, FlagRead};*)
-		command.rca := card.rca;
-		command.dataTimeout := card.readTimeout;
-		command.blockSize := card.csd.readBlockSize;
-		IF len > card.csd.readBlockSize THEN
-			command.flags := {FlagData, FlagRead, FlagMultipleBlockTx, FlagCountBlocks, FlagAutoCmd12};
-			(*INCL(command.flags, FlagMultipleBlockTx);
-			INCL(command.flags, FlagCountBlocks);
-			INCL(command.flags, FlagAutoCmd12);*)
-			command.command := CMD_READ_MULTIPLE_BLOCK
-		ELSE
-			command.flags := {FlagData, FlagRead};
-			command.command := CMD_READ_SINGLE_BLOCK
-		END;
-		ret := command.hc.transfer(command, data, ofs, len, result) & ~(CardStatus_Error IN GetR1(command));
-		stop := SdEnvironment.GetTimeCounter();
-		IF Synchronize THEN card.release END;
-		IF ret THEN
-			INC(Nread);
-			INC(NbyteRead, len);
-			INC(Tread, stop - start)
-		END;
-		RETURN ret
-	END Read;
-
-	(** Erase blocks [block, block + num) on specified card. *)
-	PROCEDURE Erase * (card: Card; block, num: LONGINT; VAR result: LONGINT): BOOLEAN;
-	VAR
-		command: Command;
-		r1: SET;
-	BEGIN
-		command.hc := card.hc;
-		command.flags := {};
-		command.rca := card.rca;
-		command.dataTimeout := card.eraseTimeout;
-
-		command.responseType := ResponseR1;
-		command.argument := block;
-		command.command := CMD_ERASE_WR_BLK_START;
-		IF ~ExecuteCommand(command, result) & (CardStatus_Error IN GetR1(command)) THEN RETURN FALSE END;
-
-		command.argument := block + num - 1;
-		command.command := CMD_ERASE_WR_BLK_END;
-		IF ~ExecuteCommand(command, result) & (CardStatus_Error IN GetR1(command)) THEN RETURN FALSE END;
-
-		command.argument := 0;
-		command.command := CMD_ERASE;
-		command.responseType := ResponseR1b;
-		IF ~ExecuteCommand(command, result) & (CardStatus_Error IN GetR1(command)) THEN RETURN FALSE END;
-
-		(*WHILE 20 IN card.hc.regs.PresentState DO END;*)
-		command.command := CMD_SEND_STATUS;
-		command.responseType := ResponseR1;
-		REPEAT
-			IF ~ExecuteCommand(command, result) THEN RETURN FALSE END;
-			r1 := GetR1(command);
-			IF CardStatus_Error IN r1 THEN RETURN FALSE END
-		UNTIL CardStatus_ReadyForData IN r1;
-		RETURN TRUE
-	END Erase;
-
-	PROCEDURE ReadCsd (card: Card; VAR result: LONGINT): BOOLEAN;
-	VAR
-		command: Command;
-		csd: ARRAY 4 OF LONGINT;
-	BEGIN
-		result := ErrorNone;
-		IF ~DeselectCards(card.hc, result) THEN RETURN FALSE END;
-
-		command.hc := card.hc;
-		command.command := CMD_SEND_CSD;
-		command.argument := LSH(card.rca, 16);
-		command.responseType := ResponseR2;
-		command.flags := {};
-		IF ~ExecuteCommand(command, result) THEN RETURN FALSE END;
-		GetR2(command, csd);
-		DecodeCsd(csd, card.csd);
-		IF EnableTrace THEN
-			PrintCardCsd(csd);
-			Log.String("[SD] Card Capacity: ");
-			PrintSize(card.csd.capacity);
-			Log.Ln;
-			Log.String("[SD] Bus frequency: "); Log.Int(card.csd.txSpeed, 0); Log.String(" Hz"); Log.Ln
-		END;
-		RETURN TRUE
-	END ReadCsd;
-
-	(** Read the SD card Configuration Register of a card *)
-	PROCEDURE ReadScr (card: Card; VAR result: LONGINT): BOOLEAN;
-	VAR
-		command: Command;
-		ofs: LONGINT;
-		scr: ARRAY 8 OF CHAR;
-	BEGIN
-		IF ~SelectCard(card.hc, card.rca, result) THEN RETURN FALSE END;
-
-		(*
-			disconnect the pull-up resistor on D3 line (important for high-speed mode with 4 lines)
-		*)
-		(*command.hc := card.hc;
-		command.command := ACMD_SET_CLR_CARD_DETECT;
-		command.argument := 0;
-		command.responseType := ResponseR1;
-		command.flags := {FlagApplicationCmd};
-		command.rca := card.rca;
-		IF ~ExecuteCommand(command, result) THEN RETURN FALSE END;*)
-
-		(* Get Card Register: SCR *)
-		command.hc := card.hc;
-		command.command := ACMD_SEND_SCR;
-		command.argument := 0;
-		command.responseType := ResponseR1;
-		command.flags := {FlagApplicationCmd, FlagData, FlagRead};
-		command.rca := card.rca;
-		command.dataTimeout := card.readTimeout;
-		(*ofs := 32 - ADDRESSOF(scr[0]) MOD 32;*)
-		IF ~card.hc.transfer(command, scr, ofs, 8, result) THEN RETURN FALSE END;
-		IF CardStatus_Error IN GetR1(command) THEN result := ErrorCard; RETURN FALSE END;
-		DecodeScr(scr, ofs, card.scr);
-		IF EnableTrace THEN PrintCardScr(card.scr) END;
-		RETURN TRUE
-	END ReadScr;
-
-	PROCEDURE GetSdStatus (card: Card);
-	TYPE Bitfield = ARRAY 16 OF LONGINT;
-	VAR
-		status: ARRAY 64 OF CHAR;
-		command: Command;
-		ignore: LONGINT;
-		bitfield: POINTER {UNSAFE,UNTRACED} TO Bitfield;
-		c: CHAR;
-		i: LONGINT;
-	BEGIN
-		ASSERT(SelectCard(card.hc, card.rca, ignore));
-		command.hc := card.hc;
-		command.rca := card.rca;
-		command.command := ACMD_SD_STATUS;
-		command.flags := {FlagApplicationCmd, FlagData, FlagRead};
-		command.responseType := ResponseR1;
-		command.dataTimeout := card.readTimeout;
-		IF ~card.hc.transfer(command, status, 0, LEN(status), ignore) THEN RETURN END;
-
-		FOR i := 0 TO LEN(status) DIV 2 DO
-			c := status[i];
-			status[i] := status[LEN(status) - 1 - i];
-			status[LEN(status) - 1 - i] := c
-		END;
-
-		bitfield := ADDRESSOF(status[0]);
-		DecodeSdStatus(bitfield^, card.sdStatus);
-		PrintSdStatus(card.sdStatus);
-	END GetSdStatus;
-
-	PROCEDURE GetCid (card: Card);
-	VAR
-		cid: Cid;
-		command: Command;
-		res: LONGINT;
-	BEGIN
-		IF ~DeselectCards(card.hc, res) THEN HALT(512) END;
-		command.hc := card.hc;
-		command.command := CMD_SEND_CID;
-		command.argument := LSH(card.rca, 16);
-		command.flags := {};
-		command.responseType := ResponseR2;
-		IF ~ExecuteCommand(command, res) THEN HALT(512) END;
-		DecodeCid(command.response, cid);
-		PrintCardCid(cid)
-	END GetCid;
-
-	(**
-		Computes data timeouts for read, write and erase operations according to SD specifications.
-		Stores them in card.readTimeout, writeTimeout, eraseTimeout.
-	*)
-	PROCEDURE ComputeTimeouts (card: Card);
-	VAR
-		readTime: LONGINT;
-	BEGIN
-		(*
-			Read timeout is the lower of:
-				o	(CSD.TAAC + CSD.NSAC / busfreq * 100) * TimeoutReadFactor
-				o	TimeoutReadFix
-			for a normal SD card and
-				TimeoutReadFix
-			for a SDHC card.
-		
-			Write timeout is very similar to read timeout, except that (CSD.TAAC + CSD.NSAC) * CSD.R2W is used.
-		*)
-		IF card.scr.version >= TypeSDHC THEN
-			card.readTimeout := TimeoutReadFix;
-			card.writeTimeout := TimeoutWriteFix
-		ELSE
-			readTime := 100 * LONGINT((card.csd.taac + REAL(card.csd.nsac * 100) / REAL(card.hc.frequency)) * 1000.0);
-			card.readTimeout := MIN(readTime, TimeoutReadFix);
-			card.writeTimeout := MIN(readTime * card.csd.r2w, TimeoutWriteFix);
-		END;
-		card.eraseTimeout := TimeoutErase;
-
-		IF EnableTrace THEN
-			Log.String("[SD] Read timeout = "); Log.Int(card.readTimeout, 0); Log.String(" ms"); Log.Ln;
-			Log.String("[SD] Write timeout = "); Log.Int(card.writeTimeout, 0); Log.String(" ms"); Log.Ln;
-			Log.String("[SD] Erase timeout = "); Log.Int(card.eraseTimeout, 0); Log.String(" ms"); Log.Ln
-		END
-	END ComputeTimeouts;
-
-	(** Select card speed mode. It is necessary to set it to high in order to use higher bus clock frequencies. *)
-	PROCEDURE SelectSpeedMode(card: Card; high: BOOLEAN; VAR res: LONGINT): BOOLEAN;
-	VAR
-		funcs: ARRAY 6 OF LONGINT;
-		status: SwitchFuncStatus;
-		val: SET;
-	BEGIN
-		funcs[0] := 1;
-		IF ~SwitchFunc(card, FALSE, funcs, status, res) THEN RETURN FALSE END;
-		IF EnableTrace THEN
-			Log.String("[SD] Select speed, before:");
-			Log.Ln;
-			PrintSwitchFuncStatus(status)
-		END;
-		IF ~(1 IN status.functionGroups[0]) THEN
-			Log.String("[SD] HIGH-SPEED MODE NOT SUPPORTED");
-			Log.Ln;
-			RETURN TRUE
-		END;
-		IF ~SwitchFunc(card, TRUE, funcs, status, res) THEN RETURN FALSE END;
-		IF EnableTrace THEN
-			Log.String("[SD] Select speed, after:");
-			Log.Ln;
-			PrintSwitchFuncStatus(status)
-		END;
-		val := SYSTEM.VAL(SET, LONGINT(card.hc.regs.HostControl1));
-		IF high THEN
-			INCL(val, HostControl1_HighSpeedEnable)
-		ELSE
-			EXCL(val, HostControl1_HighSpeedEnable)
-		END;
-		card.hc.regs.HostControl1 := SYSTEM.VAL(SHORTINT, val);
-		RETURN TRUE
-	END SelectSpeedMode;
-
-	PROCEDURE DecodeSdStatus (CONST raw: ARRAY OF LONGINT; VAR status: SdStatus);
-	VAR
-		val: LONGINT;
-	BEGIN
-		val := ReadBitfield(raw, SdStatus_DatBusWidthOfs, SdStatus_DatBusWidthWidth);
-		CASE val OF
-			 0: status.dataBusWidth := 1
-			|2: status.dataBusWidth := 4
-		ELSE
-			status.dataBusWidth := 0
-		END;
-		status.securedMode := ReadBit(raw, SdStatus_SecuredMode);
-		val := ReadBitfield(raw, SdStatus_SdCardTypeOfs, SdStatus_SdCardTypeWidth);
-		CASE val OF
-			 0: status.cardType := CategoryRW
-			|1: status.cardType := CategoryRO
-			|2: status.cardType := CategoryOTP
-		END;
-		status.sizeProtArea := ReadBitfield(raw, SdStatus_SizeOfProtectedAreaOfs, SdStatus_SizeOfProtectedAreaWidth);
-		(*! TODO: multiply sizeProtArea by MULT * BLOCK_LEN if SDSC *)
-		val := ReadBitfield(raw, SdStatus_SpeedClassOfs, SdStatus_SpeedClassWidth);
-		CASE val OF
-			 0 .. 3: status.speedClass := 2 * val
-			|4: status.speedClass := 10
-		END;
-		status.perfMove := ReadBitfield(raw, SdStatus_PerformanceMoveOfs, SdStatus_PerformanceMoveWidth);
-		status.auSize := ReadBitfield(raw, SdStatus_AuSizeOfs, SdStatus_AuSizeWidth) * 16 * 1024;
-		status.eraseSize := ReadBitfield(raw, SdStatus_EraseSizeOfs, SdStatus_EraseSizeWidth);
-		status.eraseTimeout := ReadBitfield(raw, SdStatus_EraseTimeoutOfs, SdStatus_EraseTimeoutWidth);
-		status.eraseOffset := ReadBitfield(raw, SdStatus_EraseOffsetOfs, SdStatus_EraseOffsetWidth);
-		val := ReadBitfield(raw, SdStatus_UhsSpeedGradeOfs, SdStatus_UhsSpeedGradeWidth);
-		CASE val OF
-			0, 1, 3: status.uhsSpeedGrade := val
-		END;
-		status.uhsAuSize := ReadBitfield(raw, SdStatus_UhsAuSizeOfs, SdStatus_UhsAuSizeWidth) * 1024 * 1024;
-		status.vscSpeedClass := ReadBitfield(raw, SdStatus_VideoSpeedClassOfs, SdStatus_VideoSpeedClassWidth);
-		status.vscAuSize := ReadBitfield(raw, SdStatus_VscAuSizeOfs, SdStatus_VscAuSizeWidth) * 1024 * 1024;
-		status.suspensionAdr := ReadBitfield(raw, SdStatus_SusAddrOfs, SdStatus_SusAddrWidth);
-		status.appPerfClass := ReadBitfield(raw, SdStatus_AppPerfClassOfs, SdStatus_AppPerfClassWidth);
-		val := ReadBitfield(raw, SdStatus_PerformanceEnhanceOfs, SdStatus_PerformanceEnhanceWidth);
-		status.perfEnhance := SYSTEM.VAL(SET, val) * {PerformanceCardMaintenance .. PerformanceCache};
-		IF SYSTEM.VAL(SET, val) * {3 .. MAX(SET)} # {} THEN
-			INCL(status.perfEnhance, PerformanceQueue);
-			status.commandQueueDepth := LSH(val, -3) + 1
-		END;
-		status.discardSupport := ReadBit(raw, SdStatus_DiscardSupport);
-		status.fuleSupport := ReadBit(raw, SdStatus_FuleSupport)
-	END DecodeSdStatus;
-
-	PROCEDURE DecodeCid (CONST raw: ARRAY OF LONGINT; VAR cid: Cid);
-	VAR
-		val: LONGINT;
-	BEGIN
-		val := ReadBitfield(raw, CardCid_ProductManufacturingDateOfs, CardCid_ProductManufacturingDateWidth);
-		cid.manufacturingDate.year := val DIV 10H + 2000;
-		cid.manufacturingDate.month := val MOD 10H;
-		cid.productSerialNumber := SYSTEM.VAL(ADDRESS, ReadBitfield(raw, CardCid_ProductSerialNbOfs, CardCid_ProductSerialNbWidth));
-		val := ReadBitfield(raw, CardCid_ProductRevisionOfs, CardCid_ProductRevisionWidth);
-		cid.productRevision.n := val DIV 10H;
-		cid.productRevision.m := val MOD 10H;
-		SYSTEM.MOVE(ADDRESSOF(raw[0]) + CardCid_ProductNameOfs DIV 8, ADDRESSOF(cid.productName), CardCid_ProductNameWidth DIV 8);
-		SYSTEM.MOVE(ADDRESSOF(raw[0]) + CardCid_OEM_ApplicationIdOfs DIV 8, ADDRESSOF(cid.oemId), CardCid_OEM_ApplicationIdWidth DIV 8);
-		cid.manufacturerId := ReadBitfield(raw, CardCid_ManufacturerIdOfs, CardCid_ManufacturerIdWidth)
-	END DecodeCid;
-
-	(** Fills a Csd record from the raw csd bytes *)
-	PROCEDURE DecodeCsd (CONST raw: ARRAY OF LONGINT; VAR csd: Csd);
-	VAR
-		sizeMult, val, version: LONGINT;
-		real: REAL;
-	BEGIN
-		version := ReadBitfield(raw, CardCsd_CsdStructureOfs, CardCsd_CsdStructureWidth) + 1;
-
-		IF version = 1 THEN
-			sizeMult := LSH(LONGINT(2), ReadBitfield(raw, CardCsd_CSizeMultOfs1, CardCsd_CSizeMultWidth1));
-			csd.capacity := sizeMult * (1 + ReadBitfield(raw, CardCsd_CSizeOfs1, CardCsd_CSizeWidth1)) * 512;
-		ELSE
-			csd.capacity := 512 * 1024 * (HUGEINT(ReadBitfield(raw, CardCsd_CSizeOfs2, CardCsd_CSizeWidth2)) + 1);
-		END;
-
-		csd.commandClasses := SYSTEM.VAL(SET, ReadBitfield(raw, CardCsd_CccOfs, CardCsd_CccWidth));
-		csd.nsac := ReadBitfield(raw, CardCsd_NsacOfs, CardCsd_NsacWidth) * 100;
-
-		val := ReadBitfield(raw, CardCsd_R2wFactorOfs, CardCsd_R2wFactorWidth);
-		IF val >= 6 THEN
-			csd.r2w := 0
-		ELSE
-			csd.r2w := LSH(LONGINT(1), val);
-		END;
-
-		val := ReadBitfield(raw, CardCsd_TranSpeedOfs, CardCsd_TranSpeedWidth);
-		CASE val DIV 8 OF
-			 1: csd.txSpeed := 10
-			|2: csd.txSpeed := 12
-			|3: csd.txSpeed := 13
-			|4: csd.txSpeed := 15
-			|5: csd.txSpeed := 20
-			|6: csd.txSpeed := 25
-			|7: csd.txSpeed := 30
-			|8: csd.txSpeed := 35
-			|9: csd.txSpeed := 40
-			|10: csd.txSpeed := 45
-			|11: csd.txSpeed := 50
-			|12: csd.txSpeed := 55
-			|13: csd.txSpeed := 60
-			|14: csd.txSpeed := 70
-			|15: csd.txSpeed := 80
-		ELSE
-			csd.txSpeed := 00
-		END;
-		csd.txSpeed := csd.txSpeed * 100;
-		CASE val MOD 8 OF
-			 0: csd.txSpeed := csd.txSpeed * 100
-			|1: csd.txSpeed := csd.txSpeed * 1000
-			|2: csd.txSpeed := csd.txSpeed * 10000
-			|3: csd.txSpeed := csd.txSpeed * 100000
-		END;
-
-		val := ReadBitfield(raw, CardCsd_TaacOfs, CardCsd_TaacWidth);
-		CASE val DIV 8 OF
-			 1: real := 1.0
-			|2: real := 1.2
-			|3: real := 1.3
-			|4: real := 1.5
-			|5: real := 2.0
-			|6: real := 2.5
-			|7: real := 3.0
-			|8: real := 3.5
-			|9: real := 4.0
-			|10: real := 4.5
-			|11: real := 5.0
-			|12: real := 5.5
-			|13: real := 6.0
-			|14: real := 7.0
-			|15: real := 8.0
-		ELSE
-			real := 0.0
-		END;
-		CASE val MOD 8 OF
-			 0: real := real * 1.0E-9
-			|1: real := real * 1.0E-8
-			|2: real := real * 1.0E-7
-			|3: real := real * 1.0E-6
-			|4: real := real * 1.0E-5
-			|5: real := real * 1.0E-4
-			|6: real := real * 1.0E-3
-			|7: real := real * 1.0E-2
-		END;
-		csd.taac := real;
-
-		csd.partialRead := ReadBitfield(raw, CardCsd_ReadBlPartial, 1) = 1;
-		csd.misalignedRead := ReadBitfield(raw, CardCsd_ReadBlkMisalign, 1) = 1;
-		val := ReadBitfield(raw, CardCsd_ReadBlLenOfs, CardCsd_ReadBlLenWidth);
-		IF (val <= 8) OR (val >= 12) THEN
-			csd.readBlockSize := BlockSize
-		ELSE
-			csd.readBlockSize := LSH(LONGINT(1), val)
-		END;
-
-		csd.partialWrite := ReadBitfield(raw, CardCsd_WriteBlPartial, 1) = 1;
-		csd.misalignedWrite := ReadBitfield(raw, CardCsd_WriteBlkMisalign, 1) = 1;
-		val := ReadBitfield(raw, CardCsd_WriteBlLenOfs, CardCsd_WriteBlLenWidth);
-		IF (val <= 8) OR (val >= 12) THEN
-			csd.writeBlockSize := BlockSize
-		ELSE
-			csd.writeBlockSize := LSH(LONGINT(1), val)
-		END
-	END DecodeCsd;
-
-	(** Fills a SCR record from raw data bytes *)
-	PROCEDURE DecodeScr (CONST raw: ARRAY OF CHAR; ofs: LONGINT; VAR scr: Scr);
-	TYPE
-		Array = ARRAY 8 OF CHAR;
-	VAR
-		bfield: ARRAY 2 OF LONGINT;
-		i: LONGINT;
-		val: SET;
-	BEGIN
-		FOR i := 0 TO 7 DO SYSTEM.VAL(Array, bfield)[7-i] := raw[ofs + i] END;
-		IF ReadBitfield(bfield, CardScr_StructureOfs, CardScr_StructureWidth) # 0 THEN RETURN END;
-		scr.version := ReadBitfield(bfield, CardScr_SpecVersionOfs, CardScr_SpecVersionWidth);
-		IF ReadBitfield(bfield, CardScr_SpecV3, 1) # 0 THEN scr.version := Version3 END;
-		IF ReadBitfield(bfield, CardScr_SpecV4, 1) # 0 THEN scr.version := Version4 END;
-		i := ReadBitfield(bfield, CardScr_SpecVXOfs, CardScr_SpecVXWidth);
-		IF i = CardScr_SpecVX_v5 THEN scr.version := Version5
-		ELSIF i = CardScr_SpecVX_v6 THEN scr.version := Version6
-		END;
-
-		CASE ReadBitfield(bfield, CardScr_SecurityOfs, CardScr_SecurityWidth) OF
-			 0: scr.security := TypeNone
-			|2: scr.security := TypeSDSC
-			|3: scr.security := TypeSDHC
-			|4: scr.security := TypeSDXC
-		END;
-		val := SYSTEM.VAL(SET, ReadBitfield(bfield, CardScr_BusWidthsOfs, CardScr_BusWidthsWidth));
-		FOR i := 0 TO MAX(SET) - 1 DO
-			IF i IN val THEN
-				INCL(scr.busWidth, LSH(LONGINT(1), i))
-			END
-		END
-	END DecodeScr;
-
-	(**
-		Print the state of all Host Controller registers
-	*)
-	PROCEDURE PrintHcRegisters * (regs: HcRegisters);
-	BEGIN
-		IF EnableTrace THEN
-			Log.String("[SD] HC registers status:"); Log.Ln;
-			Log.String("[SD] 	SDMASystemAddress: 0x"); Log.Hex(regs.SDMASystemAddress,-SIZEOF(LONGINT)*2); Log.Ln;
-			Log.String("[SD] 	BlockSize: 0x"); Log.Hex(regs.BlockSize,-SIZEOF(INTEGER)*2); Log.Ln;
-			Log.String("[SD] 	BlockCount: 0x"); Log.Hex(regs.BlockCount,-SIZEOF(INTEGER)*2); Log.Ln;
-			Log.String("[SD] 	Argument1: 0x"); Log.Hex(regs.Argument1,-SIZEOF(LONGINT)*2); Log.Ln;
-			Log.String("[SD] 	TransferMode: 0x"); Log.Hex(regs.TransferMode,-SIZEOF(INTEGER)*2); Log.Ln;
-			Log.String("[SD] 	Command: 0x"); Log.Hex(regs.Command,-SIZEOF(INTEGER)*2); Log.Ln;
-
-			Log.String("[SD] 	Response: 0x");
-			Log.Hex(regs.Response[0],-SIZEOF(LONGINT)*2); Log.String(" 0x");
-			Log.Hex(regs.Response[1],-SIZEOF(LONGINT)*2); Log.String(" 0x");
-			Log.Hex(regs.Response[2],-SIZEOF(LONGINT)*2); Log.String(" 0x");
-			Log.Hex(regs.Response[3],-SIZEOF(LONGINT)*2); Log.Ln;
-
-			Log.String("[SD] 	BufferData: 0x"); Log.Hex(regs.BufferData,-SIZEOF(LONGINT)*2); Log.Ln;
-			Log.String("[SD] 	PresentState: "); Log.Set(regs.PresentState); Log.Ln;
-			Log.String("[SD] 	HostControl1: 0x"); Log.Hex(regs.HostControl1,-SIZEOF(SHORTINT)*2); Log.Ln;
-			Log.String("[SD] 	PowerControl: 0x"); Log.Hex(regs.PowerControl,-SIZEOF(SHORTINT)*2); Log.Ln;
-			Log.String("[SD] 	BlockGapControl: 0x"); Log.Hex(regs.BlockGapControl,-SIZEOF(SHORTINT)*2); Log.Ln;
-			Log.String("[SD] 	WakeupControl: 0x"); Log.Hex(regs.WakeupControl,-SIZEOF(SHORTINT)*2); Log.Ln;
-			Log.String("[SD] 	ClockControl: 0x"); Log.Hex(regs.ClockControl,-SIZEOF(INTEGER)*2); Log.Ln;
-			Log.String("[SD] 	TimeoutControl: 0x"); Log.Hex(regs.TimeoutControl,-SIZEOF(SHORTINT)*2); Log.Ln;
-			Log.String("[SD] 	SoftwareReset: 0x"); Log.Hex(regs.SoftwareReset,-SIZEOF(SHORTINT)*2); Log.Ln;
-			Log.String("[SD] 	InterruptStatus: "); Log.Set(regs.InterruptStatus); Log.Ln;
-			Log.String("[SD] 	InterruptStatusEnable: "); Log.Set(regs.InterruptStatusEnable); Log.Ln;
-			Log.String("[SD] 	InterruptSignalEnable: "); Log.Set(regs.InterruptSignalEnable); Log.Ln;
-			Log.String("[SD] 	AutoCmdErrorStatus: 0x"); Log.Hex(regs.AutoCmdErrorStatus,-SIZEOF(INTEGER)*2); Log.Ln;
-			Log.String("[SD] 	HostControl2: 0x"); Log.Hex(regs.HostControl2,-SIZEOF(INTEGER)*2); Log.Ln;
-
-			Log.String("[SD] 	Capabilities: ");
-			Log.Set(regs.Capabilities[0]); Log.String(" ");
-			Log.Set(regs.Capabilities[1]); Log.Ln;
-
-			(*Log.String("[SD] 	MaximumCurrentCapabilities: 0x"); Log.Hex(regs.MaximumCurrentCapabilities,-SIZEOF(HUGEINT)*2); Log.Ln;
-			Log.String("[SD] 	ForceEventAutoCmdErrorStatus: 0x"); Log.Hex(regs.ForceEventAutoCmdErrorStatus,-SIZEOF(INTEGER)*2); Log.Ln;
-			Log.String("[SD] 	ForceEventErrorInterruptStatus: 0x"); Log.Hex(regs.ForceEventErrorInterruptStatus,-SIZEOF(INTEGER)*2); Log.Ln;
-			Log.String("[SD] 	AdmaErrorStatus: 0x"); Log.Hex(regs.AdmaErrorStatus,-SIZEOF(SHORTINT)*2); Log.Ln;
-			Log.String("[SD] 	AdmaSystemAddress: 0x"); Log.Hex(regs.AdmaSystemAddress,-SIZEOF(HUGEINT)*2); Log.Ln;*)
-
-			Log.String("[SD] 	PresetValues: 0x");
-			Log.Hex(regs.PresetValues[0],-SIZEOF(INTEGER)*2); Log.String(" 0x");
-			Log.Hex(regs.PresetValues[1],-SIZEOF(INTEGER)*2); Log.String(" 0x");
-			Log.Hex(regs.PresetValues[2],-SIZEOF(INTEGER)*2); Log.String(" 0x");
-			Log.Hex(regs.PresetValues[3],-SIZEOF(INTEGER)*2); Log.String(" 0x");
-			Log.Hex(regs.PresetValues[4],-SIZEOF(INTEGER)*2); Log.String(" 0x");
-			Log.Hex(regs.PresetValues[5],-SIZEOF(INTEGER)*2); Log.String(" 0x");
-			Log.Hex(regs.PresetValues[6],-SIZEOF(INTEGER)*2); Log.String(" 0x");
-			Log.Hex(regs.PresetValues[7],-SIZEOF(INTEGER)*2); Log.Ln;
-
-			Log.String("[SD] 	SharedBusControl: 0x"); Log.Hex(regs.SharedBusControl,-SIZEOF(LONGINT)*2); Log.Ln;
-			Log.String("[SD] 	SlotInterruptStatus: 0x"); Log.Hex(regs.SlotInterruptStatus,-SIZEOF(INTEGER)*2); Log.Ln;
-			Log.String("[SD] 	HostControllerVersion: 0x"); Log.Hex(regs.HostControllerVersion,-SIZEOF(INTEGER)*2); Log.Ln
-		END
-	END PrintHcRegisters;
-
-	(** Outputs the capabilities of a host controller on the log. *)
-	PROCEDURE PrintCapabilities * (hc: HostController);
-	VAR
-		c0, c1: SET;
-	BEGIN
-		IF EnableTrace THEN
-			c0 := hc.regs.Capabilities[0];
-			c1 := hc.regs.Capabilities[1];
-			Log.String("[SD] "); Log.String("Host Capabilities:"); Log.Ln;
-			Log.String("[SD] "); Log.String("	Timeout Clock Frequency: ");
-			IF c0 * Capabilities_TimeoutClockFrequencyMask = {} THEN
-				Log.String("Unknown")
-			ELSE
-				Log.Int(SYSTEM.VAL(LONGINT, c0 * Capabilities_TimeoutClockFrequencyMask), 0);
-				IF Capabilities_TimeoutClockUnit IN c0 THEN
-					Log.String(" MHz")
-				ELSE
-					Log.String(" kHz")
-				END
-			END;
-			Log.Ln;
-
-			Log.String("[SD] "); Log.String("	Base Clock Frequency: ");
-			IF c0 * Capabilities_BaseClockFreqSdMask = {} THEN
-				Log.String("Unknown")
-			ELSE
-				Log.Int(LSH(SYSTEM.VAL(LONGINT, c0 * Capabilities_BaseClockFreqSdMask), -Capabilities_BaseClockFreqSdOfs), 0)
-			END;
-			Log.Ln;
-
-			Log.String("[SD] "); Log.String("	Max Block Length: ");
-			Log.Int(512 * (1 + LSH(SYSTEM.VAL(LONGINT, c0 * Capabilities_MaxBlockLenMask), -Capabilities_MaxBlockLenOfs)), 0);
-			Log.String(" B");
-			Log.Ln;
-
-			Log.String("[SD] "); Log.String("	8 Bit Support for Embedded Device: ");
-			Log.Boolean(Capabilities_8BitEmbedded IN c0);
-			Log.Ln;
-
-			Log.String("[SD] "); Log.String("	Support for ADMA2: ");
-			Log.Boolean(Capabilities_ADMA2 IN c0);
-			Log.Ln;
-
-			Log.String("[SD] "); Log.String("	Support for High Speed: ");
-			Log.Boolean(Capabilities_HighSpeed IN c0);
-			Log.Ln;
-
-			Log.String("[SD] "); Log.String("	Support for SDMA: ");
-			Log.Boolean(Capabilities_SDMA IN c0);
-			Log.Ln;
-
-			Log.String("[SD] "); Log.String("	Support for Suspend/Resume: ");
-			Log.Boolean(Capabilities_SuspendResume IN c0);
-			Log.Ln;
-
-			Log.String("[SD] "); Log.String("	Voltage Support for 3.3 V: ");
-			Log.Boolean(Capabilities_Voltage33 IN c0);
-			Log.Ln;
-
-			Log.String("[SD] "); Log.String("	Voltage Support for 3.0 V: ");
-			Log.Boolean(Capabilities_Voltage30 IN c0);
-			Log.Ln;
-
-			Log.String("[SD] "); Log.String("	Voltage Support for 1.8 V: ");
-			Log.Boolean(Capabilities_Voltage18 IN c0);
-			Log.Ln;
-
-			Log.String("[SD] "); Log.String("	Support for 64 Bit Bus: ");
-			Log.Boolean(Capabilities_64BitBus IN c0);
-			Log.Ln;
-
-			Log.String("[SD] "); Log.String("	Support for Asynchronous Interrupts: ");
-			Log.Boolean(Capabilities_AsyncInterrupt IN c0);
-			Log.Ln;
-
-			Log.String("[SD] "); Log.String("	Slot Type: ");
-			IF c0 * Capabilities_SlotTypeMask = Capabilities_SlotType_Removable THEN
-				Log.String("Removable Card Slot")
-			ELSIF c0 * Capabilities_SlotTypeMask = Capabilities_SlotType_Embedded THEN
-				Log.String("Embedded Slot for One Device")
-			ELSIF c0 * Capabilities_SlotTypeMask = Capabilities_SlotType_SharedBus THEN
-				Log.String("Shared Bus Slot")
-			END;
-			Log.Ln;
-
-			IF hc.version = 3 THEN
-				Log.String("[SD] "); Log.String("	Support for SDR50: ");
-				Log.Boolean(Capabilities_SDR50 IN c1);
-				Log.Ln;
-
-				Log.String("[SD] "); Log.String("	Support for SDR104: ");
-				Log.Boolean(Capabilities_SDR104 IN c1);
-				Log.Ln;
-
-				Log.String("[SD] "); Log.String("	Support for DDR50: ");
-				Log.Boolean(Capabilities_DDR50 IN c1);
-				Log.Ln;
-
-				Log.String("[SD] "); Log.String("	Support for Driver Type A: ");
-				Log.Boolean(Capabilities_DriverTypeA IN c1);
-				Log.Ln;
-
-				Log.String("[SD] "); Log.String("	Support for Driver Type C: ");
-				Log.Boolean(Capabilities_DriverTypeC IN c1);
-				Log.Ln;
-
-				Log.String("[SD] "); Log.String("	Support for Driver Type D: ");
-				Log.Boolean(Capabilities_DriverTypeD IN c1);
-				Log.Ln;
-
-				Log.String("[SD] "); Log.String("	Timer Count for Retuning: ");
-				IF c1 * Capabilities_TimerCountRetuningMask = Capabilities_TimerCountRetuningMask THEN
-					Log.String("Unknown")
-				ELSIF c1 * Capabilities_TimerCountRetuningMask = {} THEN
-					Log.String("Disabled")
-				ELSE
-					Log.Int(LSH(LONGINT(1), LSH(SYSTEM.VAL(LONGINT, c1 * Capabilities_TimerCountRetuningMask), -Capabilities_TimerCountRetuningOfs)), 0);
-					Log.String(" s")
-				END;
-				Log.Ln;
-
-				Log.String("[SD] "); Log.String("	SDR50 Requires Retuning: ");
-				Log.Boolean(Capabilities_TuningSDR50 IN c1);
-				Log.Ln;
-
-				Log.String("[SD] "); Log.String("	Retuning Mode: ");
-				Log.Int(LSH(SYSTEM.VAL(LONGINT, c1 * Capabilities_RetuningModesMask), -Capabilities_RetuningModesOfs), 0);
-				Log.Ln;
-
-				Log.String("[SD] "); Log.String("	Clock Multiplier: ");
-				IF c1 * Capabilities_ClockMultiplierMask = {} THEN
-					Log.String("Not Supported")
-				ELSE
-					Log.Int(LSH(SYSTEM.VAL(LONGINT, c1 * Capabilities_ClockMultiplierMask), -Capabilities_ClockMultiplierOfs) + 1, 0)
-				END;
-				Log.Ln
-			END
-		END
-	END PrintCapabilities;
-
-	(** Print a card status response on the log. *)
-	PROCEDURE PrintCardStatus * (status: SET);
-	BEGIN
-		IF EnableTrace THEN
-			Log.String("[SD] Card Status:"); Log.Ln;
-			Log.String("[SD]	AKE Error: "); Log.Boolean(CardStatus_AkeSpecError IN status); Log.Ln;
-			Log.String("[SD]	App Command: "); Log.Boolean(CardStatus_AppCmd IN status); Log.Ln;
-			Log.String("[SD]	Ready For Data: "); Log.Boolean(CardStatus_ReadyForData IN status); Log.Ln;
-			Log.String("[SD]	Card State: ");
-			CASE LSH(SYSTEM.VAL(LONGINT, status * CardStatus_CurrentStateMask), -CardStatus_CurrentStateOffset) OF
-				 CardIdle: Log.String("Idle")
-				|CardReady: Log.String("Ready")
-				|CardIdentification: Log.String("Identification")
-				|CardStandby: Log.String("Standby")
-				|CardTransfer: Log.String("Transfer")
-				|CardData: Log.String("Sending Data")
-				|CardReceive: Log.String("Receiving Data")
-				|CardProgram: Log.String("Programming")
-				|CardDisabled: Log.String("Disabled")
-			END;
-			Log.Ln;
-			Log.String("[SD]	Erase Reset: "); Log.Boolean(CardStatus_EraseReset IN status); Log.Ln;
-			Log.String("[SD]	Internal ECC Enable: "); Log.Boolean(CardStatus_CardEccDisable IN status); Log.Ln;
-			Log.String("[SD]	Write_Protection Erase Skip: "); Log.Boolean(CardStatus_WpEraseSkip IN status); Log.Ln;
-			Log.String("[SD]	CSD Overwrite: "); Log.Boolean(CardStatus_CsdOverwrite IN status); Log.Ln;
-			Log.String("[SD]	Error: "); Log.Boolean(CardStatus_Error IN status); Log.Ln;
-			Log.String("[SD]	Card Controller Error: "); Log.Boolean(CardStatus_CcError IN status); Log.Ln;
-			Log.String("[SD]	Card ECC Failed: "); Log.Boolean(CardStatus_CardEccFailed IN status); Log.Ln;
-			Log.String("[SD]	Illegal Command: "); Log.Boolean(CardStatus_IllegalCommand IN status); Log.Ln;
-			Log.String("[SD]	Command CRC Error: "); Log.Boolean(CardStatus_ComCrcError IN status); Log.Ln;
-			Log.String("[SD]	Lock/Unlock Failed: "); Log.Boolean(CardStatus_LockUnlockFailed IN status); Log.Ln;
-			Log.String("[SD]	Card is Locked: "); Log.Boolean(CardStatus_CardIsLocked IN status); Log.Ln;
-			Log.String("[SD]	Write-Protection Violation: "); Log.Boolean(CardStatus_WpViolation IN status); Log.Ln;
-			Log.String("[SD]	Invalid Erase Parameters: "); Log.Boolean(CardStatus_EraseParam IN status); Log.Ln;
-			Log.String("[SD]	Erase Sequence Error: "); Log.Boolean(CardStatus_EraseSeqError IN status); Log.Ln;
-			Log.String("[SD]	Block Length Error: "); Log.Boolean(CardStatus_BlockLenError IN status); Log.Ln;
-			Log.String("[SD]	Address Error: "); Log.Boolean(CardStatus_AddressError IN status); Log.Ln;
-			Log.String("[SD]	Argument Out of Range: "); Log.Boolean(CardStatus_OutOfRange IN status); Log.Ln
-		END
-	END PrintCardStatus;
-
-	(** Print SD Status record *)
-	PROCEDURE PrintSdStatus * (status: SdStatus);
-	BEGIN
-		IF EnableTrace THEN
-			Log.String("[SD] SD Status"); Log.Ln;
-			Log.String("[SD]	data bus width: "); Log.Int(status.dataBusWidth, 0); Log.Ln;
-			Log.String("[SD]	secured mode enabled: "); Log.Boolean(status.securedMode); Log.Ln;
-			Log.String("[SD]	cardType: ");
-			CASE status.cardType OF
-				 CategoryRW: Log.String("normal RW card")
-				|CategoryRO: Log.String("read-only card")
-				|CategoryOTP: Log.String("one-time programmable card")
-			END; Log.Ln;
-			Log.String("[SD]	size of protected area: "); PrintSize(status.sizeProtArea); Log.Ln;
-			Log.String("[SD]	move performance: ");
-			CASE status.perfMove OF
-				 0: Log.String("sequential write")
-				|255: Log.String("infinite")
-			ELSE
-				Log.Int(status.perfMove, 0);
-				Log.String(" MB/s")
-			END; Log.Ln;
-			Log.String("[SD]	erase size: "); Log.Int(status.eraseSize, 0); Log.String(" AUs"); Log.Ln;
-			Log.String("[SD]	erase timeout: ");
-			IF status.eraseTimeout = 0 THEN
-				Log.String("not supported")
-			ELSE
-				Log.Int(status.eraseTimeout, 0); Log.String(" s")
-			END; Log.Ln;
-			Log.String("[SD]	erase timeout offset: "); Log.Int(status.eraseOffset, 0); Log.String(" s"); Log.Ln;
-			Log.String("[SD]	speed class: "); Log.Int(status.speedClass, 0); Log.Ln;
-			Log.String("[SD]	AU size: "); PrintSize(status.auSize); Log.Ln;
-			Log.String("[SD]	UHS speed grade: "); Log.Int(status.uhsSpeedGrade, 0); Log.Ln;
-			Log.String("[SD]	UHS AU size: "); PrintSize(status.uhsAuSize); Log.Ln;
-			Log.String("[SD]	video speed class: "); Log.Int(status.vscSpeedClass, 0); Log.Ln;
-			Log.String("[SD]	VSC AU size: "); PrintSize(status.vscAuSize); Log.Ln;
-			Log.String("[SD]	suspension address: "); Log.Int(status.suspensionAdr, 0); Log.Ln;
-			Log.String("[SD]	application performance class: ");
-			IF status.appPerfClass = 0 THEN
-				Log.String("not supported")
-			ELSE
-				Log.String("A");
-				Log.Int(status.appPerfClass, 0)
-			END; Log.Ln;
-			Log.String("[SD]	performance enhance: ");
-			IF status.perfEnhance = {} THEN Log.String("none") END;
-			IF PerformanceCardMaintenance IN status.perfEnhance THEN Log.String("card-initiated maintenance; ") END;
-			IF PerformanceHostMaintenance IN status.perfEnhance THEN Log.String("host-initiated maintenance; ") END;
-			IF PerformanceCache IN status.perfEnhance THEN Log.String("cache; ") END;
-			IF PerformanceQueue IN status.perfEnhance THEN
-				Log.String("command queue;"); Log.Ln;
-				Log.String("[SD]	command queue depth: ");
-				Log.Int(status.commandQueueDepth, 0)
-			END; Log.Ln;
-			Log.String("[SD]	discard supported: "); Log.Boolean(status.discardSupport); Log.Ln;
-			Log.String("[SD]	FULE supported: "); Log.Boolean(status.fuleSupport); Log.Ln
-		END
-	END PrintSdStatus;
-
-	(** Print the CID of a card to the log. *)
-	PROCEDURE PrintCardCid * (cid: Cid);
-	BEGIN
-		IF EnableTrace THEN
-			Log.String("[SD] CID"); Log.Ln;
-			Log.String("[SD]	manufacturing date: "); Log.Int(cid.manufacturingDate.month, 0); Log.String("/"); Log.Int(cid.manufacturingDate.year, 0); Log.Ln;
-			Log.String("[SD]	product serial number: "); Log.Int(cid.productSerialNumber, 0); Log.Ln;
-			Log.String("[SD]	product revision: "); Log.Int(cid.productRevision.n, 0); Log.String("."); Log.Int(cid.productRevision.m, 0); Log.Ln;
-			Log.String("[SD]	product name: "); Log.String(cid.productName); Log.Ln;
-			Log.String("[SD]	OEM/application id: "); Log.String(cid.oemId); Log.Ln;
-			Log.String("[SD]	manufacturer id: "); Log.Int(cid.manufacturerId, 0); Log.Ln
-		END
-	END PrintCardCid;
-
-	(** Print the CSD of a card to the log. *)
-	PROCEDURE PrintCardCsd * (CONST csd: ARRAY OF LONGINT);
-	VAR
-		cap: HUGEINT;
-		val, version, sizeMult: LONGINT;
-	BEGIN
-		IF EnableTrace THEN
-			version := ReadBitfield(csd, CardCsd_CsdStructureOfs, CardCsd_CsdStructureWidth) + 1;
-			Log.String("[SD] "); Log.String("Card CSD:"); Log.Ln;
-			Log.String("[SD] "); Log.String("	Version: "); Log.Int(version, 0); Log.Ln;
-
-			(* Common Fields *)
-			Log.String("[SD] "); Log.String("	File Format: ");
-			val := ReadBitfield(csd, CardCsd_FileFormatOfs, CardCsd_FileFormatWidth);
-			IF ReadBitfield(csd, CardCsd_FileFormatGrp, 1) = 1 THEN
-				Log.String("Unknown Value (");
-				Log.Int(val, 0);
-				Log.String(")")
-			ELSIF val = 0 THEN
-				Log.String("Hard-disk file system with partition table")
-			ELSIF val = 1 THEN
-				Log.String("FAT")
-			ELSIF val = 2 THEN
-				Log.String("Universal File Format")
-			ELSE
-				Log.String("Other")
-			END;
-			Log.Ln;
-
-			Log.String("[SD] "); Log.String("	Temporary Write Protection: "); Log.Boolean(ReadBitfield(csd, CardCsd_TmpWriteProtect, 1) = 1); Log.Ln;
-			Log.String("[SD] "); Log.String("	Permanent Write Protection: "); Log.Boolean(ReadBitfield(csd, CardCsd_PermWriteProtect, 1) = 1); Log.Ln;
-			Log.String("[SD] "); Log.String("	Copy: "); Log.Boolean(ReadBitfield(csd, CardCsd_Copy, 1) = 1); Log.Ln;
-			Log.String("[SD] "); Log.String("	Partial Block Write: "); Log.Boolean(ReadBitfield(csd, CardCsd_WriteBlPartial, 1) = 1); Log.Ln;
-			Log.String("[SD] "); Log.String("	Maximum Write Block Length: ");
-			val := ReadBitfield(csd, CardCsd_WriteBlLenOfs, CardCsd_WriteBlLenWidth);
-			IF (val <= 8) OR (val >= 12) THEN
-				Log.String("Unknown Value (");
-				Log.Int(val, 0);
-				Log.String(")")
-			ELSE
-				Log.Int(LSH(LONGINT(1), val), 0);
-			END;
-			Log.Ln;
-			Log.String("[SD] "); Log.String("	Block Program Time / Block Read Time: ");
-			val := ReadBitfield(csd, CardCsd_R2wFactorOfs, CardCsd_R2wFactorWidth);
-			IF val >= 6 THEN
-				Log.String("Unknown Value (");
-				Log.Int(val, 0);
-				Log.String(")")
-			ELSE
-				Log.Int(LSH(LONGINT(1), val), 0);
-			END;
-			Log.Ln;
-			Log.String("[SD] "); Log.String("	Group Write Protection: "); Log.Boolean(ReadBitfield(csd, CardCsd_WpGrpEnable, 1) = 1); Log.Ln;
-			Log.String("[SD] "); Log.String("	WpGrpSize: "); Log.Int(ReadBitfield(csd, CardCsd_WpGrpSizeOfs, CardCsd_WpGrpSizeWidth) + 1, 0); Log.String(" sectors"); Log.Ln;
-			Log.String("[SD] "); Log.String("	Sector Size: "); Log.Int(ReadBitfield(csd, CardCsd_SectorSizeOfs, CardCsd_SectorSizeWidth) + 1, 0); Log.Ln;
-			Log.String("[SD] "); Log.String("	Erase Block Enable: "); Log.Boolean(ReadBitfield(csd, CardCsd_EraseBlkEn, 1) = 1); Log.Ln;
-
-			IF version = 1 THEN
-				sizeMult := LSH(LONGINT(2), ReadBitfield(csd, CardCsd_CSizeMultOfs1, CardCsd_CSizeMultWidth1));
-				cap := sizeMult * (1 + ReadBitfield(csd, CardCsd_CSizeOfs1, CardCsd_CSizeWidth1)) * 512;
-			ELSE
-				cap := 512 * 1024 * (HUGEINT(ReadBitfield(csd, CardCsd_CSizeOfs2, CardCsd_CSizeWidth2)) + 1);
-			END;
-			Log.String("[SD] "); Log.String("	Card Capacity: "); Log.Int(cap, 0); Log.String(" B"); Log.Ln;
-			Log.String("[SD] "); Log.String("	DSR Implemented: "); Log.Boolean(ReadBitfield(csd, CardCsd_DsrImp, 1) = 1); Log.Ln;
-			Log.String("[SD] "); Log.String("	Misaligned Block Read: "); Log.Boolean(ReadBitfield(csd, CardCsd_ReadBlkMisalign, 1) = 1); Log.Ln;
-			Log.String("[SD] "); Log.String("	Misaligned Block Write: "); Log.Boolean(ReadBitfield(csd, CardCsd_WriteBlkMisalign, 1) = 1); Log.Ln;
-			Log.String("[SD] "); Log.String("	Partial Block Read: "); Log.Boolean(ReadBitfield(csd, CardCsd_ReadBlPartial, 1) = 1); Log.Ln;
-			(*ASSERT(ReadBitfield(csd, CardCsd_ReadBlPartial, 1) = 1);*)
-			Log.String("[SD] "); Log.String("	Maximal Block Read Length: ");
-			val := ReadBitfield(csd, CardCsd_ReadBlLenOfs, CardCsd_ReadBlLenWidth);
-			IF (val <= 8) OR (val >= 12) THEN
-				Log.String("Unknown Value (");
-				Log.Int(val, 0);
-				Log.String(")")
-			ELSE
-				Log.Int(LSH(LONGINT(1), val), 0); Log.String(" B")
-			END;
-			Log.Ln;
-			Log.String("[SD] "); Log.String("	Supported Command Classes: "); Log.Set(SYSTEM.VAL(SET, ReadBitfield(csd, CardCsd_CccOfs, CardCsd_CccWidth))); Log.Ln;
-			Log.String("[SD] "); Log.String("	Transfer Speed: ");
-			val := ReadBitfield(csd, CardCsd_TranSpeedOfs, CardCsd_TranSpeedWidth);
-			CASE val DIV 8 OF
-				 1: Log.String("1.0")
-				|2: Log.String("1.2")
-				|3: Log.String("1.3")
-				|4: Log.String("1.5")
-				|5: Log.String("2.0")
-				|6: Log.String("2.0")
-				|7: Log.String("2.5")
-				|8: Log.String("3.5")
-				|9: Log.String("4.0")
-				|10: Log.String("4.5")
-				|11: Log.String("5.0")
-				|12: Log.String("5.5")
-				|13: Log.String("6.0")
-				|14: Log.String("7.0")
-				|15: Log.String("8.0")
-			ELSE
-				Log.String("Unknown Value (");
-				Log.Int(val, 0);
-				Log.String(")")
-			END;
-			Log.String(" * 1");
-			CASE val MOD 8 OF
-				 0: Log.String("00 k")
-				|1: Log.String(" M")
-				|2: Log.String("0 M")
-				|3: Log.String("00 M")
-			END;
-			Log.String("Bit/s");
-			Log.Ln;
-
-			Log.String("[SD] "); Log.String("	Clock-Dependent Access Time: "); Log.Int(ReadBitfield(csd, CardCsd_NsacOfs, CardCsd_NsacWidth) * 100, 0); Log.String("000 clock cycles"); Log.Ln;
-			Log.String("[SD] "); Log.String("	Asynchronous Access Time: ");
-			val := ReadBitfield(csd, CardCsd_TaacOfs, CardCsd_TaacWidth);
-			CASE val DIV 8 OF
-				 1: Log.String("1.0")
-				|2: Log.String("1.2")
-				|3: Log.String("1.3")
-				|4: Log.String("1.5")
-				|5: Log.String("2.0")
-				|6: Log.String("2.5")
-				|7: Log.String("3.0")
-				|8: Log.String("3.5")
-				|9: Log.String("4.0")
-				|10: Log.String("4.5")
-				|11: Log.String("5.0")
-				|12: Log.String("5.5")
-				|13: Log.String("6.0")
-				|14: Log.String("7.0")
-				|15: Log.String("8.0")
-			ELSE
-				Log.String("Unknown Value (");
-				Log.Int(val, 0);
-				Log.String(")")
-			END;
-			Log.String(" * 1");
-			CASE val MOD 8 OF
-				 0: Log.String(" ns")
-				|1: Log.String("0 ns")
-				|2: Log.String("00 ns")
-				|3: Log.String(" microsecond")
-				|4: Log.String("0 microsecond")
-				|5: Log.String("00 microsecond")
-				|6: Log.String(" ms")
-				|7: Log.String("0 ms")
-			END;
-			Log.Ln
-		END
-	END PrintCardCsd;
-
-	PROCEDURE PrintCardScr * (CONST scr: Scr);
-	VAR i: LONGINT;
-	BEGIN
-		IF EnableTrace THEN
-			Log.String("[SD] Card SCR"); Log.Ln;
-			Log.String("[SD]	physical layer version: ");
-			CASE scr.version OF
-				 Version1: Log.String("1")
-				|Version1p1: Log.String("1.1")
-				|Version2: Log.String("2")
-				|Version3: Log.String("3")
-				|Version4: Log.String("4")
-				|Version5: Log.String("5")
-				|Version6: Log.String("6")
-			ELSE
-				Log.String("unknown")
-			END;
-			Log.Ln;
-			Log.String("[SD]	security support: ");
-			CASE scr.security OF
-				 TypeNone: Log.String("none")
-				|TypeSDSC: Log.String("SDSC")
-				|TypeSDHC: Log.String("SDHC")
-				|TypeSDXC: Log.String("SDXC")
-			END;
-			Log.Ln;
-			Log.String("[SD]	supported bus widths: "); Log.Set(scr.busWidth); Log.Ln
-		END
-	END PrintCardScr;
-
-	(** Helper to write a size in a human-readable format *)
-	PROCEDURE PrintSize (size: HUGEINT);
-	VAR
-		prefix: ARRAY 8 OF CHAR;
-		i: LONGINT;
-
-	BEGIN
-		IF size < 1024 THEN
-			Log.Int(size, 0);
-			Log.String(" ")
-		ELSE
-			prefix := 'kMGT';
-			i := 0;
-			size := size DIV 1024;
-			WHILE size > 1024 DO
-				size := size DIV 1024;
-				INC(i)
-			END;
-			Log.Int(size, 0);
-			Log.String(" ");
-			Log.Char(prefix[i])
-		END;
-		Log.String("B")
-	END PrintSize;
-
-	(**
-		Helper procedure to read bit fields in a wide register.
-			field: large bitfield
-			ofs: offset of first bit to extract
-			width: number of bits to extract
-		Returns the bits as a LONGINT.
-	*)
-	PROCEDURE ReadBitfield (CONST field: ARRAY OF LONGINT; ofs, width: LONGINT): LONGINT;
-	VAR
-		adr, bits: ADDRESS;
-	BEGIN
-		ASSERT(ofs MOD 8 + width <= 32);
-		adr := ADDRESSOF(field[0]) + ofs DIV 8;
-		bits := SYSTEM.GET8(adr) MOD 100H;
-		IF ofs MOD 8 + width > 8 THEN
-			bits := bits + LSH(ADDRESS(SYSTEM.GET8(adr + 1)) MOD 100H, 8);
-		END;
-		IF ofs MOD 8 + width > 16 THEN
-			bits := bits + LSH(ADDRESS(SYSTEM.GET8(adr + 2)) MOD 100H, 16);
-		END;
-		IF ofs MOD 8 + width > 24 THEN
-			bits := bits + LSH(ADDRESS(SYSTEM.GET8(adr + 3)) MOD 100H, 24)
-		END;
-		RETURN SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, LSH(bits, -(ofs MOD 8))) * {0 .. width - 1})
-	END ReadBitfield;
-
-	PROCEDURE ReadBit (CONST field: ARRAY OF LONGINT; bit: LONGINT): BOOLEAN;
-	BEGIN
-		RETURN SYSTEM.VAL(BOOLEAN, LSH(SYSTEM.GET8(ADDRESSOF(field[0])) + bit DIV 8, -(bit MOD 8)))
-	END ReadBit;
-
-	PROCEDURE ResetStatistics *;
-	BEGIN
-		NbyteRead := 0;
-		Nread := 0;
-		Tread := 0;
-		NbyteWritten := 0;
-		Nwrite := 0;
-		Twrite := 0
-	END ResetStatistics;
-END Sd.

ARM/ARM.A2/SdDisks.Mod

@@ -1,314 +0,0 @@
-MODULE SdDisks;
-(**
-	AUTHOR Timothée Martiel
-	PURPOSE Disk driver for SD cards.
-*)
-IMPORT
-	SYSTEM,
-	Objects, Kernel, Plugins, Disks, Strings,
-	Sd, SdEnvironment, KernelLog;
-
-CONST
-	NameBase		= "SD";
-
-	BlockSize		= 512; (** Size of a SD block *)
-	CacheSize		= 32; (** Number of entries in cache *)
-	WBSize 			= 150; (** Number of entries in write buffer *)
-	(*FlushPeriod	= 5 * 1000;*)
-
-	EnableCache* = FALSE;
-
-TYPE
-	CacheEntry = RECORD
-		buffer: POINTER TO ARRAY OF CHAR;
-		ru: LONGINT;
-		active: BOOLEAN;
-	END;
-
-	WriteBufferEntry = RECORD
-		buffer: POINTER TO ARRAY OF CHAR;
-		block, len: LONGINT;
-	END;
-
-	(**
-		SD Card Disk Device
-	*)
-	Device * = OBJECT (Disks.Device)
-	VAR
-		card: Sd.Card;
-		next: Device;
-		timer: Kernel.Timer;
-		cache: POINTER TO ARRAY OF CacheEntry;
-		wbuffer: POINTER TO ARRAY OF WriteBufferEntry;
-		bufferSize: LONGINT;
-		head, size: LONGINT; (** Write buffer parameters *)
-		stop: BOOLEAN;
-
-		PROCEDURE & InitSdDevice (card: Sd.Card);
-		VAR i: LONGINT;
-		BEGIN
-			SELF.card := card;
-			blockSize := BlockSize;
-			CASE card.sdStatus.speedClass OF
-				 2, 4:
-				 	IF card.csd.capacity > 1024*1024*1024 THEN
-				 		bufferSize := 32 * 1024 DIV BlockSize
-				 	ELSE
-				 		bufferSize := 16 * 1024 DIV BlockSize
-				 	END
-				|6: bufferSize := 64 * 1024 DIV BlockSize
-				|10: bufferSize := 512 * 1024 DIV BlockSize
-			END;
-			INCL(flags, Disks.Removable);
-			IF EnableCache THEN
-				NEW(cache, CacheSize);
-				FOR i := 0 TO CacheSize - 1 DO NEW(cache[i].buffer, bufferSize * BlockSize) END;
-				NEW(timer);
-				NEW(wbuffer, WBSize);
-				FOR i := 0 TO WBSize - 1 DO NEW(wbuffer[i].buffer, bufferSize * BlockSize) END;
-			END;
-		END InitSdDevice;
-
-		PROCEDURE Transfer * (op, block, num: LONGINT; VAR data: ARRAY OF CHAR; ofs: LONGINT; VAR res: LONGINT);
-		VAR
-			size: LONGINT;
-
-			PROCEDURE TransferCached();
-			VAR
-				s, ru, ruIdx, ruOfs: LONGINT;
-				entry: POINTER {UNSAFE} TO CacheEntry;
-				wbentry: POINTER {UNSAFE} TO WriteBufferEntry;
-			BEGIN
-				(* Caching *)
-				WHILE size > 0 DO
-					ru := block DIV bufferSize;
-					ruOfs := block MOD bufferSize;
-					s := MIN(size, (bufferSize - ruOfs) * BlockSize);
-					ruIdx := ru MOD CacheSize;
-					IF ~UpdateCacheEntry(ru, ruIdx, res) THEN RETURN END;
-					entry := ADDRESSOF(cache[ruIdx]);
-					IF op = Disks.Write THEN
-						SYSTEM.MOVE(ADDRESSOF(data[ofs]), ADDRESSOF(entry.buffer[ruOfs * BlockSize]), s);
-						(*IF ru = wbuffer[(head + SELF.size - 1) MOD WBSize].block DIV bufferSize THEN
-							wbentry := ADDRESSOF(wbuffer[(head + SELF.size - 1) MOD WBSize]);
-							SYSTEM.MOVE(ADDRESSOF(data[ofs]), ADDRESSOF(wbentry.buffer[ruOfs * BlockSize]), s);
-							INC(wbentry.len, s);
-						ELSE*)
-							AWAIT(SELF.size < WBSize);
-							wbentry := ADDRESSOF(wbuffer[(head + SELF.size) MOD WBSize]);
-							SYSTEM.MOVE(ADDRESSOF(data[ofs]), ADDRESSOF(wbentry.buffer[0]), s);
-							wbentry.block := block;
-							wbentry.len := s;
-							INC(SELF.size)
-						(*END*)
-						; INC(NbufferQueueSize, SELF.size); INC(NbufferQueueSamples);
-					ELSE
-						SYSTEM.MOVE(ADDRESSOF(entry.buffer[ruOfs * BlockSize]), ADDRESSOF(data[ofs]), s);
-					END;
-					DEC(size, s);
-					INC(block, s DIV BlockSize);
-					INC(ofs, s)
-				END;
-			END TransferCached;
-
-			PROCEDURE TransferUncached();
-			VAR
-				ignore: BOOLEAN;
-			BEGIN
-				size := num * blockSize;
-				CASE op OF
-					 Disks.Write:
-					 	ignore := Sd.Write(card, block, size, data, ofs, res)
-					|Disks.Read:
-						ignore := Sd.Read(card, block, size, data, ofs, res)
-				END
-			END TransferUncached;
-
-		BEGIN {EXCLUSIVE}
-
-			size := num * blockSize;
-
-			IF EnableCache THEN
-				TransferCached;
-			ELSE
-				TransferUncached;
-			END;
-		END Transfer;
-
-		PROCEDURE GetSize * (VAR size, res: LONGINT);
-		BEGIN
-			size := LONGINT(card.csd.capacity);
-			IF size < 0 THEN size := MAX(LONGINT) END;
-			res := Disks.Ok
-		END GetSize;
-
-		PROCEDURE Handle * (VAR msg: Disks.Message;  VAR res: LONGINT);
-		BEGIN
-			res := 0;
-			IF msg IS Disks.LockMsg THEN
-				Sd.SetLedState(card.hc, TRUE)
-			ELSIF msg IS Disks.UnlockMsg THEN
-				Sd.SetLedState(card.hc, FALSE);
-				IF EnableCache THEN Sync; END;
-			ELSIF (msg IS Disks.EjectMsg) OR (msg IS Disks.SyncMsg) THEN
-				IF EnableCache THEN Sync; END;
-			END
-		END Handle;
-
-		(** Make sure that the RU ru is in cache entry idx *)
-		PROCEDURE UpdateCacheEntry (ru, idx: LONGINT; VAR res: LONGINT): BOOLEAN;
-		VAR entry: POINTER {UNSAFE} TO CacheEntry;
-		BEGIN
-			entry := ADDRESSOF(cache[idx]);
-			IF ~entry.active OR (entry.ru # ru) THEN
-				INC(NcacheMiss);
-				IF entry.active THEN INC(NcacheEvict) END;
-				(*IF entry.active & entry.mod THEN
-					INC(NcacheWriteback);
-					IF ~Sd.Write(card, entry.ru * bufferSize, bufferSize * BlockSize, entry.buffer^, 0, res) THEN RETURN FALSE END
-				END;*)
-				entry.active := TRUE;
-				(*entry.mod := FALSE;*)
-				entry.ru := ru;
-				IF ~Sd.Read(card, ru * bufferSize, bufferSize * BlockSize, entry.buffer^, 0, res) THEN RETURN FALSE END
-			ELSE
-				INC(NcacheHits)
-			END;
-			RETURN TRUE
-		END UpdateCacheEntry;
-
-		(** Write back all modified cache entries to disk and invalidate all entries *)
-		PROCEDURE Sync;
-		VAR
-			i, len, res, ofs: LONGINT;
-			wbentry, wbnext: POINTER {UNSAFE} TO WriteBufferEntry;
-			ignore: BOOLEAN;
-		BEGIN {EXCLUSIVE}
-			wbentry := ADDRESSOF(wbuffer[head MOD WBSize]);
-			i := 1;
-			len := wbentry.len;
-			LOOP
-				IF i = size THEN EXIT END;
-				wbnext := ADDRESSOF(wbuffer[(head + i) MOD WBSize]);
-				IF wbentry.block + len DIV BlockSize # wbnext.block THEN EXIT END;
-				ofs := wbnext.block MOD bufferSize;
-				SYSTEM.MOVE(ADDRESSOF(wbnext.buffer[ofs]), ADDRESSOF(wbentry.buffer[ofs]), wbnext.len);
-				INC(len, wbnext.len);
-				INC(i)
-			END;
-			ignore := Sd.Write(card, wbentry.block, len, wbentry.buffer^, 0, res);
-			INC(head, i);
-			DEC(size, i);
-			INC(NbufferWrites);
-			INC(NbufferSize, len)
-		END Sync;
-
-		PROCEDURE Stop;
-		BEGIN {EXCLUSIVE}
-			stop := TRUE
-		END Stop;
-
-	BEGIN {ACTIVE, PRIORITY(Objects.Normal)}
-		LOOP
-			BEGIN {EXCLUSIVE}
-				AWAIT(stop OR (size > 0));
-				IF stop THEN EXIT END;
-			END;
-			IF EnableCache THEN Sync; END;
-		END;
-		IF EnableCache THEN Sync; END;
-	END Device;
-
-	(** Handle SD Controller Events: create & register a new disk on card insertion, remove disk on card removal *)
-	PROCEDURE HandleSdEvent * (card: Sd.Card; event: LONGINT);
-	VAR
-		disk, prev: Device;
-		name, id: ARRAY 32 OF CHAR;
-		result: LONGINT;
-	BEGIN
-		CASE event OF
-			 Sd.OnInitialization:
-				NEW(disk, card);
-				Strings.IntToStr(diskId, id);
-				name := NameBase;
-				Strings.Append(name, id);
-				disk.SetName(name);
-
-				disk.desc := "SD";
-				CASE card.scr.security OF
-					 Sd.TypeNone, Sd.TypeSDSC:
-					|Sd.TypeSDHC: Strings.Append(disk.desc, "HC")
-					|Sd.TypeSDXC: Strings.Append(disk.desc, "XC")
-				ELSE
-					Strings.Append(disk.desc, "??");
-					KernelLog.String("[SD] unknown card type: "); KernelLog.Int(card.scr.security, 0); KernelLog.Ln;
-				END;
-				Strings.Append(disk.desc, " card, v");
-				CASE card.scr.version OF
-					 Sd.Version1: Strings.Append(disk.desc, "1")
-					|Sd.Version1p1: Strings.Append(disk.desc, "1.10")
-					|Sd.Version2: Strings.Append(disk.desc, "2")
-					|Sd.Version3: Strings.Append(disk.desc, "3")
-					|Sd.Version4: Strings.Append(disk.desc, "4")
-					|Sd.Version5: Strings.Append(disk.desc, "5")
-					|Sd.Version6: Strings.Append(disk.desc, "6")
-				ELSE
-					Strings.Append(disk.desc, "?");
-					KernelLog.String("[SD] unknown card version: "); KernelLog.Int(card.scr.version, 0); KernelLog.Ln;
-				END;
-
-				Disks.registry.Add(disk, result);
-
-				IF result # Plugins.Ok THEN
-					SdEnvironment.String("Error registering disk");
-					SdEnvironment.Ln
-				ELSE
-					INC(diskId);
-					disk.next := devices;
-					devices := disk;
-					SdEnvironment.String("Disk ");
-					SdEnvironment.String(name);
-					SdEnvironment.String(" is now available");
-					SdEnvironment.Ln
-				END
-
-			|Sd.OnRemoval:
-				ASSERT(devices # NIL);
-				IF devices.card = card THEN
-					devices.Stop;
-					SdEnvironment.String("Removed disk ");
-					SdEnvironment.String(devices.name);
-					SdEnvironment.Ln;
-					devices := devices.next
-				ELSE
-					disk := devices;
-					WHILE (disk # NIL) & (disk.card # card) DO
-						prev := disk;
-						disk := disk.next
-					END;
-					ASSERT(disk # NIL);
-					disk.Stop;
-					SdEnvironment.String("Removed disk ");
-					SdEnvironment.String(disk.name);
-					SdEnvironment.Ln;
-					prev.next := disk.next
-				END;
-		END
-	END HandleSdEvent;
-
-VAR
-	devices: Device;
-	diskId: LONGINT;
-
-	(* Statistics *)
-	NcacheHits *, NcacheMiss *, NcacheEvict *, NbufferWrites *, NbufferSize *, NbufferQueueSize *, NbufferQueueSamples *: LONGINT;
-
-	PROCEDURE ResetStats *;
-	BEGIN
-		NcacheHits := 0;
-		NcacheMiss := 0;
-		NcacheEvict := 0;
-		NbufferWrites := 0;
-		NbufferSize := 0
-	END ResetStats;
-END SdDisks.

ARM/ARM.A2/SdEnvironment.Mod

@@ -1,113 +0,0 @@
-MODULE SdEnvironment;
-(**
-	AUTHOR Timothée Martiel, 2015
-	PURPOSE Runtime Environment abstraction for SD Host Controller driver, A2 version
-*)
-
-IMPORT
-	Machine, Objects, KernelLog, Strings, Locks, PsConfig, BootConfig;
-	
-TYPE
-	Time* = HUGEINT; (* Time type *)
-
-VAR
-	InstallHandler *: PROCEDURE (handler: Objects.EventHandler; irq: LONGINT);
-
-	Char *: PROCEDURE (c: CHAR);
-	String *: PROCEDURE (CONST str: ARRAY OF CHAR);
-	Int *: PROCEDURE (i: HUGEINT; w: LONGINT);
-	Hex *: PROCEDURE (i: HUGEINT; w: LONGINT);
-	Address *: PROCEDURE (a: ADDRESS);
-	Set *: PROCEDURE (s: SET);
-	Boolean *: PROCEDURE (b: BOOLEAN);
-	Ln *: PROCEDURE;
-	FlushDCacheRange *,
-	InvalidateDCacheRange *: PROCEDURE (adr: ADDRESS; len: SIZE);
-	
-	GetTimeCounter-: PROCEDURE(): Time;
-	
-	cpuClockHz: LONGINT;
-
-	PROCEDURE Enable * (sd: LONGINT): BOOLEAN;
-	VAR
-		key, value: ARRAY 32 OF CHAR;
-	BEGIN
-		key := "SdEnable";
-		Strings.IntToStr(sd, value);
-		Strings.Append(key, value);
-		Machine.GetConfig(key, value);
-		RETURN value = "1"
-	END Enable;
-
-	PROCEDURE HcClock * (sd: LONGINT): LONGINT;
-	VAR
-		clock, res: LONGINT;
-	BEGIN
-		clock := LONGINT(PsConfig.GetIoClockFrequency(PsConfig.IoSdio, res));
-		ASSERT(res = 0);
-		RETURN clock
-	END HcClock;
-
-	PROCEDURE GetLock * (VAR acq, rel: PROCEDURE {DELEGATE});
-	VAR
-		lock: Locks.Lock;
-	BEGIN
-		NEW(lock);
-		acq := lock.Acquire;
-		rel := lock.Release
-	END GetLock;
-	
-	(** Convert microseconds to time counts *)
-	PROCEDURE FromMicro*(us: Time): Time;
-	BEGIN
-		RETURN us * ENTIERH(0.5D0+LONGREAL(cpuClockHz)/2.0D6);
-	END FromMicro;
-
-	(** Convert time counts to microseconds *)
-	PROCEDURE ToMicro*(time: Time): Time;
-	BEGIN
-		RETURN ENTIERH((0.5D0 + time) / (LONGREAL(cpuClockHz)) * 2.0D6)
-	END ToMicro;
-
-	(** Convert milliseconds to time counts *)
-	PROCEDURE FromMilli*(ms: Time): Time;
-	BEGIN
-		RETURN ms * ENTIERH(0.5D0 + LONGREAL(cpuClockHz)/2.0D3);
-	END FromMilli;
-
-	(** Convert time counts to milliseconds *)
-	PROCEDURE ToMilli*(time: Time): Time;
-	BEGIN
-		RETURN ENTIERH((0.5D0 + time) / (LONGREAL(cpuClockHz)) * 2.0D3)
-	END ToMilli;
-
-	PROCEDURE WaitMilli*(ms: Time);
-	VAR t: Time;
-	BEGIN
-		t := GetTimeCounter() + FromMilli(ms);
-		WHILE GetTimeCounter() <= t DO END;
-	END WaitMilli;
-	
-	PROCEDURE WaitMicro*(us: Time);
-	VAR t: Time;
-	BEGIN
-		t := GetTimeCounter() + FromMicro(us);
-		WHILE GetTimeCounter() <= t DO END;
-	END WaitMicro;
-	
-BEGIN
-	InstallHandler := Objects.InstallHandler;
-	Char := KernelLog.Char;
-	String := KernelLog.String;
-	Int := KernelLog.Int;
-	Hex := KernelLog.Hex;
-	Address := KernelLog.Address;
-	Set := KernelLog.Set;
-	Boolean := KernelLog.Boolean;
-	Ln := KernelLog.Ln;
-	FlushDCacheRange := Machine.FlushDCacheRange;
-	InvalidateDCacheRange := Machine.InvalidateDCacheRange;
-	cpuClockHz := BootConfig.GetIntValue("CpuClockHz");
-	
-	GetTimeCounter := Machine.GetTimer;
-END SdEnvironment.2

ARM/ARM.A2/SdInspect.Mod

@@ -1,223 +0,0 @@
-MODULE SdInspect; (** AUTHOR ""; PURPOSE ""; *)
-
-IMPORT
-	BootConfig, Commands, KernelLog, Options,
-	Sd;
-
-VAR
-	hc: Sd.HostController;
-	card: Sd.Card;
-	result: LONGINT;
-
-	(** SdInspect.Command [-a|--acmd] [-d|--data] [-r|--read] [--auto12] [--auto23] [-m|-multi] [-c|--count] [--dma] cmd arg resp rca [datalen] ~ *)
-	PROCEDURE Command * (context: Commands.Context);
-	VAR
-		rsp: ARRAY 32 OF CHAR;
-		opt: Options.Options;
-		command: Sd.Command;
-		datalen, rca: LONGINT;
-		data: POINTER TO ARRAY OF CHAR;
-	BEGIN
-		NEW(opt);
-		opt.Add('d', "data", Options.Flag);
-		opt.Add('r', "read", Options.Flag);
-		opt.Add(0X, "auto12", Options.Flag);
-		opt.Add(0X, "auto23", Options.Flag);
-		opt.Add('m', "multi", Options.Flag);
-		opt.Add('c', "count", Options.Flag);
-		opt.Add(0X, "dma", Options.Flag);
-		opt.Add('a', "acmd", Options.Flag);
-		IF ~opt.Parse(context.arg, context.error) THEN RETURN END;
-
-		command.hc := hc;
-		IF context.arg.GetInteger(command.command, FALSE) THEN
-			IF context.arg.GetInteger(command.argument, TRUE) THEN
-				IF context.arg.GetString(rsp) THEN
-					IF rsp = "R1" THEN
-						command.responseType := Sd.ResponseR1
-					ELSIF rsp = "R1b" THEN
-						command.responseType := Sd.ResponseR1b
-					ELSIF rsp = "R2" THEN
-						command.responseType := Sd.ResponseR2
-					ELSIF rsp = "R3" THEN
-						command.responseType := Sd.ResponseR3
-					ELSIF rsp = "R4" THEN
-						command.responseType := Sd.ResponseR4
-					ELSIF rsp = "R5" THEN
-						command.responseType := Sd.ResponseR5
-					ELSIF rsp = "R6" THEN
-						command.responseType := Sd.ResponseR6
-					ELSIF rsp = "R7" THEN
-						command.responseType := Sd.ResponseR7
-					ELSE
-						context.error.String("Unknown response type ");
-						context.error.String(rsp);
-						context.error.Ln;
-						RETURN
-					END;
-
-					IF context.arg.GetInteger(command.rca, TRUE) THEN
-						(* flags *)
-						IF opt.GetFlag("read") THEN INCL(command.flags, Sd.FlagRead) END;
-						IF opt.GetFlag("auto12") THEN INCL(command.flags, Sd.FlagAutoCmd12) END;
-						IF opt.GetFlag("auto23") THEN INCL(command.flags, Sd.FlagAutoCmd23) END;
-						IF opt.GetFlag("multi") THEN INCL(command.flags, Sd.FlagMultipleBlockTx) END;
-						IF opt.GetFlag("count") THEN INCL(command.flags, Sd.FlagCountBlocks) END;
-						IF opt.GetFlag("dma") THEN INCL(command.flags, Sd.FlagUseDma) END;
-						IF opt.GetFlag("acmd") THEN INCL(command.flags, Sd.FlagApplicationCmd) END;
-						IF opt.GetFlag("data") THEN
-							INCL(command.flags, Sd.FlagData);
-							IF context.arg.GetInteger(datalen, TRUE) THEN
-								NEW(data, datalen);
-								IF hc.execute(command, data^, 0, datalen, result) THEN
-									context.out.String("Command successful");
-									context.out.Ln;
-									context.out.Update;
-									IF Sd.FlagRead IN command.flags THEN
-										KernelLog.String("Data:");
-										KernelLog.Ln;
-										KernelLog.Buffer(data^, 0, datalen)
-									END
-								ELSE
-									context.out.String("Command failed: ");
-									context.out.Int(result, 0);
-									context.out.Ln
-								END
-							ELSE
-								context.error.String("Expected data length");
-								context.error.Ln
-							END
-						ELSE
-							IF Sd.ExecuteCommand(command, result) THEN
-								context.out.String("Command successful");
-								context.out.Ln
-							ELSE
-								context.out.String("Command failed: ");
-								context.out.Int(result, 0);
-								context.out.Ln
-							END
-						END;
-
-						context.out.String("Response: ");
-						CASE command.responseType OF
-							 Sd.ResponseR1, Sd.ResponseR1b:
-								context.out.Update;
-								Sd.PrintCardStatus(Sd.GetR1(command))
-							|Sd.ResponseR2:
-								context.out.Hex(command.response[0], -8);
-								context.out.Char(' ');
-								context.out.Hex(command.response[1], -8);
-								context.out.Char(' ');
-								context.out.Hex(command.response[2], -8);
-								context.out.Char(' ');
-								context.out.Hex(command.response[3], -8);
-								context.out.Char(' ')
-							|Sd.ResponseR3: context.out.Hex(Sd.GetR3(command), -8)
-							|Sd.ResponseR4: context.out.Hex(Sd.GetR4(command), -8)
-							|Sd.ResponseR5: context.out.Hex(Sd.GetR5(command), -8)
-							|Sd.ResponseR6: context.out.Hex(Sd.GetR6(command), -8)
-							|Sd.ResponseR7: context.out.Hex(Sd.GetR7(command), -8)
-						END;
-						context.out.Ln
-					ELSE
-						context.error.String("Expected RCA");
-						context.error.Ln
-					END
-				ELSE
-					context.error.String("Expected response type");
-					context.error.Ln
-				END
-			ELSE
-				context.error.String("Expected argument number");
-				context.error.Ln
-			END
-		ELSE
-			context.error.String("Expected cmd number");
-			context.error.Ln
-		END
-	END Command;
-
-	PROCEDURE Read *;
-	VAR
-		data: ARRAY 512 OF CHAR;
-		res: LONGINT;
-	BEGIN
-		IF ~Sd.Read(card, 0, 512, data, 0, res) THEN
-			KernelLog.String("Read Failed: ");
-			KernelLog.Int(res, 0);
-			KernelLog.Ln
-		ELSE
-			KernelLog.String("Read succeeded");
-			KernelLog.Ln;
-			KernelLog.Buffer(data, 0, 512)
-		END
-	END Read;
-
-	PROCEDURE Reads *;
-	CONST
-		Size = 1024 * 1024;
-	VAR
-		data: ARRAY Size OF CHAR;
-		res: LONGINT;
-	BEGIN
-		IF ~Sd.Read(card, 0, Size, data, 0, res) THEN
-			KernelLog.String("Read Failed: ");
-			KernelLog.Int(res, 0);
-			KernelLog.Ln
-		ELSE
-			KernelLog.String("Read succeeded");
-			KernelLog.Ln;
-			KernelLog.Buffer(data, 0, 512)
-		END
-	END Reads;
-
-	PROCEDURE Write *;
-	VAR
-		data: ARRAY 512 OF CHAR;
-		res: LONGINT;
-	BEGIN
-		IF ~Sd.Write(card, 0, 512, data, 0, res) THEN
-			KernelLog.String("Write Failed: ");
-			KernelLog.Int(res, 0);
-			KernelLog.Ln
-		ELSE
-			KernelLog.String("Write succeeded");
-			KernelLog.Ln;
-			KernelLog.Buffer(data, 0, 512)
-		END
-	END Write;
-
-	PROCEDURE Writes *;
-	VAR
-		data: ARRAY 8 * 512 OF CHAR;
-		res: LONGINT;
-	BEGIN
-		IF ~Sd.Write(card, 0, 8 * 512, data, 0, res) THEN
-			KernelLog.String("Write Failed: ");
-			KernelLog.Int(res, 0);
-			KernelLog.Ln
-		ELSE
-			KernelLog.String("Write succeeded");
-			KernelLog.Ln;
-			KernelLog.Buffer(data, 0, 512)
-		END
-	END Writes;
-
-	PROCEDURE Test *;
-	VAR
-		command: Sd.Command;
-		res: LONGINT;
-	BEGIN
-		command.hc := hc;
-		command.rca := 7;
-		command.command := Sd.CMD_SELECT_DESELECT_CARD;
-		command.argument := 70000H;
-		command.responseType := Sd.ResponseR1b;
-		TRACE(Sd.ExecuteCommand(command, res));
-		TRACE(res)
-	END Test;
-
-BEGIN
-	hc := Sd.New(ADDRESS(0E0100000H), BootConfig.GetIntValue("PsRefClockHz"), NIL, NIL);
-	NEW(card);
-END SdInspect.

ARM/ARM.A2/Zynq.ARM.Platform.Mod

@@ -1,510 +0,0 @@
-MODULE Platform;
-(** Zynq platform-specific constants for A2.
-	Author: Timothee Martiel
-*)
-
-CONST
-	(* ===== Units ===== *)
-	k *		= 1024;
-	M *	= k * k;
-	G *		= k * k * k;
-
-	(* Maximum number of CPUs for that platform *)
-	MaxCpuNb * = 2;
-
-	(* ===== Physical Memory Layout ===== *)
-	DDRStart * = 0;
-	OCMStart * = 0;
-	OCMSize * = 192 * k;
-	IOStart * = 1 * G;
-	IOSize * = 3040 * M;
-
-	(* ===== Registers ===== *)
-	(* ===== MPCORE registers and related devices ===== *)
-	PrivateWatchdogIrq * = 30;
-	PrivateWatchdogDisableKey0 * = 12345678H;
-	PrivateWatchdogDisableKey1 * = 87654321H;
-
-	MpcoreBase* = ADDRESS(0F8F00000H);
-	ICDDCR* = MpcoreBase + 1000H; (* distributor control register *)
-	ICDICFR* = MpcoreBase + 1C00H; (* interrupt configuration register *)
-	ICCICR* = MpcoreBase + 0100H;  (* cpu interface control register *)
-	ICCPMR* = MpcoreBase + 0104H; (* interrupt priority mask register *)
-	ICCEOIR* = MpcoreBase + 0110H; (* end of interrupt register *)
-	ICDIPTR* = MpcoreBase + 1800H; (* interrupt processor target registers *)
-	ICDIPR* =   MpcoreBase + 1400H; (* interrupt priority registers *)
-	ICDICER* =  MpcoreBase + 1180H; (* interrupt clear enable register *)
-	ICDISER* = MpcoreBase + 1100H; (* interrupt set enable register *)
-	ICDISPR* = MpcoreBase + 1200H; (* set pending register *)
-	ICDICPR* = MpcoreBase + 1280H; (* clear pending register *)
-	ICCIAR* = MpcoreBase + 10CH; (* Interrupt Ackknowledge Register *)
-	ICCBPR* = MpcoreBase + 108H; (* Binary Point Register *)
-	GlobalTimerCounterRegister0* = MpcoreBase + 200H;
-	GlobalTimerCounterRegister1* = MpcoreBase + 204H;
-	GlobalTimerControlRegister* = MpcoreBase + 208H;
-	GlobalTimerInterruptStatusRegister* = MpcoreBase+ 20CH;
-	ComparatorValueRegister0* = MpcoreBase + 210H;
-	ComparatorValueRegister1* = MpcoreBase + 214H;
-	AutoIncrementRegister* = MpcoreBase + 218H;
-
-	PrivateLoadValueRegister* = MpcoreBase + 600H;
-	PrivateTimerCounterRegister* = MpcoreBase + 604H;
-	PrivateTimerControlRegister* = MpcoreBase + 608H;
-	PrivateTimerInterruptStatusRegister* = MpcoreBase+ 60CH;
-
-	SCUControlReg* = MpcoreBase;
-
-	(* Interrupt constants *)
-	(*! TODO: USEFUL? *)
-	ICIP* = (* TODO *) 0H;
-	ICMR* = (* TODO *) 0H;
-	ICLR* = (* TODO *) 0H;
-	InterruptVectors* = 0H;
-	FIQMode* 		= 11H;   (* Fast Interrupt Mode *)
-	IRQMode* 		= 12H;   (* Interrupt Mode *)
-	SVCMode* 		= 13H;   (* SuperVisorMode *)
-	UndefMode*	= 1BH;   (* Undefined instruction mode *)
-	UserMode* 		= 10H;   (* User mode *)
-	AbortMode* 	= 17H;   (* Abort mode *)
-	SystemMode*	= 1FH;
-	(* Exceptions *)
-	FIQDisabled* 	= 40H;   (* Fast interrupts disabled globally *)
-	IRQDisabled* 	= 80H;   (* Interrupts disabled globally *)
-	
-	(* ===== System Level Control register access ===== *)
-	SlcrBase* = 0xF8000000; (** Base address for System Level Control (SLCR) registers *)
-	SlcrLockKey* = 0x767B; (** SLCR lock key; write this value to SLCR_LOCK register to disable writing to SLCR registers *)
-	SlcrUnlockKey* = 0xDF0D; (** SLCR unlock key; write this value to SLCR_UNLOCK register to enable writing to SLCR registers *)
-
-	(* ===== System Watchdog registers ===== *)
-	SWDTBase = ADDRESS(0'F800'5000H);
-
-	(* ===== Device Configuration registers ===== *)
-	DevCfgBase * = 0F8007000H;					(** Base address of the devcfg registers *)
-	DevCfgDmaPlAdr * = ADDRESS(0FFFFFFFFH);	(** Devcfg DMA address of the PL *)
-	DevCfgMctrlOffset * = 80H;						(** Offset of the MCTRL register; needed for early initialization in zynq bootloader *)
-	DevCfgMctrlPsVersionOfs * = 28;
-	DevCfgMctrlPsVersion10 * = 0;
-	DevCfgMctrlPsVersion20 * = 1;
-	DevCfgMctrlPsVersion30 * = 2;
-	DevCfgMctrlPsVersion31 * = 3;
-
-	(* ===== AXI interfaces ===== *)
-	MasterAxiGp0Base* = 07F000000H; (** base address for Master AXI General Purpose interface 0 *)
-	MasterAxiGp1Base* = 0BF000000H; (** base address for Master AXI General Purpose interface 1 *)
-
-	(* ===== GPIO Registers ===== *)
-	GpioBase * = ADDRESS(0E000A000H); (** Base address of GPIO registers *)
-	GpioData * = GpioBase + 40H; (** Base address of GPIO data registers *)
-	GpioBankNb * = 4; (** Number of GPIO banks *)
-	GpioBank * = [GpioBase + 204H, GpioBase + 244H, GpioBase + 284H, GpioBase + 2C4H]; (** Base address of GPIO bank control registers *)
-
-	(* ===== UART ===== *)
-	UartBase* = [ADDRESS(0E0000000H),ADDRESS(0E0001000H)]; (* base address for all UART controllers present in the system *)
-	UartModemPinsConnected* = [FALSE,FALSE];
-	UartIrq * = [59,82];
-
-	(* ===== USB ===== *)
-	UsbNb * = 2; (** Number of USB controllers *)
-	UsbBase * = [ADDRESS(0E0002100H), ADDRESS(0E0003100H)]; (** Base addresses of USB controllers: CAPLENGTH must be at offset 0. *)
-	UsbIrq * = [53, 76]; (** USB IRQs *)
-
-	(* ===== SD ===== *)
-	SdNb * = 2;
-	SdBase * = [ADDRESS(0E0100000H), ADDRESS(0E0101000H)];
-	SdIrq * = [56, 79];
-
-	RAMCore * = 100000H;
-	RAMLogicalLow * = 0H;
-	RAMLogicalHigh * = ADDRESS(10000000H);
-	RAMDiskBase * = 100000H;
-	RAMDiskSize * = 140 * 1024;
-	OFSBlockSize * = 4096;
-	HostPort * = '';
-	ModRoot * = 21318H;
-
-TYPE
-	
-	(** System Level Control (SLCR) registers definition *)
-	SlcrRegisters* = POINTER{UNSAFE,UNTRACED} TO RECORD
-		SCL*: LONGINT; (** 0x00000000 32 rw 0x00000000 Secure Configuration Lock *)
-		SLCR_LOCK*: LONGINT; (** 0x00000004 32 wo 0x00000000 SLCR Write Protection Lock *)
-		SLCR_UNLOCK*: LONGINT; (** 0x00000008 32 wo 0x00000000 SLCR Write Protection Unlock *)
-		SLCR_LOCKSTA-: LONGINT; (** 0x0000000C 32 ro 0x00000001 SLCR Write Protection Status *)
-		padding0: ARRAY 60 OF LONGINT;
-		ARM_PLL_CTRL*: LONGINT; (** 0x00000100 32 rw 0x0001A008 ARM PLL Control *)
-		DDR_PLL_CTRL*: LONGINT; (** 0x00000104 32 rw 0x0001A008 DDR PLL Control *)
-		IO_PLL_CTRL*: LONGINT; (** 0x00000108 32 rw 0x0001A008 IO PLL Control *)
-		PLL_STATUS-: LONGINT; (** 0x0000010C 32 ro 0x0000003F PLL Status *)
-		ARM_PLL_CFG*: LONGINT; (** 0x00000110 32 rw 0x00177EA0 ARM PLL Configuration *)
-		DDR_PLL_CFG*: LONGINT; (** 0x00000114 32 rw 0x00177EA0 DDR PLL Configuration *)
-		IO_PLL_CFG*: LONGINT; (** 0x00000118 32 rw 0x00177EA0 IO PLL Configuration *)
-		padding01: LONGINT;
-		ARM_CLK_CTRL*: LONGINT; (** 0x00000120 32 rw 0x1F000400 CPU Clock Control *)
-		DDR_CLK_CTRL*: LONGINT; (** 0x00000124 32 rw 0x18400003 DDR Clock Control *)
-		DCI_CLK_CTRL*: LONGINT; (** 0x00000128 32 rw 0x01E03201 DCI clock control *)
-		APER_CLK_CTRL*: LONGINT; (** 0x0000012C 32 rw 0x01FFCCCD AMBA Peripheral Clock Control *)
-		USB0_CLK_CTRL*: LONGINT; (** 0x00000130 32 rw 0x00101941 USB 0 ULPI Clock Control *)
-		USB1_CLK_CTRL*: LONGINT; (** 0x00000134 32 rw 0x00101941 USB 1 ULPI Clock Control *)
-		GEM0_RCLK_CTRL*: LONGINT; (** 0x00000138 32 rw 0x00000001 GigE 0 Rx Clock and Rx Signals Select *)
-		GEM1_RCLK_CTRL*: LONGINT; (** 0x0000013C 32 rw 0x00000001 GigE 1 Rx Clock and Rx Signals Select *)
-		GEM0_CLK_CTRL*: LONGINT; (** 0x00000140 32 rw 0x00003C01 GigE 0 Ref Clock Control *)
-		GEM1_CLK_CTRL*: LONGINT; (** 0x00000144 32 rw 0x00003C01 GigE 1 Ref Clock Control *)
-		SMC_CLK_CTRL*: LONGINT; (** 0x00000148 32 rw 0x00003C21 SMC Ref Clock Control *)
-		LQSPI_CLK_CTRL*: LONGINT; (** 0x0000014C 32 rw 0x00002821 Quad SPI Ref Clock Control *)
-		SDIO_CLK_CTRL*: LONGINT; (** 0x00000150 32 rw 0x00001E03 SDIO Ref Clock Control *)
-		UART_CLK_CTRL*: LONGINT; (** 0x00000154 32 rw 0x00003F03 UART Ref Clock Control *)
-		SPI_CLK_CTRL*: LONGINT; (** 0x00000158 32 rw 0x00003F03 SPI Ref Clock Control *)
-		CAN_CLK_CTRL*: LONGINT; (** 0x0000015C 32 rw 0x00501903 CAN Ref Clock Control *)
-		CAN_MIOCLK_CTRL*: LONGINT; (** 0x00000160 32 rw 0x00000000 CAN MIO Clock Control *)
-		DBG_CLK_CTRL*: LONGINT; (** 0x00000164 32 rw 0x00000F03 SoC Debug Clock Control *)
-		PCAP_CLK_CTRL*: LONGINT; (** 0x00000168 32 rw 0x00000F01 PCAP Clock Control *)
-		TOPSW_CLK_CTRL*: LONGINT; (** 0x0000016C 32 rw 0x00000000 Central Interconnect Clock Control *)
-		FPGA0_CLK_CTRL*: LONGINT; (** 0x00000170 32 rw 0x00101800 PL Clock 0 Output control *)
-		FPGA0_THR_CTRL*: LONGINT; (** 0x00000174 32 rw 0x00000000 PL Clock 0 Throttle control *)
-		FPGA0_THR_CNT*: LONGINT; (** 0x00000178 32 rw 0x00000000 PL Clock 0 Throttle Count control *)
-		FPGA0_THR_STA-: LONGINT; (** 0x0000017C 32 ro 0x00010000 PL Clock 0 Throttle Status read *)
-		FPGA1_CLK_CTRL*: LONGINT; (** 0x00000180 32 rw 0x00101800 PL Clock 1 Output control *)
-		FPGA1_THR_CTRL*: LONGINT; (** 0x00000184 32 rw 0x00000000 PL Clock 1 Throttle control *)
-		FPGA1_THR_CNT*: LONGINT; (** 0x00000188 32 rw 0x00000000 PL Clock 1 Throttle Count *)
-		FPGA1_THR_STA-: LONGINT; (** 0x0000018C 32 ro 0x00010000 PL Clock 1 Throttle Status control *)
-		FPGA2_CLK_CTRL*: LONGINT; (** 0x00000190 32 rw 0x00101800 PL Clock 2 output control *)
-		FPGA2_THR_CTRL*: LONGINT; (** 0x00000194 32 rw 0x00000000 PL Clock 2 Throttle Control *)
-		FPGA2_THR_CNT*: LONGINT; (** 0x00000198 32 rw 0x00000000 PL Clock 2 Throttle Count *)
-		FPGA2_THR_STA-: LONGINT; (** 0x0000019C 32 ro 0x00010000 PL Clock 2 Throttle Status *)
-		FPGA3_CLK_CTRL*: LONGINT; (** 0x000001A0 32 rw 0x00101800 PL Clock 3 output control *)
-		FPGA3_THR_CTRL*: LONGINT; (** 0x000001A4 32 rw 0x00000000 PL Clock 3 Throttle Control *)
-		FPGA3_THR_CNT*: LONGINT; (** 0x000001A8 32 rw 0x00000000 PL Clock 3 Throttle Count *)
-		FPGA3_THR_STA-: LONGINT; (** 0x000001AC 32 ro 0x00010000 PL Clock 3 Throttle Status *)
-		padding1: ARRAY 5 OF LONGINT;
-		CLK_621_TRUE*: LONGINT; (** 0x000001C4 32 rw 0x00000001 CPU Clock Ratio Mode select *)
-		padding2: ARRAY 14 OF LONGINT;
-		PSS_RST_CTRL*: LONGINT; (** 0x00000200 32 rw 0x00000000 PS Software Reset Control *)
-		DDR_RST_CTRL*: LONGINT; (** 0x00000204 32 rw 0x00000000 DDR Software Reset Control *)
-		TOPSW_RST_CTRL*: LONGINT; (** 0x00000208 32 rw 0x00000000 Central Interconnect Reset Control *)
-		DMAC_RST_CTRL*: LONGINT; (** 0x0000020C 32 rw 0x00000000 DMAC Software Reset Control *)
-		USB_RST_CTRL*: LONGINT; (** 0x00000210 32 rw 0x00000000 USB Software Reset Control *)
-		GEM_RST_CTRL*: LONGINT; (** 0x00000214 32 rw 0x00000000 Gigabit Ethernet SW Reset Control *)
-		SDIO_RST_CTRL*: LONGINT; (** 0x00000218 32 rw 0x00000000 SDIO Software Reset Control *)
-		SPI_RST_CTRL*: LONGINT; (** 0x0000021C 32 rw 0x00000000 SPI Software Reset Control *)
-		CAN_RST_CTRL*: LONGINT; (** 0x00000220 32 rw 0x00000000 CAN Software Reset Control *)
-		I2C_RST_CTRL*: LONGINT; (** 0x00000224 32 rw 0x00000000 I2C Software Reset Control *)
-		UART_RST_CTRL*: LONGINT; (** 0x00000228 32 rw 0x00000000 UART Software Reset Control *)
-		GPIO_RST_CTRL*: LONGINT; (** 0x0000022C 32 rw 0x00000000 GPIO Software Reset Control *)
-		LQSPI_RST_CTRL*: LONGINT; (** 0x00000230 32 rw 0x00000000 Quad SPI Software Reset Control *)
-		SMC_RST_CTRL*: LONGINT; (** 0x00000234 32 rw 0x00000000 SMC Software Reset Control *)
-		OCM_RST_CTRL*: LONGINT; (** 0x00000238 32 rw 0x00000000 OCM Software Reset Control *)
-		padding3: LONGINT;
-		FPGA_RST_CTRL*: SET; (** 0x00000240 32 rw 0x01F33F0F FPGA Software Reset Control *)
-		A9_CPU_RST_CTRL*: LONGINT; (** 0x00000244 32 rw 0x00000000 CPU Reset and Clock control *)
-		padding4: LONGINT;
-		RS_AWDT_CTRL*: LONGINT; (** 0x0000024C 32 rw 0x00000000 Watchdog Timer Reset Control *)
-		padding5: ARRAY 2 OF LONGINT;
-		REBOOT_STATUS*: LONGINT; (** 0x00000258 32 rw 0x00400000 Reboot Status, persistent *)
-		BOOT_MODE*: LONGINT; (** 0x0000025C 32 mixed x Boot Mode Strapping Pins *)
-		padding6: ARRAY 40 OF LONGINT;
-		APU_CTRL*: LONGINT; (** 0x00000300 32 rw 0x00000000 APU Control *)
-		WDT_CLK_SEL*: LONGINT; (** 0x00000304 32 rw 0x00000000 SWDT clock source select *)
-		padding7: ARRAY 78 OF LONGINT;
-		TZ_DMA_NS*: LONGINT; (** 0x00000440 32 rw 0x00000000 DMAC TrustZone Config *)
-		TZ_DMA_IRQ_NS*: LONGINT; (** 0x00000444 32 rw 0x00000000 DMAC TrustZone Config for Interrupts *)
-		TZ_DMA_PERIPH_NS*: LONGINT; (** 0x00000448 32 rw 0x00000000 DMAC TrustZone Config for Peripherals *)
-		padding8: ARRAY 57 OF LONGINT;
-		PSS_IDCODE-: LONGINT; (** 0x00000530 32 ro x PS IDCODE *)
-		padding9: ARRAY 51 OF LONGINT;
-		DDR_URGENT*: LONGINT; (** 0x00000600 32 rw 0x00000000 DDR Urgent Control *)
-		padding10: ARRAY 2 OF LONGINT;
-		DDR_CAL_START*: LONGINT; (** 0x0000060C 32 mixed 0x00000000 DDR Calibration Start Triggers *)
-		padding11: LONGINT;
-		DDR_REF_START*: LONGINT; (** 0x00000614 32 mixed 0x00000000 DDR Refresh Start Triggers *)
-		DDR_CMD_STA*: LONGINT; (** 0x00000618 32 mixed 0x00000000 DDR Command Store Status *)
-		DDR_URGENT_SEL*: LONGINT; (** 0x0000061C 32 rw 0x00000000 DDR Urgent Select *)
-		DDR_DFI_STATUS*: LONGINT; (** 0x00000620 32 mixed 0x00000000 DDR DFI status *)
-		padding12: ARRAY 55 OF LONGINT;
-		MIO_PIN_00*: LONGINT; (** 0x00000700 32 rw 0x00001601 MIO Pin 0 Control *)
-		MIO_PIN_01*: LONGINT; (** 0x00000704 32 rw 0x00001601 MIO Pin 1 Control *)
-		MIO_PIN_02*: LONGINT; (** 0x00000708 32 rw 0x00000601 MIO Pin 2 Control *)
-		MIO_PIN_03*: LONGINT; (** 0x0000070C 32 rw 0x00000601 MIO Pin 3 Control *)
-		MIO_PIN_04*: LONGINT; (** 0x00000710 32 rw 0x00000601 MIO Pin 4 Control *)
-		MIO_PIN_05*: LONGINT; (** 0x00000714 32 rw 0x00000601 MIO Pin 5 Control *)
-		MIO_PIN_06*: LONGINT; (** 0x00000718 32 rw 0x00000601 MIO Pin 6 Control *)
-		MIO_PIN_07*: LONGINT; (** 0x0000071C 32 rw 0x00000601 MIO Pin 7 Control *)
-		MIO_PIN_08*: LONGINT; (** 0x00000720 32 rw 0x00000601 MIO Pin 8 Control *)
-		MIO_PIN_09*: LONGINT; (** 0x00000724 32 rw 0x00001601 MIO Pin 9 Control *)
-		MIO_PIN_10*: LONGINT; (** 0x00000728 32 rw 0x00001601 MIO Pin 10 Control *)
-		MIO_PIN_11*: LONGINT; (** 0x0000072C 32 rw 0x00001601 MIO Pin 11 Control *)
-		MIO_PIN_12*: LONGINT; (** 0x00000730 32 rw 0x00001601 MIO Pin 12 Control *)
-		MIO_PIN_13*: LONGINT; (** 0x00000734 32 rw 0x00001601 MIO Pin 13 Control *)
-		MIO_PIN_14*: LONGINT; (** 0x00000738 32 rw 0x00001601 MIO Pin 14 Control *)
-		MIO_PIN_15*: LONGINT; (** 0x0000073C 32 rw 0x00001601 MIO Pin 15 Control *)
-		MIO_PIN_16*: LONGINT; (** 0x00000740 32 rw 0x00001601 MIO Pin 16 Control *)
-		MIO_PIN_17*: LONGINT; (** 0x00000744 32 rw 0x00001601 MIO Pin 17 Control *)
-		MIO_PIN_18*: LONGINT; (** 0x00000748 32 rw 0x00001601 MIO Pin 18 Control *)
-		MIO_PIN_19*: LONGINT; (** 0x0000074C 32 rw 0x00001601 MIO Pin 19 Control *)
-		MIO_PIN_20*: LONGINT; (** 0x00000750 32 rw 0x00001601 MIO Pin 20 Control *)
-		MIO_PIN_21*: LONGINT; (** 0x00000754 32 rw 0x00001601 MIO Pin 21 Control *)
-		MIO_PIN_22*: LONGINT; (** 0x00000758 32 rw 0x00001601 MIO Pin 22 Control *)
-		MIO_PIN_23*: LONGINT; (** 0x0000075C 32 rw 0x00001601 MIO Pin 23 Control *)
-		MIO_PIN_24*: LONGINT; (** 0x00000760 32 rw 0x00001601 MIO Pin 24 Control *)
-		MIO_PIN_25*: LONGINT; (** 0x00000764 32 rw 0x00001601 MIO Pin 25 Control *)
-		MIO_PIN_26*: LONGINT; (** 0x00000768 32 rw 0x00001601 MIO Pin 26 Control *)
-		MIO_PIN_27*: LONGINT; (** 0x0000076C 32 rw 0x00001601 MIO Pin 27 Control *)
-		MIO_PIN_28*: LONGINT; (** 0x00000770 32 rw 0x00001601 MIO Pin 28 Control *)
-		MIO_PIN_29*: LONGINT; (** 0x00000774 32 rw 0x00001601 MIO Pin 29 Control *)
-		MIO_PIN_30*: LONGINT; (** 0x00000778 32 rw 0x00001601 MIO Pin 30 Control *)
-		MIO_PIN_31*: LONGINT; (** 0x0000077C 32 rw 0x00001601 MIO Pin 31 Control *)
-		MIO_PIN_32*: LONGINT; (** 0x00000780 32 rw 0x00001601 MIO Pin 32 Control *)
-		MIO_PIN_33*: LONGINT; (** 0x00000784 32 rw 0x00001601 MIO Pin 33 Control *)
-		MIO_PIN_34*: LONGINT; (** 0x00000788 32 rw 0x00001601 MIO Pin 34 Control *)
-		MIO_PIN_35*: LONGINT; (** 0x0000078C 32 rw 0x00001601 MIO Pin 35 Control *)
-		MIO_PIN_36*: LONGINT; (** 0x00000790 32 rw 0x00001601 MIO Pin 36 Control *)
-		MIO_PIN_37*: LONGINT; (** 0x00000794 32 rw 0x00001601 MIO Pin 37 Control *)
-		MIO_PIN_38*: LONGINT; (** 0x00000798 32 rw 0x00001601 MIO Pin 38 Control *)
-		MIO_PIN_39*: LONGINT; (** 0x0000079C 32 rw 0x00001601 MIO Pin 39 Control *)
-		MIO_PIN_40*: LONGINT; (** 0x000007A0 32 rw 0x00001601 MIO Pin 40 Control *)
-		MIO_PIN_41*: LONGINT; (** 0x000007A4 32 rw 0x00001601 MIO Pin 41 Control *)
-		MIO_PIN_42*: LONGINT; (** 0x000007A8 32 rw 0x00001601 MIO Pin 42 Control *)
-		MIO_PIN_43*: LONGINT; (** 0x000007AC 32 rw 0x00001601 MIO Pin 43 Control *)
-		MIO_PIN_44*: LONGINT; (** 0x000007B0 32 rw 0x00001601 MIO Pin 44 Control *)
-		MIO_PIN_45*: LONGINT; (** 0x000007B4 32 rw 0x00001601 MIO Pin 45 Control *)
-		MIO_PIN_46*: LONGINT; (** 0x000007B8 32 rw 0x00001601 MIO Pin 46 Control *)
-		MIO_PIN_47*: LONGINT; (** 0x000007BC 32 rw 0x00001601 MIO Pin 47 Control *)
-		MIO_PIN_48*: LONGINT; (** 0x000007C0 32 rw 0x00001601 MIO Pin 48 Control *)
-		MIO_PIN_49*: LONGINT; (** 0x000007C4 32 rw 0x00001601 MIO Pin 49 Control *)
-		MIO_PIN_50*: LONGINT; (** 0x000007C8 32 rw 0x00001601 MIO Pin 50 Control *)
-		MIO_PIN_51*: LONGINT; (** 0x000007CC 32 rw 0x00001601 MIO Pin 51 Control *)
-		MIO_PIN_52*: LONGINT; (** 0x000007D0 32 rw 0x00001601 MIO Pin 52 Control *)
-		MIO_PIN_53*: LONGINT; (** 0x000007D4 32 rw 0x00001601 MIO Pin 53 Control *)
-		padding13: ARRAY 11 OF LONGINT;
-		MIO_LOOPBACK*: LONGINT; (** 0x00000804 32 rw 0x00000000 Loopback function within MIO *)
-		padding14: LONGINT;
-		MIO_MST_TRI0*: LONGINT; (** 0x0000080C 32 rw 0xFFFFFFFF MIO pin Tri-state Enables, 31:0 *)
-		MIO_MST_TRI1*: LONGINT; (** 0x00000810 32 rw 0x003FFFFF MIO pin Tri-state Enables, 53:32 *)
-		padding15: ARRAY 7 OF LONGINT;
-		SD0_WP_CD_SEL*: LONGINT; (** 0x00000830 32 rw 0x00000000 SDIO 0 WP CD select *)
-		SD1_WP_CD_SEL*: LONGINT; (** 0x00000834 32 rw 0x00000000 SDIO 1 WP CD select *)
-		padding16: ARRAY 50 OF LONGINT;
-		LVL_SHFTR_EN*: LONGINT; (** 0x00000900 32 rw 0x00000000 Level Shifters Enable *)
-		padding17: ARRAY 3 OF LONGINT;
-		OCM_CFG*: LONGINT; (** 0x00000910 32 rw 0x00000000 OCM Address Mapping *)
-		padding18: ARRAY 66 OF LONGINT;
-		Reserved*: LONGINT; (** 0x00000A1C 32 rw 0x00010101 Reserved *)
-		padding19: ARRAY 56 OF LONGINT;
-		GPIOB_CTRL*: LONGINT; (** 0x00000B00 32 rw 0x00000000 PS IO Buffer Control *)
-		GPIOB_CFG_CMOS18*: LONGINT; (** 0x00000B04 32 rw 0x00000000 MIO GPIOB CMOS 1.8V config *)
-		GPIOB_CFG_CMOS25*: LONGINT; (** 0x00000B08 32 rw 0x00000000 MIO GPIOB CMOS 2.5V config *)
-		GPIOB_CFG_CMOS33*: LONGINT; (** 0x00000B0C 32 rw 0x00000000 MIO GPIOB CMOS 3.3V config *)
-		padding20: LONGINT;
-		GPIOB_CFG_HSTL*: LONGINT; (** 0x00000B14 32 rw 0x00000000 MIO GPIOB HSTL config *)
-		GPIOB_DRVR_BIAS_CTRL*: LONGINT; (** 0x00000B18 32 mixed 0x00000000 MIO GPIOB Driver Bias Control *)
-		padding21: ARRAY 9 OF LONGINT;
-		DDRIOB_ADDR0*: LONGINT; (** 0x00000B40 32 rw 0x00000800 DDR IOB Config for A[14:0], CKE and DRST_B *)
-		DDRIOB_ADDR1*: LONGINT; (** 0x00000B44 32 rw 0x00000800 DDR IOB Config for BA[2:0], ODT, CS_B, WE_B, RAS_B and CAS_B *)
-		DDRIOB_DATA0*: LONGINT; (** 0x00000B48 32 rw 0x00000800 DDR IOB Config for Data 15:0 *)
-		DDRIOB_DATA1*: LONGINT; (** 0x00000B4C 32 rw 0x00000800 DDR IOB Config for Data 31:16 *)
-		DDRIOB_DIFF0*: LONGINT; (** 0x00000B50 32 rw 0x00000800 DDR IOB Config for DQS 1:0 *)
-		DDRIOB_DIFF1*: LONGINT; (** 0x00000B54 32 rw 0x00000800 DDR IOB Config for DQS 3:2 *)
-		DDRIOB_CLOCK*: LONGINT; (** 0x00000B58 32 rw 0x00000800 DDR IOB Config for Clock Output *)
-		DDRIOB_DRIVE_SLEW_ADDR*: LONGINT; (** 0x00000B5C 32 rw 0x00000000 Drive and Slew controls for Address and Command pins of the DDR Interface *)
-		DDRIOB_DRIVE_SLEW_DATA*: LONGINT; (** 0x00000B60 32 rw 0x00000000 Drive and Slew controls for DQ pins of the DDR Interface *)
-		DDRIOB_DRIVE_SLEW_DIFF*: LONGINT; (** 0x00000B64 32 rw 0x00000000 Drive and Slew controls for DQS pins of the DDR Interface *)
-		DDRIOB_DRIVE_SLEW_CLOCK*: LONGINT; (** 0x00000B68 32 rw 0x00000000 Drive and Slew controls for Clock pins of the DDR Interface *)
-		DDRIOB_DDR_CTRL*: LONGINT; (** 0x00000B6C 32 rw 0x00000000 DDR IOB Buffer Control *)
-		DDRIOB_DCI_CTRL*: LONGINT; (** 0x00000B70 32 rw 0x00000020 DDR IOB DCI Config *)
-		DDRIOB_DCI_STATUS*: LONGINT; (** 0x00000B74 32 mixed 0x00000000 DDR IO Buffer DCI Status *)
-	END;
-
-	(** Device Configuration (Devcfg) register definitions *)
-	DevCfgRegisters * = POINTER {UNSAFE,UNTRACED} TO RECORD
-		CTRL *,								(** 000H 32 mixed 0C006000H Control Register *)
-		LOCK *,								(** 004H 32 mixed 00000000H Lock Register *)
-		CFG *,									(** 008H 32 rw 00000508H Configuration Register *)
-		INT_STS *,								(** 00CH 32 mixed 00000000H Interrupt Status Register *)
-		INT_MASK *,							(** 010H 32 rw FFFFFFFFH Interrupt Mask Register *)
-		STATUS *,								(** 014H 32 mixed 40000820H Status Register *)
-		DMA_SRC_ADDR *,						(** 018H 32 rw 00000000H DMA Source Address Register *)
-		DMA_DST_ADDR *,					(** 01CH 32 rw 00000000H DMA Destination Address Register *)
-		DMA_SRC_LEN *,						(** 020H 32 rw 00000000H DMA Source Transfer Length *)
-		DMA_DST_LEN *,						(** 024H 32 rw 00000000H DMA Destination Transfer Length *)
-		ROM_SHADOW *,						(** 028H 32 wo 00000000H ROM Shadow Register *)
-		MULTIBOOT_ADDR *,					(** 02CH 32 rw 00000000H MULTI Boot Address Pointer *)
-		SW_ID *,								(** 030H 32 mixed 00000000H Software ID Register *)
-		UNLOCK *: LONGINT;				(** 034H 32 rw 00000000 Unlock Register *)
-		padding0: ARRAY 18 OF LONGINT;	(** padding: 038H to 080H *)
-		MCTRL *: LONGINT;					(** 080H 32 mixed xxxxxxxxH Miscellanous Control Register *)
-		padding1: ARRAY 31 OF LONGINT;	(** padding: 084H to 100H *)
-		XADCIF_CFG *,							(** 100H 32 rw 00001114H XADC Interface Configuration *)
-		XADCIF_INT_STS *,						(** 104H 32 mixed 00000200H XADC Interface Interrupt Status *)
-		XADCIF_INT_MASK *,					(** 108H 32 rw FFFFFFFFH XADC Interface Interrupt Mask *)
-		XADCIF_MSTS *,						(** 10CH 32 ro 00000500H XADC Interface Miscellanous Status Register *)
-		XADCIF_CMDFIFO *,					(** 110H 32 wo 00000000H XADC Interface Command FIFO Register *)
-		XADCIF_RDFIFO *,						(** 114H 32 ro 00000000H XADC Interface Data FIFO Register *)
-		XADCIF_MCTL *: LONGINT;			(** 118H 32 rw 00000010H XADC Interface Miscellanous Control Register *)
-	END;
-
-	MpcoreRegisters * = POINTER {UNSAFE, UNTRACED} TO RECORD
-		SCU_CONTROL_REGISTER * {ALIGNED(1)}: LONGINT; (* 0x00000000 32 rw 0x00000002 SCU Control Register *)
-		SCU_CONFIGURATION_REGISTER * {ALIGNED(1)}: LONGINT; (* 0x00000004 32 ro 0x00000501 SCU Configuration Register *)
-		SCU_CPU_Power_Status_Register * {ALIGNED(1)}: LONGINT; (* 0x00000008 32 rw 0x00000000 SCU CPU Power Status Register *)
-		SCU_Invalidate_All_Registers_in_Secure_State * {ALIGNED(1)}: LONGINT; (* 0x0000000C 32 wo 0x00000000 SCU Invalidate All Registers in Secure State *)
-		padd0 {ALIGNED(1)}: ARRAY 48 OF CHAR;
-		Filtering_Start_Address_Register * {ALIGNED(1)}: LONGINT; (* 0x00000040 32 rw 0x00100000 Filtering Start Address Register *)
-		Filtering_End_Address_Register * {ALIGNED(1)}: LONGINT; (* 0x00000044 32 rw 0x00000000 Defined by FILTEREND input *)
-		padd1 {ALIGNED(1)}: ARRAY 8 OF CHAR;
-		SCU_Access_Control_Register_SAC * {ALIGNED(1)}: LONGINT; (* 0x00000050 32 rw 0x0000000F SCU Access Control (SAC) Register *)
-		SCU_Non_secure_Access_Control_Register * {ALIGNED(1)}: LONGINT; (* 0x00000054 32 ro 0x00000000 SCU Non-secure Access Control Register SNSAC *)
-		padd2 {ALIGNED(1)}: ARRAY 168 OF CHAR;
-		ICCICR * {ALIGNED(1)}: LONGINT; (* 0x00000100 32 rw 0x00000000 CPU Interface Control Register *)
-		ICCPMR * {ALIGNED(1)}: LONGINT; (* 0x00000104 32 rw 0x00000000 Interrupt Priority Mask Register *)
-		ICCBPR * {ALIGNED(1)}: LONGINT; (* 0x00000108 32 rw 0x00000002 Binary Point Register *)
-		ICCIAR * {ALIGNED(1)}: LONGINT; (* 0x0000010C 32 rw 0x000003FF Interrupt Acknowledge Register *)
-		ICCEOIR * {ALIGNED(1)}: LONGINT; (* 0x00000110 32 rw 0x00000000 End Of Interrupt Register *)
-		ICCRPR * {ALIGNED(1)}: LONGINT; (* 0x00000114 32 rw 0x000000FF Running Priority Register *)
-		ICCHPIR * {ALIGNED(1)}: LONGINT; (* 0x00000118 32 rw 0x000003FF Highest Pending Interrupt Register *)
-		ICCABPR * {ALIGNED(1)}: LONGINT; (* 0x0000011C 32 rw 0x00000003 Aliased Non-secure Binary Point Register *)
-		padd3 {ALIGNED(1)}: ARRAY 220 OF CHAR;
-		ICCIDR * {ALIGNED(1)}: LONGINT; (* 0x000001FC 32 ro 0x3901243B CPU Interface Implementer Identification Register *)
-		Global_Timer_Counter_Register0 * {ALIGNED(1)}: LONGINT; (* 0x00000200 32 rw 0x00000000 Global Timer Counter Register 0 *)
-		Global_Timer_Counter_Register1 * {ALIGNED(1)}: LONGINT; (* 0x00000204 32 rw 0x00000000 Global Timer Counter Register 1 *)
-		Global_Timer_Control_Register * {ALIGNED(1)}: LONGINT; (* 0x00000208 32 rw 0x00000000 Global Timer Control Register *)
-		Global_Timer_Interrupt_Status_Register * {ALIGNED(1)}: LONGINT; (* 0x0000020C 32 rw 0x00000000 Global Timer Interrupt Status Register *)
-		Comparator_Value_Register0 * {ALIGNED(1)}: LONGINT; (* 0x00000210 32 rw 0x00000000 Comparator Value Register_0 *)
-		Comparator_Value_Register1 * {ALIGNED(1)}: LONGINT; (* 0x00000214 32 rw 0x00000000 Comparator Value Register_1 *)
-		Auto_increment_Register * {ALIGNED(1)}: LONGINT; (* 0x00000218 32 rw 0x00000000 Auto-increment Register *)
-		padd4 {ALIGNED(1)}: ARRAY 996 OF CHAR;
-		Private_Timer_Load_Register * {ALIGNED(1)}: LONGINT; (* 0x00000600 32 rw 0x00000000 Private Timer Load Register *)
-		Private_Timer_Counter_Register * {ALIGNED(1)}: LONGINT; (* 0x00000604 32 rw 0x00000000 Private Timer Counter Register *)
-		Private_Timer_Control_Register * {ALIGNED(1)}: LONGINT; (* 0x00000608 32 rw 0x00000000 Private Timer Control Register *)
-		Private_Timer_Interrupt_Status_Register * {ALIGNED(1)}: LONGINT; (* 0x0000060C 32 rw 0x00000000 Private Timer Interrupt Status Register *)
-		padd5 {ALIGNED(1)}: ARRAY 16 OF CHAR;
-		Watchdog_Load_Register * {ALIGNED(1)}: LONGINT; (* 0x00000620 32 rw 0x00000000 Watchdog Load Register *)
-		Watchdog_Counter_Register * {ALIGNED(1)}: LONGINT; (* 0x00000624 32 rw 0x00000000 Watchdog Counter Register *)
-		Watchdog_Control_Register * {ALIGNED(1)}: LONGINT; (* 0x00000628 32 rw 0x00000000 Watchdog Control Register *)
-		Watchdog_Interrupt_Status_Register * {ALIGNED(1)}: LONGINT; (* 0x0000062C 32 rw 0x00000000 Watchdog Interrupt Status Register *)
-		Watchdog_Reset_Status_Register * {ALIGNED(1)}: LONGINT; (* 0x00000630 32 rw 0x00000000 Watchdog Reset Status Register *)
-		Watchdog_Disable_Register * {ALIGNED(1)}: LONGINT; (* 0x00000634 32 rw 0x00000000 Watchdog Disable Register *)
-		padd6 {ALIGNED(1)}: ARRAY 2504 OF CHAR;
-		ICDDCR * {ALIGNED(1)}: LONGINT; (* 0x00001000 32 rw 0x00000000 Distributor Control Register *)
-		ICDICTR * {ALIGNED(1)}: LONGINT; (* 0x00001004 32 ro 0x0000FC22 Interrupt Controller Type Register *)
-		ICDIIDR * {ALIGNED(1)}: LONGINT; (* 0x00001008 32 ro 0x0102043B Distributor Implementer Identification Register *)
-		padd7 {ALIGNED(1)}: ARRAY 116 OF CHAR;
-		ICDISR0 * {ALIGNED(1)}: LONGINT; (* 0x00001080 32 rw 0x00000000 Interrupt Security Register_0 *)
-		ICDISR1 * {ALIGNED(1)}: LONGINT; (* 0x00001084 32 rw 0x00000000 Interrupt Security Register_1 *)
-		ICDISR2 * {ALIGNED(1)}: LONGINT; (* 0x00001088 32 rw 0x00000000 Interrupt Security Register_2 *)
-		padd8 {ALIGNED(1)}: ARRAY 116 OF CHAR;
-		ICDISER0 * {ALIGNED(1)}: LONGINT; (* 0x00001100 32 rw 0x0000FFFF Interrupt Set-enable Register 0 *)
-		ICDISER1 * {ALIGNED(1)}: LONGINT; (* 0x00001104 32 rw 0x00000000 Interrupt Set-enable Register 1 *)
-		ICDISER2 * {ALIGNED(1)}: LONGINT; (* 0x00001108 32 rw 0x00000000 Interrupt Set-enable Register 2 *)
-		padd9 {ALIGNED(1)}: ARRAY 116 OF CHAR;
-		ICDICER0 * {ALIGNED(1)}: LONGINT; (* 0x00001180 32 rw 0x0000FFFF Interrupt Clear-Enable Register 0 *)
-		ICDICER1 * {ALIGNED(1)}: LONGINT; (* 0x00001184 32 rw 0x00000000 Interrupt Clear-Enable Register 1 *)
-		ICDICER2 * {ALIGNED(1)}: LONGINT; (* 0x00001188 32 rw 0x00000000 Interrupt Clear-Enable Register 2 *)
-		padd10 {ALIGNED(1)}: ARRAY 116 OF CHAR;
-		ICDISPR0 * {ALIGNED(1)}: LONGINT; (* 0x00001200 32 rw 0x00000000 Interrupt Set-pending Register_0 *)
-		ICDISPR1 * {ALIGNED(1)}: LONGINT; (* 0x00001204 32 rw 0x00000000 Interrupt Set-pending Register_1 *)
-		ICDISPR2 * {ALIGNED(1)}: LONGINT; (* 0x00001208 32 rw 0x00000000 Interrupt Set-pending Register_2 *)
-		padd11 {ALIGNED(1)}: ARRAY 116 OF CHAR;
-		ICDICPR0 * {ALIGNED(1)}: LONGINT; (* 0x00001280 32 rw 0x00000000 Interrupt Clear-Pending Register_0 *)
-		ICDICPR1 * {ALIGNED(1)}: LONGINT; (* 0x00001284 32 rw 0x00000000 Interrupt Clear-Pending Register_1 *)
-		ICDICPR2 * {ALIGNED(1)}: LONGINT; (* 0x00001288 32 rw 0x00000000 Interrupt Clear-Pending Register_2 *)
-		padd12 {ALIGNED(1)}: ARRAY 116 OF CHAR;
-		ICDABR0 * {ALIGNED(1)}: LONGINT; (* 0x00001300 32 rw 0x00000000 Active Bit register_0 *)
-		ICDABR1 * {ALIGNED(1)}: LONGINT; (* 0x00001304 32 rw 0x00000000 Active Bit register_1 *)
-		ICDABR2 * {ALIGNED(1)}: LONGINT; (* 0x00001308 32 rw 0x00000000 Active Bit register_2 *)
-		padd13 {ALIGNED(1)}: ARRAY 244 OF CHAR;
-		ICDIPR0 * {ALIGNED(1)}: LONGINT; (* 0x00001400 32 rw 0x00000000 Interrupt Priority Register_0 *)
-		ICDIPR1 * {ALIGNED(1)}: LONGINT; (* 0x00001404 32 rw 0x00000000 Interrupt Priority Register_1 *)
-		ICDIPR2 * {ALIGNED(1)}: LONGINT; (* 0x00001408 32 rw 0x00000000 Interrupt Priority Register_2 *)
-		ICDIPR3 * {ALIGNED(1)}: LONGINT; (* 0x0000140C 32 rw 0x00000000 Interrupt Priority Register_3 *)
-		ICDIPR4 * {ALIGNED(1)}: LONGINT; (* 0x00001410 32 rw 0x00000000 Interrupt Priority Register_4 *)
-		ICDIPR5 * {ALIGNED(1)}: LONGINT; (* 0x00001414 32 rw 0x00000000 Interrupt Priority Register_5 *)
-		ICDIPR6 * {ALIGNED(1)}: LONGINT; (* 0x00001418 32 rw 0x00000000 Interrupt Priority Register_6 *)
-		ICDIPR7 * {ALIGNED(1)}: LONGINT; (* 0x0000141C 32 rw 0x00000000 Interrupt Priority Register_7 *)
-		ICDIPR8 * {ALIGNED(1)}: LONGINT; (* 0x00001420 32 rw 0x00000000 Interrupt Priority Register_8 *)
-		ICDIPR9 * {ALIGNED(1)}: LONGINT; (* 0x00001424 32 rw 0x00000000 Interrupt Priority Register_9 *)
-		ICDIPR10 * {ALIGNED(1)}: LONGINT; (* 0x00001428 32 rw 0x00000000 Interrupt Priority Register_10 *)
-		ICDIPR11 * {ALIGNED(1)}: LONGINT; (* 0x0000142C 32 rw 0x00000000 Interrupt Priority Register_11 *)
-		ICDIPR12 * {ALIGNED(1)}: LONGINT; (* 0x00001430 32 rw 0x00000000 Interrupt Priority Register_12 *)
-		ICDIPR13 * {ALIGNED(1)}: LONGINT; (* 0x00001434 32 rw 0x00000000 Interrupt Priority Register_13 *)
-		ICDIPR14 * {ALIGNED(1)}: LONGINT; (* 0x00001438 32 rw 0x00000000 Interrupt Priority Register_14 *)
-		ICDIPR15 * {ALIGNED(1)}: LONGINT; (* 0x0000143C 32 rw 0x00000000 Interrupt Priority Register_15 *)
-		ICDIPR16 * {ALIGNED(1)}: LONGINT; (* 0x00001440 32 rw 0x00000000 Interrupt Priority Register_16 *)
-		ICDIPR17 * {ALIGNED(1)}: LONGINT; (* 0x00001444 32 rw 0x00000000 Interrupt Priority Register_17 *)
-		ICDIPR18 * {ALIGNED(1)}: LONGINT; (* 0x00001448 32 rw 0x00000000 Interrupt Priority Register_18 *)
-		ICDIPR19 * {ALIGNED(1)}: LONGINT; (* 0x0000144C 32 rw 0x00000000 Interrupt Priority Register_19 *)
-		ICDIPR20 * {ALIGNED(1)}: LONGINT; (* 0x00001450 32 rw 0x00000000 Interrupt Priority Register_20 *)
-		ICDIPR21 * {ALIGNED(1)}: LONGINT; (* 0x00001454 32 rw 0x00000000 Interrupt Priority Register_21 *)
-		ICDIPR22 * {ALIGNED(1)}: LONGINT; (* 0x00001458 32 rw 0x00000000 Interrupt Priority Register_22 *)
-		ICDIPR23 * {ALIGNED(1)}: LONGINT; (* 0x0000145C 32 rw 0x00000000 Interrupt Priority Register_23 *)
-		padd14 {ALIGNED(1)}: ARRAY 928 OF CHAR;
-		ICDIPTR0 * {ALIGNED(1)}: LONGINT; (* 0x00001800 32 ro 0x01010101 Interrupt Processor Targets Register 0 *)
-		ICDIPTR1 * {ALIGNED(1)}: LONGINT; (* 0x00001804 32 ro 0x01010101 Interrupt Processor Targets Register 1 *)
-		ICDIPTR2 * {ALIGNED(1)}: LONGINT; (* 0x00001808 32 ro 0x01010101 Interrupt Processor Targets Register 2 *)
-		ICDIPTR3 * {ALIGNED(1)}: LONGINT; (* 0x0000180C 32 ro 0x01010101 Interrupt Processor Targets Register 3 *)
-		ICDIPTR4 * {ALIGNED(1)}: LONGINT; (* 0x00001810 32 rw 0x00000000 Interrupt Processor Targets Register 4 *)
-		ICDIPTR5 * {ALIGNED(1)}: LONGINT; (* 0x00001814 32 ro 0x00000000 Interrupt Processor Targets Register 5 *)
-		ICDIPTR6 * {ALIGNED(1)}: LONGINT; (* 0x00001818 32 ro 0x01000000 Interrupt Processor Targets Register 6 *)
-		ICDIPTR7 * {ALIGNED(1)}: LONGINT; (* 0x0000181C 32 ro 0x01010101 Interrupt Processor Targets Register 7 *)
-		ICDIPTR8 * {ALIGNED(1)}: LONGINT; (* 0x00001820 32 rw 0x00000000 Interrupt Processor Targets Register 8 *)
-		ICDIPTR9 * {ALIGNED(1)}: LONGINT; (* 0x00001824 32 rw 0x00000000 Interrupt Processor Targets Register 9 *)
-		ICDIPTR10 * {ALIGNED(1)}: LONGINT; (* 0x00001828 32 rw 0x00000000 Interrupt Processor Targets Register 10 *)
-		ICDIPTR11 * {ALIGNED(1)}: LONGINT; (* 0x0000182C 32 rw 0x00000000 Interrupt Processor Targets Register 11 *)
-		ICDIPTR12 * {ALIGNED(1)}: LONGINT; (* 0x00001830 32 rw 0x00000000 Interrupt Processor Targets Register 12 *)
-		ICDIPTR13 * {ALIGNED(1)}: LONGINT; (* 0x00001834 32 rw 0x00000000 Interrupt Processor Targets Register 13 *)
-		ICDIPTR14 * {ALIGNED(1)}: LONGINT; (* 0x00001838 32 rw 0x00000000 Interrupt Processor Targets Register 14 *)
-		ICDIPTR15 * {ALIGNED(1)}: LONGINT; (* 0x0000183C 32 rw 0x00000000 Interrupt Processor Targets Register 15 *)
-		ICDIPTR16 * {ALIGNED(1)}: LONGINT; (* 0x00001840 32 rw 0x00000000 Interrupt Processor Targets Register 16 *)
-		ICDIPTR17 * {ALIGNED(1)}: LONGINT; (* 0x00001844 32 rw 0x00000000 Interrupt Processor Targets Register 17 *)
-		ICDIPTR18 * {ALIGNED(1)}: LONGINT; (* 0x00001848 32 rw 0x00000000 Interrupt Processor Targets Register 18 *)
-		ICDIPTR19 * {ALIGNED(1)}: LONGINT; (* 0x0000184C 32 rw 0x00000000 Interrupt Processor Targets Register 19 *)
-		ICDIPTR20 * {ALIGNED(1)}: LONGINT; (* 0x00001850 32 rw 0x00000000 Interrupt Processor Targets Register 20 *)
-		ICDIPTR21 * {ALIGNED(1)}: LONGINT; (* 0x00001854 32 rw 0x00000000 Interrupt Processor Targets Register 21 *)
-		ICDIPTR22 * {ALIGNED(1)}: LONGINT; (* 0x00001858 32 rw 0x00000000 Interrupt Processor Targets Register 22 *)
-		ICDIPTR23 * {ALIGNED(1)}: LONGINT; (* 0x0000185C 32 rw 0x00000000 Interrupt Processor Targets Register 23 *)
-		padd15 {ALIGNED(1)}: ARRAY 928 OF CHAR;
-		ICDICFR0 * {ALIGNED(1)}: LONGINT; (* 0x00001C00 32 ro 0xAAAAAAAA Interrupt Configuration Register 0 *)
-		ICDICFR1 * {ALIGNED(1)}: LONGINT; (* 0x00001C04 32 rw 0x7DC00000 Interrupt Configuration Register 1 *)
-		ICDICFR2 * {ALIGNED(1)}: LONGINT; (* 0x00001C08 32 rw 0x55555555 Interrupt Configuration Register 2 *)
-		ICDICFR3 * {ALIGNED(1)}: LONGINT; (* 0x00001C0C 32 rw 0x55555555 Interrupt Configuration Register 3 *)
-		ICDICFR4 * {ALIGNED(1)}: LONGINT; (* 0x00001C10 32 rw 0x55555555 Interrupt Configuration Register 4 *)
-		ICDICFR5 * {ALIGNED(1)}: LONGINT; (* 0x00001C14 32 rw 0x55555555 Interrupt Configuration Register 5 *)
-		padd16 {ALIGNED(1)}: ARRAY 232 OF CHAR;
-		ppi_status * {ALIGNED(1)}: LONGINT; (* 0x00001D00 32 ro 0x00000000 PPI Status Register *)
-		spi_status_0 * {ALIGNED(1)}: LONGINT; (* 0x00001D04 32 ro 0x00000000 SPI Status Register 0 *)
-		spi_status_1 * {ALIGNED(1)}: LONGINT; (* 0x00001D08 32 ro 0x00000000 SPI Status Register 1 *)
-		padd17 {ALIGNED(1)}: ARRAY 500 OF CHAR;
-		ICDSGIR * {ALIGNED(1)}: LONGINT; (* 0x00001F00 32 rw 0x00000000 Software Generated Interrupt Register *)
-		padd18 {ALIGNED(1)}: ARRAY 204 OF CHAR;
-		ICPIDR4 * {ALIGNED(1)}: LONGINT; (* 0x00001FD0 32 rw 0x00000004 Peripheral ID4 *)
-		ICPIDR5 * {ALIGNED(1)}: LONGINT; (* 0x00001FD4 32 rw 0x00000000 Peripheral ID5 *)
-		ICPIDR6 * {ALIGNED(1)}: LONGINT; (* 0x00001FD8 32 rw 0x00000000 Peripheral ID6 *)
-		ICPIDR7 * {ALIGNED(1)}: LONGINT; (* 0x00001FDC 32 rw 0x00000000 Peripheral ID7 *)
-		ICPIDR0 * {ALIGNED(1)}: LONGINT; (* 0x00001FE0 32 rw 0x00000090 Peripheral ID0 *)
-		ICPIDR1 * {ALIGNED(1)}: LONGINT; (* 0x00001FE4 32 rw 0x000000B3 Peripheral ID1 *)
-		ICPIDR2 * {ALIGNED(1)}: LONGINT; (* 0x00001FE8 32 rw 0x0000001B Peripheral ID2 *)
-		ICPIDR3 * {ALIGNED(1)}: LONGINT; (* 0x00001FEC 32 rw 0x00000000 Peripheral ID3 *)
-		ICCIDR0 * {ALIGNED(1)}: LONGINT; (* 0x00001FF0 32 rw 0x0000000D Component ID0 *)
-		ICCIDR1 * {ALIGNED(1)}: LONGINT; (* 0x00001FF4 32 rw 0x000000F0 Component ID1 *)
-		ICCIDR2 * {ALIGNED(1)}: LONGINT; (* 0x00001FF8 32 rw 0x00000005 Component ID2 *)
-		ICCIDR3 * {ALIGNED(1)}: LONGINT; (* 0x00001FFC 32 rw 0x000000B1 Component ID3 *)
-	END;
-
-	SWDTRegisters * = POINTER {UNSAFE, UNTRACED} TO RECORD
-		XWDTPS_ZMR_OFFSET * {ALIGNED(1)}: LONGINT; (* 0x00000000 24 mixed 0x000001C0 WD zero mode register *)
-		XWDTPS_CCR_OFFSET * {ALIGNED(1)}: LONGINT; (* 0x00000004 26 mixed 0x00003FFC Counter Control Register *)
-		XWDTPS_RESTART_OFFSET * {ALIGNED(1)}: LONGINT; (* 0x00000008 16 wo 0x00000000 Restart key register - this not a real register as no data is stored *)
-		XWDTPS_SR_OFFSET * {ALIGNED(1)}: LONGINT; (* 0x0000000C 1 ro 0x00000000 Status Register *)
-	END;
-
-VAR
-	slcr*: SlcrRegisters; (** System Level Control (SLCR) registers set *)
-	devcfg*: DevCfgRegisters; (** Device Configuration (Devcfg) register set *)
-	mpcore*: MpcoreRegisters; (** Cortex-A9 multiprocessor extensions (MPCore) register set *)
-	swdt*: SWDTRegisters; (** System watchdog (SWDT) register set *)
-
-BEGIN
-	slcr := SlcrBase;
-	devcfg := DevCfgBase;
-	mpcore := MpcoreBase;
-	swdt := SWDTBase;
-END Platform.

ARM/ARM.A2/Zynq.DisplayLinear.Mod

@@ -1,338 +0,0 @@
-MODULE DisplayLinear;
-
-IMPORT SYSTEM, Displays, Plugins, Machine, Kernel, Commands, Options,
-	PsConfig, AcAxisIo, Video := AcStreamVideoOut, AcAxiDma, Trace;
-
-CONST
-	MaxWidth = 1920;
-	MaxHeight = 1080;
-
-	CacheLineSize = 32; (* cache line size in bytes *)
-	DmaBurstLen = 16;
-
-	(*
-		Video settings for 1024 x 768 @ 62 Hz
-	*)
-	Width* = 1024;
-	Height* = 768;
-
-	PlClkDiv0* = 10;
-	PlClkDiv1* = 15;
-	PlClkDiv2* = 3;
-
-	HorizFrontPorch* = 24;
-	HorizSyncWidth* = 136;
-	HorizBackPorch* = 160;
-	HorizSyncPolarity* = TRUE;
-
-	VertFrontPorch* = 3;
-	VertSyncWidth* = 6;
-	VertBackPorch* = 29;
-	VertSyncPolarity* = TRUE;
-
-(*
-	(*
-		Video settings for 800 x 480 @ 65 Hz
-	*)
-	Width* = 800;
-	Height* = 480;
-
-	PlClkDiv0* = 10;
-	PlClkDiv1* = 15*2;
-	PlClkDiv2* = 3*2;
-
-	HorizFrontPorch* = 40;
-	HorizSyncWidth* = 48;
-	HorizBackPorch* = 88;
-	HorizSyncPolarity* = TRUE;
-
-	VertFrontPorch* = 13;
-	VertSyncWidth* = 3;
-	VertBackPorch* = 32;
-	VertSyncPolarity* = TRUE;
-*)
-
-	DefaultColor* = LONGINT(0FFFFFFFFH); (** the color of the booting screen  *)
-
-TYPE
-
-	Display = OBJECT(Displays.Display)
-	CONST
-		Format = 4;
-
-		(** Transfer a block of pixels in "raw" display format to (op = set) or from (op = get) the display.  Pixels in the rectangular area are transferred from left to right and top to bottom.  The pixels are transferred to or from "buf", starting at "ofs".  The line byte increment is "stride", which may be positive, negative or zero. *)
-		PROCEDURE Transfer*(VAR buf: ARRAY OF CHAR; ofs, stride, x, y, w, h, op: LONGINT);
-		VAR bufadr, buflow, bufhigh, dispadr,w0,b,d: ADDRESS;
-		BEGIN
-
-			IF w > 0 THEN
-				ASSERT(fbadr # 0);
-				bufadr := ADDRESSOF(buf[ofs]);
-				dispadr := fbadr + y * fbstride + x * Format;
-				IF Displays.reverse THEN
-					dispadr := fbadr + (height-y-1) * fbstride + (width-x-1) * Format;
-				END;
-
-				ASSERT((dispadr >= fbadr) & ((y+h-1)*fbstride + (x+w-1)*Format <=  fbsize));	(* display index check *)
-				w := w * Format;	(* convert to bytes *)
-				CASE op OF
-					Displays.set:
-						IF Displays.reverse THEN
-							WHILE h > 0 DO
-								w0 := w DIV Format; b:= bufadr; d := dispadr;
-								WHILE w0 > 0 DO
-									SYSTEM.MOVE(b, d, Format);
-									INC(b,Format);
-									DEC(d, Format);
-									DEC(w0);
-								END;
-								INC(bufadr, stride); DEC(dispadr, fbstride);
-								DEC(h)
-							END
-						ELSE
-							w0 := w DIV Format;
-							WHILE h > 0 DO
-								Copy32(bufadr,dispadr,w0); (*SYSTEM.MOVE(bufadr, dispadr, w);*) Machine.FlushDCacheRange(dispadr,w);
-								INC(bufadr, stride); INC(dispadr, fbstride);
-								DEC(h)
-							END
-						END;
-					|Displays.get:
-						IF Displays.reverse THEN
-							buflow := ADDRESSOF(buf[0]); bufhigh := buflow + LEN(buf);
-							WHILE h > 0 DO
-								ASSERT((bufadr >= buflow) & (bufadr+w <= bufhigh));	(* index check *)
-								w0 := w DIV Format; b:= bufadr; d := dispadr;
-								WHILE w0 > 0 DO
-									SYSTEM.MOVE(d, b, Format);
-									INC(b,Format);
-									DEC(d, Format);
-									DEC(w0);
-								END;
-								INC(bufadr, stride); DEC(dispadr, fbstride);
-								DEC(h)
-							END;
-						ELSE
-							buflow := ADDRESSOF(buf[0]); bufhigh := buflow + LEN(buf);
-							WHILE h > 0 DO
-								ASSERT((bufadr >= buflow) & (bufadr+w <= bufhigh));	(* index check *)
-								SYSTEM.MOVE(dispadr, bufadr, w);
-								INC(bufadr, stride); INC(dispadr, fbstride);
-								DEC(h)
-							END;
-						END;
-					ELSE (* skip *)
-				END
-			END
-		END Transfer;
-
-	END Display;
-
-VAR
-	display: Display;
-	vout: Video.Controller;
-
-	pixelClock: REAL; (* pixel clock in Hz *)
-
-	buf: POINTER TO ARRAY OF CHAR;
-	bufAddr: ADDRESS;
-
-	rCfgCmd, rCfgData: AcAxisIo.Output;
-	rStatus: AcAxisIo.Input;
-	videoCfg: AcAxisIo.Output;
-	rdma: AcAxiDma.ReadController;
-
-	(*
-		Reset programming logic
-
-		polarity: reset signal polarity, TRUE for active high and FALSE for active low
-	*)
-	PROCEDURE ResetPl(polarity: BOOLEAN);
-	VAR res, t: LONGINT;
-	BEGIN
-		IF polarity THEN (* active high *)
-			ASSERT(PsConfig.SetPlResets({},res));
-			t := Kernel.GetTicks();
-			WHILE Kernel.GetTicks() - t < 1 DO END;
-			ASSERT(PsConfig.SetPlResets({0..3},res));
-		ELSE (* active low *)
-			ASSERT(PsConfig.SetPlResets({0..3},res));
-			t := Kernel.GetTicks();
-			WHILE Kernel.GetTicks() - t < 1 DO END;
-			ASSERT(PsConfig.SetPlResets({},res));
-		END;
-	END ResetPl;
-
-	(*
-		Setup clocks required for video streaming
-	*)
-	PROCEDURE SetupClocks;
-	VAR
-		res: LONGINT;
-		freq: HUGEINT;
-	BEGIN
-		(*
-			Setup DMA frequency
-		*)
-		freq := PsConfig.GetPllClockFrequency(PsConfig.IoPll,res);
-		Trace.String("IO PLL frequency is "); Trace.Int(freq,0); Trace.String(" Hz"); Trace.Ln;
-		ASSERT(PsConfig.SetPlResets({0,1,2,3},res));
-		IF PsConfig.SetPlClock(0,PsConfig.IoPll,PlClkDiv0,1,res) THEN
-			Trace.String("FPGA clock 0 frequency has been changed to "); Trace.Int(PsConfig.GetPlClockFrequency(0,res),0); Trace.String(" Hz"); Trace.Ln;
-		ELSE Trace.String("Error while setting FPGA clock 0 frequency, res="); Trace.Int(res,0); Trace.Ln;
-		END;
-
-		(*
-			Setup display clocks
-		*)		
-		(* pixel clock *)
-		pixelClock := REAL(freq)/PlClkDiv1;
-		IF PsConfig.SetPlClock(1,PsConfig.IoPll,PlClkDiv1,1,res) THEN
-			Trace.String("FPGA clock 1 frequency has been changed to "); Trace.Int(PsConfig.GetPlClockFrequency(1,res),0); Trace.String(" Hz"); Trace.Ln;
-		ELSE Trace.String("Error while setting FPGA clock 1 frequency, res="); Trace.Int(res,0); Trace.Ln;
-		END;
-		(* clock used for serialization *)
-		IF PsConfig.SetPlClock(2,PsConfig.IoPll,PlClkDiv2,1,res) THEN
-			Trace.String("FPGA clock 2 frequency has been changed to "); Trace.Int(PsConfig.GetPlClockFrequency(2,res),0); Trace.String(" Hz"); Trace.Ln;
-		ELSE Trace.String("Error while setting FPGA clock 2 frequency, res="); Trace.Int(res,0); Trace.Ln;
-		END;
-	END SetupClocks;
-
-	PROCEDURE Init;
-	VAR
-		res: LONGINT;
-		d: LONGINT;
-	BEGIN
-		SetupClocks;
-
-		(*
-			Reset the programming logic
-		*)
-		ResetPl(FALSE);
-
-		(*
-			Setup ActiveCells components ports
-		*)
-		ASSERT(AcAxisIo.GetOutput(0,0, rCfgCmd));
-		ASSERT(AcAxisIo.GetOutput(0,1, rCfgData));
-		ASSERT(AcAxisIo.GetInput(0,0, rStatus));
-		ASSERT(AcAxisIo.GetOutput(0,2, videoCfg));
-
-		(*
-			Allocate frame buffer
-		*)
-		NEW(buf,CacheLineSize*((MaxHeight*MaxWidth*4+CacheLineSize-1) DIV CacheLineSize)+CacheLineSize);
-		bufAddr := ADDRESSOF(buf[0]);
-		bufAddr := bufAddr + (CacheLineSize - bufAddr MOD CacheLineSize); (* align to cache line size boundary *)
-		Trace.String("DisplayLinear: bufAddr0="); Trace.Hex(ADDRESSOF(buf[0]),-8); Trace.Ln;
-		Trace.String("DisplayLinear: bufAddr="); Trace.Hex(bufAddr,-8); Trace.Ln;
-		ASSERT(bufAddr MOD CacheLineSize = 0);
-		ASSERT(ADDRESSOF(buf[LEN(buf)-1]) >= bufAddr+MaxHeight*MaxWidth*4-1);
-
-		(*
-			Setup video streaming
-		*)
-		Video.InitController(vout,videoCfg,pixelClock);
-
-		Video.SetHorizActiveSize(vout,Width);
-		Video.SetHorizFrontPorch(vout,HorizFrontPorch);
-		Video.SetHorizSyncWidth(vout,HorizSyncWidth);
-		Video.SetHorizBackPorch(vout,HorizBackPorch);
-		Video.SetHorizSyncPolarity(vout,HorizSyncPolarity);
-
-		Video.SetVertActiveSize(vout,Height);
-		Video.SetVertFrontPorch(vout,VertFrontPorch);
-		Video.SetVertSyncWidth(vout,VertSyncWidth);
-		Video.SetVertBackPorch(vout,VertBackPorch);
-		Video.SetVertSyncPolarity(vout,VertSyncPolarity);
-
-		(*
-			Setup AXI DMA for transfering data from the frame buffer to the video output
-		*)
-
-		(* configure read channel of S_AXI_HP0 as a 32-bit interface *)
-		d := SYSTEM.GET32(0xF8008000); SYSTEM.PUT32(0xF8008000,SYSTEM.MSK(d,0xFFFFFFFE)+1);
-		
-		Machine.Fill32(bufAddr,Width*Height*4,DefaultColor); (* fill the framebuffer with the default color *)
-		Machine.FlushDCacheRange(bufAddr,Width*Height*4);
-
-		AcAxiDma.InitController(rdma,rCfgCmd,rCfgData,rStatus,4,16);
-		AcAxiDma.SetBurstLen(rdma,DmaBurstLen);
-
-		(* configure read DMA transfer *)
-		AcAxiDma.SetAddr(rdma,bufAddr);
-		AcAxiDma.SetCount(rdma,Width*Height);
-		AcAxiDma.SetWrap(rdma,TRUE); (* recurring transfer *)
-		
-		(*
-			Enable video output
-		*)
-		Video.Enable(vout,TRUE);
-		AcAxiDma.Start(rdma);
-		
-		(*
-			Install the display
-		*)
-		NEW(display);
-		display.width := Width;
-		display.height := Height;
-		display.offscreen := 0;
-		display.format := 4;
-		display.unit := 10000;
-		display.InitFrameBuffer(bufAddr,Width*Height*4,Width*4);
-		display.desc := "Linear framebuffer driver for Zynq";
-		display.Update;
-		Displays.registry.Add(display,res);
-		ASSERT(res = Plugins.Ok);
-	END Init;	
-
-	PROCEDURE Install*(context: Commands.Context);
-	VAR options: Options.Options;
-	BEGIN
-		IF context # NIL THEN
-			NEW(options);
-			options.Add("r", "reverse", Options.Flag);
-			IF options.Parse(context.arg, context.error) THEN
-				IF options.GetFlag("r") THEN Displays.Reverse() END;
-			END;
-		END;
-	END Install;
-
-	PROCEDURE -Copy32(sadr: ADDRESS; dadr: ADDRESS; len: LONGINT);
-	CODE
-		LDR	R0, [SP, #dadr]
-		LDR	R1, [SP, #len]
-		LDR	R2, [SP, #sadr]
-		MOV	R3, #0
-	loop:
-		CMP	R3, R1
-		BGE	end
-		LDR	R4, [R2, #0]
-		STR	R4, [R0, #0]
-		ADD	R0, R0, #4
-		ADD	R2, R2, #4
-		ADD	R3, R3, #1
-		B loop
-	end:
-		ADD SP, SP, 12
-	(*BEGIN
-		SYSTEM.MOVE(sadr, dadr, 4*len)*)
-	END Copy32;
-
-BEGIN
-	Init;
-END DisplayLinear.
-
-SystemTools.DoCommands
-
-WinDisks.Install I: RW ~
-FSTools.Mount AOS AosFS PhysicalDrive4#3 ~
-
-SystemTools.DoCommands
-
-FSTools.CopyFiles -o WORK:/build/DisplayLinear.Gof => AOS:/DisplayLinear.Gof ~
-FSTools.CopyFiles -o WORK:/build/DisplayLinear.Sym => AOS:/DisplayLinear.Sym ~
-
-FSTools.Unmount AOS ~
-WinDisks.Uninstall PhysicalDrive4 ~
-~

ARM/ARM.A2/Zynq.Gpio.Mod

@@ -1,103 +0,0 @@
-MODULE Gpio; (** AUTHOR "Timothée Martiel"; PURPOSE "GPIO driver"; *)
-
-(*! TODO:
-	- Interrupt configuration
-*)
-
-IMPORT Platform;
-
-CONST
-	(** Direction: Input *)
-	Input *		= FALSE;
-	(** Direction: Output *)
-	Output *	= TRUE;
-
-TYPE
-	DataReg = POINTER {UNSAFE,UNTRACED} TO RECORD
-		DATA: ARRAY 4 OF SET;
-		DATA_RO: ARRAY 4 OF SET;
-	END;
-
-	BankCtrlReg = POINTER {UNSAFE,UNTRACED} TO RECORD
-		DIRM, OEN, INT_MASK, INT_EN, INT_DIS, INT_STAT, INT_TYPE, INT_POLARITY, INT_ANY: SET;
-	END;
-
-VAR
-	bankCtrlRegs: ARRAY 4 OF BankCtrlReg;
-	dataRegs: DataReg;
-	i: LONGINT;
-
-	(** Set the direction of 'gpio' to output if 'out' is TRUE and to input otherwise. *)
-	PROCEDURE SetDirection * (gpio: LONGINT; out: BOOLEAN);
-	VAR
-		bank, ofs: LONGINT;
-	BEGIN
-		GetBankOfs(gpio, bank, ofs);
-		IF (bank < 0) & (ofs < 0) THEN RETURN END;
-
-		IF out THEN
-			INCL(bankCtrlRegs[bank].DIRM, ofs)
-		ELSE
-			EXCL(bankCtrlRegs[bank].DIRM, ofs)
-		END
-	END SetDirection;
-
-	(** If 'on' enable (if 'off' disable) output for 'gpio'. 'gpio' direction must be set to output prior to this call. *)
-	PROCEDURE EnableOutput * (gpio: LONGINT; on: BOOLEAN);
-	VAR
-		bank, ofs: LONGINT;
-	BEGIN
-		GetBankOfs(gpio, bank, ofs);
-		IF (bank < 0) & (ofs < 0) THEN RETURN END;
-
-		IF on THEN
-			INCL(bankCtrlRegs[bank].OEN, ofs)
-		ELSE
-			EXCL(bankCtrlRegs[bank].OEN, ofs)
-		END
-	END EnableOutput;
-
-	(** Set the data of output GPIO 'gpio' to 'data' (TRUE for high, FALSE for low). *)
-	PROCEDURE SetData * (gpio: LONGINT; data: BOOLEAN);
-	VAR
-		bank, ofs: LONGINT;
-	BEGIN
-		GetBankOfs(gpio, bank, ofs);
-		IF (bank < 0) & (ofs < 0) THEN RETURN END;
-
-		IF data THEN
-			INCL(dataRegs.DATA[bank], ofs)
-		ELSE
-			EXCL(dataRegs.DATA[bank], ofs)
-		END
-	END SetData;
-
-	(** Get data of input GPIO 'gpio': TRUE for high, FALSE for low. *)
-	PROCEDURE GetData * (gpio: LONGINT): BOOLEAN;
-	VAR
-		bank, ofs: LONGINT;
-	BEGIN
-		GetBankOfs(gpio, bank, ofs);
-		IF (bank < 0) & (ofs < 0) THEN HALT(100) END;
-
-		RETURN ofs IN dataRegs.DATA_RO[bank]
-	END GetData;
-
-	PROCEDURE GetBankOfs (gpio: LONGINT; VAR bank, ofs: LONGINT);
-	BEGIN
-		IF gpio < 54 THEN
-			bank := gpio DIV 32;
-			ofs := gpio MOD 32
-		ELSE
-			(*! TODO: implement *)
-		END;
-		bank := -1;
-		ofs := -1
-	END GetBankOfs;
-
-BEGIN
-	dataRegs := Platform.GpioData;
-	FOR i := 0 TO Platform.GpioBankNb - 1 DO
-		bankCtrlRegs[i] := Platform.GpioBank[i]
-	END
-END Gpio.

ARM/ARM.A2/Zynq.PrecisionTimer.Mod

@@ -1,30 +0,0 @@
-MODULE PrecisionTimer; (** AUTHOR ""; PURPOSE ""; *)
-
-IMPORT
-	Machine, BootConfig;
-
-TYPE
-	Counter* = HUGEINT;
-
-	(**
-		Query timer counter in ticks
-	*)
-	PROCEDURE GetCounter*(): Counter;
-	BEGIN
-		RETURN Machine.GetTimer();
-	END GetCounter;
-
-	(**
-		Query timer tick frequency in Hz
-	*)
-	PROCEDURE GetFrequency*(): Counter;
-	BEGIN
-		RETURN frequencyInHz;
-	END GetFrequency;
-
-VAR
-	frequencyInHz: Counter;
-
-BEGIN
-	frequencyInHz := BootConfig.GetIntValue("CpuClockHz");
-END PrecisionTimer.

ARM/ARM.A2/Zynq.PrivateWatchdog.Mod

@@ -1,62 +0,0 @@
-MODULE PrivateWatchdog; (** AUTHOR "Timothée Martiel, 11/2017"; PURPOSE "Zynq private watchdog driver"; *)
-IMPORT SYSTEM, Platform;
-
-CONST
-	(** Modes *)
-	Reset * = TRUE; (** Resets the system *)
-	Interrupt * = FALSE; (** Triggers an interrupt *)
-
-	ControlWatchdogEnable = 0;
-	ControlAutoReload = 1;
-	ControlItEnable = 2;
-	ControlWdMode = 3;
-	ControlPrescalerOfs = 8;
-	ControlPrescalerMask = {8 .. 15};
-
-VAR
-	frequency: HUGEINT;
-
-	(** Start the private watchdog with the given mode and delay *)
-	PROCEDURE Start * (mode: BOOLEAN; delay: LONGINT);
-	VAR
-		val: SET;
-	BEGIN
-		ASSERT(frequency > 0);
-		Platform.mpcore.Watchdog_Reset_Status_Register := 1; (* Clear the reset status *)
-		Feed(delay);
-		val := {ControlWatchdogEnable};
-		IF mode THEN
-			(* Reset *)
-			INCL(val, ControlWdMode)
-		ELSE
-			INCL(val, ControlItEnable)
-		END;
-		Platform.mpcore.Watchdog_Control_Register := SYSTEM.VAL(LONGINT, val)
-	END Start;
-
-	(** Stop private watchdog *)
-	PROCEDURE Stop *;
-	BEGIN
-		Platform.mpcore.Watchdog_Disable_Register := Platform.PrivateWatchdogDisableKey0;
-		Platform.mpcore.Watchdog_Disable_Register := LONGINT(Platform.PrivateWatchdogDisableKey1);
-		Platform.mpcore.Watchdog_Control_Register := 0
-	END Stop;
-
-	(** Feed the watchdog: overwrites its count with the given delay *)
-	PROCEDURE Feed * (delay: LONGINT);
-	BEGIN
-		Platform.mpcore.Watchdog_Load_Register := LONGINT(HUGEINT(delay) * frequency);
-	END Feed;
-
-	(** Check if the watchdog has been triggered *)
-	PROCEDURE Triggered * (): BOOLEAN;
-	BEGIN
-		RETURN Platform.mpcore.Watchdog_Reset_Status_Register = 1
-	END Triggered;
-
-	(** Initialise watchdog reference frequency (CPU freq / 2) *)
-	PROCEDURE Init * (timerFrequency: HUGEINT);
-	BEGIN
-		frequency := timerFrequency
-	END Init;
-END PrivateWatchdog.

ARM/ARM.A2/Zynq.PsConfig.Mod

@@ -1,376 +0,0 @@
-(**
-	AUTHOR "Alexey Morozov, HighDim GmbH, 2015";
-	PURPOSE "Interface for system level configuration/control of Zynq Processing System (PS)";
-*)
-MODULE PsConfig;
-
-IMPORT
-	SYSTEM, Platform, BootConfig, Trace;
-
-CONST
-	(** error codes *)
-	Ok* = 0;
-	InvalidChannel* = 1; (** invalid channel (e.g. PL clock channel) specified *)
-	InvalidClockSource* = 2; (** invalid clock source specified *)
-	InvalidDivisor* = 3; (** invalid clock divisor value specified *)
-	InvalidModule* = 4; (** invalid I/O module specified *)
-	InvalidDevice* = 5; (** invalid I/O device for specified module *)
-
-	UnknownError* = 256;
-
-	(** PLL clock source types *)
-	IoPll* = 0; (** IO PLL used as a clock source for IO peripherals *)
-	ArmPll* = 1; (** ARM PLL used as a clock source for the CPU *)
-	DdrPll* = 3; (** DDR PLL used as a clock source for DDR memory *)
-
-	(** I/O Clock Modules *)
-	IoUsb* = 0;
-	IoGem* = 1;
-	IoSdio* = 2;
-	IoSmc* = 3;
-	IoSpi* = 4;
-	IoQuadSpi* = 5;
-	IoUart* = 6;
-	IoCan* = 7;
-	IoGpio* = 8;
-	IoI2c* = 9;
-
-VAR
-	psRefClockHz: HUGEINT;
-
-	(**
-		Get clock frequency of a given PLL clock source
-
-		srcSel: source selector (either of IoPll, ArmPll, DdrPll)
-		res: result code; zero in case of success
-
-		Returns the frequency in Hz
-	*)
-	PROCEDURE GetPllClockFrequency*(srcSel: LONGINT; VAR res: LONGINT): HUGEINT;
-	BEGIN
-		CASE srcSel OF
-			|IoPll: RETURN HUGEINT(LSH(SYSTEM.MSK(Platform.slcr.IO_PLL_CTRL,0x7F000),-12)) * psRefClockHz;
-			|ArmPll: RETURN HUGEINT(LSH(SYSTEM.MSK(Platform.slcr.ARM_PLL_CTRL,0x7F000),-12)) * psRefClockHz;
-			|DdrPll: RETURN HUGEINT(LSH(SYSTEM.MSK(Platform.slcr.DDR_PLL_CTRL,0x7F000),-12)) * psRefClockHz;
-		ELSE
-			res := InvalidClockSource; RETURN 0;
-		END;
-	END GetPllClockFrequency;
-
-	(**
-		Setup reset signals to programming logic
-
-		assertedChannels: specifies the set of PL channels with asserted reset; can include 0, 1, 2, 3
-		res: result code; zero in case of success
-
-		Returns TRUE in case of success
-	*)
-	PROCEDURE SetPlResets*(assertedChannels: SET; VAR res: LONGINT): BOOLEAN;
-	BEGIN
-		IF assertedChannels * {4..31} # {} THEN res := InvalidChannel; RETURN FALSE; END;
-
-		Platform.slcr.SLCR_UNLOCK := Platform.SlcrUnlockKey; (* enable writing to SLCR registers *)
-		Platform.slcr.FPGA_RST_CTRL := assertedChannels;
-		Platform.slcr.SLCR_LOCK := Platform.SlcrLockKey; (* disable writing to SLCR registers *)
-
-		res := Ok;
-		RETURN TRUE;
-	END SetPlResets;
-
-	(**
-		Setup a given channel of Programming Logic (PL) clock
-
-		channel: selected channel (either of 0, 1, 2, 3)
-		srcSel: source selector (either of IoPll, ArmPll, DdrPll)
-		divisor0: provides the divisor used to divide the source clock to generate the required generated clock frequency. First cascade divider.
-		divisor1: provides the divisor used to divide the source clock to generate the required generated clock frequency. Second cascade divider.
-		res: result code; zero in case of success
-
-		Returns TRUE in case of success
-	*)
-	PROCEDURE SetPlClock*(channel: LONGINT; srcSel: LONGINT; divisor0, divisor1: LONGINT; VAR res: LONGINT): BOOLEAN;
-	BEGIN
-		IF (srcSel > 0) OR (srcSel > 3) THEN res := InvalidClockSource; RETURN FALSE; END;
-		IF (divisor0 < 1) OR (divisor0 > 63) OR (divisor1 < 0) OR (divisor1 > 63) THEN res := InvalidDivisor; RETURN FALSE; END;
-
-		Platform.slcr.SLCR_UNLOCK := Platform.SlcrUnlockKey; (* enable writing to SLCR registers *)
-
-		CASE channel OF
-			|0: Platform.slcr.FPGA0_CLK_CTRL := srcSel + LSH(divisor0,8) + LSH(divisor1,20);
-			|1: Platform.slcr.FPGA1_CLK_CTRL := srcSel + LSH(divisor0,8) + LSH(divisor1,20);
-			|2: Platform.slcr.FPGA2_CLK_CTRL := srcSel + LSH(divisor0,8) + LSH(divisor1,20);
-			|3: Platform.slcr.FPGA3_CLK_CTRL := srcSel + LSH(divisor0,8) + LSH(divisor1,20);
-		ELSE
-			Platform.slcr.SLCR_LOCK := Platform.SlcrLockKey; (* disable writing to SLCR registers *)
-			res := InvalidChannel;
-			RETURN FALSE;
-		END;
-
-		Platform.slcr.SLCR_LOCK := Platform.SlcrLockKey; (* disable writing to SLCR registers *)
-
-		res := Ok;
-		RETURN TRUE;
-	END SetPlClock;
-
-	(**
-		Get clock frequency of a given PL clock channel
-
-		res: result code; zero in case of success
-
-		Returns the frequency in Hz
-	*)
-	PROCEDURE GetPlClockFrequency*(channel: LONGINT; VAR res: LONGINT): HUGEINT;
-	VAR
-		d, srcSel, divisor0, divisor1: LONGINT;
-	BEGIN
-		CASE channel OF
-			|0: d := Platform.slcr.FPGA0_CLK_CTRL;
-			|1: d := Platform.slcr.FPGA1_CLK_CTRL;
-			|2: d := Platform.slcr.FPGA2_CLK_CTRL;
-			|3: d := Platform.slcr.FPGA3_CLK_CTRL;
-		ELSE
-			res := InvalidChannel;
-			RETURN 0;
-		END;
-
-		srcSel := LSH(SYSTEM.MSK(d,0x30),-4);
-		divisor0 := LSH(SYSTEM.MSK(d,0x3F00),-8);
-		divisor1 := LSH(SYSTEM.MSK(d,0x3F00000),-20);
-
-		RETURN GetPllClockFrequency(srcSel,res) DIV (divisor0*divisor1);
-	END GetPlClockFrequency;
-
-	(**
-		Stop a given PL clock
-
-		channel: clock channel number
-		res: result code; zero in case of success
-
-		Returns TRUE in case of success
-	*)
-	PROCEDURE StopPlClock*(channel: LONGINT; VAR res: LONGINT): BOOLEAN;
-	BEGIN
-
-		Platform.slcr.SLCR_UNLOCK := Platform.SlcrUnlockKey; (* enable writing to SLCR registers *)
-
-		CASE channel OF
-			|0: Platform.slcr.FPGA0_THR_CNT := 1;
-			|1: Platform.slcr.FPGA1_THR_CNT := 1;
-			|2: Platform.slcr.FPGA2_THR_CNT := 1;
-			|3: Platform.slcr.FPGA3_THR_CNT := 1;
-		ELSE
-			Platform.slcr.SLCR_LOCK := Platform.SlcrLockKey; (* disable writing to SLCR registers *)
-			res := InvalidChannel;
-			RETURN FALSE;
-		END;
-
-		Platform.slcr.SLCR_LOCK := Platform.SlcrLockKey; (* disable writing to SLCR registers *)
-
-		res := Ok;
-		RETURN TRUE;
-	END StopPlClock;
-
-	(**
-		Start a given PL clock
-
-		channel: clock channel number
-		res: result code; zero in case of success
-
-		Returns TRUE in case of success
-	*)
-	PROCEDURE StartPlClock*(channel: LONGINT; VAR res: LONGINT): BOOLEAN;
-	BEGIN
-		Platform.slcr.SLCR_UNLOCK := Platform.SlcrUnlockKey; (* enable writing to SLCR registers *)
-
-		CASE channel OF
-			|0: Platform.slcr.FPGA0_THR_CNT := 0;
-			|1: Platform.slcr.FPGA1_THR_CNT := 0;
-			|2: Platform.slcr.FPGA2_THR_CNT := 0;
-			|3: Platform.slcr.FPGA3_THR_CNT := 0;
-		ELSE
-			Platform.slcr.SLCR_LOCK := Platform.SlcrLockKey; (* disable writing to SLCR registers *)
-			res := InvalidChannel;
-			RETURN FALSE;
-		END;
-
-		Platform.slcr.SLCR_LOCK := Platform.SlcrLockKey; (* disable writing to SLCR registers *)
-
-		res := Ok;
-		RETURN TRUE;
-	END StartPlClock;
-
-	(**
-		Stop given PL clocks
-
-		channels: a set of clock channels to stop
-		res: result code; zero in case of success
-
-		Returns TRUE in case of success
-	*)
-	PROCEDURE StopPlClocks*(channels: SET; VAR res: LONGINT): BOOLEAN;
-	BEGIN
-		IF channels * {0,1,2,3} = {} THEN res := InvalidChannel; RETURN FALSE; END;
-
-		Platform.slcr.SLCR_UNLOCK := Platform.SlcrUnlockKey; (* enable writing to SLCR registers *)
-
-		IF 0 IN channels THEN Platform.slcr.FPGA0_THR_CNT := 1; END;
-		IF 1 IN channels THEN Platform.slcr.FPGA1_THR_CNT := 1; END;
-		IF 2 IN channels THEN Platform.slcr.FPGA2_THR_CNT := 1; END;
-		IF 3 IN channels THEN Platform.slcr.FPGA3_THR_CNT := 1; END;
-
-		Platform.slcr.SLCR_LOCK := Platform.SlcrLockKey; (* disable writing to SLCR registers *)
-
-		res := Ok;
-		RETURN TRUE;
-	END StopPlClocks;
-
-	(**
-		Start given PL clocks
-
-		channels: a set of clock channels to start
-		res: result code; zero in case of success
-
-		Returns TRUE in case of success
-	*)
-	PROCEDURE StartPlClocks*(channels: SET; VAR res: LONGINT): BOOLEAN;
-	BEGIN
-		IF channels * {0,1,2,3} = {} THEN res := InvalidChannel; RETURN FALSE; END;
-
-		Platform.slcr.SLCR_UNLOCK := Platform.SlcrUnlockKey; (* enable writing to SLCR registers *)
-
-		IF 0 IN channels THEN Platform.slcr.FPGA0_THR_CNT := 0; END;
-		IF 1 IN channels THEN Platform.slcr.FPGA1_THR_CNT := 0; END;
-		IF 2 IN channels THEN Platform.slcr.FPGA2_THR_CNT := 0; END;
-		IF 3 IN channels THEN Platform.slcr.FPGA3_THR_CNT := 0; END;
-
-		Platform.slcr.SLCR_LOCK := Platform.SlcrLockKey; (* disable writing to SLCR registers *)
-
-		res := Ok;
-		RETURN TRUE;
-	END StartPlClocks;
-
-	PROCEDURE GetIoClockFrequency*(module: LONGINT; VAR res: LONGINT): HUGEINT;
-	VAR
-		baseFreq: HUGEINT;
-		val: LONGINT;
-	BEGIN
-		CASE module OF
-			 IoUsb: (*!TODO*)
-			|IoGem: (*!TODO*)
-			|IoSdio: val := Platform.slcr.SDIO_CLK_CTRL;
-			|IoSmc: val := Platform.slcr.SMC_CLK_CTRL;
-			|IoSpi: val := Platform.slcr.SPI_CLK_CTRL;
-			|IoQuadSpi: val := Platform.slcr.LQSPI_CLK_CTRL;
-			|IoUart: val := Platform.slcr.UART_CLK_CTRL;
-			|IoCan: (*!TODO*)
-			|IoGpio: (*!TODO*)
-			|IoI2c: (*!TODO*)
-		ELSE
-			res := InvalidModule;
-			RETURN 0;
-		END;
-		CASE module OF
-			 IoUsb: (*!TODO*)
-			|IoGem: (*!TODO*)
-			|IoSdio, IoSmc, IoSpi, IoQuadSpi, IoUart:
-				val := LSH(SYSTEM.MSK(val, 0x3f00), -8)
-			|IoCan:(*!TODO*)
-			|IoGpio:(*!TODO*)
-			|IoI2c:(*!TODO*)
-		END;
-		baseFreq := GetPllClockFrequency(GetIoClockSource(module, res), res);
-		IF res # Ok THEN RETURN 0 END;
-		RETURN baseFreq DIV val
-	END GetIoClockFrequency;
-
-	PROCEDURE GetIoClockSource*(module: LONGINT; VAR res: LONGINT): LONGINT;
-	VAR
-		pll, val: LONGINT;
-	BEGIN
-		res := Ok;
-		CASE module OF
-			 IoUsb: (*!TODO*)
-			|IoGem: (*!TODO*)
-			|IoSdio: val := Platform.slcr.SDIO_CLK_CTRL;
-			|IoSmc: val := Platform.slcr.SMC_CLK_CTRL;
-			|IoSpi: val := Platform.slcr.SPI_CLK_CTRL;
-			|IoQuadSpi: val := Platform.slcr.LQSPI_CLK_CTRL;
-			|IoUart: val := Platform.slcr.UART_CLK_CTRL;
-			|IoCan: (*!TODO*)
-			|IoGpio: (*!TODO*)
-			|IoI2c: (*!TODO*)
-		ELSE
-			res := InvalidModule;
-			RETURN -1;
-		END;
-		CASE module OF
-			 IoUsb: (*!TODO*)
-			|IoGem: (*!TODO*)
-			|IoSdio, IoSmc, IoSpi, IoQuadSpi, IoUart:
-				pll := LSH(SYSTEM.MSK(val, 0x30), -4);
-				IF pll = 2 THEN pll := ArmPll END;
-			|IoCan:(*!TODO*)
-			|IoGpio:(*!TODO*)
-			|IoI2c:(*!TODO*)
-		END;
-		RETURN pll
-	END GetIoClockSource;
-
-	PROCEDURE SetIoClockFrequency*(module: LONGINT; freq: HUGEINT; VAR res: LONGINT): BOOLEAN;
-	VAR
-		baseFreq: HUGEINT;
-		val, div: LONGINT;
-	BEGIN
-		res := Ok;
-		CASE module OF
-			 IoUsb: (*!TODO*)
-			|IoGem: (*!TODO*)
-			|IoSdio: val := Platform.slcr.SDIO_CLK_CTRL;
-			|IoSmc: val := Platform.slcr.SMC_CLK_CTRL;
-			|IoSpi: val := Platform.slcr.SPI_CLK_CTRL;
-			|IoQuadSpi: val := Platform.slcr.LQSPI_CLK_CTRL;
-			|IoUart: val := Platform.slcr.UART_CLK_CTRL;
-			|IoCan: (*!TODO*)
-			|IoGpio: (*!TODO*)
-			|IoI2c: (*!TODO*)
-		ELSE
-			res := InvalidModule;
-			RETURN FALSE;
-		END;
-		baseFreq := GetPllClockFrequency(GetIoClockSource(module, res), res);
-		IF res # Ok THEN RETURN FALSE END;
-
-		Platform.slcr.SLCR_UNLOCK := Platform.SlcrUnlockKey; (* enable writing to SLCR registers *)
-		CASE module OF
-			 IoUsb: (*!TODO*)
-			|IoGem: (*!TODO*)
-			|IoSdio, IoSmc, IoSpi, IoQuadSpi, IoUart:
-				div := LONGINT(baseFreq DIV freq);
-				val := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, val) - {8 .. 13} + SYSTEM.VAL(SET, LSH(div, 8)) * {8 .. 13});
-				Platform.slcr.SDIO_CLK_CTRL := val
-			|IoCan:(*!TODO*)
-			|IoGpio:(*!TODO*)
-			|IoI2c:(*!TODO*)
-		END;
-		Platform.slcr.SLCR_LOCK := Platform.SlcrLockKey; (* disable writing to SLCR registers *)
-		RETURN TRUE
-	END SetIoClockFrequency;
-
-	PROCEDURE SetIoClockSource*(module, source: LONGINT; VAR res: LONGINT): BOOLEAN;
-	BEGIN
-		
-	END SetIoClockSource;
-
-	PROCEDURE StartIoClock*(module, device: LONGINT; VAR res: LONGINT): BOOLEAN;
-	BEGIN
-		
-	END StartIoClock;
-
-	PROCEDURE StopIoClock*(module, device: LONGINT; VAR res: LONGINT): BOOLEAN;
-	BEGIN
-		
-	END StopIoClock;
-
-BEGIN
-	psRefClockHz := BootConfig.GetIntValue("PsRefClockHz");
-END PsConfig.

ARM/ARM.A2/Zynq.PsSerials.Mod

@@ -1,136 +0,0 @@
-MODULE PsSerials; (** AUTHOR "Timothée Martiel, 11/2017"; PURPOSE "Serial interface for Zynq PS UARTs"; *)
-
-IMPORT Platform, BootConfig, Modules, Strings, PsUartMin, PsUart, Serials, Objects, Machine;
-
-TYPE
-	Port = OBJECT (Serials.Port)
-	VAR
-		uart: PsUart.UartController;
-		
-		sendCharLock := FALSE : BOOLEAN;
-
-		PROCEDURE & Init (id: LONGINT);
-		BEGIN
-			uart := PsUart.GetUart(id);
-			ASSERT(uart # NIL);
-		END Init;
-
-		PROCEDURE Open (bps, data, parity, stop : LONGINT; VAR res: LONGINT);
-		BEGIN{EXCLUSIVE}
-			PsUart.Open(uart, bps, data, parity, stop, res);
-		END Open;
-
-		PROCEDURE Close;
-		BEGIN{EXCLUSIVE}
-			PsUart.Close(uart);
-		END Close;
-
-		PROCEDURE Yield(VAR res: LONGINT): BOOLEAN;
-		BEGIN
-			IF uart.open THEN
-				Objects.Yield;
-				RETURN TRUE;
-			ELSE
-				res := Serials.Closed;
-				RETURN FALSE;
-			END;
-		END Yield;
-
-		PROCEDURE Yield0(VAR res: LONGINT): BOOLEAN;
-		BEGIN
-			IF uart.open THEN
-				RETURN TRUE;
-			ELSE
-				res := Serials.Closed;
-				RETURN FALSE;
-			END;
-		END Yield0;
-
-		PROCEDURE SendChar(char: CHAR; VAR res: LONGINT);
-		BEGIN
-			Machine.AcquireObject(sendCharLock);
-			(*! use Yield0 method to make sure no low-level lock is acquired here - required when used as trace output *)
-			PsUart.SendChar(uart, char, TRUE, Yield0, res);
-		FINALLY
-			Machine.ReleaseObject(sendCharLock);
-		END SendChar;
-
-		PROCEDURE Send(CONST buf: ARRAY OF CHAR; ofs, len: LONGINT; propagate: BOOLEAN; VAR res: LONGINT);
-		BEGIN
-			PsUart.Send(uart, buf, ofs, len, propagate, Yield, res);
-		END Send;
-
-		PROCEDURE ReceiveChar(VAR char: CHAR; VAR res: LONGINT);
-		BEGIN
-			char := PsUart.ReceiveChar(uart, Yield, res);
-		END ReceiveChar;
-
-		PROCEDURE Receive(VAR buf: ARRAY OF CHAR; ofs, size, min: LONGINT; VAR len, res: LONGINT);
-		BEGIN
-			PsUart.Receive(uart, buf, ofs, size, min, len, Yield, res);
-		END Receive;
-
-		PROCEDURE Available(): LONGINT;
-		BEGIN
-			RETURN PsUart.Available(uart);
-		END Available;
-
-		PROCEDURE GetPortState(VAR openstat : BOOLEAN; VAR bps, data, parity, stop : LONGINT);
-		BEGIN{EXCLUSIVE}
-			openstat := uart.open;
-			bps := uart.bps;
-			data := uart.data;
-			parity := uart.parity;
-			stop := uart.stop;
-		END GetPortState;
-
-	END Port;
-
-VAR
-	ports: ARRAY 2 OF Port;
-
-	PROCEDURE Init;
-	VAR
-		i, clk, res: LONGINT;
-		name, desc: ARRAY 32 OF CHAR;
-		tracePort: LONGINT;
-	BEGIN
-		clk := BootConfig.GetIntValue("UartInputClockHz");
-		FOR i := 0 TO LEN(Platform.UartBase,0)-1 DO
-			PsUart.Install(i, Platform.UartBase[i], clk, res);
-		END;
-
-		(* if one of PS UART's is used for tracing, make the corresponding port open to allow trace output via PsUartMin *)
-		tracePort := BootConfig.GetIntValue("TracePort");
-		IF (tracePort >= 1) & (tracePort <= LEN(Platform.UartBase,0)) THEN
-			PsUart.Open(PsUart.GetUart(tracePort-1), BootConfig.GetIntValue("TraceBPS"),PsUartMin.DefaultDataBits,PsUartMin.DefaultParity,PsUartMin.DefaultStop, res);
-		ELSE tracePort := -1;
-		END;
-
-		FOR i := 0 TO LEN(ports) - 1 DO
-			NEW(ports[i], i);
-			name := "UART";
-			Strings.AppendInt(name, i+1);
-			desc := "Zynq PS UART";
-			Strings.AppendInt(desc, i);
-			Serials.RegisterOnboardPort(i+1, ports[i], name, desc);
-		END;
-
-		IF tracePort >= 0 THEN
-			(* switch from PsUartMin to port-based trace output *)
-			Serials.SetTracePort(tracePort, BootConfig.GetIntValue("TraceBPS"),PsUartMin.DefaultDataBits,PsUartMin.DefaultParity,PsUartMin.DefaultStop, res);
-		END;
-		Modules.InstallTermHandler(Cleanup)
-	END Init;
-
-	PROCEDURE Cleanup;
-	VAR i: LONGINT;
-	BEGIN
-		FOR i := 0 TO LEN(ports) - 1 DO
-			IF ports[i] # NIL THEN Serials.UnRegisterPort(ports[i]) END
-		END
-	END Cleanup;
-
-BEGIN
-	Init
-END PsSerials.

ARM/ARM.A2/Zynq.PsTraceDevice.Mod

@@ -1,37 +0,0 @@
-MODULE TraceDevice;
-(**
-	AUTHOR: Timothee Martiel, Alexey Morozov, HighDim GmbH, 2013-2017
-	PURPOSE: simple abtraction for installing kernel tracing over Zynq PS UART
-*)
-
-IMPORT SYSTEM, Platform, BootConfig, Trace, PsUartMin;
-
-VAR
-	uart: PsUartMin.UartRegisters;
-
-	PROCEDURE TraceChar(ch: CHAR);
-	VAR ignore: LONGINT;
-	BEGIN
-		PsUartMin.SendChar(uart, ch, TRUE, NIL, ignore);
-	END TraceChar;
-
-	PROCEDURE Install *;
-	VAR
-		uartId: LONGINT;
-		res: LONGINT;
-	BEGIN
-		Trace.Init;
-		uartId := BootConfig.GetIntValue("TracePort")-1;
-
-		PsUartMin.Install(uartId, Platform.UartBase[uartId], BootConfig.GetIntValue("UartInputClockHz"), res);
-		IF res # 0 THEN RETURN; END;
-
-		uart := PsUartMin.GetUart(uartId);
-
-		IF ~PsUartMin.SetBps(uart, BootConfig.GetIntValue("TraceBPS"), res) THEN RETURN; END;
-		PsUartMin.Enable(uart,TRUE);
-
-		Trace.Char := TraceChar;
-	END Install;
-
-END TraceDevice.

ARM/ARM.A2/Zynq.PsUart.Mod

@@ -1,541 +0,0 @@
-MODULE PsUart;
-(**
-	AUTHOR: Alexey Morozov, Timothee Martiel, HighDim GmbH, 2013-2018
-	PURPOSE: driver implementation for Xilinx Zynq UART PS controller
-*)
-
-IMPORT SYSTEM, UartMin := PsUartMin, PsUartInterrupts, Trace;
-
-CONST
-	(** Receive errors - compatible with A2 Serials *)
-	OverrunError* = 10;
-	ParityError* = 11;
-	FramingError* = 12;
-	BreakInterrupt* = 13;
-
-	DefaultRxBufSize* = 4096;
-	DefaultTxBufSize* = 4096;
-
-	ReceiveTimeoutInUs* = 500; (** Receive timeout in microseconds *)
-
-	(* RX data interrupts *)
-	RxDataInterrupts = {UartMin.XUARTPS_IXR_TOUT , UartMin.XUARTPS_IXR_RXFULL , UartMin.XUARTPS_IXR_RXOVR};
-
-	(* RX error interrupts *)
-	RxErrorInterrupts = {UartMin.XUARTPS_IXR_PARITY , UartMin.XUARTPS_IXR_FRAMING , UartMin.XUARTPS_IXR_OVER};
-
-	(* TX data interrupts *)
-	TxDataInterrupts = {UartMin.XUARTPS_IXR_TXEMPTY, UartMin.XUARTPS_IXR_TTRIG};
-
-	(* TX error interrupts *)
-	TxErrorInterrupts = {UartMin.XUARTPS_IXR_TOVR};
-
-TYPE
-
-	UartController* = POINTER TO RECORD
-		id-: LONGINT; (** UART controller ID *)
-		regs-: UartMin.UartRegisters; (** controller registers *)
-		inputClock-: LONGINT; (** controller input clock in Hz *)
-		bps-, data-, parity-, stop-: LONGINT; (** current parameter values *)
-
-		open-: BOOLEAN; (** TRUE if the controller is open *)
-
-		rxBuf: POINTER TO ARRAY OF CHAR; (* receive (RX) circular buffer *)
-		rxBufRdPos, rxBufWrPos: LONGINT; (* RX buffer read and write positions *)
-
-		txBuf: POINTER TO ARRAY OF CHAR; (* transmit (TX) circular buffer *)
-		txBufRdPos, txBufWrPos: LONGINT; (* TX buffer read and write positions *)
-
-		errors: SET;
-	END;
-
-VAR
-	uarts: ARRAY 2 OF UartController;
-
-	(* Disable all UART interrupts *)
-	PROCEDURE DisableInterrupts(regs: UartMin.UartRegisters);
-	BEGIN
-		regs.idr := UartMin.XUARTPS_IXR_MASK;
-	END DisableInterrupts;
-
-	PROCEDURE IntrHandler(param: ANY);
-	VAR
-		uart: UartController;
-		intrStatus: SET;
-	BEGIN
-		uart := param(UartController);
-		(*Trace.String("imr="); Trace.Set(uart.regs.imr); Trace.Ln;
-		Trace.String("isr="); Trace.Set(uart.regs.isr); Trace.Ln;*)
-
-		intrStatus := uart.regs.imr * uart.regs.isr;
-		uart.regs.isr := intrStatus; (* clear the interrupt *)
-
-		(*Trace.String("intrStatus="); Trace.Set(intrStatus); Trace.Ln;*)
-
-		IF intrStatus * (RxDataInterrupts+RxErrorInterrupts) # {} THEN
-			IntrHandlerRx(uart,intrStatus);
-		END;
-
-		IF intrStatus * TxDataInterrupts # {} THEN
-			IntrHandlerTx(uart,intrStatus);
-		END;
-	END IntrHandler;
-
-	PROCEDURE IntrHandlerRx(uart: UartController; intrStatus: SET);
-	VAR
-		bufWrPos: LONGINT;
-	BEGIN
-
-		IF intrStatus * RxErrorInterrupts # {} THEN
-			IF UartMin.XUARTPS_IXR_OVER IN intrStatus THEN
-				INCL(uart.errors,OverrunError);
-				Trace.String("---rx overrun(1)---: intrStatus="); Trace.Set(intrStatus); Trace.Ln;
-				RETURN;
-			END;
-		END;
-
-		bufWrPos := uart.rxBufWrPos;
-
-		WHILE ~(UartMin.XUARTPS_SR_RXEMPTY IN uart.regs.sr) DO
-
-			uart.rxBuf[bufWrPos] := CHR(uart.regs.fifo);
-			INC(bufWrPos);
-			IF bufWrPos = LEN(uart.rxBuf) THEN
-				bufWrPos := 0;
-			END;
-
-			IF bufWrPos = uart.rxBufRdPos THEN
-				INCL(uart.errors,OverrunError);
-				Trace.String("---rx overrun(2)---: intrStatus="); Trace.Set(intrStatus); Trace.Ln;
-				RETURN;
-			END;
-		END;
-
-		uart.rxBufWrPos := bufWrPos;
-	END IntrHandlerRx;
-
-	PROCEDURE IntrHandlerTx(uart: UartController; intrStatus: SET);
-	VAR bufRdPos: LONGINT;
-	BEGIN
-		IF intrStatus * TxErrorInterrupts # {} THEN
-			IF UartMin.XUARTPS_IXR_TOVR IN intrStatus THEN
-				INCL(uart.errors,OverrunError);
-				Trace.String("---tx overrun---: intrStatus="); Trace.Set(intrStatus); Trace.Ln;
-				RETURN;
-			END;
-		END;
-
-		bufRdPos := uart.txBufRdPos;
-
-		WHILE (bufRdPos # uart.txBufWrPos) & ~(UartMin.XUARTPS_SR_TXFULL IN uart.regs.sr) DO
-			uart.regs.fifo := ORD(uart.txBuf[bufRdPos]);
-			INC(bufRdPos);
-			IF bufRdPos = LEN(uart.txBuf) THEN
-				bufRdPos := 0;
-			END;
-		END;
-
-		(* disable TX data interrupts if the buffer is empty *)
-		IF bufRdPos = uart.txBufWrPos THEN
-			uart.regs.idr := uart.regs.idr + TxDataInterrupts;
-		END;
-
-		uart.txBufRdPos := bufRdPos;
-	END IntrHandlerTx;
-
-	(*
-		Returns TRUE if a cyclic buffer is full
-	*)
-	PROCEDURE BufIsFull(bufWrPos, bufRdPos, bufSize: LONGINT): BOOLEAN;
-	BEGIN
-		IF bufWrPos # (bufSize-1) THEN
-			RETURN bufRdPos = (bufWrPos+1);
-		ELSE
-			RETURN bufRdPos = 0;
-		END;
-	END BufIsFull;
-
-	(**
-		Install a UART controller present in the system
-
-		uart: ID (0-based index) of the UART controller to install
-		base: controller base address
-		inputClock: controller input clock in Hz
-		res: returned error code, 0 in case of success
-	*)
-	PROCEDURE Install* (uart: LONGINT; base: ADDRESS; inputClock: LONGINT; VAR res: LONGINT);
-	VAR ctl: UartController;
-	BEGIN
-		UartMin.Install(uart, base, inputClock, res);
-		IF res # 0 THEN RETURN; END;
-
-		NEW(ctl);
-		uarts[uart] := ctl;
-
-		ctl.id := uart;
-		ctl.regs := UartMin.GetUart(uart);
-		ctl.inputClock := inputClock;
-		ctl.open := FALSE;
-		ctl.bps := UartMin.DefaultBPS;
-		ctl.data := UartMin.DefaultDataBits;
-		ctl.parity := UartMin.DefaultParity;
-		ctl.stop := UartMin.DefaultStop;
-
-		NEW(ctl.rxBuf,DefaultRxBufSize);
-		NEW(ctl.txBuf,DefaultTxBufSize);
-
-		ASSERT(PsUartInterrupts.InstallInterruptHandler(uart,IntrHandler,ctl));
-	END Install;
-
-	(**
-		Get UART controller with a given ID
-
-		uart: UART controller ID
-
-		Returns NIL in case if no controller with given ID has been installed
-	*)
-	PROCEDURE GetUart*(uart: LONGINT): UartController;
-	BEGIN
-		IF (uart >= 0) & (uart < LEN(uarts)) THEN
-			RETURN uarts[uart];
-		ELSE RETURN NIL;
-		END;
-	END GetUart;
-
-	(**
-		Open a UART controller
-
-		uart: UART controller
-		bps: baudrate
-		data: number of data bits
-		parity: parity control
-		stop: number of stop bits
-		res: returned error code, 0 in case of success
-	*)
-	PROCEDURE Open*(uart: UartController; bps, data, parity, stop: LONGINT; VAR res: LONGINT);
-	VAR n: LONGINT;
-	BEGIN
-		IF uart.open THEN res := UartMin.PortInUse; RETURN; END;
-
-		UartMin.Reset(uart.regs);
-
-		IF ~UartMin.SetBps(uart.regs, bps, res) OR
-			~UartMin.SetDataBits(uart.regs, data, res) OR
-			~UartMin.SetParity(uart.regs, parity, res) OR
-			~UartMin.SetStopBits(uart.regs, stop, res) THEN  RETURN;
-		END;
-
-		uart.bps := bps;
-		uart.data := data;
-		uart.parity := parity;
-		uart.stop := stop;
-
-		uart.rxBufWrPos := 0;
-		uart.rxBufRdPos := 0;
-
-		uart.txBufWrPos := 0;
-		uart.txBufRdPos := 0;
-
-		(* configure receive timeout to be as close as possible to ReceiveTimeoutInUs *)
-		n := ENTIER((ReceiveTimeoutInUs*REAL(bps)+1000000) / 4000000 + 0.5);
-		n := MAX(1,MIN(255,n-1));
-		TRACE(n);
-		uart.regs.rxtout := n;
-
-		uart.regs.cr := uart.regs.cr + {UartMin.XUARTPS_CR_TORST}; (* restart receive timeout counter *)
-
-		uart.regs.rxwm := 32; (* RX FIFO triggering threshold *)
-
-		uart.regs.txwm := 32; (* TX FIFO triggering threshold *)
-
-		uart.regs.ier := (RxDataInterrupts+RxErrorInterrupts+TxErrorInterrupts);
-
-		UartMin.Enable(uart.regs,TRUE);
-		
-		res := 0;
-		uart.open := TRUE;
-	END Open;
-
-	(**
-		Close a UART controller
-
-		uart: UART controller
-	*)
-	PROCEDURE Close*(uart: UartController);
-	BEGIN
-		uart.open := FALSE;
-		DisableInterrupts(uart.regs);
-		UartMin.Enable(uart.regs,FALSE);
-	END Close;
-
-	PROCEDURE OccupiedBufSpace(bufWrPos, bufRdPos, bufSize: LONGINT): LONGINT;
-	VAR n: LONGINT;
-	BEGIN
-		n := bufWrPos - bufRdPos;
-		IF n >= 0 THEN
-			RETURN n;
-		ELSE
-			RETURN n+bufSize;
-		END;
-	END OccupiedBufSpace;
-
-	(* Returns the amount of available free space in a cyclic buffer *)
-	PROCEDURE AvailableBufSpace(bufWrPos, bufRdPos, bufSize: LONGINT): LONGINT;
-	VAR n: LONGINT;
-	BEGIN
-		n := bufWrPos - bufRdPos;
-		IF n >= 0 THEN
-			RETURN bufSize-1-n;
-		ELSE
-			RETURN -n-1;
-		END;
-	END AvailableBufSpace;
-
-	(**
-		Returns number of bytes available in the receive buffer of a UART controller
-
-		uart: UART controller
-		res: error code, 0 in case of success
-	*)
-	PROCEDURE Available*(uart: UartController): LONGINT;
-	BEGIN
-		RETURN OccupiedBufSpace(uart.rxBufWrPos,uart.rxBufRdPos,LEN(uart.rxBuf));
-	END Available;
-
-	(**
-		Send a single character to the UART
-
-		ch: character to send
-		propagate: TRUE for flushing the TX FIFO buffer
-		res: error code, 0 in case of success
-	*)
-	PROCEDURE SendChar*(uart: UartController; ch: CHAR; propagate: BOOLEAN; onBusy: UartMin.BusyLoopCallback; VAR res: LONGINT);
-	BEGIN
-		(*! for the moment just write directly to the FIFO *)
-		res := 0;
-		WHILE uart.open DO
-			IF ~(UartMin.XUARTPS_SR_TNFUL IN uart.regs.sr) THEN
-				uart.regs.fifo := ORD(ch); RETURN;
-			END;
-		END;
-		
-		res := UartMin.Closed;
-	(*TYPE ArrayOfChar1 = ARRAY 1 OF CHAR;
-	BEGIN
-		(*!TODO: do not use interrupts here to avoid problems when SendChar is used for trace output *)
-		Send(uart, SYSTEM.VAL(ArrayOfChar1,ch), 0, 1, propagate, onBusy, res);*)
-	END SendChar;
-
-	(**
-		Send data to the UART
-	*)
-	PROCEDURE Send*(uart: UartController; CONST buf: ARRAY OF CHAR; offs, len: LONGINT; propagate: BOOLEAN; onBusy: UartMin.BusyLoopCallback; VAR res: LONGINT);
-	VAR
-		bufWrPos, n: LONGINT;
-	BEGIN
-
-		IF ~uart.open THEN res := UartMin.Closed; RETURN; END;
-
-		WHILE uart.open & (len > 0) DO
-
-			bufWrPos := uart.txBufWrPos;
-			n := AvailableBufSpace(bufWrPos,uart.txBufWrPos,LEN(uart.txBuf));
-
-			IF n # 0 THEN
-
-				n := MIN(n,len);
-				DEC(len,n);
-
-				WHILE n > 0 DO
-					uart.txBuf[bufWrPos] := buf[offs];
-					INC(bufWrPos);
-					IF bufWrPos = LEN(uart.txBuf) THEN
-						bufWrPos := 0;
-					END;
-					INC(offs); DEC(n);
-				END;
-
-				uart.txBufWrPos := bufWrPos;
-
-				(* enable TX interrupts *)
-				uart.regs.ier := uart.regs.ier + TxDataInterrupts;
-			ELSE
-				(* enable TX interrupts *)
-				uart.regs.ier := uart.regs.ier + TxDataInterrupts;
-				IF (onBusy # NIL) & ~onBusy(res) THEN RETURN; END;
-			END;
-		END;
-
-		IF propagate THEN
-			(* flush the buffer *)
-			WHILE uart.open & (uart.txBufRdPos # uart.txBufWrPos) DO
-				IF (onBusy # NIL) & ~onBusy(res) THEN RETURN; END;
-			END;
-
-			(* flush the FIFO *)
-			WHILE uart.open & ~(UartMin.XUARTPS_SR_TXEMPTY IN uart.regs.sr) DO
-				IF (onBusy # NIL) & ~onBusy(res) THEN RETURN; END;
-			END;
-		END;
-
-		IF uart.open THEN
-			res := 0;
-		ELSE
-			IF OverrunError IN uart.errors THEN res := OverrunError;
-			ELSE res := UartMin.Closed;
-			END;
-		END;
-(*	BEGIN
-
-		WHILE uart.open & (len > 0) DO
-			IF ~(UartMin.XUARTPS_SR_TNFUL IN uart.regs.sr) THEN
-				uart.regs.fifo := ORD(buf[offs]);
-				INC(offs); DEC(len);
-			ELSIF (onBusy # NIL) & ~onBusy(res) THEN
-				RETURN;
-			END;
-		END;
-
-		IF propagate THEN (* flush the FIFO *)
-			WHILE uart.open & ~(UartMin.XUARTPS_SR_TXEMPTY IN uart.regs.sr) DO
-				IF (onBusy # NIL) & ~onBusy(res) THEN RETURN; END;
-			END;
-		END;
-
-		IF uart.open THEN
-			res := UartMin.Ok;
-		ELSE
-			res := UartMin.Closed;
-		END;*)
-	END Send;
-
-	(**
-		Receive a single character from UART
-
-		res: error code, 0 in case of success
-
-		Remarks: blocks until a character is available
-	*)
-	PROCEDURE ReceiveChar*(uart: UartController; onBusy: UartMin.BusyLoopCallback; VAR res: LONGINT): CHAR;
-	VAR
-		buf: ARRAY 1 OF CHAR;
-		len: LONGINT;
-	BEGIN
-		Receive(uart,buf,0,1,1,len,onBusy,res);
-		RETURN buf[0];
-	END ReceiveChar;
-
-	(**
-		Receive data from the UART
-	*)
-	PROCEDURE Receive*(uart: UartController; VAR buf: ARRAY OF CHAR; offs, size, min: LONGINT; VAR len: LONGINT; onBusy: UartMin.BusyLoopCallback; VAR res: LONGINT);
-	VAR
-		bufRdPos, n: LONGINT;
-	BEGIN
-		IF ~uart.open THEN res := UartMin.Closed; RETURN; END;
-
-		res := 0;
-		len := 0;
-
-		IF size = 0 THEN RETURN; END;
-
-		min := MIN(size,min);
-
-		WHILE uart.open & (size > 0) DO
-
-			bufRdPos := uart.rxBufRdPos;
-
-			n := OccupiedBufSpace(uart.rxBufWrPos,bufRdPos,LEN(uart.rxBuf));
-
-			IF n # 0 THEN
-
-				n := MIN(n,size);
-				DEC(size,n); INC(len,n);
-				IF min > 0 THEN DEC(min,n); END;
-
-				WHILE n > 0 DO
-					buf[offs] := uart.rxBuf[bufRdPos];
-					INC(bufRdPos);
-					IF bufRdPos = LEN(uart.rxBuf) THEN
-						bufRdPos := 0;
-					END;
-					INC(offs); DEC(n);
-				END;
-
-				uart.rxBufRdPos := bufRdPos;
-
-			ELSIF min > 0 THEN
-				IF (onBusy # NIL) & ~onBusy(res) THEN RETURN; END;
-			ELSE
-				RETURN;
-			END;
-		END;
-
-	(*BEGIN
-		res := Ok;
-		len := 0;
-
-		IF size = 0 THEN RETURN; END;
-
-		min := MIN(size,min);
-
-		WHILE uart.open & (~(UartMin.XUARTPS_SR_RXEMPTY IN uart.regs.sr) OR (min > 0)) DO
-			IF ~(UartMin.XUARTPS_SR_RXEMPTY IN uart.regs.sr) THEN
-				WHILE (size > 0) & ~(UartMin.XUARTPS_SR_RXEMPTY IN uart.regs.sr) DO
-					buf[offs] := uart.regs.fifo;
-					DEC(min); DEC(size); INC(offs); INC(len);
-				END;
-			ELSIF (onBusy # NIL) & ~onBusy(res) THEN
-				RETURN;
-			END;
-		END;
-
-		IF ~uart.open THEN
-			res := Closed;
-		END;*)
-	END Receive;
-
-	PROCEDURE PrintRegisters(regs: UartMin.UartRegisters);
-	BEGIN
-		Trace.String("cr("); Trace.Hex(ADDRESSOF(regs.cr),-8); Trace.String("): "); Trace.Set(regs.cr); Trace.Ln;
-		Trace.String("mr("); Trace.Hex(ADDRESSOF(regs.mr),-8); Trace.String("): "); Trace.Set(regs.mr); Trace.Ln;
-		Trace.String("ier(");  Trace.Hex(ADDRESSOF(regs.ier),-8); Trace.String("): write only"); Trace.Ln;
-		Trace.String("idr("); Trace.Hex(ADDRESSOF(regs.idr),-8); Trace.String("): write only"); Trace.Ln;
-		Trace.String("imr("); Trace.Hex(ADDRESSOF(regs.imr),-8); Trace.String("): "); Trace.Set(regs.imr); Trace.Ln;
-		Trace.String("isr("); Trace.Hex(ADDRESSOF(regs.isr),-8); Trace.String("): "); Trace.Set(regs.isr); Trace.Ln;
-		Trace.String("baudgen("); Trace.Hex(ADDRESSOF(regs.baudgen),-8); Trace.String("): "); Trace.Int(regs.baudgen,0); Trace.Ln;
-		Trace.String("rxtout("); Trace.Hex(ADDRESSOF(regs.rxtout),-8); Trace.String("): "); Trace.Int(regs.rxtout,0); Trace.Ln;
-		Trace.String("rxwm("); Trace.Hex(ADDRESSOF(regs.rxwm),-8); Trace.String("): "); Trace.Int(regs.rxwm,0); Trace.Ln;
-		Trace.String("modemcr("); Trace.Hex(ADDRESSOF(regs.modemcr),-8); Trace.String("): "); Trace.Set(regs.modemcr); Trace.Ln;
-		Trace.String("modemsr("); Trace.Hex(ADDRESSOF(regs.modemsr),-8); Trace.String("): "); Trace.Set(regs.modemsr); Trace.Ln;
-		Trace.String("sr("); Trace.Hex(ADDRESSOF(regs.sr),-8); Trace.String("): "); Trace.Set(regs.sr); Trace.Ln;
-		Trace.String("fifo(");  Trace.Hex(ADDRESSOF(regs.fifo),-8); Trace.String("): --- "); Trace.Ln;
-		Trace.String("bauddiv("); Trace.Hex(ADDRESSOF(regs.bauddiv),-8); Trace.String("): "); Trace.Int(regs.bauddiv,0); Trace.Ln;
-		Trace.String("flowdel("); Trace.Hex(ADDRESSOF(regs.flowdel),-8); Trace.String("): "); Trace.Int(regs.flowdel,0); Trace.Ln;
-		Trace.String("txwm("); Trace.Hex(ADDRESSOF(regs.txwm),-8); Trace.String("): "); Trace.Int(regs.txwm,0); Trace.Ln;
-	END PrintRegisters;
-
-	PROCEDURE Show*;
-	BEGIN
-		IF uarts[0] # NIL THEN
-			Trace.StringLn("PS UART0:");
-			PrintRegisters(uarts[0].regs);
-			Trace.String("rxBufRdPos="); Trace.Int(uarts[0].rxBufRdPos,0); Trace.Ln;
-			Trace.String("rxBufWrPos="); Trace.Int(uarts[0].rxBufWrPos,0); Trace.Ln;
-			Trace.String("txBufRdPos="); Trace.Int(uarts[0].txBufRdPos,0); Trace.Ln;
-			Trace.String("txBufWrPos="); Trace.Int(uarts[0].txBufWrPos,0); Trace.Ln;
-			Trace.Ln;
-		END;
-		IF uarts[1] # NIL THEN
-			Trace.StringLn("PS UART1:");
-			PrintRegisters(uarts[1].regs);
-			Trace.String("rxBufRdPos="); Trace.Int(uarts[1].rxBufRdPos,0); Trace.Ln;
-			Trace.String("rxBufWrPos="); Trace.Int(uarts[1].rxBufWrPos,0); Trace.Ln;
-			Trace.String("txBufRdPos="); Trace.Int(uarts[1].txBufRdPos,0); Trace.Ln;
-			Trace.String("txBufWrPos="); Trace.Int(uarts[1].txBufWrPos,0); Trace.Ln;
-			Trace.Ln;
-		END;
-
-	END Show;
-
-END PsUart.

ARM/ARM.A2/Zynq.PsUartInterrupts.Mod

@@ -1,59 +0,0 @@
-(**
-	AUTHOR: Alexey Morozov, Timothee Martiel, HighDim GmbH, 2013-2018
-	PURPOSE: interrupt handling infrastracture for Zynq PS UART driver used in A2
-*)
-MODULE PsUartInterrupts;
-
-IMPORT
-	Platform, Machine;
-
-TYPE
-	(** UART interrupt handler *)
-	UartInterruptHandler* = PROCEDURE(param: ANY);
-
-VAR
-	intrHandler0, intrHandler1: UartInterruptHandler;
-	intrHandlerParam0, intrHandlerParam1: ANY;
-
-	PROCEDURE IntrHandlerUart0(VAR state: Machine.State);
-	BEGIN
-		intrHandler0(intrHandlerParam0);
-	END IntrHandlerUart0;
-
-	PROCEDURE IntrHandlerUart1(VAR state: Machine.State);
-	BEGIN
-		intrHandler1(intrHandlerParam1);
-	END IntrHandlerUart1;
-
-	(**
-		Install a UART interrupt handler
-
-		uart: PS UART controller ID
-		interruptHandler: interrupt handler
-		interruptHandlerParam: parameter to be passed to interrupt handler
-
-		Return: FALSE in case of a wrong value of UART ID or if interruptHandler is NIL
-	*)
-	PROCEDURE InstallInterruptHandler*(uart: LONGINT; interruptHandler: UartInterruptHandler; interruptHandlerParam: ANY): BOOLEAN;
-	BEGIN
-		IF interruptHandler = NIL THEN
-			RETURN FALSE;
-		END;
-
-		CASE uart OF
-			0:
-				intrHandler0 := interruptHandler;
-				intrHandlerParam0 := interruptHandlerParam;
-				Machine.InstallHandler(IntrHandlerUart0,Platform.UartIrq[0]);
-			|1:
-				intrHandler1 := interruptHandler;
-				intrHandlerParam1 := interruptHandlerParam;
-				Machine.InstallHandler(IntrHandlerUart1,Platform.UartIrq[1]);
-		ELSE
-			RETURN FALSE;
-		END;
-
-		RETURN TRUE;
-	END InstallInterruptHandler;
-
-END PsUartInterrupts.

ARM/ARM.A2/Zynq.PsUartMin.Mod

@@ -1,455 +0,0 @@
-MODULE PsUartMin;
-(**
-	AUTHOR: Alexey Morozov, Timothee Martiel, HighDim GmbH, 2013-2017
-	PURPOSE: minimal driver implementation for Xilinx Zynq UART PS controller
-*)
-
-IMPORT SYSTEM;
-
-CONST
-	(** Parity types - compatible with A2 Serials *)
-	ParNo* = 0;  ParOdd* = 1;  ParEven* = 2;  ParMark* = 3;  ParSpace* = 4;
-
-	(** Stop bits - compatible with A2 Serials *)
-	Stop1* = 1;  Stop2* = 2;  Stop1dot5* = 3;
-
-	(** Error codes - compatible with A2 Serials *)
-	Ok* =  0;
-	Closed* = -1;
-	PortInUse* =  1; NoSuchPort* =  2; WrongBPS* =  3; WrongData* =  4; WrongParity* =  5; WrongStop* =  6;
-
-	(* Default settings *)
-	DefaultBPS* = 115200; DefaultDataBits* = 8; DefaultParity* = ParNo; DefaultStop* = Stop1;
-
-	NumUarts* = 2; (** number of supported UART controllers *)
-
-	 (* Control Register Bit Definition
-	 	The Control register (CR) controls the major functions of the device.
-	 *)
-	XUARTPS_CR_STOPBRK* = 8; (* Stop transmission of break *)
-	XUARTPS_CR_STARTBRK* = 7; (* Set break *)
-	XUARTPS_CR_TORST* = 6; (* RX timeout counter restart *)
-	XUARTPS_CR_TX_DIS* = 5; (* TX disabled. *)
-	XUARTPS_CR_TX_EN* = 4; (* TX enabled *)
-	XUARTPS_CR_RX_DIS* = 3; (* RX disabled. *)
-	XUARTPS_CR_RX_EN* = 2; (* RX enabled *)
-	XUARTPS_CR_EN_DIS_MASK* = {2..5}; (* Enable/disable Mask *)
-	XUARTPS_CR_TXRST* = 1; (* TX logic reset *)
-	XUARTPS_CR_RXRST* = 0; (* RX logic reset *)
-
-	(* Mode Register Bit Definition
-
-		The mode register (MR) defines the mode of transfer as well as the data
-		format. If this register is modified during transmission or reception,
-		data validity cannot be guaranteed.
-	*)
-	XUARTPS_MR_CHMODE_R_LOOP = {8,9}; (* Remote loopback mode *)
-	XUARTPS_MR_CHMODE_L_LOOP = {9}; (* Local loopback mode *)
-	XUARTPS_MR_CHMODE_ECHO = {8}; (* Auto echo mode *)
-	XUARTPS_MR_CHMODE_NORM = {}; (* Normal mode *)
-	XUARTPS_MR_CHMODE_SHIFT = 8; (* Mode shift *)
-	XUARTPS_MR_CHMODE_MASK = {8..9}; (* Mode mask *)
-	XUARTPS_MR_STOPMODE_2 = {7}; (* 2 stop bits *)
-	XUARTPS_MR_STOPMODE_1_5 = {6}; (* 1.5 stop bits *)
-	XUARTPS_MR_STOPMODE_1 = {}; (* 1 stop bit *)
-	XUARTPS_MR_STOPMODE_SHIFT = 6; (* Stop bits shift *)
-	XUARTPS_MR_STOPMODE_MASK = {6..7}; (* Stop bits mask *)
-	XUARTPS_MR_PARITY_NONE = {5}; (* No parity mode *)
-	XUARTPS_MR_PARITY_MARK = {3,4}; (* Mark parity mode *)
-	XUARTPS_MR_PARITY_SPACE = {4}; (* Space parity mode *)
-	XUARTPS_MR_PARITY_ODD = {3}; (* Odd parity mode *)
-	XUARTPS_MR_PARITY_EVEN = {}; (* Even parity mode *)
-	XUARTPS_MR_PARITY_SHIFT = 3; (* Parity setting shift *)
-	XUARTPS_MR_PARITY_MASK = {3..5}; (* Parity mask *)
-	XUARTPS_MR_CHARLEN_6 = {1,2}; (* 6 bits data *)
-	XUARTPS_MR_CHARLEN_7 = {2}; (* 7 bits data *)
-	XUARTPS_MR_CHARLEN_8 = {}; (* 8 bits data *)
-	XUARTPS_MR_CHARLEN_SHIFT = 1; (* Data Length shift *)
-	XUARTPS_MR_CHARLEN_MASK = {1..2}; (* Data length mask *)
-	XUARTPS_MR_CLKSEL_BIT = 0; (* Input clock selection *)
-
-	(** Interrupt Registers
-
-		Interrupt control logic uses the interrupt enable register (IER) and the
-		interrupt disable register (IDR) to set the value of the bits in the
-		interrupt mask register (IMR). The IMR determines whether to pass an
-		interrupt to the interrupt status register (ISR).
-		Writing a 1 to IER Enbables an interrupt, writing a 1 to IDR disables an
-		interrupt. IMR and ISR are read only, and IER and IDR are write only.
-		Reading either IER or IDR returns 0x00.
-
-		All four registers have the same bit definitions.
-	*)
-	XUARTPS_IXR_RBRK	= 13; (** Rx FIFO break detect interrupt *)
-	XUARTPS_IXR_TOVR*	= 12; (** Tx FIFO Overflow interrupt *)
-	XUARTPS_IXR_TNFUL*	= 11; (** Tx FIFO Nearly Full interrupt *)
-	XUARTPS_IXR_TTRIG*	= 10; (** Tx Trig interrupt *)
-	XUARTPS_IXR_DMS*		= 9; (** Modem status change interrupt *)
-	XUARTPS_IXR_TOUT*	= 8; (** Timeout error interrupt *)
-	XUARTPS_IXR_PARITY* 	= 7; (** Parity error interrupt *)
-	XUARTPS_IXR_FRAMING*	= 6; (** Framing error interrupt *)
-	XUARTPS_IXR_OVER*	= 5; (** Overrun error interrupt *)
-	XUARTPS_IXR_TXFULL* 	= 4; (** TX FIFO full interrupt. *)
-	XUARTPS_IXR_TXEMPTY*	= 3; (** TX FIFO empty interrupt. *)
-	XUARTPS_IXR_RXFULL* 	= 2; (** RX FIFO full interrupt. *)
-	XUARTPS_IXR_RXEMPTY*	= 1; (** RX FIFO empty interrupt. *)
-	XUARTPS_IXR_RXOVR*  	= 0; (** RX FIFO trigger interrupt. *)
-	XUARTPS_IXR_MASK*	= {0..13}; (** Valid bit mask *)
-
-	(** Channel Status Register
-
-		The channel status register (CSR) is provided to enable the control logic
-		to monitor the status of bits in the channel interrupt status register,
-		even if these are masked out by the interrupt mask register.
-	*)
-	XUARTPS_SR_TNFUL* =	14; (** TX FIFO Nearly Full Status *)
-	XUARTPS_SR_TTRIG*	 =	13; (** TX FIFO Trigger Status *)
-	XUARTPS_SR_FLOWDEL* =	12; (** RX FIFO fill over flow delay *)
-	XUARTPS_SR_TACTIVE* =	11; (** TX active *)
-	XUARTPS_SR_RACTIVE* =	10; (** RX active *)
-	XUARTPS_SR_DMS*	 =	9; (** Delta modem status change *)
-	XUARTPS_SR_TOUT*	 =	8; (** RX timeout *)
-	XUARTPS_SR_PARITY* =	7; (** RX parity error *)
-	XUARTPS_SR_FRAME* =	6; (** RX frame error *)
-	XUARTPS_SR_OVER*	 =	5; (** RX overflow error *)
-	XUARTPS_SR_TXFULL* =	4; (** TX FIFO full *)
-	XUARTPS_SR_TXEMPTY* =	3; (** TX FIFO empty *)
-	XUARTPS_SR_RXFULL* =	2; (** RX FIFO full *)
-	XUARTPS_SR_RXEMPTY* =	1; (** RX FIFO empty *)
-	XUARTPS_SR_RXOVR* =	0; (** RX FIFO fill over trigger *)
-
-	(*
-		Modem Control register
-	*)
-	XUARTPS_MODEMCR_FCM = 5;
-	XUARTPS_MODEMCR_RTS = 1;
-	XUARTPS_MODEMCR_DTR = 0;
-
-	(*
-		Modem Status register
-	*)
-	XUARTPS_MODEMSR_FCMS = 8;
-	XUARTPS_MODEMSR_DCD = 7;
-	XUARTPS_MODEMSR_RI = 6;
-	XUARTPS_MODEMSR_DSR = 5;
-	XUARTPS_MODEMSR_CTS = 4;
-	XUARTPS_MODEMSR_DCDX = 3;
-	XUARTPS_MODEMSR_RIX = 2;
-	XUARTPS_MODEMSR_DSRX = 1;
-	XUARTPS_MODEMSR_CTSX = 0;
-
-	(* The following constant defines the amount of error that is allowed for
-		a specified baud rate. This error is the difference between the actual
-		baud rate that will be generated using the specified clock and the
-		desired baud rate.
-	*)
-	XUARTPS_MAX_BAUD_ERROR_RATE = 3;	(* max % error allowed *)
-
-TYPE
- 	(*
- 		(* Register offsets for the UART controller *)
-		XUARTPS_CR_OFFSET = 0x0000;  (* Control Register [8:0] *)
-		XUARTPS_MR_OFFSET = 0x0004;  (* Mode Register [9:0] *)
-		XUARTPS_IER_OFFSET = 0x0008;  (* Interrupt Enable [12:0] *)
-		XUARTPS_IDR_OFFSET = 0x000C;  (* Interrupt Disable [12:0] *)
-		XUARTPS_IMR_OFFSET = 0x0010;  (* Interrupt Mask [12:0] *)
-		XUARTPS_ISR_OFFSET = 0x0014;  (* Interrupt Status [12:0]*)
-		XUARTPS_BAUDGEN_OFFSET = 0x0018;  (* Baud Rate Generator [15:0] *)
-		XUARTPS_RXTOUT_OFFSET = 0x001C;  (* RX Timeout [7:0] *)
-		XUARTPS_RXWM_OFFSET = 0x0020;  (* RX FIFO Trigger Level [5:0] *)
-		XUARTPS_MODEMCR_OFFSET = 0x0024;  (* Modem Control [5:0] *)
-		XUARTPS_MODEMSR_OFFSET = 0x0028;  (* Modem Status [8:0] *)
-		XUARTPS_SR_OFFSET = 0x002C;  (* Channel Status [14:0] *)
-		XUARTPS_FIFO_OFFSET = 0x0030;  (* FIFO [7:0] *)
-		XUARTPS_BAUDDIV_OFFSET = 0x0034;  (* Baud Rate Divider [7:0] *)
-		XUARTPS_FLOWDEL_OFFSET = 0x0038;  (* Flow Delay [5:0] *)
-		XUARTPS_TXWM_OFFSET = 0x0044;  (* TX FIFO Trigger Level [5:0] *)
-		XUARTPS_RXBS_OFFSET = 0x0048;  (* RX FIFO Byte Status [11:0] *)
-	*)
-	UartRegisters* = POINTER {UNSAFE, UNTRACED}  TO RECORD
-		cr*, mr*, ier*, idr*, imr*, isr*: SET;
-		baudgen*, rxtout*, rxwm*: LONGINT;
-		modemcr*, modemsr*: SET;
-		sr*: SET;
-		fifo*: LONGINT;
-		bauddiv*, flowdel*: LONGINT;
-		padding2: ARRAY 2 OF LONGINT;
-		txwm*: LONGINT;
-	END;
-
-	BusyLoopCallback* = PROCEDURE{DELEGATE}(VAR res: LONGINT): BOOLEAN;
-
-VAR
-	uarts: ARRAY NumUarts OF UartRegisters;
-	inputClocks: ARRAY NumUarts OF LONGINT;
-
-	(**
-		Install a UART controller
-
-		uart: ID (0-based index) of the UART controller to install
-		base: controller base address
-		inputClock: controller input clock in Hz
-		res: returned error code, 0 in case of success
-	*)
-	PROCEDURE Install* (uart: LONGINT; base: ADDRESS; inputClock: LONGINT; VAR res: LONGINT);
-	BEGIN
-		IF (uart < 0) OR (uart >= LEN(uarts)) THEN
-			res := NoSuchPort; RETURN;
-		END;
-
-		res := Ok;
-
-		uarts[uart] := base;
-		inputClocks[uart] := inputClock;
-
-		Reset(uarts[uart]);
-		ASSERT(SetBps(uarts[uart],DefaultBPS,res));
-		ASSERT(SetDataBits(uarts[uart],DefaultDataBits,res));
-		ASSERT(SetParity(uarts[uart],DefaultParity,res));
-		ASSERT(SetStopBits(uarts[uart],DefaultStop,res));
-	END Install;
-
-	(**
-		Get UART controller with a given ID
-	*)
-	PROCEDURE GetUart*(uart: LONGINT): UartRegisters;
-	BEGIN
-		IF (uart >= 0) & (uart < LEN(uarts)) THEN
-			RETURN uarts[uart];
-		ELSE RETURN NIL;
-		END;
-	END GetUart;
-
-	(**
-		Enable/Disable the UART controller
-
-		enable: TRUE for enabling
-	*)
-	PROCEDURE Enable*(uart: UartRegisters; enable: BOOLEAN);
-	BEGIN
-		IF enable THEN
-			uart.cr := uart.cr * SET(-XUARTPS_CR_EN_DIS_MASK) + {XUARTPS_CR_RX_EN, XUARTPS_CR_TX_EN};
-		ELSE
-			uart.cr := uart.cr * SET(-XUARTPS_CR_EN_DIS_MASK) + {XUARTPS_CR_RX_DIS, XUARTPS_CR_TX_DIS};
-		END;
-	END Enable;
-
-	(**
-		Reset the controller
-	*)
-	PROCEDURE Reset*(uart: UartRegisters);
-	BEGIN
-		(* disable all UART interrupts *)
-		uart.idr := XUARTPS_IXR_MASK;
-
-		(* disable RX/TX *)
-		uart.cr := {XUARTPS_CR_RX_DIS, XUARTPS_CR_TX_DIS};
-
-		(* software reset of RX and TX - this clears the FIFO. *)
-		uart.cr := {XUARTPS_CR_RXRST, XUARTPS_CR_TXRST};
-
-(*! this makes the controller crazy when executed within PsUart.Open
-		(* clear status flags - SW reset will not clear sticky flags *)
-		uart.isr := XUARTPS_IXR_MASK;*)
-
-		(* set CR to its default value *)
-		uart.cr := {XUARTPS_CR_RX_DIS, XUARTPS_CR_TX_DIS, XUARTPS_CR_STOPBRK};
-	END Reset;
-
-	(*
-		Setup baudrate in bps
-	*)
-	PROCEDURE SetBps*(uart: UartRegisters; baudrate: LONGINT; VAR res: LONGINT): BOOLEAN;
-	VAR
-		i, clock: LONGINT;
-		valBAUDDIV, valBRGR, calcBaudrate, baudError: LONGINT;
-		bestError, bestBRGR, bestBAUDDIV: LONGINT;
-	BEGIN
-		i := 0;
-		WHILE (i < LEN(uarts)) & (uarts[i] # uart) DO INC(i); END;
-		ASSERT(i < LEN(uarts));
-		clock := inputClocks[i];
-
-		(*
-			Make sure the baud rate is not impossilby large.
-	 		Fastest possible baud rate is Input Clock / 2
-		*)
-		IF (baudrate <= 0) OR (baudrate*2 > clock) THEN
-			res := NoSuchPort; RETURN FALSE;
-		END;
-
-		(* Check whether the input clock is divided by 8 *)
-		IF XUARTPS_MR_CLKSEL_BIT IN uart.mr THEN
-			clock := clock DIV 8;
-		END;
-
-		(* Determine the Baud divider. It can be 4 to 254.
-			Loop through all possible combinations *)
-		bestError := MAX(LONGINT);
-		FOR valBAUDDIV := 4 TO 255 DO
-
-			(* Calculate the value for BRGR register *)
-			valBRGR := clock DIV (baudrate * (valBAUDDIV + 1));
-
-			IF valBRGR > 0 THEN
-				(* Calculate the baud rate from the BRGR value *)
-				calcBaudrate := clock DIV (valBRGR * (valBAUDDIV + 1));
-
-				(* Avoid unsigned integer underflow *)
-				IF baudrate > calcBaudrate THEN
-					baudError := baudrate - calcBaudrate;
-				ELSE
-					baudError := calcBaudrate - baudrate;
-				END;
-
-				(*
-					Find the calculated baud rate closest to requested baud rate.
-				*)
-				IF baudError < bestError THEN
-					bestBRGR := valBRGR;
-					bestBAUDDIV := valBAUDDIV;
-					bestError := baudError;
-				END;
-			END;
-
-			INC(valBAUDDIV);
-		END;
-
-		(*
-			Make sure the best error is not too large.
-		*)
-		IF (bestError * 100) DIV baudrate > XUARTPS_MAX_BAUD_ERROR_RATE THEN (* baudrate error *)
-			res := WrongBPS; RETURN FALSE;
-		END;
-
-		(* write baudrate settings *)
-		uart.baudgen := bestBRGR;
-		uart.bauddiv := bestBAUDDIV;
-
-		res := Ok;
-		RETURN TRUE
-	END SetBps;
-
-	(**
-		Set number of data bits
-	*)
-	PROCEDURE SetDataBits*(uart: UartRegisters; dataBits: LONGINT; VAR res: LONGINT): BOOLEAN;
-	VAR reg: SET;
-	BEGIN
-		CASE dataBits OF
-			 6: reg := XUARTPS_MR_CHARLEN_6;
-			|7: reg := XUARTPS_MR_CHARLEN_7;
-			|8: reg := XUARTPS_MR_CHARLEN_8;
-		ELSE
-			res := WrongData; RETURN FALSE;
-		END;
-
-		uart.mr := uart.mr * SET(-XUARTPS_MR_CHARLEN_MASK) + reg;
-
-		res := Ok;
-		RETURN TRUE
-	END SetDataBits;
-
-	(**
-		Setup parity check type
-	*)
-	PROCEDURE SetParity*(uart: UartRegisters; parityType: LONGINT; VAR res: LONGINT): BOOLEAN;
-	VAR reg: SET;
-	BEGIN
-		CASE parityType OF
-			 ParNo: reg := XUARTPS_MR_PARITY_NONE;
-			|ParEven: reg := XUARTPS_MR_PARITY_EVEN;
-			|ParOdd: reg := XUARTPS_MR_PARITY_ODD;
-			|ParMark: reg := XUARTPS_MR_PARITY_MARK;
-			|ParSpace: reg := XUARTPS_MR_PARITY_SPACE;
-		ELSE
-			res := WrongParity; RETURN FALSE;
-		END;
-
-		uart.mr := uart.mr * SET(-XUARTPS_MR_PARITY_MASK) + reg;
-
-		res := Ok;
-		RETURN TRUE
-	END SetParity;
-
-	(**
-		Setup number of stop bits
-	*)
-	PROCEDURE SetStopBits*(uart: UartRegisters; stopBits: LONGINT; VAR res: LONGINT): BOOLEAN;
-	VAR reg: SET;
-	BEGIN
-		CASE stopBits OF
-			 Stop1: reg := XUARTPS_MR_STOPMODE_1;
-			|Stop2: reg := XUARTPS_MR_STOPMODE_2;
-			|Stop1dot5: reg := XUARTPS_MR_STOPMODE_1_5;
-		ELSE
-			res := WrongStop; RETURN FALSE;
-		END;
-
-		uart.mr := uart.mr * SET(-XUARTPS_MR_STOPMODE_MASK) + reg;
-
-		res := Ok;
-		RETURN TRUE
-	END SetStopBits;
-
-	(**
-		Send a single character to the UART
-
-		ch: character to send
-		propagate: TRUE for flushing the TX FIFO buffer
-		res: error code, 0 in case of success
-	*)
-	PROCEDURE SendChar*(uart: UartRegisters; ch: CHAR; propagate: BOOLEAN; onBusy: BusyLoopCallback; VAR res: LONGINT);
-	BEGIN
-		(* Wait until TX FIFO is not full *)
-		WHILE (XUARTPS_CR_TX_EN IN uart.cr) & (XUARTPS_SR_TXFULL IN uart.sr) DO
-			IF (onBusy # NIL) & ~onBusy(res) THEN RETURN; END;
-		END;
-
-		IF (XUARTPS_CR_TX_EN IN uart.cr) THEN
-			uart.fifo := ORD(ch);
-			IF propagate THEN (* flush the FIFO *)
-				WHILE (XUARTPS_CR_TX_EN IN uart.cr) & ~(XUARTPS_SR_TXEMPTY IN uart.sr) DO
-					IF (onBusy # NIL) & ~onBusy(res) THEN RETURN; END;
-				END;
-			END;
-			IF (XUARTPS_CR_TX_EN IN uart.cr) THEN res := Ok; ELSE res := Closed; END;
-		ELSE res := Closed;
-		END;
-	END SendChar;
-
-	(**
-		Receive a single character from UART
-
-		res: error code, 0 in case of success
-
-		Remarks: blocks until a character is available
-	*)
-	PROCEDURE ReceiveChar*(uart: UartRegisters; onBusy: BusyLoopCallback; VAR res: LONGINT): CHAR;
-	BEGIN
-		(* wait until data is available *)
-		WHILE (XUARTPS_CR_RX_EN IN uart.cr) & (XUARTPS_SR_RXEMPTY IN uart.sr) DO
-			IF (onBusy # NIL) & ~onBusy(res) THEN RETURN 0X; END;
-		END;
-
-		IF (XUARTPS_CR_RX_EN IN uart.cr) THEN
-			res := Ok; RETURN CHR(uart.fifo);
-		ELSE
-			res := Closed; RETURN 0X;
-		END;
-	END ReceiveChar;
-
-	(**
-		Returns number of bytes available in the receive FIFO of the UART controller
-
-		res: error code, 0 in case of success
-	*)
-	PROCEDURE Available*(uart: UartRegisters): LONGINT;
-	BEGIN
-		IF ~(XUARTPS_SR_RXEMPTY IN uart.sr) THEN
-			RETURN 1;
-		END;
-		RETURN 0;
-	END Available;
-
-END PsUartMin.

ARM/ARM.A2/Zynq.SdControllers.Mod

@@ -1,214 +0,0 @@
-MODULE SdControllers;
-(**
-	AUTHOR Timothée Martiel, 12/2015
-	PURPOSE SD Host Controller Initialization for Zynq SoC.
-*)
-
-IMPORT
-	Platform, Modules, Objects, Commands,
-	Sd, SdDisks, SdEnvironment, Log := SdEnvironment;
-
-CONST
-	Ready = 0;
-	Running = 1;
-	Stopped = 2;
-	Error = 3;
-
-TYPE
-	HostController * = OBJECT
-	VAR
-		hc: Sd.HostController;
-		handler: InterruptHandler;
-		state, event: LONGINT;
-		card: Sd.Card;
-		halted: BOOLEAN;
-
-		PROCEDURE & Init (base: ADDRESS; int: LONGINT; clock: HUGEINT);
-		VAR
-			result: LONGINT;
-		BEGIN
-			NEW(hc);
-			Sd.InitHostController(hc, base);
-			IF ~Sd.SetExternalClock(hc, clock, clock, result) THEN
-				Log.String("[SD] Failed to initialize host controller: error code ");
-				Log.Int(result, 0);
-				Log.Ln;
-				state := Error;
-				RETURN
-			END;
-			state := Ready; (* Do not put this later, as events might be triggered in the constructor *)
-			NEW(handler, SELF);
-			SdEnvironment.InstallHandler(handler.Handle, int);
-		END Init;
-
-		PROCEDURE HandleEvent (card: Sd.Card; event: LONGINT; param: ANY);
-		BEGIN {EXCLUSIVE}
-			AWAIT(state # Running);
-			SELF.event := event;
-			SELF.card := card;
-			IF state = Ready THEN state := Running END
-		END HandleEvent;
-
-		PROCEDURE Stop;
-		BEGIN {EXCLUSIVE}
-			IF state < Stopped THEN state := Stopped END;
-			AWAIT(halted)
-		END Stop;
-
-		PROCEDURE WaitForEventCompletion;
-		BEGIN {EXCLUSIVE}
-			AWAIT(state # Running)
-		END WaitForEventCompletion;
-
-	BEGIN {ACTIVE}
-		LOOP
-			BEGIN {EXCLUSIVE}
-				AWAIT(state # Ready);
-				IF state >= Stopped THEN EXIT END;
-			END;
-			SdDisks.HandleSdEvent(card, event);
-			BEGIN {EXCLUSIVE}
-				state := Ready
-			END
-		END
-	FINALLY
-		BEGIN {EXCLUSIVE} halted := TRUE END
-	END HostController;
-
-	InterruptHandler * = OBJECT
-	VAR
-		hc: Sd.HostController;
-		timer: Objects.Timer;
-		mask: SET;
-		blocked: BOOLEAN;
-
-		PROCEDURE & Init (hc: HostController);
-		BEGIN
-			SELF.hc := hc.hc;
-			NEW(timer);
-			blocked := FALSE
-		END Init;
-
-		PROCEDURE Block (hc: Sd.HostController; mask: SET; timeout: LONGINT): BOOLEAN;
-		VAR
-			irqs: SET;
-		BEGIN {EXCLUSIVE}
-			ASSERT(hc = SELF.hc);
-			blocked := TRUE;
-			irqs := hc.regs.InterruptSignalEnable;
-			hc.regs.InterruptSignalEnable := irqs + mask;
-			SELF.mask := mask;
-			Objects.SetTimeout(timer, Unblock, timeout);
-			AWAIT(~blocked);
-			hc.regs.InterruptSignalEnable := irqs;
-			RETURN mask * hc.regs.InterruptStatus # {}
-		END Block;
-
-		PROCEDURE Unblock;
-		BEGIN {EXCLUSIVE}
-			blocked := FALSE
-		END Unblock;
-
-		PROCEDURE Handle;
-		BEGIN
-			IF hc.regs.InterruptStatus * mask # {} THEN
-				Unblock;
-				Objects.CancelTimeout(timer);
-			END;
-			Sd.HandleInterrupt(hc);
-		END Handle;
-	END InterruptHandler;
-
-VAR
-	hc: ARRAY 2 OF HostController;
-
-	PROCEDURE Init;
-	VAR
-		i: LONGINT;
-	BEGIN
-		Modules.InstallTermHandler(Cleanup);
-		FOR i := 0 TO Platform.SdNb - 1 DO
-			IF SdEnvironment.Enable(i) THEN
-				IF Sd.EnableTrace THEN
-					Log.String("[SD] Enabling controller "); Log.Int(i, 0); Log.Ln;
-					Log.String("[SD]	register base = "); Log.Address(Platform.SdBase[i]); Log.Ln;
-					Log.String("[SD]	base clock = "); Log.Int(SdEnvironment.HcClock(i), 0); Log.String(" Hz"); Log.Ln;
-					Log.String("[SD]	irq = "); Log.Int(Platform.SdIrq[i], 0); Log.Ln;
-				END;
-				NEW(hc[i], Platform.SdBase[i], Platform.SdIrq[i], SdEnvironment.HcClock(i));
-				Sd.SetEventHandler(hc[i].hc, hc[i].HandleEvent, NIL);
-				hc[i].WaitForEventCompletion;
-(*				Sd.SetBlocker(hc[i].hc, hc[i].handler.Block)*)
-			ELSE
-				IF Sd.EnableTrace THEN
-					Log.String("[SD] Not Enabling controller "); Log.Int(i, 0); Log.Ln
-				END;
-			END
-		END
-	END Init;
-
-	PROCEDURE Cleanup;
-	VAR
-		i: LONGINT;
-	BEGIN
-		FOR i := 0 TO LEN(hc) - 1 DO
-			IF hc[i] # NIL THEN hc[i].Stop END
-		END
-	END Cleanup;
-
-	PROCEDURE Statistics * (c: Commands.Context);
-	VAR
-		accesses: LONGINT;
-		byteRead, byteWritten, read, write: HUGEINT;
-		tread, twrite: HUGEINT;
-		speedR, speedW: LONGREAL;
-	BEGIN
-		byteRead := Sd.NbyteRead;
-		byteWritten := Sd.NbyteWritten;
-		read := Sd.Nread;
-		write := Sd.Nwrite;
-		tread := SdEnvironment.ToMicro(Sd.Tread);
-		twrite := SdEnvironment.ToMicro(Sd.Twrite);
-
-		IF read > 0 THEN
-			speedR := LONGREAL(byteRead) / LONGREAL(tread);
-			c.out.String("SD Statistics:"); c.out.Ln;
-			c.out.String("  Bytes read: "); c.out.Int(byteRead, 0); c.out.Ln;
-			c.out.String("  Number of reads: "); c.out.Int(read, 0); c.out.Ln;
-			c.out.String("  Read time: "); c.out.Int(tread, 0); c.out.String(" us"); c.out.Ln;
-			c.out.String("  Average read size: "); c.out.Int(byteRead DIV read, 0); c.out.String(" bytes"); c.out.Ln;
-			c.out.String("  Read speed: "); c.out.FloatFix(speedR, 0, 3, 0); c.out.String(" Mb/s"); c.out.Ln;
-			c.out.String("  Average read time: "); c.out.FloatFix(LONGREAL(tread) / LONGREAL(read), 0, 3, 0); c.out.String(" us"); c.out.Ln;
-		ELSE
-			c.out.String("No read statistics");
-			c.out.Ln
-		END;
-
-		IF write > 0 THEN
-			speedW := LONGREAL(byteWritten) / LONGREAL(twrite);
-			c.out.String("  Bytes written: "); c.out.Int(byteWritten, 0); c.out.Ln;
-			c.out.String("  Number of writes: "); c.out.Int(write, 0); c.out.Ln;
-			c.out.String("  Write time: "); c.out.Int(twrite, 0); c.out.String(" us"); c.out.Ln;
-			c.out.String("  Average write size: "); c.out.Int(byteWritten DIV write, 0); c.out.String(" bytes"); c.out.Ln;
-			c.out.String("  Write speed: "); c.out.FloatFix(speedW, 0, 3, 0); c.out.String(" Mb/s"); c.out.Ln;
-			c.out.String("  Average write time: "); c.out.FloatFix(LONGREAL(twrite) / LONGREAL(write), 0, 3, 0); c.out.String(" us"); c.out.Ln;
-		ELSE
-			c.out.String("No write statistics");
-			c.out.Ln
-		END;
-
-		accesses := SdDisks.NcacheHits + SdDisks.NcacheMiss;
-		c.out.String("SD Disks Cache Statistics"); c.out.Ln;
-		c.out.String("  Number of accesses: "); c.out.Int(accesses, 0); c.out.Ln;
-		c.out.String("  Number of hits: "); c.out.Int(SdDisks.NcacheHits, 0); c.out.String(" ("); c.out.FloatFix(SdDisks.NcacheHits / accesses * 100.0, 0, 2, 0); c.out.String(" %)"); c.out.Ln;
-		c.out.String("  Number of misses: "); c.out.Int(SdDisks.NcacheMiss, 0); c.out.String(" ("); c.out.FloatFix(SdDisks.NcacheMiss / accesses * 100.0, 0, 2, 0); c.out.String(" %)"); c.out.Ln;
-		c.out.String("  Number of evictions: "); c.out.Int(SdDisks.NcacheEvict, 0); c.out.String(" ("); c.out.FloatFix(SdDisks.NcacheEvict / SdDisks.NcacheMiss * 100.0, 0, 2, 0); c.out.String(" %)"); c.out.Ln;
-		c.out.String("SD Disks Write Buffer Statistics"); c.out.Ln;
-		c.out.String("  Average write size: "); c.out.FloatFix(SdDisks.NbufferSize / SdDisks.NbufferWrites, 0, 2, 0); c.out.String(" bytes"); c.out.Ln;
-		c.out.String("  Average queue length: "); c.out.FloatFix(SdDisks.NbufferQueueSize / SdDisks.NbufferQueueSamples, 0, 2, 0); c.out.Ln;
-		c.out.Update;
-	END Statistics;
-
-BEGIN
-	Init
-END SdControllers.

ARM/ARM.A2/Zynq.SystemWatchdog.Mod

@@ -1,68 +0,0 @@
-MODULE SystemWatchdog; (** AUTHOR "Timothée Martiel"; PURPOSE "Zynq system watchdog driver"; *)
-
-IMPORT SYSTEM, Platform;
-
-CONST
-	(** Modes *)
-	Reset * = TRUE; (** In this mode, the watchdog resets the whole system when triggered *)
-	Irq * = FALSE; (** In this mode, the watchdog triggers IRQ 30 *)
-
-	ZmrWdEn = 0;
-	ZmrRstEn = 1;
-	ZmrIrqEn = 2;
-	ZmrIrqLen4 = {};
-	ZmrIrqLen8 = {7};
-	ZmrIrqLen16 = {8};
-	ZmrIrqLen32 = {7, 8};
-	ZmrIrqLenMask = {7, 8};
-	ZmrKey = LSH(LONGINT(0ABCH), 12); (*0AB'C0'00H;*)
-
-	CcrDelayMask = {2 .. 13};
-	CcrPrescalerMask = 3H;
-	CcrKey = 92'00'00H;
-
-	RestartKey = 1999H;
-
-	(** Start the watchdog for delay ms *)
-	PROCEDURE Start * (mode: BOOLEAN; delay: LONGINT);
-	VAR val: SET;
-	BEGIN
-		Stop;
-		(* Set clock input *)
-		Platform.slcr.SLCR_UNLOCK := Platform.SlcrUnlockKey;
-		Platform.slcr.WDT_CLK_SEL := 0;
-		Platform.slcr.SLCR_LOCK := Platform.SlcrLockKey;
-
-		(* Set delay *)
-		val := SYSTEM.VAL(SET, LSH(delay * 150'000', -12) + 1) * CcrDelayMask;
-		Platform.swdt.XWDTPS_CCR_OFFSET := CcrKey + SYSTEM.VAL(LONGINT, val);
-
-		(* Enable Watchdog *)
-		IF mode THEN
-			INCL(val, ZmrRstEn)
-		ELSE
-			INCL(val, ZmrIrqEn)
-		END;
-		INCL(val, ZmrWdEn);
-		val := val + ZmrIrqLen4;
-		Platform.swdt.XWDTPS_ZMR_OFFSET := ZmrKey + SYSTEM.VAL(LONGINT, val);
-		Feed
-	END Start;
-
-	(** Stop the watchdog *)
-	PROCEDURE Stop *;
-	BEGIN
-		Platform.swdt.XWDTPS_ZMR_OFFSET := ZmrKey
-	END Stop;
-
-	(** Feed the watchdog: set its count to delay ms *)
-	PROCEDURE Feed *;
-	BEGIN
-		Platform.swdt.XWDTPS_RESTART_OFFSET := RestartKey;
-	END Feed;
-
-	PROCEDURE Test *;
-	BEGIN
-		Start(Reset, 100)
-	END Test;
-END SystemWatchdog.

ARM/ARM.A2/Zynq.UsbEhciPhy.Mod

@@ -1,118 +0,0 @@
-MODULE UsbEhciPhy; (** AUTHOR "Timothée Martiel"; PURPOSE "TUSB1210 USB EHCI PHY Control"; *)
-
-IMPORT SYSTEM, Kernel, KernelLog, Gpio, UsbDebug;
-
-CONST
-	(* Ulpi Viewport bits *)
-	UlpiWakeup = 31;
-	UlpiRun = 30;
-	UlpiWrite = 29;
-	UlpiAddressMask = {16 .. 23};
-	UlpiAddressOfs = 16;
-	UlpiWriteDataMask = {0 .. 7};
-
-	(* ULPI addresses *)
-	FuncCtrl = 4H;
-	FuncCtrlSet = 5H;
-	FuncCtrlClr = 6H;
-	IfcCtrlSet = 8H;
-	IfcCtrlClr = 9H;
-	OtgCtrlSet = 0BH;
-	OtgCtrlClr = 0CH;
-
-	(* Register bits in FuncCtrl *)
-	Reset = 5;
-	SuspendM = 6;
-	Opmode = {3, 4};
-	OpmodeNorm = {};
-	XcvrSelect = {0, 1};
-	XcvrHS = {};
-	XcvrFS = {0};
-	XcvrLS = {1};
-	
-
-	(* Register bits in OtgCtrl *)
-	IdPullUp = 0;
-	DmPullDown = 2;
-	DpPullDown = 1;
-	DrvVbus = 5;
-	DrvVbusExt = 6;
-
-	(* Default Timeout. Value comes from Linux implementation *)
-	Timeout = 2000;
-
-	(** Wakeup ULPI *)
-	PROCEDURE Wakeup (viewport: ADDRESS): BOOLEAN;
-	VAR
-		timer: Kernel.MilliTimer;
-		reg: SET;
-	BEGIN
-		Kernel.SetTimer(timer, Timeout);
-		SYSTEM.PUT32(viewport, {UlpiWakeup});
-		REPEAT
-			reg := SYSTEM.VAL(SET, SYSTEM.GET32(viewport))
-		UNTIL ~(31 IN reg) OR Kernel.Expired(timer);
-		IF (31 IN reg) & (UsbDebug.Level >= UsbDebug.Errors) THEN
-			KernelLog.String("TUSB1210 UsbEhciPhy: could not wakeup PHY");
-			KernelLog.Ln
-		END;
-		RETURN ~(31 IN reg)
-	END Wakeup;
-
-	(** Write to ULPI register *)
-	PROCEDURE Write(viewport, address: ADDRESS; value: SET): BOOLEAN;
-	VAR
-		timer: Kernel.MilliTimer;
-		reg: SET;
-	BEGIN
-		IF ~Wakeup(viewport) THEN RETURN FALSE END;
-		Kernel.SetTimer(timer, Timeout);
-		SYSTEM.PUT32(viewport, SYSTEM.VAL(SET, value) * UlpiWriteDataMask + SYSTEM.VAL(SET, LSH(address, UlpiAddressOfs)) * UlpiAddressMask + {UlpiWrite, UlpiRun});
-		REPEAT
-			SYSTEM.GET(viewport, reg);
-		UNTIL ~(30 IN reg) OR Kernel.Expired(timer);
-		IF (30 IN reg) & (UsbDebug.Level >= UsbDebug.Errors) THEN
-			KernelLog.String("TUSB1210 UsbEhcuPhy: could not write to PHY");
-			KernelLog.Ln
-		END;
-		RETURN ~(30 IN reg)
-	END Write;
-
-	(**
-	 * Inits the ULPI via the Viewport register of the EHCI controller.
-	 * Has to be done when the controller is configured and running.
-	 *
-	 * 'viewport' is the address of the viewport register. 'reset' is the GPIO
-	 * pin to which the full ULPI reset is wired (negative if not available).
-	 *)
-	PROCEDURE Init * (viewport: ADDRESS; reset: LONGINT): BOOLEAN;
-	VAR
-		i: LONGINT;
-	BEGIN
-		IF reset >= 0 THEN
-			Gpio.SetDirection(reset, Gpio.Output);
-			Gpio.EnableOutput(reset, TRUE);
-			Gpio.SetData(reset, TRUE);
-			Gpio.SetData(reset, FALSE);
-			(*! TODO: Wait 2 us *)
-			FOR i := 0 TO 1000000 DO END;
-			Gpio.SetData(reset, TRUE)
-		ELSE
-			KernelLog.Enter; KernelLog.String("Skipping GPIO USB reset"); KernelLog.Exit
-		END;
-
-		(* Reset *)
-		IF viewport # 0 THEN
-			IF ~Write(viewport, FuncCtrlSet, {Reset}) THEN RETURN FALSE END;
-			IF ~Write(viewport, OtgCtrlSet, {DmPullDown, DpPullDown, IdPullUp}) THEN RETURN FALSE END;
-			IF ~Write(viewport, FuncCtrlSet, {2, SuspendM} + OpmodeNorm + XcvrLS) THEN RETURN FALSE END;
-			IF ~Write(viewport, FuncCtrlClr, {0 .. 6} - OpmodeNorm  - XcvrLS - {2, SuspendM}) THEN RETURN FALSE END;
-			IF ~Write(viewport, OtgCtrlSet, {DrvVbus, DrvVbusExt}) THEN RETURN FALSE END;
-			IF ~Write(viewport, FuncCtrlClr, {2}) THEN RETURN FALSE END
-		ELSE
-			KernelLog.Enter; KernelLog.String("Skipping USB Viewport reset"); KernelLog.Exit
-		END;
-		KernelLog.Enter; KernelLog.String("USB PHY Initialized sucessfully"); KernelLog.Exit;
-		RETURN TRUE
-	END Init;
-END UsbEhciPhy.

ARM/ARM.A2/Zynq.XEmac.Mod

@@ -1,1602 +0,0 @@
-MODULE XEmac; (** AUTHOR "Timothee Martiel"; PURPOSE "Zynq7000 Ethernet Controller Driver"; *)
-(** 2014.08.26		Adapted the driver for Minos to A2 *)
-
-IMPORT SYSTEM, Machine, Objects, Kernel, KernelLog, Network;
-
-CONST
-	Trace = FALSE;
-
-	IRQ = 54;
-
-	(* Directions in ErrorHandler *)
-	Send = 1X;
-	Recv = 2X;
-
-	(* Link speed detect modes *)
-	LinkSpeedAutodetect = 0;
-	LinkSpeed10 = 1;
-	LinkSpeed100 = 2;
-	LinkSpeed1000 = 3;
-	LinkSpeedMode = LinkSpeedAutodetect;
-
-	(* state *)
-	IsReady = 11111111H;
-	IsStarted = 22222222H;
-
-	(* Buffer descriptors *)
-   	BdSize = 8;
-	RxBdCount = 512;
-	TxBdCount = 512;
-	BdAdrOffset = 0H;
-	BdStatOffset = 4H;
-
-	BufSize = 1536;
-
-	ZeroMAC = SYSTEM.VAL(Network.LinkAdr, [0X, 0X, 0X, 0X, 0X, 0X, 0X, 0X]);
-
-	MaxTypeId = 4;
-
-	(* Options *)
-	(**
-	 * Accept all incoming packets.
-	 * This option defaults to disabled (cleared)
-	 *)
-	Promisc = 0;
-	(**
-	 * Frame larger than 1516 support for Tx & Rx.
-	 * This option defaults to disabled (cleared)
-	 *)
-	Frame1536 = 1;(* 00000002H; *)
-	(**
-	 * VLAN Rx & Tx frame support.
-	 * This option defaults to disabled (cleared)
-	 *)
-	Vlan = 2;(* 00000004H; *)
-	(**
-	 * Enable recognition of flow control frames on Rx
-	 * This option defaults to enabled (set)
-	 *)
-	FlowControl = 4;(* 00000010H; *)
-	(**
-	 * Strip FCS and PAD from incoming frames. Note: PAD from VLAN frames is not
-	 * stripped.
-	 * This option defaults to enabled (set)
-	 *)
-	FcsStrip = 5;(* 00000020H; *)
-	(**
-	 * Generate FCS field and add PAD automatically for outgoing frames.
-	 * This option defaults to disabled (cleared)
-	 *)
-	FcsInsert = 6;(* 00000040H; *)
-	(**
-	 * Enable Length/TYPE error checking for incoming frames. When this option is
-	 * set, the MAC will filter frames that have a mismatched TYPE/length field
-	 * and if REPORT_RXERR is set, the user is notified when these
-	 * TYPEs of frames are encountered. When this option is cleared, the MAC will
-	 * allow these TYPEs of frames to be received.
-	 *
-	 * This option defaults to disabled (cleared)
-	 *)
-	LenTypeErr = 7;(* 00000080H; *)
-	(**
-	 * Enable the transmitter.
-	 * This option defaults to enabled (set)
-	 *)
-	TransmitterEnable = 8;(* 00000100H; *)
-	(**
-	 * Enable the receiver
-	 * This option defaults to enabled (set)
-	 *)
-	ReceiverEnable = 9;(*00000200H *);
-	(**
-	 * Allow reception of the broadcast address
-	 * This option defaults to enabled (set)
-	 *)
-	Broadcast = 10;(* 00000400H; *)
-	(**
-	 * Allows reception of multicast addresses programmed into hash
-	 * This option defaults to disabled (clear)
-	 *)
-	Multicast = 11;(* 00000800H; *)
-	(**
-	 * Enable the RX checksum offload
-	 * This option defaults to enabled (set)
-	 *)
-	RxChksumEnable = 12;(* 00001000H; *)
-	(**
-	 * Enable the TX checksum offload
-	 * This option defaults to enabled (set)
-	 *)
-	TxChksumEnable = 13;(* 00002000H; *)
-	Defaults = {Promisc, FlowControl, FcsInsert, FcsStrip, Broadcast, LenTypeErr, TransmitterEnable, ReceiverEnable, RxChksumEnable, TxChksumEnable};
-
-	(* Register relative addresses *)
-	Nwctrl = 0H;
-	Nwcfg = 4H;
-	Nwsr = 8H;
-	Dmacr = 10H;
-	Txsr = 14H;
-	Rxqbase = 18H;
-	Txqbase = 1CH;
-	Rxsr = 20H;
-	Isr = 24H;
-	Ier = 28H;
-	Idr = 2CH;
-	Imr = 30H;
-	PhyMntnc = 34H;
-	Rxpause = 38H;
-	Txpause = 3CH;
-	HashL = 80H;
-	HashH = 84H;
-	Last = 1B4H;
-	Laddr1l = 88H;
-	Laddr1h = 8CH;
-	Laddr2l = 90H;
-	Laddr2h = 94H;
-	Laddr3l = 98H;
-	Laddr3h = 9CH;
-	Laddr4l = 0A0H;
-	Laddr4h = 0A4H;
-	Match1 = 0A8H;
-	Match2 = 0ACH;
-	Match3 = 0B0H;
-	Match4 = 0B4H;
-	Stretch = 0BCH;
-	OctTxL = 100H;
-	OctTxH = 104H;
-	Txcnt = 108H;
-	Txbccnt = 10CH;
-	Txmccnt = 110H;
-	Txpausecnt = 114H;
-	Tx64cnt = 118H;
-	Tx65cnt = 11CH;
-	Tx128cnt = 120H;
-	Tx256cnt = 124H;
-	Tx512cnt = 128H;
-	Tx1024cnt = 12CH;
-	Tx1519cnt = 130H;
-	Txuruncnt = 134H;
-	Snglcollcnt = 138H;
-	Multicollcnt = 13CH;
-	Excesscollcnt = 140H;
-	Latecollcnt = 144H;
-	Txdefercnt = 148H;
-	Txcsensecnt = 14CH;
-	Octrxl = 150H;
-	Octrxh = 154H;
-	Rxcnt = 158H;
-	Rxbroadcnt = 15CH;
-	Rxmulticnt = 160H;
-	Rxpausecnt = 164H;
-	Rx64cnt = 168H;
-	Rx65cnt = 16CH;
-	Rx128cnt = 170H;
-	Rx256cnt = 174H;
-	Rx512cnt = 178H;
-	Rx1024cnt = 17CH;
-	Rx1519cnt = 180H;
-	Rxundrcnt = 184H;
-	Rxovrcnt = 188H;
-	Rxjabcnt = 18CH;
-	Rxfcscnt = 190H;
-	Rxlengthcnt = 194H;
-	Rxsymbcnt = 198H;
-	Rxaligncnt = 19CH;
-	Rxreserrcnt = 1A0H;
-	Rxorcnt = 1A4H;
-	Rxipccnt = 1A8H;
-	Rxtcpccnt = 1ACH;
-	Rxudpccnt = 1B0H;
-	C1588_sec = 1D0H;
-	C1588_nanosec = 1D4H;
-	C1588_adj = 1D8H;
-	C1588_inc = 1DCH;
-	Ptp_txsec = 1E0H;
-	Ptp_txnanosec = 1E4H;
-	Ptp_rxsec = 1E8H;
-	Ptp_rxnanosec = 1ECH;
-	Ptpp_txsec = 1F0H;
-	Ptpp_txnanosec = 1F4H;
-	Ptpp_rxsec = 1F8H;
-	Ptpp_rxnanosec = 1FCH;
-
-	(** Masks and bits *)
-	DmacrRxBuf = {16 .. 23};
-	DmacrRxBufShift = 16;
-	DmacrTcpChksum = 11;
-	DmacrTxSize = 10;
-	DmacrRxSize = {8, 9};
-	DmacrEndian = 7;
-	DmacrBlength = {0 .. 4};
-	DmacrSingleAhbBurst = 0;
-	DmacrIncr4AhbBurst = 2;
-	DmacrIncr8AhbBurst = 3;
-	DmacrIncr16AhbBurst = 4;
-
-	IxrPtppstx = 25;
-	IxrPtppdrtx = 24;
-	IxrPtpstx = 23;
-	IxrPtpdrtx = 22;
-
-	IxrPtppsrx = 21;
-	IxrPtppdrrx = 20;
-	IxrPtpsrx = 19;
-	IxrPtpdrrx = 18;
-
-	IxrPauseTx = 14;
-	IxrPauseZero = 13;
-	IxrPauseNzero = 12;
-	IxrHrespnOk = 11;
-	IxrRxOvr = 10;
-
-	IxrTxCompl = 7;
-	IxrTxExh = 6;
-	IxrRetry = 5;
-	IxrUrun = 4;
-
-	IxrTxUsed = 3;
-	IxrRxUsed = 2;
-	IxrFrameRx = 1;
-	IxrMgmnt = 0;
-
-	IxrAll = {0 .. 14};
-	IxrTxErr = {IxrTxExh, IxrRetry, IxrUrun, IxrTxUsed};
-	IxrRxErr = {IxrHrespnOk, IxrRxUsed, IxrRxOvr};
-
-	LaddrMach = {0 .. 31};
-
-	NwcfgBadpreambEn = 29;
-	NwcfgIpdStretch = 28;
-	NwcfgFcsIgnore = 26;
-	NwcfgHdRxEn = 25;
-	NwcfgRxChkSumEn = 24;
-	NwcfgPauseCopyDi = 23;
-	NwcfgMdcShift = 18;
-	NwcfgMdcClkDiv = {18 .. 20};
-	NwcfgFcsRem = 17;
-	NwcfgLengthErrDscrd = 16;
-	Nwcfg1000 = 10;
-	Nwcfg100 = 0;
-	NwcfgUcastHashEn = 7;
-	NwcfgFdEn = 1;
-	Nwcfg1536RxEn = 8;
-	NwcfgNvlanDisc = 2;
-	NwcfgPauseEn = 13;
-	NwcfgCopyAllEn = 4;
-	NwcfgBcastDi = 5;
-	NwcfgMcastHashEn = 6;
-
-	NwctrlZeroPauseTx = {11};
-	NwctrlPauseTx = {11};
-	NwctrlHaltTx = {10};
-	NwctrlStartTx = {9};
-	NwctrlStatwen = {7};
-	NwctrlStatinc = {6};
-	NwctrlStatclr = {5};
-	NwctrlMdEn = {4};
-	NwctrlTxEn = {3};
-	NwctrlRxEn = {2};
-	NwctrlLoopEn = {1};
-
-	NwsrMdio = 1;
-	NwsrMdioIdle = 2;
-
-	PhyMntncOp = {17, 30};
-	PhyMntncOpR = {29};
-	PhyMntncOpW = {28};
-	PhyMntncAddR = {23 .. 27};
-	PhyMntncReg = {18 .. 22};
-	PhyMntncData = {0 .. 15};
-	PhyMntncPhyAdShift = 23;
-	PhyMntncPhRegShift = 18;
-
-	RxsrHrespnok = 3;
-	RxsrRxOvr = 2;
-	RxsrFrameRx = 1;
-	RxsrBuffna = 0;
-	RxsrError = 13;
-
-	RxBufBcast = 31;
-	RxBufMultiHash = 30;
-	RxBufUniHash = 29;
-	RxBufExh = 28;
-	RxBufAMatch = {25,26};
-	RxBufIDfound = 24;
-	RxBufIDmatch = {22,23};
-	RxBufVlan = 21;
-	RxBufPri = 20;
-	RxBufVpri = {17..19};
-	RxBufCfi = 16;
-	RxBufEof = 15;
-	RxBufSof = 14;
-	RxBufLen = {0 .. 13};
-	RxBufWrap = 1;
-	RxBufNew = 0;
-	RxBufAdd = {2 .. 31};
-	RxBufSize = 1536;
-	RxBufUnit = 64;
-
-	TxBufUsed = 31;
-	TxBufWrap = 30;
-	TxBufRetry = 29;
-	TxBufUrun = 28;
-	TxBufExh = 27;
-	TxBufTcp = 26;
-	TxBufNocrc = 16;
-	TxBufLast = 15;
-	TxBufLen = {0 .. 13};
-
-	TxsrHrespnok = 8;
-	TxsrUrun = 6;
-	TxsrTxCompl = 5;
-	TxsrBufExh = 4;
-	TxsrTxGo = 3;
-	TxsrRxOvr = 2;
-	TxsrFrameRx = 1;
-	TxsrUsedRead = 0;
-	TxsrError = {TxsrHrespnok, TxsrUrun, TxsrBufExh, TxsrRxOvr, TxsrFrameRx, TxsrUsedRead};
-
-	(** Clock divisors *)
-	MdcDiv8 = 0;
-	MdcDiv16 = 1;
-	MdcDiv32 = 2;
-	MdcDiv48 = 3;
-	MdcDiv64 = 4;
-	MdcDiv96 = 5;
-	MdcDiv128 = 6;
-	MdcDiv224 = 7;
-
-	(* Phy return state *)
-	EmacMiiReadError = 1003;
-	EmacMiiBusy = 1004;
-	Success = 0;
-	Failure = 1;
-	DeviceIsStarted = 5;
-	DeviceIsStopped = 6;
-
-	(* Phy registers *)
-	IeeeControlReg = 0;
-	IeeeStatusReg = 1;
-	IeeeAutonegoAdvertiseReg = 4;
-	IeeePartnerAbilities1Reg = 5;
-	Ieee1000AdvertiseReg = 9;
-	IeeePartnerAbilities3Reg = 10;
-	IeeeCopperSpecificControlReg = 16;
-	IeeeSpecificStatusReg = 17;
-	IeeeCopperSpecificStatusReg2 = 19;
-	IeeeControlRegMac = 21;
-	IeeePageAddressRegister = 22;
-
-	(* Phy bits and masks *)
-	Advertise10Half = 5;
-	Advertise10Full = 6;
-	Advertise100Half = 7;
-	Advertise100Full = 8;
-	Advertise100 = {Advertise100Full, Advertise100Half};
-	Advertise10 = {Advertise10Full, Advertise10Half};
-	Advertise1000 = {8, 9};
-
-	IeeeCtrl1GbpsLinkspeed = 2040H;
-	IeeeCtrlLinkSpeed = {6};
-	IeeeCtrlLinkSpeed1000M = {6};
-	IeeeCtrlLinkSpeed100M = {13};
-	IeeeCtrlLinkSpeed10M = {};
-	IeeeCtrlReset = {15};
-	IeeeCtrlAutonegotiateEnable = {12};
-	IeeeStatAutonegotiateCapable = {3};
-	IeeeStatAutonegotiateComplete = {5};
-	IeeeStatAutonegotiateRestart = {9};
-	IeeeStat1gbpsExtensions = {8};
-	IeeeAn1Ability = {5 .. 12};
-	IeeeAn3Ability1Gbps = {10 .. 11};
-	IeeeAn1Ability100Mbps = {7 .. 9};
-	IeeeAn1Ability10Mbps = {5 .. 6};
-	IeeeRgmiiTxRxClockDelayed = {4 .. 5};
-
-	IeeeAsymmetricPause = {11};
-	IeeePause = {10};
-	IeeeAutonegError = {15};
-
-	PhyDetectReg = 1;
-	PhyDetect = {3, 11, 12};
-
-TYPE
-	Buffer = ARRAY BufSize OF CHAR;
-
-	(** Implements the Network.LinkDevice abstract class. *)
-	LinkDevice * = OBJECT (Network.LinkDevice)
-		VAR
-			ctrl: Controller;
-
-		PROCEDURE & Constr * (type, mtu, adrSize: LONGINT);
-		VAR
-			i: LONGINT;
-		BEGIN
-			Constr^(type, mtu, adrSize);
-			FOR i := 0 TO LEN(broadcast) - 1 DO
-				broadcast[i] := 0FFX
-			END;
-		END Constr;
-
-		PROCEDURE Linked * (): LONGINT;
-		BEGIN
-			RETURN Network.LinkLinked
-		END Linked;
-
-		PROCEDURE DoSend * (dst: Network.LinkAdr; type: LONGINT; CONST l3hdr, l4hdr, data: ARRAY OF CHAR; h3len, h4len, dofs, dlen: LONGINT);
-		BEGIN
-			ctrl.SendFrame(dst, type, l3hdr, l4hdr, data, h3len, h4len, dofs, dlen);
-		END DoSend;
-
-		PROCEDURE Finalize * (on: BOOLEAN);
-		BEGIN
-			Finalize^(on)
-		END Finalize;
-	END LinkDevice;
-
-	(** Ethernet controller driver. *)
-	Controller = OBJECT
-		VAR
-			(** Base of memory-mapped registers *)
-			iobase: ADDRESS;
-			dev: LinkDevice;
-			phy: Phy;
-			state, isStarted: LONGINT;
-			speed: LONGINT;
-			timer: Kernel.Timer;
-			rxFrames: POINTER TO ARRAY OF Buffer;
-			txFrame: Buffer;
-			lastRxQBar, lastTxQBar: ADDRESS;
-			rxBdBase, txBdBase: ADDRESS;
-			options: SET;
-			txBdStartAdr, txBdEndAdr, rxBdStartAdr, rxBdEndAdr: ADDRESS;
-			kill, start: BOOLEAN;
-
-			(* For DMA interaction *)
-			buffer: POINTER TO ARRAY OF CHAR;
-
-			(** Statistics *)
-			nbrRxFrames, nbrtxFrames, nbrRxErrors, nbrTxErrors: LONGINT;
-
-		(** Initializes the controller.
-			iobase: base address of the registers
-		*)
-		PROCEDURE & Init * (iobase: ADDRESS; ld: LinkDevice);
-		VAR
-			i: LONGINT;
-			reg: SET;
-			(* TEST *)arp: ARRAY 28 OF CHAR;
-			buf: ARRAY 256 OF Network.Buffer;
-		BEGIN
-			NEW(timer);
-			NEW(rxFrames, RxBdCount);
-			options := Defaults;
-			SELF.iobase := iobase;
-			dev := ld;
-			dev.calcChecksum := {Network.ChecksumIP, Network.ChecksumTCP, Network.ChecksumUDP};
-			kill := FALSE;
-			start := FALSE;
-			state := IsReady;
-			Reset;
-
-			(* Initialize HW *)
-			IF Trace THEN KernelLog.String("Zynq.XEmac: Initializing hardware"); KernelLog.Ln END;
-			SetMacAddress(1, SYSTEM.VAL(Network.LinkAdr, [0X, 0AX, 35X, 0X, 1X, 2X, 0X, 0X]));
-			SetMdioDivisor(MdcDiv224);
-			NEW(phy, iobase);
-			speed := phy.linkSpeed;
-			IF speed # 1000 THEN
-				IF Trace THEN KernelLog.String("XEmac: error in speed initialization."); KernelLog.Ln END;
-				RETURN
-			END;
-
-			SetOperatingSpeed(speed);
-
-			SYSTEM.GET(iobase + Dmacr, reg);
-			INCL(reg, 4);
-			SYSTEM.PUT(iobase + Dmacr, reg);
-
-			SetMdioDivisor(MdcDiv224);
-			IF Trace THEN KernelLog.String("XEmac: Initializing DMA"); KernelLog.Ln END;
-			FOR i := 0 TO 6000000 DO END;
-
-			InitDMA;
-			
-			(* preallocate network stack buffers *)
-			FOR i := 0 TO LEN(buf,0)-1 DO
-				buf[i] := Network.GetNewBuffer();
-			END;
-			FOR i := 0 TO LEN(buf,0)-1 DO
-				Network.ReturnBuffer(buf[i]);
-			END;
-
-			IF Trace THEN KernelLog.String("XEmac: Starting controller"); KernelLog.Ln END;
-			Start
-		END Init;
-
-		(* Terminates the process *)
-		PROCEDURE Kill;
-		BEGIN {EXCLUSIVE}
-			kill := TRUE
-		END Kill;
-
-		PROCEDURE Start;
-		VAR
-			reg: SET;
-		BEGIN
-			IF Trace THEN KernelLog.String("Starting XEmac"); KernelLog.Ln END;
-			IF isStarted = IsStarted THEN RETURN END;
-			(* Start DMA *)
-			SYSTEM.PUT(iobase + Rxqbase, rxBdBase);
-			SYSTEM.PUT(iobase + Txqbase, txBdBase);
-
-			(* Clear any existing interrupt status *)
-			SYSTEM.PUT(iobase + Isr, IxrAll);
-
-			(* Optionally enable TX and RX *)
-			IF TransmitterEnable IN options THEN
-				SYSTEM.GET(iobase + Nwctrl, reg);
-				reg := reg + NwctrlTxEn;
-				SYSTEM.PUT(iobase + Nwctrl, reg)
-			END;
-			IF ReceiverEnable IN options THEN
-				SYSTEM.GET(iobase + Nwctrl, reg);
-				reg := reg + NwctrlRxEn;
-				SYSTEM.PUT(iobase + Nwctrl, reg)
-			END;
-
-			(* Enable TX and RX interrupts *)
-			SYSTEM.PUT(iobase + Ier, (IxrTxErr + IxrRxErr + {IxrTxCompl, IxrFrameRx}) * IxrAll);
-
-			(*BEGIN {EXCLUSIVE}
-				start := TRUE
-			END;*)
-		(*VAR
-			reg: SET;
-		BEGIN
-			SYSTEM.GET(iobase + Nwctrl, reg);
-			reg := reg + NwctrlStartTx;
-			SYSTEM.PUT(iobase + Nwctrl, reg)*)
-		END Start;
-
-		PROCEDURE Stop;
-		VAR
-			reg: SET;
-		BEGIN
-			ASSERT(state = IsReady);
-			(* Disable all interrupts *)
-			SYSTEM.PUT32(iobase + Idr, IxrAll);
-			(* Disable TX and RX *)
-			SYSTEM.GET(iobase + Nwctrl, reg);
-			reg := reg - (NwctrlRxEn + NwctrlTxEn);
-			SYSTEM.PUT(iobase + Nwctrl, reg);
-			isStarted := 0
-		END Stop;
-
-		PROCEDURE Transmit;
-		VAR
-			reg: SET;
-		BEGIN
-			IF Trace THEN KernelLog.String("XEmac: transmitting"); KernelLog.Ln END;
-			SYSTEM.GET(iobase + Nwctrl, reg);
-			reg := reg + NwctrlStartTx;
-			SYSTEM.PUT(iobase + Nwctrl, reg)
-		END Transmit;
-
-		(** Stop and restart device *)
-		PROCEDURE Reset;
-		VAR
-			i, tmp: LONGINT;
-			reg: SET;
-		BEGIN
-			IF Trace THEN KernelLog.String("XEmac resetting controller"); KernelLog.Ln END;
-			ASSERT(state = IsReady);
-
-			Stop;
-			options := Defaults;
-			reg := (NwctrlStatclr + NwctrlMdEn) * (-NwctrlLoopEn);
-			SYSTEM.PUT(iobase + Nwctrl, reg);
-
-			reg := {};
-			INCL(reg, Nwcfg100);
-			INCL(reg, NwcfgFdEn);
-			INCL(reg, NwcfgUcastHashEn);
-			SYSTEM.PUT(iobase + Nwcfg, reg);
-
-			i := RxBufSize DIV RxBufUnit;
-			IF RxBufSize MOD RxBufUnit # 0 THEN INC(i) END;
-			reg := SYSTEM.VAL(SET, LSH(i, DmacrRxBufShift)) * DmacrRxBuf + DmacrRxSize;
-			INCL(reg, DmacrTxSize);
-			SYSTEM.PUT(iobase + Dmacr, reg);
-
-			SYSTEM.PUT32(iobase + Txsr, 0);
-			SYSTEM.PUT32(iobase + Rxqbase, 0);
-			SYSTEM.PUT32(iobase + Txqbase, 0);
-			SYSTEM.PUT32(iobase + Rxsr, 0);
-			SYSTEM.PUT32(iobase + Idr, IxrAll);
-
-			SYSTEM.GET(iobase + Isr, reg);
-			SYSTEM.PUT(iobase + Isr, reg);
-
-			SYSTEM.PUT32(iobase + PhyMntnc, 0);
-
-			ClearHash;
-
-			(* Clear all MAC addresses *)
-			FOR i := 1 TO 4 DO
-				SetMacAddress(i, ZeroMAC);
-				tmp := SetTypeIdCheck(i, 0)
-			END;
-
-			(* Clear all counters. *)
-			FOR i := 0 TO (Last- OctTxL) DIV 4 - 1 DO
-				SYSTEM.GET(iobase + OctTxL + 4 * i, reg)
-			END;
-
-			(* Disable receiver. *)
-			SYSTEM.GET(iobase + Nwctrl, reg);
-			SYSTEM.PUT(iobase + Nwctrl, reg - NwctrlRxEn);
-
-			SetOptions(options - {TransmitterEnable, ReceiverEnable});
-			ClearOptions(-options);
-		END Reset;
-
-		PROCEDURE ResetDevice;
-		VAR
-			options: SET;
-		BEGIN
-			Stop;
-			options := SELF.options;
-			Reset;
-			SetOptions(options);
-			ClearOptions(-options)
-		END ResetDevice;
-
-		PROCEDURE SendFrame (CONST dst: Network.LinkAdr; type: LONGINT; CONST l3hdr, l4hdr, data: ARRAY OF CHAR; h3len, h4len, dofs, dlen: LONGINT);
-		VAR
-			txLen, offset: LONGINT;
-			bufferAdr, txbd: ADDRESS;
-			intsEnabled: BOOLEAN;
-			reg: SET;
-		BEGIN (*{EXCLUSIVE}*)
-			IF Trace THEN KernelLog.String("XEmac: Sending Frame"); KernelLog.Ln END;
-			(* Prepare buffer *) (* This part is taken from RTL8169.Mod *)
-			txLen := 14 + h3len + h4len + dlen;
-			bufferAdr := ADDRESSOF(txFrame[0]);
-
-			(* set destination mac address (first 6 bytes of eth frame) *)
-			SYSTEM.MOVE(ADDRESSOF(dst[0]), bufferAdr, 6);
-			(*txFrame[0] := dst[0]; txFrame[1] := dst[1]; txFrame[2] := dst[2]; txFrame[3] := dst[3]; txFrame[4] := dst[4]; txFrame[5] := dst[5];*)
-			(* set source mac address (6 bytes @ offset 6 of eth frame) *)
-			SYSTEM.MOVE(ADDRESSOF(dev.local[0]), bufferAdr + 6, 6);
-			(*txFrame[6]:=000X;txFrame[7]:=00AX;txFrame[8]:=035X;txFrame[9]:=000X;txFrame[10]:=001X;txFrame[11]:=002X;*)
-
-			(* set upper layer type, bring type from host to network byte order *)
-			SYSTEM.PUT16(bufferAdr + 12, ROT(SYSTEM.VAL(INTEGER, SHORT(type)), 8));
-
-			(*IF Trace THEN
-				KernelLog.Buffer(txFrame, 0, txLen);
-				KernelLog.Ln
-			END;*)
-
-			offset := 14;
-			(* move layer 3 and layer 4 headers, data *)
-			IF h3len > 0 THEN
-				SYSTEM.MOVE(ADDRESSOF(l3hdr[0]), bufferAdr + offset, h3len);
-				INC(offset, h3len);
-			END;
-			IF h4len > 0 THEN
-				SYSTEM.MOVE(ADDRESSOF(l4hdr[0]), bufferAdr + offset, h4len);
-				INC(offset, h4len);
-			END;
-			IF offset + dlen < BufSize THEN
-				SYSTEM.MOVE(ADDRESSOF(data[0]) + dofs, bufferAdr + offset, dlen);
-				INC(offset, dlen);
-			END;
-
-			(* make the frame at least 64 bytes long *)
-			WHILE offset < 60 DO
-				txFrame[offset] := CHR(0);
-				INC(offset);
-				INC(txLen)
-			END;
-
-			(*IF Trace THEN
-				KernelLog.String("Sending frame of length ");
-				KernelLog.Int(txLen, 0);
-				KernelLog.Ln;
-				KernelLog.Memory(bufferAdr, txLen)
-			END;*)
-
-			(* Send it with DMA *)
-			intsEnabled := Machine.AreInterruptsEnabled();
-			Machine.DisableInterrupts;
-
-			SYSTEM.GET(iobase + Txqbase, txbd);
-			IF txbd = 0 THEN txbd := txBdStartAdr END;
-
-			Machine.FlushDCacheRange(ADDRESSOF(txFrame[0]), txLen);
-
-			SYSTEM.PUT(txbd + BdAdrOffset, ADDRESSOF(txFrame));
-			IF txbd # txBdEndAdr THEN
-				SYSTEM.PUT(txbd + BdStatOffset, {TxBufLast} + SYSTEM.VAL(SET, txLen));
-			ELSE
-				IF Trace THEN KernelLog.String("END OF TXBUFFERS"); KernelLog.Ln END;
-				SYSTEM.PUT(txbd + BdStatOffset, {TxBufLast, TxBufWrap} + SYSTEM.VAL(SET, txLen));
-			END;
-			
-			(* no need to flush/invalidate cache for BD memory space
-			Machine.FlushDCacheRange(txbd, BdSize);
-			*)
-			
-			CODE
-				DSB
-			END;
-
-			(* Transmit *)
-			Transmit;
-
-			IF intsEnabled THEN Machine.EnableInterrupts END;
-		END SendFrame;
-
-		(** Called by the polling body. Signals the new frames to the link device *)
-		PROCEDURE ReceiveFrame;
-		VAR
-			currentBd, adr: ADDRESS;
-			len, i: LONGINT;
-			reg: SET;
-			buf: Network.Buffer;
-			type: INTEGER;
-		BEGIN
-			(*IF Trace THEN KernelLog.String("Receiving frame"); KernelLog.Ln END;*)
-			currentBd := lastRxQBar;
-			SYSTEM.GET(currentBd + BdAdrOffset, adr);
-			adr := adr - (adr MOD 4);
-
-			SYSTEM.GET(currentBd, reg);
-			IF RxBufNew IN reg THEN
-				(*IF Trace THEN
-					KernelLog.String("Current BD: "); KernelLog.Address(currentBd); KernelLog.Ln;
-					KernelLog.String("QBar: "); KernelLog.Address(SYSTEM.GET32(iobase + Rxqbase)); KernelLog.Ln
-				END;*)
-
-				IF SYSTEM.GET32(currentBd + 4) = 0 THEN
-					SYSTEM.GET(iobase + Nwctrl, reg);
-					reg := reg * SET(-NwctrlRxEn);
-					SYSTEM.PUT(iobase + Nwctrl, reg);
-
-					SYSTEM.GET(iobase + Nwctrl, reg);
-					reg := reg + NwctrlRxEn + {18};
-					SYSTEM.PUT(iobase + Nwctrl, reg)
-				ELSE
-					IF Trace THEN KernelLog.String("Receiving frame"); KernelLog.Ln END;
-					SYSTEM.GET(currentBd + BdStatOffset, reg);
-					len := SYSTEM.VAL(LONGINT, reg * RxBufLen);
-					(* Invalidate DCache *)
-					(* no need to flush/invalidate cache for BD memory space
-					Machine.InvalidateDCacheRange(currentBd,BdSize);
-					*)
-					Machine.InvalidateDCacheRange(adr,len);					
-
-					(* Construct Frame *)
-					buf := Network.GetNewBuffer(); ASSERT(buf # NIL);
-					buf.ofs := 14;
-					buf.len := len - 14;
-					buf.next := NIL;
-					buf.prev := NIL;
-					buf.calcChecksum := dev.calcChecksum;
-					
-					SYSTEM.MOVE(adr+6,ADDRESSOF(buf.src[0]),6);
-					
-					type := INTEGER(SYSTEM.GET8(adr + 12)) * 100H + INTEGER(SYSTEM.GET8(adr + 13));
-					SYSTEM.MOVE(adr,ADDRESSOF(buf.data[0]),len);
-					dev.QueueBuffer(buf, type)
-				END
-			END;
-
-			IF currentBd = rxBdEndAdr THEN
-				SYSTEM.PUT32(currentBd + BdAdrOffset, adr + 2);
-				lastRxQBar := rxBdStartAdr
-			ELSE
-				SYSTEM.PUT32(currentBd + BdAdrOffset, adr);
-				INC(lastRxQBar, BdSize)
-			END;
-			SYSTEM.PUT32(currentBd + BdStatOffset, 0);
-			
-			(* no need to flush/invalidate cache for BD memory space
-			Machine.FlushDCacheRange(currentBd, BdSize);
-			*)
-		END ReceiveFrame;
-
-		PROCEDURE SetOptions (opts: SET);
-		VAR
-			reg, regNetCfg, regNewNetCfg: SET;
-		BEGIN
-			IF Trace THEN KernelLog.String("XEmac.SetOptions: "); KernelLog.Hex(SYSTEM.VAL(ADDRESS, opts), -8); KernelLog.Ln END;
-
-			ASSERT(state = IsReady);
-
-
-			(* Many of these options will change the NET_CONFIG registers.
-			 * To reduce the amount of IO to the device, group these options here
-			 * and change them all at once.
-			 *)
-
-			(* Grab current register contents *)
-			SYSTEM.GET(iobase + Nwcfg, regNetCfg);
-			regNewNetCfg := regNetCfg;
-			IF Trace THEN KernelLog.String("regNetCfg="); KernelLog.Hex(SYSTEM.VAL(LONGINT, regNetCfg), -8); KernelLog.Ln END;
-			(*
-			 * It is configured to max 1536.
-			 *)
-			IF Frame1536 IN opts  THEN
-				regNewNetCfg := regNewNetCfg + {Nwcfg1536RxEn};
-			END;
-
-			(* Turn on VLAN packet only, only VLAN tagged will be accepted *)
-			IF Vlan IN opts  THEN
-				regNewNetCfg := regNewNetCfg + {NwcfgNvlanDisc};
-			END;
-
-			(* Turn on FCS stripping on receive packets *)
-			IF FcsStrip IN opts  THEN
-				regNewNetCfg := regNewNetCfg + {NwcfgFcsRem};
-			END;
-
-			(* Turn on length/type field checking on receive packets *)
-			IF LenTypeErr IN opts  THEN
-				regNewNetCfg := regNewNetCfg + {NwcfgLengthErrDscrd};
-			END;
-
-			(* Turn on flow control *)
-			IF FlowControl IN opts  THEN
-				regNewNetCfg := regNewNetCfg + {NwcfgPauseEn};
-			END;
-
-			(* Turn on promiscuous frame filtering (all frames are received) *)
-			IF Promisc IN opts  THEN
-				regNewNetCfg := regNewNetCfg + {NwcfgCopyAllEn};
-			END;
-
-			(* Allow broadcast address reception *)
-			IF Broadcast IN opts  THEN
-				regNewNetCfg := regNewNetCfg - {NwcfgBcastDi};
-			END;
-
-			(* Allow multicast address filtering *)
-			IF Multicast IN opts  THEN
-				regNewNetCfg := regNewNetCfg + {NwcfgMcastHashEn};
-			END;
-
-			(* enable RX checksum offload *)
-			IF RxChksumEnable IN opts  THEN
-				regNewNetCfg := regNewNetCfg + {NwcfgRxChkSumEn};
-			END;
-
-			(* Officially change the NET_CONFIG registers if it needs to be
-			 * modified.
-			 *)
-			IF regNetCfg # regNewNetCfg THEN
-				SYSTEM.PUT(iobase + Nwcfg, regNewNetCfg);
-			END;
-			IF Trace THEN KernelLog.String("regNewNetCfg="); KernelLog.Hex(SYSTEM.VAL(LONGINT, regNewNetCfg), -8); KernelLog.Ln END;
-
-			(* Enable TX checksum offload *)
-			IF TxChksumEnable IN opts  THEN
-				SYSTEM.GET(iobase + Dmacr, reg);
-				reg := reg + {DmacrTcpChksum};
-				SYSTEM.PUT(iobase + Dmacr, reg);
-				IF Trace THEN KernelLog.String("DMACR_OFFSET reg="); KernelLog.Hex(SYSTEM.VAL(LONGINT, reg), -8); KernelLog.Ln END;
-			END;
-
-			(* Enable transmitter *)
-			IF TransmitterEnable IN opts  THEN
-				SYSTEM.GET(iobase + Nwctrl, reg);
-				reg := reg + NwctrlTxEn;
-				SYSTEM.PUT(iobase + Nwctrl, reg);
-				IF Trace THEN KernelLog.String("NWCTRL_OFFSET reg="); KernelLog.Hex(SYSTEM.VAL(LONGINT, reg), -8); KernelLog.Ln END;
-			END;
-
-			(* Enable receiver *)
-			IF ReceiverEnable IN opts  THEN
-				SYSTEM.GET(iobase + Nwctrl, reg);
-				reg := reg + NwctrlRxEn;
-				SYSTEM.PUT(iobase + Nwctrl, reg);
-				IF Trace THEN KernelLog.String("NWCTRL_OFFSET reg="); KernelLog.Hex(SYSTEM.VAL(LONGINT, reg), -8); KernelLog.Ln END;
-			END;
-
-			(* The remaining options not handled here are managed elsewhere in the
-			 * driver. No register modifications are needed at this time. Reflecting
-			 * the option in InstancePtr->Options is good enough for now.
-			 *)
-
-			(* Set options word to its new value *)
-			SELF.options := SELF.options + opts;
-			IF Trace THEN KernelLog.String("SetOptions END "); KernelLog.Address(SYSTEM.VAL(ADDRESS, SELF.options)); KernelLog.Ln END;
-		END SetOptions;
-
-		PROCEDURE ClearOptions (opts: SET);
-		VAR
-			reg, old: SET;
-		BEGIN
-			IF Trace THEN KernelLog.String("XEmac: Clear Options"); KernelLog.Ln END;
-
-			SYSTEM.GET(iobase + Nwcfg, reg);
-			old := reg;
-
-			(*
-			 * It is configured to max 1536.
-			 *)
-			IF Frame1536 IN opts  THEN
-				EXCL(reg, Nwcfg1536RxEn);
-			END;
-
-			(* Turn off VLAN packet only, only VLAN tagged will be accepted *)
-			IF Vlan IN opts  THEN
-				EXCL(reg, NwcfgNvlanDisc);
-			END;
-
-			(* Turn off FCS stripping on receive packets *)
-			IF FcsStrip IN opts  THEN
-				EXCL(reg, NwcfgFcsRem);
-			END;
-
-			(* Turn off length/type field checking on receive packets *)
-			IF LenTypeErr IN opts  THEN
-				EXCL(reg, NwcfgLengthErrDscrd);
-			END;
-
-			(* Turn off flow control *)
-			IF FlowControl IN opts  THEN
-				EXCL(reg, NwcfgPauseEn);
-			END;
-
-			(* Turn off promiscuous frame filtering (all frames are received) *)
-			IF Promisc IN opts  THEN
-				EXCL(reg, NwcfgCopyAllEn);
-			END;
-
-			(* Forbid broadcast address reception *)
-			IF Broadcast IN opts  THEN
-				EXCL(reg, NwcfgBcastDi);
-			END;
-
-			(* Forbid multicast address filtering *)
-			IF Multicast IN opts  THEN
-				EXCL(reg, NwcfgMcastHashEn);
-			END;
-
-			(* Disable RX checksum offload *)
-			IF RxChksumEnable IN opts  THEN
-				EXCL(reg, NwcfgRxChkSumEn);
-			END;
-
-			(* Officially change the NET_CONFIG registers if it needs to be
-			 * modified.
-			 *)
-			IF reg # old THEN
-				SYSTEM.PUT(iobase + Nwcfg, reg);
-			END;
-			IF Trace THEN KernelLog.String("regNewNetCfg="); KernelLog.Hex(SYSTEM.VAL(LONGINT, reg), -8); KernelLog.Ln END;
-
-			(* Disable TX checksum offload *)
-			IF TxChksumEnable IN opts  THEN
-				SYSTEM.GET(iobase + Dmacr, reg);
-				EXCL(reg, DmacrTcpChksum);
-				SYSTEM.PUT(iobase + Dmacr, reg);
-				IF Trace THEN KernelLog.String("DMACR_OFFSET reg="); KernelLog.Hex(SYSTEM.VAL(LONGINT, reg), -8); KernelLog.Ln END;
-			END;
-
-			(* Disable transmitter *)
-			IF TransmitterEnable IN opts  THEN
-				SYSTEM.GET(iobase + Nwctrl, reg);
-				reg := reg * SET(-NwctrlTxEn);
-				SYSTEM.PUT(iobase + Nwctrl, reg);
-				IF Trace THEN KernelLog.String("NWCTRL_OFFSET reg="); KernelLog.Hex(SYSTEM.VAL(LONGINT, reg), -8); KernelLog.Ln END;
-			END;
-
-			(* Disable receiver *)
-			IF ReceiverEnable IN opts  THEN
-				SYSTEM.GET(iobase + Nwctrl, reg);
-				reg := reg * SET(-NwctrlRxEn);
-				SYSTEM.PUT(iobase + Nwctrl, reg);
-				IF Trace THEN KernelLog.String("NWCTRL_OFFSET reg="); KernelLog.Hex(SYSTEM.VAL(LONGINT, reg), -8); KernelLog.Ln END;
-			END;
-
-			SELF.options := SELF.options * (-opts);
-		END ClearOptions;
-
-		PROCEDURE ClearHash;
-		BEGIN
-			IF Trace THEN KernelLog.String("XEmac: Clear Hash"); KernelLog.Ln END;
-			ASSERT(state = IsReady);
-			SYSTEM.PUT32(iobase + HashL, 0);
-			SYSTEM.PUT32(iobase + HashH, 0)
-		END ClearHash;
-
-		PROCEDURE SetMdioDivisor (divisor: LONGINT);
-			VAR
-				reg: SET;
-		BEGIN
-			ASSERT(state = IsReady);
-			(* Only last 3 bits are valid *)
-			ASSERT(divisor < 8);
-
-			SYSTEM.GET(iobase + Nwcfg, reg);
-			reg := reg * SET(-NwcfgMdcClkDiv);
-			reg := reg + SYSTEM.VAL(SET, LSH(divisor, NwcfgMdcShift));
-			SYSTEM.PUT(iobase + Nwcfg, reg);
-		END SetMdioDivisor;
-
-		PROCEDURE SetOperatingSpeed (speed: LONGINT);
-		VAR
-			reg: SET;
-		BEGIN
-			IF Trace THEN KernelLog.String("XEmac: setting operating speed."); KernelLog.Ln END;
-			ASSERT(state = IsReady);
-			ASSERT((speed = 10) OR (speed = 100) OR (speed = 1000));
-
-			SYSTEM.GET(iobase + Nwcfg, reg);
-
-			reg := reg - {Nwcfg1000, Nwcfg100};
-			CASE speed OF
-				 10:
-				|100:
-					INCL(reg, Nwcfg100)
-				|1000:
-					INCL(reg, Nwcfg1000)
-			END;
-
-			SYSTEM.PUT(iobase + Nwcfg, reg);
-
-			IF Trace THEN KernelLog.String("Waiting for operation speed to stabilize"); KernelLog.Ln END;
-			timer.Sleep(1000);
-			IF Trace THEN KernelLog.String("XEmac: operating speed set."); KernelLog.Ln END;
-		END SetOperatingSpeed;
-
-		(*! TODO: change parameter interface to a more convenient one *)
-		PROCEDURE SetMacAddress(index: LONGINT; mac: Network.LinkAdr);
-		VAR
-			reg: SET;
-		BEGIN
-			ASSERT(index > 0);
-			DEC(index);
-			reg := SYSTEM.VAL(SET, ORD(mac[0]) + LSH(ORD(mac[1]), 8) + LSH(ORD(mac[2]), 16) + LSH(ORD(mac[3]), 24));
-			SYSTEM.PUT(iobase + Laddr1l + (index * 8), reg);
-
-			(* There are reserved bits in TOP so don't affect them *)
-			SYSTEM.GET(iobase + Laddr1h + (index * 8), reg);
-			reg := reg * SET(-LaddrMach) + SYSTEM.VAL(SET, ORD(mac[4]) + LSH(ORD(mac[5]), 8));
-			SYSTEM.PUT(iobase + Laddr1h + index * 8, reg);
-
-			dev.local := mac;
-			IF Trace THEN
-				KernelLog.String("XEmac MAC address set to: ");
-				KernelLog.Hex(ORD(mac[0]), -2); KernelLog.String(".");
-				KernelLog.Hex(ORD(mac[1]), -2); KernelLog.String(".");
-				KernelLog.Hex(ORD(mac[2]), -2); KernelLog.String(".");
-				KernelLog.Hex(ORD(mac[3]), -2); KernelLog.String(".");
-				KernelLog.Hex(ORD(mac[4]), -2); KernelLog.String(".");
-				KernelLog.Hex(ORD(mac[5]), -2); KernelLog.Ln
-			END
-		END SetMacAddress;
-
-		PROCEDURE SetTypeIdCheck(index, idCheck: LONGINT): LONGINT;
-		BEGIN
-			ASSERT(state = IsReady);
-			ASSERT((index > 0) & (index <= MaxTypeId));
-			IF isStarted = IsStarted THEN
-				RETURN IsStarted
-			END;
-
-			SYSTEM.PUT(iobase + Match1 + index * 4, idCheck);
-			RETURN Success
-		END SetTypeIdCheck;
-
-		PROCEDURE InitDMA;
-		CONST
-			MB = 1024*1024;
-		VAR
-			beginAdr, endAdr, adr: ADDRESS;
-			reg: SET;
-			i: LONGINT;
-		BEGIN
-			IF Trace THEN KernelLog.String("XEmac: Starting DMA"); KernelLog.Ln END;
-			
-			(*
-			NEW(buffer, (RxBdCount + TxBdCount + 20) * BdSize);
-			*)
-
-			(* allocate 2 pages (each page is 1 MBytes) of memory in Heaps for mapping one full page uncached 
-				without affecting any adjacent data *)
-			NEW(buffer,2*MB);
-			ASSERT((RxBdCount + TxBdCount + 20) * BdSize <= MB);
-			beginAdr := ADDRESSOF(buffer[0]);
-			beginAdr := beginAdr + (MB - beginAdr MOD MB);
-			ASSERT(beginAdr MOD MB = 0);
-			Machine.DisableDCacheRange(beginAdr,MB);
-			
-			(* setup DMA RX buffer descriptors *)
-			rxBdStartAdr := beginAdr;
-			endAdr := beginAdr + (RxBdCount - 1) * BdSize;
-			rxBdEndAdr := endAdr;
-			i := 0;
-			adr := beginAdr;
-			WHILE adr < endAdr DO
-				SYSTEM.PUT32(adr + BdAdrOffset, ADDRESSOF(rxFrames[i][0]));
-				INC(adr, BdSize);
-				INC(i)
-			END;
-
-			SYSTEM.PUT32(adr + BdAdrOffset, ADDRESSOF(rxFrames[i][0]) + 2);
-			lastRxQBar := beginAdr;
-			rxBdBase := beginAdr;
-			CODE
-				DSB
-			END;
-			
-			(* no need to flush/invalidate cache for BD memory space
-			(* Flush DCache *)
-			Machine.FlushDCacheRange(beginAdr, RxBdCount * BdSize);
-			*)
-			
-			IF Trace THEN KernelLog.String("XEmac: RX buffers are set up."); KernelLog.Ln END;
-
-			(* setup DMA TX buffer descriptors *)
-			beginAdr := endAdr + BdSize;
-			txBdStartAdr := beginAdr;
-			endAdr := beginAdr + (TxBdCount - 1) * BdSize;
-			txBdEndAdr := endAdr;
-			adr := beginAdr;
-			WHILE adr < endAdr DO
-				SYSTEM.PUT32(adr, 0);
-				SYSTEM.PUT32(adr + 4, {TxBufUsed});
-				INC(adr, BdSize)
-			END;
-			SYSTEM.PUT32(adr + 4, {TxBufUsed, TxBufWrap});
-			lastTxQBar := beginAdr;
-			txBdBase := beginAdr;
-			CODE
-				DSB
-			END;
-			
-			(* no need to flush/invalidate cache for BD memory space
-			(* Flush DCache *)
-			Machine.FlushDCacheRange(txBdBase, TxBdCount * BdSize);
-			*)
-			
-			IF Trace THEN KernelLog.String("XEmac: TX buffers are set up."); KernelLog.Ln END;
-
-			Objects.InstallHandler(SELF.InterruptHandler, IRQ);
-			IF Trace THEN KernelLog.String("DMA Initialized"); KernelLog.Ln END
-		END InitDMA;
-
-		(**
-			Interrupt handler -- tries to handle the maximum number of IRQs
-			at once.
-		*)
-		PROCEDURE InterruptHandler;
-		VAR
-			regISR, regSR: SET;
-		BEGIN
-			ASSERT(state = IsReady);
-
-			(* Get and clear interrupts *)
-			SYSTEM.GET(iobase + Isr, regISR);
-			SYSTEM.PUT(iobase + Isr, regISR);
-
-			(* Transmit complete interrupt *)
-			IF IxrTxCompl IN regISR THEN
-				SYSTEM.PUT(iobase + Txsr, {TxsrTxCompl, TxsrUsedRead});
-				SendHandler
-			END;
-
-			(* Receive complete interrupt *)
-			IF IxrFrameRx IN regISR THEN
-				SYSTEM.PUT(iobase + Rxsr, {RxsrFrameRx, RxsrBuffna});
-				ReceiveHandler
-			END;
-
-			(* Receive error conditions interrupt *)
-			IF IxrRxErr * regISR # {} THEN
-				(* Clear Rx status register *)
-				SYSTEM.GET(iobase + Rxsr, regSR);
-				SYSTEM.PUT(iobase + Rxsr, regSR);
-				IF IxrRxUsed IN regISR THEN
-					(* Flush a packet from Rx SRAM *)
-					SYSTEM.GET(iobase + Nwctrl, regSR);
-					SYSTEM.PUT(iobase + Nwctrl, regSR + {18})
-				END;
-				ErrorHandler(Recv, regSR)
-			END;
-
-			(* Transmit error interrupt
-				TxCompl also activates TxUsed when asserted: we have to check for a real error.
-			*)
-			IF (IxrTxErr * regISR # {}) & (~(IxrTxCompl IN regISR)) THEN
-				SYSTEM.GET(iobase + Txsr, regSR);
-				SYSTEM.PUT(iobase + Txsr, regSR);
-				ErrorHandler(Send, regSR)
-			END;
-		END InterruptHandler;
-
-		PROCEDURE SendHandler;
-		VAR
-			reg: SET;
-			currBdPtr: ADDRESS;
-		BEGIN
-			IF Trace THEN KernelLog.String("XEmac.SendHandler"); KernelLog.Ln END;
-			SYSTEM.GET(iobase + Txsr, reg);
-			SYSTEM.PUT(iobase + Txsr, reg);
-
-			LOOP
-				currBdPtr := lastTxQBar;
-				IF currBdPtr = SYSTEM.GET32(iobase + Txqbase) THEN EXIT END;
-				SYSTEM.PUT32(currBdPtr + BdAdrOffset, 0);
-				IF currBdPtr = txBdEndAdr THEN
-					SYSTEM.PUT(currBdPtr + BdStatOffset, {TxBufUsed, TxBufWrap});
-					lastTxQBar := txBdStartAdr
-				ELSE
-					SYSTEM.PUT(currBdPtr + BdStatOffset, {TxBufUsed});
-					INC(lastTxQBar, BdSize)
-				END
-			END;
-			IF Trace THEN KernelLog.String("XEmac.SendHandler END"); KernelLog.Ln END
-		END SendHandler;
-
-		PROCEDURE ReceiveHandler;
-		(*VAR
-			buf: Network.Buffer;
-			type: LONGINT;*)
-		VAR
-			reg: SET;
-			tmp: LONGINT;
-		BEGIN
-			IF Trace THEN KernelLog.String("XEmac.ReceiveHandler"); KernelLog.Ln END;
-			SYSTEM.GET(iobase + Rxsr, reg);
-			SYSTEM.PUT(iobase + Rxsr, reg);
-
-			SYSTEM.GET(iobase + Rxcnt, tmp);
-			IF tmp = 0 THEN
-				SYSTEM.GET(iobase + Nwctrl, reg);
-				reg := reg * SET(-NwctrlRxEn);
-				SYSTEM.PUT(iobase + Nwctrl, reg);
-				SYSTEM.GET(iobase + Nwctrl, reg);
-				reg := reg  + NwctrlRxEn;
-				SYSTEM.PUT(iobase + Nwctrl, reg)
-			END
-		END ReceiveHandler;
-
-		PROCEDURE ErrorHandler (direction: CHAR; errorWord: SET);
-		BEGIN
-			IF Trace THEN KernelLog.String("XEmac.ErrorHandler: Error while ") END;
-			CASE direction OF
-				 Send:
-				 	KernelLog.String("sending"); KernelLog.Ln;
-				 	IF TxsrHrespnok IN errorWord THEN
-				 		KernelLog.String("[XEmac ERROR] Transmit DMA error"); KernelLog.Ln
-				 	END;
-				 	IF TxsrUrun IN errorWord THEN
-				 		KernelLog.String("[XEmac ERROR] Transmit underrun"); KernelLog.Ln
-				 	END;
-				 	IF TxsrBufExh IN errorWord THEN
-				 		KernelLog.String("[XEmac ERROR] Transmit buffer exhausted"); KernelLog.Ln
-				 	END;
-				 	IF TxsrRxOvr IN errorWord THEN
-				 		KernelLog.String("[XEmac ERROR] Transmit retry limit exceeded"); KernelLog.Ln
-				 	END;
-				 	IF TxsrFrameRx IN errorWord THEN
-				 		KernelLog.String("[XEmac ERROR] Transmit collision"); KernelLog.Ln
-				 	END;
-				 	IF TxsrUsedRead IN errorWord THEN
-				 		KernelLog.String("[XEmac ERROR] Transmit buffer not available"); KernelLog.Ln;
-				 		KernelLog.String("QBar = "); KernelLog.Address(SYSTEM.GET32(iobase + Txqbase)); KernelLog.Ln
-				 	END;
-				|Recv:
-				 	KernelLog.String("receiving"); KernelLog.Ln;
-					IF RxsrHrespnok IN errorWord THEN
-						KernelLog.String("[XEmac ERROR] Receive DMA error"); KernelLog.Ln
-					END;
-					IF RxsrRxOvr IN errorWord THEN
-						KernelLog.String("[XEmac ERROR] Receive overrun"); KernelLog.Ln
-					END;
-					IF RxsrBuffna IN errorWord THEN
-						KernelLog.String("[XEmac ERROR] Receive buffer not available"); KernelLog.Ln
-					END
-			END;
-			ResetDevice
-		END ErrorHandler;
-
-		PROCEDURE SendTestFrame;
-		VAR
-			txbd: ADDRESS;
-			intsEnabled: BOOLEAN;
-		BEGIN
-			txFrame[0]:=0FFX;txFrame[1]:=0FFX;txFrame[2]:=0FFX;txFrame[3]:=0FFX;txFrame[4]:=0FFX;txFrame[5]:=0FFX;
-			txFrame[6]:=000X;txFrame[7]:=00AX;txFrame[8]:=035X;txFrame[9]:=000X;txFrame[10]:=001X;txFrame[11]:=002X;
-			txFrame[12]:=008X;txFrame[13]:=006X;txFrame[14]:=000X;txFrame[15]:=001X;
-			txFrame[16]:=008X;txFrame[17]:=000X;txFrame[18]:=006X;txFrame[19]:=004X;txFrame[20]:=000X;txFrame[21]:=001X;txFrame[22]:=000X;txFrame[23]:=00AX;
-			txFrame[24]:=035X;txFrame[25]:=000X;txFrame[26]:=001X;txFrame[27]:=002X;txFrame[28]:=0C0X;txFrame[29]:=0A8X;txFrame[30]:=001X;txFrame[31]:=00AX;
-			txFrame[32]:=000X;txFrame[33]:=000X;txFrame[34]:=000X;txFrame[35]:=000X;txFrame[36]:=000X;txFrame[37]:=000X;txFrame[38]:=0C0X;txFrame[39]:=0A8X;
-			txFrame[40]:=001X;txFrame[41]:=00AX;txFrame[42]:=000X;txFrame[43]:=000X;txFrame[44]:=000X;txFrame[45]:=000X;txFrame[46]:=000X;txFrame[47]:=000X;
-			txFrame[48]:=001X;txFrame[49]:=00AX;txFrame[50]:=000X;txFrame[51]:=000X;txFrame[52]:=000X;txFrame[53]:=000X;txFrame[54]:=000X;txFrame[55]:=000X;
-			txFrame[56]:=001X;txFrame[57]:=00AX;txFrame[58]:=000X;txFrame[59]:=000X;
-
-			KernelLog.String("Sending Test Frame"); KernelLog.Ln;
-			KernelLog.Address(ADDRESSOF(txFrame)); KernelLog.Ln;
-			KernelLog.Buffer(txFrame, 0, 60);
-			(* Send it with DMA *)
-			intsEnabled := Machine.AreInterruptsEnabled();
-			Machine.DisableInterrupts;
-
-			SYSTEM.GET(iobase + Txqbase, txbd);
-			KernelLog.String("SendTestFrame: txbd = "); KernelLog.Address(txbd); KernelLog.Ln;
-			IF txbd = 0 THEN txbd := txBdStartAdr END;
-			KernelLog.String("SendTestFrame: txbd = "); KernelLog.Address(txbd); KernelLog.Ln;
-
-			Machine.FlushDCacheRange(ADDRESSOF(txFrame), 60);
-
-			SYSTEM.PUT(txbd + BdAdrOffset, ADDRESSOF(txFrame));
-			IF txbd # txBdEndAdr THEN
-				SYSTEM.PUT(txbd + BdStatOffset, {TxBufLast} + SYSTEM.VAL(SET, 60));
-			ELSE
-				SYSTEM.PUT(txbd + BdStatOffset, {TxBufLast, TxBufWrap} + SYSTEM.VAL(SET, 60));
-			END;
-			
-			(* no need to flush/invalidate cache for BD memory space
-			Machine.FlushDCacheRange(txbd, BdSize);
-			*)
-			
-			CODE
-				DSB
-			END;
-
-			(* Transmit *)
-			Transmit;
-
-			IF intsEnabled THEN Machine.EnableInterrupts END;
-			IF Trace THEN KernelLog.String("Frame sent"); KernelLog.Ln END
-		END SendTestFrame;
-
-		PROCEDURE DumpDBMem(start: ADDRESS; count: LONGINT);
-		VAR
-			i: LONGINT;
-		BEGIN
-			FOR i := 0 TO count DO
-				KernelLog.Address(start); KernelLog.String(":	");
-				KernelLog.Address(SYSTEM.GET32(start)); KernelLog.String(" - ");
-				INC(start, 4);
-				KernelLog.Address(SYSTEM.GET32(start)); KernelLog.Ln;
-				INC(start, 4)
-			END;
-		END DumpDBMem;
-
-	BEGIN {ACTIVE}
-		(* Receive is done by polling *)
-		(*BEGIN {EXCLUSIVE}
-			AWAIT(start)
-		END;*)
-		LOOP
-			(*BEGIN {EXCLUSIVE}
-				IF kill THEN EXIT END
-			END;*)
-			IF lastRxQBar # SYSTEM.GET32(iobase + Rxqbase) THEN
-				ReceiveFrame
-			END
-		END
-	END Controller;
-
-	(** Phy subsystem of the controller. *)
-	Phy = OBJECT
-	VAR
-		iobase, phybase: ADDRESS;
-		linkSpeed: LONGINT;
-		timer: Kernel.Timer;
-
-		PROCEDURE & Setup * (iobase: ADDRESS);
-		BEGIN
-			SELF.iobase := iobase;
-			NEW(timer);
-			IF LinkSpeedMode = LinkSpeedAutodetect THEN
-				linkSpeed := GetIEEEPhySpeed();
-				IF linkSpeed = 1000 THEN
-					IF Trace THEN KernelLog.String("Autonegociated speed: 1000 MB/s"); KernelLog.Ln END;
-					SetUpSLCRDivisors(1000)
-				ELSIF linkSpeed = 100 THEN
-					IF Trace THEN KernelLog.String("Autonegociated speed: 100 MB/s"); KernelLog.Ln END;
-					SetUpSLCRDivisors(100)
-				ELSIF linkSpeed = 10 THEN
-					IF Trace THEN KernelLog.String("Autonegociated speed: 10 MB/s"); KernelLog.Ln END;
-					SetUpSLCRDivisors(10)
-				ELSE
-					IF Trace THEN KernelLog.String("Defaulting autonegociated speed to 10 MB/s"); KernelLog.Ln END;
-					SetUpSLCRDivisors(10)
-				END;
-				RETURN
-			ELSIF LinkSpeedMode = LinkSpeed1000 THEN
-				linkSpeed := 1000;
-			ELSIF LinkSpeedMode = LinkSpeed100 THEN
-				linkSpeed := 100;
-			ELSE
-				linkSpeed := 10;
-			END;
-			SetUpSLCRDivisors(linkSpeed);
-			ConfigureIEEEPhySpeed(linkSpeed);
-			timer.Sleep(1000)
-		END Setup;
-
-		PROCEDURE Detect (): ADDRESS;
-		VAR
-			status, phyReg: LONGINT;
-			phyAdr: ADDRESS;
-		BEGIN
-			IF Trace THEN KernelLog.String("XEmac: Detecting PHY"); KernelLog.Ln END;
-			phyAdr := 31;
-			WHILE phyAdr > 0 DO
-				status := Read(phyAdr, PhyDetectReg, phyReg);
-				IF (phyReg # 0FFFFH) & (SYSTEM.VAL(SET, phyReg) * PhyDetect = PhyDetect) THEN
-					IF Trace THEN KernelLog.String("Found PHY at "); KernelLog.Address(phyAdr); KernelLog.Ln END;
-					RETURN phyAdr
-				END;
-				DEC(phyAdr)
-			END;
-			IF Trace THEN KernelLog.String("PHY not found. Assuming its address is 0"); KernelLog.Ln END;
-			RETURN 0
-		END Detect;
-
-		PROCEDURE GetIEEEPhySpeed (): LONGINT;
-		VAR
-			temp, control, res, status, capabilities: LONGINT;
-			phyAdr: ADDRESS;
-		BEGIN
-			phyAdr := Detect();
-			IF Trace THEN KernelLog.String("Start PHY autonegociation"); KernelLog.Ln END;
-			res := Write(phyAdr, IeeePageAddressRegister, 2);
-			res := Read(phyAdr, IeeeControlRegMac, control);
-			control := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, control) + IeeeRgmiiTxRxClockDelayed);
-			res := Write(phyAdr, IeeeControlRegMac, control);
-
-			res := Write(phyAdr, IeeePageAddressRegister, 0);
-
-			res := Read(phyAdr, IeeeAutonegoAdvertiseReg, control);
-			control := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, control) + IeeeAsymmetricPause + IeeePause + Advertise100 + Advertise10);
-			res := Write(phyAdr, IeeeAutonegoAdvertiseReg, control);
-
-			res := Read(phyAdr, Ieee1000AdvertiseReg, control);
-			control := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, control) + Advertise1000);
-			res := Write(phyAdr, Ieee1000AdvertiseReg, control);
-
-			res := Write(phyAdr, IeeePageAddressRegister, 0);
-			res := Read(phyAdr, IeeeCopperSpecificControlReg, control);
-			control := control + LSH(7, 12); (* Max number of gigabit attemps *)
-			INCL(SYSTEM.VAL(SET, control), 11); (* Enable dowshift *)
-			res := Write(phyAdr, IeeeCopperSpecificControlReg, control);
-
-			res := Read(phyAdr, IeeeControlReg, control);
-			control := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, control) + IeeeCtrlAutonegotiateEnable);
-			control := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, control) + IeeeStatAutonegotiateRestart);
-			res := Write(phyAdr, IeeeControlReg, control);
-
-			res := Read(phyAdr, IeeeControlReg, control);
-			control := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, control) + IeeeCtrlReset);
-			res := Write(phyAdr, IeeeControlReg, control);
-
-			REPEAT
-				IF Trace THEN KernelLog.String("Waiting for PHY reset"); KernelLog.Ln END;
-				res := Read(phyAdr, IeeeControlReg, control)
-			UNTIL SYSTEM.VAL(SET, control) * IeeeCtrlReset = {};
-
-			IF Trace THEN KernelLog.String("Waiting for PHY to complete autonegotiation"); KernelLog.Ln END;
-
-			res := Read(phyAdr, IeeeStatusReg, status);
-			WHILE SYSTEM.VAL(SET, status) * IeeeStatAutonegotiateComplete = {} DO
-				timer.Sleep(1000);
-				res := Read(phyAdr, IeeeCopperSpecificStatusReg2, temp);
-				IF Trace & (SYSTEM.VAL(SET, temp) * IeeeAutonegError # {}) THEN
-					KernelLog.String("Autonegotiation error");
-					KernelLog.Ln
-				END;
-				res := Read(phyAdr, IeeeStatusReg, status)
-			END;
-			IF Trace THEN KernelLog.String("Autonegotiation complete"); KernelLog.Ln END;
-
-			res := Read(phyAdr, IeeeSpecificStatusReg, capabilities);
-			IF 15 IN SYSTEM.VAL(SET, capabilities) THEN
-				RETURN 1000 (* MB/s *)
-			ELSIF 14 IN SYSTEM.VAL(SET, capabilities) THEN
-				RETURN 100 (* MB/s *)
-			ELSE
-				RETURN 10 (* MB/s *)
-			END
-		END GetIEEEPhySpeed;
-
-		PROCEDURE ConfigureIEEEPhySpeed (speed: LONGINT);
-		VAR
-			control, res, wait: LONGINT;
-			phyAdr: ADDRESS;
-		BEGIN
-			phyAdr := Detect();
-			res := Write(phyAdr, IeeePageAddressRegister, 2);
-			res := Read(phyAdr, IeeeControlRegMac, control);
-			control := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, control) + IeeeRgmiiTxRxClockDelayed);
-			res := Write(phyAdr, IeeeControlRegMac, control);
-
-			res := Write(phyAdr, IeeePageAddressRegister, 0);
-
-			res := Read(phyAdr, IeeeAutonegoAdvertiseReg, control);
-			control := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, control) + IeeeAsymmetricPause);
-			control := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, control) + IeeePause);
-			res := Write(phyAdr, IeeeAutonegoAdvertiseReg, control);
-
-			res := Read(phyAdr, IeeeControlReg, control);
-			control := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, control) * (-IeeeCtrlLinkSpeed1000M) * (-IeeeCtrlLinkSpeed100M) * (-IeeeCtrlLinkSpeed10M));
-
-			IF linkSpeed = 1000 THEN
-				control := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, control) + IeeeCtrlLinkSpeed1000M)
-			ELSIF linkSpeed = 100 THEN
-				control := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, control) + IeeeCtrlLinkSpeed100M)
-				(* Don't advertise PHY speed of 1000 MBPS *)
-			ELSIF linkSpeed = 10 THEN
-				control := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, control) + IeeeCtrlLinkSpeed10M)
-			END;
-		END ConfigureIEEEPhySpeed;
-
-		PROCEDURE SetUpSLCRDivisors (div: LONGINT);
-		END SetUpSLCRDivisors;
-
-		PROCEDURE Write (address, register: ADDRESS; data: LONGINT): LONGINT;
-		VAR
-			reg, mgtcr, ipisr: SET;
-		BEGIN
-			IF Trace THEN KernelLog.String("PHY write"); KernelLog.Ln END;
-			SYSTEM.GET(iobase + Nwsr, reg);
-			(* Make sure no other PHY operation is currently in progress *)
-			IF ~(NwsrMdioIdle IN reg) THEN
-				IF Trace THEN KernelLog.String("XEmac Phy write aborted: PHY busy"); KernelLog.Ln END;
-				RETURN EmacMiiBusy
-			END;
-
-			(* Construct Mgtcr mask for the operation *)
-			mgtcr := PhyMntncOp + PhyMntncOpW + SYSTEM.VAL(SET, LSH(phybase, PhyMntncPhyAdShift))
-					+ SYSTEM.VAL(SET, LSH(address, PhyMntncPhyAdShift))
-					+ SYSTEM.VAL(SET, LSH(register, PhyMntncPhRegShift)) + SYSTEM.VAL(SET,data);
-			SYSTEM.PUT(iobase + PhyMntnc, mgtcr);
-
-			REPEAT
-				SYSTEM.GET(iobase + Nwsr, ipisr)
-			UNTIL NwsrMdioIdle IN ipisr;
-			RETURN Success
-		END Write;
-
-		PROCEDURE Read (address, register: ADDRESS; VAR data: LONGINT): LONGINT;
-		VAR
-			reg, ipisr, mgtcr: SET;
-		BEGIN
-			SYSTEM.GET(iobase + Nwsr, reg);
-			IF ~(NwsrMdioIdle IN reg) THEN
-				IF Trace THEN KernelLog.String("XEmac Phy read aborted: PHY busy"); KernelLog.Ln END;
-				RETURN EmacMiiBusy
-			END;
-
-			mgtcr := PhyMntncOp + PhyMntncOpR
-					+ SYSTEM.VAL(SET, LSH(address, PhyMntncPhyAdShift))
-					+ SYSTEM.VAL(SET, LSH(register, PhyMntncPhRegShift));
-			SYSTEM.PUT(iobase + PhyMntnc, mgtcr);
-
-			REPEAT
-				SYSTEM.GET(iobase + Nwsr, ipisr)
-			UNTIL NwsrMdioIdle IN ipisr;
-			data := SYSTEM.GET32(iobase + PhyMntnc) MOD 10000H;
-			RETURN Success
-		END Read;
-	END Phy;
-
-VAR
-	ld: LinkDevice;
-	res: LONGINT;
-BEGIN
-	NEW(ld, Network.TypeEthernet, 1500, 6); (*! What is the correct MTU? *)
-	ld.SetName("XEmac");
-	Network.registry.Add(ld, res);
-	NEW(ld.ctrl, ADDRESS(0E000B000H), ld);
-END XEmac.