Răsfoiți Sursa

Modifications and additions for the Win64 kernel -- work in progress.
Files may be unified and may thus disappear again from repository.

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

felixf 7 ani în urmă
părinte
comite
228cc1102f

+ 19 - 0
source/Builds.Tool

@@ -33,4 +33,23 @@ LINUX32G -- 32 bit linux a2 using generic object files
 			Shell StaticLinker Compiler FoxOberonFrontend FoxARMBackend FoxAMDBackend ~
 
 
+Win64G -- work in progress
+================
+
+SystemTools.DoCommands 
+
+Compiler.Compile -b=AMD --bits=64 --objectFile=Generic --newObjectFile  --symbolFile=Textual  --objectFileExtension=.GofWw --symbolFileExtension=.SymWw 
+	--traceModule=Trace
+	AMD64.Runtime.Mod Trace.Mod Generic.Win64.Kernel32.Mod Win64.Machine.Mod Heaps.Mod Generic.Modules.Mod 
+	Win64.Objects.Mod Win32.Kernel.Mod ~
+
+StaticLinker.Link --fileFormat=PE64CUI --fileName=A264.exe --extension=GofWw --displacement=401000H  
+	Runtime Trace Kernel32 
+	Heaps Modules Objects Kernel ~
+
+FSTools.CloseFiles A264.exe  ~
+~
+
+	KernelLog Streams Commands Files WinFS Clock Dates Reals Strings Diagnostics BitSets StringPool ObjectFile GenericLinker Reflection  GenericLoader  BootConsole ~
+	~
 

+ 2 - 0
source/FoxAMD64Assembler.Mod

@@ -2117,6 +2117,8 @@ TYPE
 							IF ~PutData (bits16) THEN SkipLine END;
 						ELSIF ident = "DD" THEN
 							IF ~PutData (bits32) THEN SkipLine END;
+						ELSIF ident = "DQ" THEN
+							IF ~PutData (bits64) THEN SkipLine END;
 						ELSIF ident = "REP" THEN
 							NextSymbol;
 							emitter.code.PutByte (InstructionSet.prfREP);

+ 2 - 1
source/FoxCompiler.Mod

@@ -547,8 +547,9 @@ BEGIN
 	NEW(platforms);
 	defaultPlatform := "";
 	(* platform definitions hard coded for the common cases -- maybe (parts of it) should be outsourced to a file ?*)
-	DoAddPlatform("Win32","-b=AMD --objectFile=Binary --symbolFile=Binary --objectFileExtensions=.Obw --symbolFileExtension=.Obw");
+	DoAddPlatform("Win32","-b=AMD --objectFile=Binary --symbolFile=Binary --objectFileExtension=.Obw --symbolFileExtension=.Obw");
 	DoAddPlatform("Win32G","-b=AMD --objectFile=Generic --symbolFile=Textual --newObjectFile --mergeSections --objectFileExtension=.GofW --symbolFileExtension=.SymW --preciseGC --trackLeave --writeBarriers");
+	DoAddPlatform("Win64G","-b=AMD --bits=64 --objectFile=Generic --newObjectFile  --symbolFile=Textual  --objectFileExtension=.GofWw --symbolFileExtension=.SymWw --traceModule=Trace");
 	DoAddPlatform("Win32C","-b=AMD --cooperative --objectFile=Generic --newObjectFile --traceModule=Trace --objectFileExtension=.GofCW --symbolFileExtension=.SymCW");
 	DoAddPlatform("ARM","-b=ARM --objectFile=Generic --newObjectFile --metaData=simple --objectFileExtension=.Goa --symbolFileExtension=.Sya");
 	DoAddPlatform("Minos","-b=ARM --objectFile=Minos"); 

+ 10 - 3
source/FoxIntermediateBackend.Mod

@@ -596,6 +596,7 @@ TYPE
 			recordType: SyntaxTree.RecordType;
 			isModuleBody: BOOLEAN;
 			parametersSize: LONGINT;
+			position: LONGINT;
 
 			PROCEDURE Signature;
 			VAR parameter: SyntaxTree.Parameter; procedureType: SyntaxTree.ProcedureType; returnType : SyntaxTree.Type;
@@ -652,6 +653,7 @@ TYPE
 			IF Trace & (dump # NIL) THEN dump.String("DeclarationVisitor:Procedure"); dump.Ln END;
 			*)
 			(* code section for this procedure *)
+			position := x.position.start;
 			scope := x.procedureScope;
 			prevScope := currentScope;
 			currentScope := scope;
@@ -749,9 +751,14 @@ TYPE
 								Error(formalParameter.position,"Calling convention error: cannot be passed as register");
 							ELSE
 								IntermediateCode.InitRegisterClass(registerClass, IntermediateCode.Parameter, registerParameter[registerNumber]);
-								type := GetType(system, formalParameter.type);
+								IF formalParameter.type.IsRecordType() THEN
+									ASSERT (formalParameter.kind IN {SyntaxTree.VarParameter, SyntaxTree.ConstParameter});
+									type := addressType;
+								ELSE
+									type := GetType(system, formalParameter.type);
+								END;
 								src := IntermediateCode.Register(type, registerClass, implementationVisitor.AcquireRegister(type, registerClass));
-								IntermediateCode.InitMemory(dest,GetType(system,formalParameter.type),implementationVisitor.fp,ToMemoryUnits(system,formalParameter.offsetInBits));
+								IntermediateCode.InitMemory(dest,type,implementationVisitor.fp,ToMemoryUnits(system,formalParameter.offsetInBits));
 								ir.Emit(Mov(Basic.invalidPosition,dest, src));
 								implementationVisitor.ReleaseIntermediateOperand(src);
 								INC(registerNumber);
@@ -5943,7 +5950,7 @@ TYPE
 			END;
 			
 			(* === return parameter space === *)
-			IF (procedureType.callingConvention = SyntaxTree.WinAPICallingConvention) & passByRegister THEN
+			IF (procedureType.callingConvention = SyntaxTree.WinAPICallingConvention) & passByRegister & (registerNumber > 0) THEN
 				parametersSize := ToMemoryUnits(system,parameters.Length()*addressType.sizeInBits);
 				IF parametersSize < 32 THEN 
 					(* allocated space for all parameter registers *)

+ 69 - 25
source/Generic.Win64.Kernel32.Mod

@@ -1,4 +1,7 @@
-(* Copyright (c) Felix Friedrich, ETH Zürich, 2017 *)
+(* Copyright (c) Felix Friedrich, ETH Zürich, 2017 
+	This is the 64-bit version of Kernel32. The name may be misleading but it copies 1:1 what the Microsoft developers did
+	[There is no Kernel64 DLL in WIndows. Kernel32 is chosen according to the bit-width of the application]
+*)
 
 MODULE Kernel32;   (** AUTHOR "ejz,fof"; PURPOSE "Definition of the Win64 Kernel32 API used by (Win)Aos"; *)
 
@@ -158,7 +161,7 @@ CONST
 TYPE
 	(* OutputStringProc* = PROCEDURE (VAR str: ARRAY OF CHAR); *)
 
-	BOOL* = LONGINT;
+	BOOL* = WORD;
 
 	HANDLE* = ADDRESS;  HMODULE* = ADDRESS;
 	HINSTANCE* = ADDRESS;  ATOM* = INTEGER;  HGLOBAL* = HANDLE;
@@ -194,7 +197,7 @@ TYPE
 
 	(** Critical-section object. *)
 	CriticalSection* = RECORD
-		a, b, c, d, e, f: LONGINT
+		a, b, c, d, e, f: SIZE;
 	END;
 
 	(** thread context and exception information *)
@@ -207,11 +210,11 @@ TYPE
 
 	Context* = RECORD
 		ContextFlags*: SET;
-		DR0*, DR1*, DR2*, DR3*, DR6*, DR7*: LONGINT;
+		DR0*, DR1*, DR2*, DR3*, DR6*, DR7*: SIZE;
 		FloatSave*: FloatingSaveArea;
-		GS*, FS*, ES*, DS*: LONGINT;
-		EDI*, ESI*, EBX*, EDX*, ECX*, EAX*: LONGINT;
-		BP*, PC*, CS*, FLAGS*, SP*, SS*: LONGINT; (* whereas BP is EBP and SP is ESP *)
+		GS*, FS*, ES*, DS*: SIZE;
+		EDI*, ESI*, EBX*, EDX*, ECX*, EAX*: SIZE;
+		BP*, PC*, CS*, FLAGS*, SP*, SS*: SIZE; (* whereas BP is EBP and SP is ESP *)
 	END;
 
 	Wow64Context*= RECORD (Context)
@@ -532,7 +535,7 @@ VAR
 	GetPrivateProfileString-: PROCEDURE {WINAPI} ( CONST lpAppName: ARRAY OF CHAR;
 																			CONST lpKeyName: ARRAY OF CHAR;
 																			CONST lpDefault: ARRAY OF CHAR;
-																			CONST lpReturnedString: ARRAY OF CHAR;
+																			VAR lpReturnedString: ARRAY OF CHAR;
 																			nSize: LONGINT;
 																			CONST lpFileName: ARRAY OF CHAR): LONGINT;
 	(** The GetProcessAffinityMask function retrieves the process affinity mask for the specified process and the system affinity mask for the system. *)
@@ -767,11 +770,11 @@ VAR
 	(** The TryEnterCriticalSection function attempts to enter a critical section without blocking. *)
 	TryEnterCriticalSection-: PROCEDURE {WINAPI} ( VAR lpCriticalSection: CriticalSection ): BOOL;
 	(** The VirtualAlloc function reserves or commits a region of pages in the virtual address space of the calling process. *)
-	VirtualAlloc-: PROCEDURE {WINAPI} ( lpAddress: ADDRESS;  dwSize: LONGINT;
+	VirtualAlloc-: PROCEDURE {WINAPI} ( lpAddress: ADDRESS;  dwSize: SIZE;
 																    flAllocationType, flProtect: SET ): ADDRESS;
 	(** The VirtualFree function releases or decommits (or both) a region of pages within the virtual address space of the
 			calling process. *)
-	VirtualFree-: PROCEDURE {WINAPI} ( lpAddress: ADDRESS;  dwSize: LONGINT;
+	VirtualFree-: PROCEDURE {WINAPI} ( lpAddress: ADDRESS;  dwSize: SIZE;
 																  dwFreeType: SET ): BOOL;
 	(** The WaitForSingleObject function returns when one of the following occurs:
 			The specified object is in the signaled state.
@@ -822,10 +825,26 @@ VAR
 	PROCEDURE NoOutputString(CONST str: ARRAY OF CHAR);
 	BEGIN
 	END NoOutputString;
+	
+	PROCEDURE ConsoleString(CONST str: ARRAY OF CHAR);
+	VAR i: LONGINT;
+	BEGIN
+		i := 0; 
+		WHILE (i<LEN(str)) & (str[i] # 0X) DO
+			TraceChar(str[i]);INC(i); 
+		END;
+	END ConsoleString;
+
+	PROCEDURE TraceChar(c: CHAR);
+	VAR len: LONGINT; b: BOOL;
+	BEGIN
+		len := 1;
+		b := WriteFile(hout,c,len,len,NIL);
+	END TraceChar;
 
-	PROCEDURE SendToDebugger*(CONST str: ARRAY OF CHAR;  x: LONGINT );
+	PROCEDURE SendToDebugger*(CONST str: ARRAY OF CHAR;  x: ADDRESS );
 	VAR s: ARRAY 16 OF CHAR;
-		d, i: LONGINT;
+		d: ADDRESS; i: SIZE;
 	BEGIN
 		outputDebugString( str );  s[8] := 0X;
 		FOR i := 7 TO 0 BY -1 DO
@@ -898,7 +917,9 @@ VAR
 		GetProcAddress(mod, "GetLogicalDriveStringsA",SYSTEM.VAL(ADDRESS,GetLogicalDriveStrings));
 		GetProcAddress(mod, "GetLogicalDrives",SYSTEM.VAL(ADDRESS,GetLogicalDrives));
 		GetProcAddress(mod, "GetModuleFileNameA",SYSTEM.VAL(ADDRESS,GetModuleFileName));
+		
 		GetProcAddress(mod, "GetModuleHandleA",SYSTEM.VAL(ADDRESS,GetModuleHandle));
+		
 		GetProcAddress(mod, "GetOverlappedResult",SYSTEM.VAL(ADDRESS,GetOverlappedResult));
 		GetProcAddress(mod, "GetPrivateProfileStringA",SYSTEM.VAL(ADDRESS,GetPrivateProfileString));
 		(* must be done by linker: GetProcAddress(mod, "GetProcAddress",SYSTEM.VAL(ADDRESS,getProcAddress)); *)
@@ -906,7 +927,9 @@ VAR
 		GetProcAddress(mod, "GetProcessHeap",SYSTEM.VAL(ADDRESS,GetProcessHeap));
 		GetProcAddress(mod, "GetProcessTimes", SYSTEM.VAL(ADDRESS, GetProcessTimes));
 		GetProcAddress(mod, "GetStartupInfoA",SYSTEM.VAL(ADDRESS,GetStartupInfo));
+		
 		GetProcAddress(mod, "GetStdHandle",SYSTEM.VAL(ADDRESS,GetStdHandle));
+		
 		GetProcAddress(mod, "GetSystemInfo",SYSTEM.VAL(ADDRESS,GetSystemInfo));
 		GetProcAddress(mod, "GetSystemTime",SYSTEM.VAL(ADDRESS,GetSystemTime));
 		GetProcAddress(mod, "GetTempFileNameA",SYSTEM.VAL(ADDRESS,GetTempFileName));
@@ -933,7 +956,9 @@ VAR
 		GetProcAddress(mod, "InitializeCriticalSection",SYSTEM.VAL(ADDRESS,InitializeCriticalSection));
 		GetProcAddress(mod, "InterlockedDecrement",SYSTEM.VAL(ADDRESS,InterlockedDecrement));
 		GetProcAddress(mod, "InterlockedIncrement",SYSTEM.VAL(ADDRESS,InterlockedIncrement));
+		
 		GetProcAddress(mod, "IsDebuggerPresent",SYSTEM.VAL(ADDRESS,IsDebuggerPresent));
+		
 		GetProcAddress(mod, "LeaveCriticalSection",SYSTEM.VAL(ADDRESS,LeaveCriticalSection));
 		(* must be done by linker: GetProcAddress(mod, "LoadLibraryA",SYSTEM.VAL(ADDRESS,LoadLibrary)); *)
 		GetProcAddress(mod, "LocalFileTimeToFileTime",SYSTEM.VAL(ADDRESS,LocalFileTimeToFileTime));
@@ -986,30 +1011,29 @@ VAR
 		GetProcAddress(mod, "VirtualAlloc",SYSTEM.VAL(ADDRESS,VirtualAlloc));
 		GetProcAddress(mod, "VirtualFree",SYSTEM.VAL(ADDRESS,VirtualFree));
 		GetProcAddress(mod, "WaitForSingleObject",SYSTEM.VAL(ADDRESS,WaitForSingleObject));
+		
 		GetProcAddress(mod, "WriteFile",SYSTEM.VAL(ADDRESS,WriteFile));
+		
 		GetProcAddress(mod, "GlobalMemoryStatusEx",SYSTEM.VAL(ADDRESS,GlobalMemoryStatusEx));
+		
 		isEXE := hInstance = NULL;
 		IF isEXE THEN hInstance := GetModuleHandle( NIL ) END;
+
+		SetTraceConsole;
 		IF IsDebuggerPresent()=True THEN
 			OutputString := OutputDebugString
 		ELSE
-			OutputString := NoOutputString
+			OutputString := ConsoleString
 		END;
-		
-		SetTraceConsole;
 		Trace.String("Test"); Trace.Ln; 
-		
-		LOOP END;
+		Trace.Address(InitializeCriticalSection);
+		Trace.String(" =="); Trace.Ln; 
 	END Init;
+	
+	VAR g: BOOLEAN;
 
 VAR hout: HANDLE;
 
-	PROCEDURE TraceChar(c: CHAR);
-	VAR len: LONGINT; b: BOOL;
-	BEGIN
-		len := 1;
-		b := WriteFile(hout,c,len,len,NIL);
-	END TraceChar;
 
 	PROCEDURE SetTraceConsole;
 	VAR res: LONGINT;
@@ -1068,8 +1092,11 @@ VAR hout: HANDLE;
 			MOV getProcAddress, RAX
 	END EntryPoint;
 		
+(*BEGIN
+	Init;*)
+	
 BEGIN
-	Init;
+	Trace.String("Kernel32 (64bit)"); Trace.Ln;
 END Kernel32.
 	
 --newObjectFile 
@@ -1085,4 +1112,21 @@ Compiler.Compile -b=AMD --bits=64 --objectFile=Generic --metaData=Simple
 StaticLinker.Link --fileFormat=PE64CUI --fileName=A264.exe --extension=GofWw --displacement=401000H  
 	Runtime Kernel32 ~
 
-FSTools.CloseFiles A264.exe  ~
+FSTools.CloseFiles A264.exe  ~
+
+
+SystemTools.DoCommands 
+
+Compiler.Compile -b=AMD --bits=64 --objectFile=Generic --newObjectFile  --symbolFile=Textual  --objectFileExtension=.GofWw --symbolFileExtension=.SymWw 
+	AMD64.Runtime.Mod Trace.Mod Generic.Win64.Kernel32.Mod Win64.Machine.Mod Heaps.Mod Generic.Modules.Mod 
+	Win64.Objects.Mod Win32.Kernel.Mod ~
+
+StaticLinker.Link --fileFormat=PE64CUI --fileName=A264.exe --extension=GofWw --displacement=401000H  
+	Runtime Trace Kernel32 
+	Heaps Modules Objects Kernel ~
+
+FSTools.CloseFiles A264.exe  ~
+~
+
+	KernelLog Streams Commands Files WinFS Clock Dates Reals Strings Diagnostics BitSets StringPool ObjectFile GenericLinker Reflection  GenericLoader  BootConsole ~
+	~

+ 1 - 1
source/Heaps.Mod

@@ -1684,7 +1684,7 @@ BEGIN
 END AssignRecord;
 
 PROCEDURE AssignArray*(dest: ADDRESS; tag: StaticTypeBlockU;  numElems: SIZE; src: ADDRESS);
-VAR i, j: LONGINT; sval: ADDRESS; 
+VAR i, j: SIZE; sval: ADDRESS; 
 BEGIN
 	FOR j := 0 TO LEN(tag.pointerOffsets)-1 DO
 	FOR i := 0 TO numElems-1 DO

+ 1097 - 0
source/Win64.Machine.Mod

@@ -0,0 +1,1097 @@
+MODULE Machine;
+(** AUTHOR "pjm,fof"; PURPOSE "Bootstrapping, configuration and machine interface, adaption to windows fof"; *)
+(* red marked parts are WinAos specific *)
+
+IMPORT SYSTEM, Trace, Kernel32;
+
+CONST
+	Version = "WinAos (32bit) ";
+
+	DefaultConfigFile = "aos.ini";
+	DefaultGenericConfigFile = "aosg.ini";
+	UserConfigFile = "myaos.ini";
+
+	MaxCPU* = 8;	(* dummy definition to make GC for both Win32 and I386 work *)
+
+	DefaultObjectFileExtension* = ".Obw";
+
+	(** bits in features variable *)
+	MTTR* = 12;  MMX* = 23;
+
+	debug* = FALSE;   (** display more debug output during booting *)
+
+CONST
+	AddressSize = SIZEOF(ADDRESS);
+	StaticBlockSize = 32;		(* static heap block size *)
+	BlockHeaderSize = 2 * AddressSize;
+	(* change this when Heaps.HeapBlock is modified *)
+	RecordDescSize = 4 * AddressSize;  (* needs to be adapted in case Heaps.RecordBlockDesc is changed *)
+
+(** standard lock levels (in order) *)  (* also refer to Traps.Show *)
+	TraceOutput* = 0;   (* Trace output *)
+	Memory* = 1;   (* Virtual memory management, stack and page allocation *)
+	Heaps* = 2;   (* Storage allocation and Garbage collection *)
+	Interrupts* = 3;   (* Interrupt handling. *)
+	Modules* = 4;   (* Module list *)
+	Objects* = 5;   (* Ready queue *)
+	Processors* = 6;   (* Interprocessor interrupts *)
+	KernelLog* = 7;   (* Atomic output *)
+	GC* = 8;
+	MaxLocks = 9;   (* { <= 32 } *)
+
+	StrongChecks = FALSE;
+
+	HeaderSize = 40H; (* cf. Linker0 *)
+	EndBlockOfs = 38H;	(* cf. Linker0 *)
+	MemoryBlockOfs = BlockHeaderSize + RecordDescSize + BlockHeaderSize; (* memory block (including header) starts at offset HeaderSize *)
+
+	MemBlockSize = 32*1024*1024; (* must be multiple of StaticBlockSize *)
+	MinMemBlockSize = 4*1024*1024;
+
+	NilVal = 0;
+
+	Second* = 1000; (* frequency of ticks increments in Hz *)
+
+
+CONST
+		(* error codes *)
+		Ok* = 0;
+		NilAdr* = -1;	(* nil value for addresses (not same as pointer NIL value) *)
+		IsCooperative* = FALSE;
+TYPE
+	Vendor* = ARRAY 13 OF CHAR;
+	IDMap* = ARRAY 16 OF SHORTINT;
+
+	Range* = RECORD
+		adr*, size*: LONGINT
+	END;
+
+	MemoryBlock* = POINTER TO MemoryBlockDesc;
+	MemoryBlockDesc* = RECORD
+		next- {UNTRACED}: MemoryBlock;
+		startAdr-: ADDRESS; 		(* sort key in linked list of memory blocks *)
+		size-: SIZE;
+		beginBlockAdr-, endBlockAdr-: ADDRESS
+	END;
+
+	(* dummy definition to make GC work for both I386 and Win32 - copied from I386.Machine.Mod, but not really used *)
+	Stack* = RECORD	(** values are read-only *)
+			low: ADDRESS;		(* lowest virtual address that may be allocated for stack *)
+		adr*: ADDRESS;		(* lowest address on allocated stack *)	(* exported for Objects only *)
+		high*: ADDRESS;	(* next virtual address after stack *)	(* exported for Objects only *)
+	END;
+
+VAR
+
+	LastAddress: RECORD END;
+
+	MMXSupport*: BOOLEAN;
+	SSESupport*: BOOLEAN;
+	SSE2Support*: BOOLEAN;
+	SSE3Support-: BOOLEAN; (* PH 04/11*)
+	SSSE3Support-: BOOLEAN;
+	SSE41Support-: BOOLEAN;
+	SSE42Support-: BOOLEAN;
+	SSE5Support-: BOOLEAN;
+	AVXSupport-: BOOLEAN;
+
+	version*: ARRAY 64 OF CHAR;   (** Aos version *)
+	features*,features2*: SET;   (** processor features *)
+	fcr*: SET;   (** default floating-point control register value (default rounding mode is towards -infinity, for ENTIER) *)
+	mhz*: HUGEINT;   (** clock rate of GetTimer() in MHz, or 0 if not known *)
+	boottime-: HUGEINT; (** in timer units *)
+
+	commandLine-: ARRAY 256 OF CHAR;
+	hin, hout: Kernel32.HANDLE;
+
+VAR
+	lock-: ARRAY MaxLocks OF CHAR;  (* not implemented as SET because of shared access *)
+	cs: ARRAY MaxLocks OF Kernel32.CriticalSection;
+	trace: ARRAY 2 OF CHAR;
+	defaultConfigFile, userConfigFile, traceName: ARRAY Kernel32.MaxPath OF CHAR;
+
+	gcThreshold-: SIZE;
+	bootHeapAdr: ADDRESS; 	(* initialized by linker, variable name must not be changed, see Win32.Aos.Link *)
+	bootHeapSize: SIZE; 			(* initialized by linker, variable name must not be changed, see Win32.Aos.Link *)
+	memBlockHead-{UNTRACED}, memBlockTail-{UNTRACED}: MemoryBlock; (* head and tail of sorted list of memory blocks *)
+
+
+	(** 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;
+
+	(** -- Atomic operations -- *)
+
+	(** Atomic INC(x). *)
+	PROCEDURE -AtomicInc*(VAR x: LONGINT);
+	CODE {SYSTEM.AMD64}
+		POP RAX
+		LOCK
+		INC DWORD [RAX]
+	END AtomicInc;
+
+	(** Atomic DEC(x). *)
+	PROCEDURE -AtomicDec*(VAR x: LONGINT);
+	CODE {SYSTEM.AMD64}
+		POP RAX
+		LOCK
+		DEC DWORD [RAX]
+	END AtomicDec;
+
+	(** Atomic EXCL. *)
+	PROCEDURE AtomicExcl* (VAR s: SET; bit: LONGINT);
+	CODE {SYSTEM.AMD64}
+		MOV EAX, [RBP + bit]
+		MOV RBX, [RBP + s]
+		LOCK
+		BTR [RBX], EAX
+	END AtomicExcl;
+
+	(** Atomic INC(x, y). *)
+	PROCEDURE -AtomicAdd*(VAR x: LONGINT; y: LONGINT);
+	CODE {SYSTEM.AMD64}
+		POP EBX
+		POP RAX
+		LOCK
+		ADD DWORD [RAX], EBX
+	END AtomicAdd;
+
+	(** Atomic test-and-set. Set x = TRUE and return old value of x. *)
+	PROCEDURE -AtomicTestSet*(VAR x: BOOLEAN): BOOLEAN;
+	CODE {SYSTEM.AMD64}
+		POP RBX
+		MOV AL, 1
+		XCHG [RBX], AL
+	END AtomicTestSet;
+
+	(* 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 {SYSTEM.AMD64}
+		POP EBX		; new
+		POP EAX		; old
+		POP RCX		; address of x
+		LOCK CMPXCHG [RCX], EBX	; atomicly compare x with old and set it to new if equal
+	END AtomicCAS;
+
+
+	(** -- Miscellaneous -- *)
+
+	(* Return current instruction pointer *)
+	PROCEDURE CurrentPC* (): ADDRESS;
+	CODE {SYSTEM.AMD64}
+		MOV RAX, [RBP + 8]
+	END CurrentPC;
+
+	(* Return current frame pointer *)
+	PROCEDURE -CurrentBP* (): ADDRESS;
+	CODE {SYSTEM.AMD64}
+		MOV RAX, RBP
+	END CurrentBP;
+
+	(* Set current frame pointer *)
+	PROCEDURE -SetBP* (bp: ADDRESS);
+	CODE {SYSTEM.AMD64}
+		POP RBP
+	END SetBP;
+
+	(* Return current stack pointer *)
+	PROCEDURE -CurrentSP* (): ADDRESS;
+	CODE {SYSTEM.AMD64}
+		MOV RAX, RSP
+	END CurrentSP;
+
+	(* Set current stack pointer *)
+	PROCEDURE -SetSP* (sp: ADDRESS);
+	CODE {SYSTEM.AMD64}
+		POP RSP
+	END SetSP;
+
+	(** This procedure should be called in all spin loops as a hint to the processor (e.g. Pentium 4). *)
+	PROCEDURE -SpinHint*;
+	CODE {SYSTEM.AMD64}
+		PAUSE
+	END SpinHint;
+
+	(** Fill "size" bytes at "destAdr" with "filler". "size" must be multiple of 4. *)
+	PROCEDURE Fill32* (destAdr: ADDRESS; size: SIZE; filler: LONGINT);
+	CODE {SYSTEM.AMD64}
+		MOV RDI, [RBP + destAdr]
+		MOV RCX, [RBP + size]
+		MOV EAX, [RBP + filler]
+		TEST RCX, 3
+		JZ ok
+		PUSH 8	; ASSERT failure
+		INT 3
+	ok:
+		SHR RCX, 2
+		CLD
+		REP STOSD
+	END Fill32;
+	(** -- Processor initialization -- *)
+
+	PROCEDURE -SetFCR( s: SET );
+	CODE {SYSTEM.i386, SYSTEM.FPU}
+		FLDCW	[ESP]	;  parameter s
+		POP	EAX
+	END SetFCR;
+
+	PROCEDURE -FCR( ): SET;
+	CODE {SYSTEM.i386, SYSTEM.FPU}
+		PUSH	0
+		FNSTCW	[ESP]
+		FWAIT
+		POP	EAX
+	END FCR;
+
+	PROCEDURE -InitFPU;
+	CODE {SYSTEM.i386, SYSTEM.FPU}
+		FNINIT
+	END InitFPU;
+
+(** Setup FPU control word of current processor. *)
+
+	PROCEDURE SetupFPU*;
+	BEGIN
+		InitFPU;  SetFCR( fcr )
+	END SetupFPU;
+
+(** CPU identification. *)
+
+	PROCEDURE CPUID*( VAR vendor: Vendor;  VAR version: LONGINT;  VAR features1,features2: SET );
+	CODE {SYSTEM.i386, SYSTEM.Pentium}
+		MOV	EAX, 0
+		CPUID
+		CMP	EAX, 0
+		JNE	ok
+		MOV	ESI, [EBP+vendor]
+		MOV	[ESI], AL	;  AL = 0
+		MOV	ESI, [EBP+version]
+		MOV	[ESI], EAX	;  EAX = 0
+		MOV	ESI, [EBP+features1]
+		MOV	[ESI], EAX
+		MOV	ESI, [EBP+features2]
+		MOV	[ESI], EAX
+		JMP	end
+		ok:
+		MOV	ESI, [EBP+vendor]
+		MOV	[ESI], EBX
+		MOV	[ESI+4], EDX
+		MOV	[ESI+8], ECX
+		MOV	BYTE [ESI+12], 0
+		MOV	EAX, 1
+		CPUID
+		MOV	ESI, [EBP+version]
+		MOV	[ESI], EAX
+		MOV	ESI, [EBP+features1]
+		MOV	[ESI], EDX
+		MOV	ESI, [EBP+features2]
+		MOV	[ESI], ECX
+		end:
+	END CPUID;
+
+	PROCEDURE GetConfig*( CONST name: ARRAY OF CHAR;  VAR val: ARRAY OF CHAR );
+	CONST ConfigKey = "Configuration";
+	BEGIN
+		COPY ("", val);
+		TRACE(name,val,userConfigFile,defaultConfigFile); 
+		IF Kernel32.GetPrivateProfileString (ConfigKey, name, "", val, LEN (val), userConfigFile) # 0 THEN
+		ELSIF Kernel32.GetPrivateProfileString (ConfigKey, name, "", val, LEN (val), defaultConfigFile) # 0 THEN
+		END;
+		TRACE(name,val); 
+		IF (name = "ObjectFileExtension") & (val = "") THEN
+			IF Kernel32.Generic THEN
+				val := ".GofW";
+			ELSE
+				val := ".Obw"
+			END;
+		END;
+	END GetConfig;
+
+	PROCEDURE Shutdown*( restart: BOOLEAN );
+	BEGIN
+		RemoveTraceFile;
+		Kernel32.Shutdown( 0 );   (* calls the finalizer of Heaps *)
+	END Shutdown;
+
+(* Dan: from new Machine *)
+PROCEDURE -GetTimer*(): HUGEINT;
+CODE {SYSTEM.Pentium}
+	RDTSC	; set EDX:EAX
+END GetTimer;
+
+(* Dan:  mono CPU PCs *)
+PROCEDURE ID*(): LONGINT;
+BEGIN
+	RETURN 0
+END ID;
+
+
+(**
+ * Flush Data Cache for the specified virtual address range. If len is negative, flushes the whole cache.
+ * This is used on some architecture to interact with DMA hardware (e.g. Ethernet and USB. It can be
+ * left empty on Intel architecture.
+ *)
+PROCEDURE FlushDCacheRange * (adr: ADDRESS; len: LONGINT);
+END FlushDCacheRange;
+
+(**
+ * Invalidate Data Cache for the specified virtual address range. If len is negative, flushes the whole cache.
+ * This is used on some architecture to interact with DMA hardware (e.g. Ethernet and USB. It can be
+ * left empty on Intel architecture.
+ *)
+PROCEDURE InvalidateDCacheRange * (adr: ADDRESS; len: LONGINT);
+END InvalidateDCacheRange;
+
+(**
+ * Invalidate Instruction Cache for the specified virtual address range. If len is negative, flushes the whole cache.
+ * This is used on some architecture to interact with DMA hardware (e.g. Ethernet and USB. It can be
+ * left empty on Intel architecture.
+ *)
+PROCEDURE InvalidateICacheRange * (adr: ADDRESS; len: LONGINT);
+END InvalidateICacheRange;
+
+
+(* setup MMX, SSE and SSE2..SSE5 and AVX extension *)
+
+PROCEDURE SetupSSE2Ext;
+CONST
+	MMXFlag=23;(*IN features from EBX*)
+	FXSRFlag = 24;
+	SSEFlag = 25;
+	SSE2Flag = 26;
+	SSE3Flag = 0; (*IN features2 from ECX*) (*PH 04/11*)
+	SSSE3Flag =9;
+	SSE41Flag =19;
+	SSE42Flag =20;
+	SSE5Flag = 11;
+	AVXFlag = 28;
+BEGIN
+	MMXSupport := MMXFlag IN features;
+	SSESupport := SSEFlag IN features;
+	SSE2Support := SSESupport & (SSE2Flag IN features);
+	SSE3Support := SSE2Support & (SSE3Flag IN features2);
+	SSSE3Support := SSE3Support & (SSSE3Flag IN features2); (* PH 04/11*)
+	SSE41Support := SSE3Support & (SSE41Flag IN features2);
+	SSE42Support := SSE3Support & (SSE42Flag IN features2);
+	SSE5Support := SSE3Support & (SSE5Flag IN features2);
+	AVXSupport := SSE3Support & (AVXFlag IN features2);
+
+	IF SSESupport & (FXSRFlag IN features) THEN
+		(* InitSSE(); *) (*! not privileged mode in Windows not allowed *)
+	END;
+END SetupSSE2Ext;
+
+PROCEDURE ReadCommandLine(VAR commandLine: ARRAY OF CHAR);
+VAR adr: ADDRESS; i: LONGINT; ch: CHAR;
+BEGIN
+	adr := Kernel32.GetCommandLine();
+	SYSTEM.GET(adr,ch);
+	i := 0;
+	WHILE (i<LEN(commandLine)-1) & (ch # 0X) DO
+		commandLine[i] := ch;
+		INC(adr); INC(i);
+		SYSTEM.GET(adr,ch);
+	END;
+END ReadCommandLine;
+
+PROCEDURE ParseLine(VAR c: ARRAY OF CHAR; VAR iniFile: ARRAY OF CHAR);
+VAR i: LONGINT;
+
+	PROCEDURE SkipSpaces;
+	BEGIN
+		WHILE (c[i] <= " ") & (c[i] # 0X) DO INC(i) END;
+	END SkipSpaces;
+
+	PROCEDURE SkipName;
+	BEGIN
+		WHILE (c[i] > " ") DO INC(i) END;
+	END SkipName;
+
+	PROCEDURE CheckName(CONST name: ARRAY OF CHAR): BOOLEAN;
+	VAR j: LONGINT;
+	BEGIN
+		j := 0;
+		WHILE (c[i] = name[j]) & (c[i] # 0X) & (name[j] # 0X) DO
+			INC(i); INC(j);
+		END;
+		RETURN (name[j] = 0X);
+	END CheckName;
+
+	PROCEDURE ReadName(VAR name: ARRAY OF CHAR);
+	VAR j: LONGINT;
+	BEGIN
+		SkipSpaces;
+		j := 0;
+		WHILE (c[i] > " ") & (j < LEN(name)-1) DO
+			name[j] := c[i];
+			INC(i); INC(j);
+		END;
+		name[j] := 0X;
+	END ReadName;
+
+BEGIN
+	c[LEN(c)-1] := 0X;
+	i := 0;
+	SkipSpaces;
+	SkipName;
+	SkipSpaces;
+	IF c[i] = "-" THEN (* option *)
+		INC(i);
+		IF CheckName("ini") THEN SkipSpaces; ReadName(iniFile) END;
+	END;
+END ParseLine;
+
+PROCEDURE TraceChar(c: CHAR);
+VAR len: LONGINT; b: Kernel32.BOOL;
+BEGIN
+	len := 1;
+	b := Kernel32.WriteFile(hout,c,len,len,NIL);
+END TraceChar;
+
+PROCEDURE SetTraceFile(VAR filename: ARRAY OF CHAR);
+BEGIN
+	Trace.String("trace -> file "); Trace.String(filename); Trace.Ln;
+	hout := Kernel32.CreateFile(filename, {Kernel32.GenericWrite}, {Kernel32.FileShareRead}, NIL, Kernel32.CreateAlways, {Kernel32.FileAttributeNormal}, Kernel32.NULL);
+	Kernel32.GetFullPathName(filename, LEN(filename), filename, NIL);
+	Trace.Char := TraceChar;
+END SetTraceFile;
+
+PROCEDURE SetTraceConsole;
+VAR res: LONGINT;
+BEGIN
+	Trace.String("trace -> console"); Trace.Ln;
+	res := Kernel32.AllocConsole ();
+	hin := Kernel32.GetStdHandle (Kernel32.STDInput);
+	hout := Kernel32.GetStdHandle (Kernel32.STDOutput);
+	Trace.Char := TraceChar;
+END SetTraceConsole;
+
+PROCEDURE SetupTraceName(VAR traceName: ARRAY OF CHAR);
+VAR
+	ext: ARRAY 256 OF CHAR;
+	extPos,i,j: LONGINT;
+	systemTime: Kernel32.SystemTime;
+	ch: CHAR;
+
+	PROCEDURE AppendDecimals(int: LONGINT; from, to: LONGINT);
+	VAR ten: LONGINT;
+	BEGIN
+		WHILE to >= from DO
+			traceName[i] := CHR(ORD("0")+ int DIV to MOD 10); INC(i);
+			to := to DIV 10;
+		END;
+	END AppendDecimals;
+
+BEGIN
+	Kernel32.GetLocalTime(systemTime);
+
+	extPos := 0;
+	REPEAT
+		ch := traceName[i];
+
+		IF ch = "." THEN j := 0; extPos := i END;
+
+		ext[j] := ch;
+		INC(j); INC(i);
+	UNTIL ch = 0X;
+
+	IF extPos > 0 THEN i := extPos END;
+	ext[j] := 0X;
+
+	AppendDecimals(systemTime.wYear,1,1000);
+	AppendDecimals(systemTime.wMonth,1,10);
+	AppendDecimals(systemTime.wDay,1,10);
+	traceName[i] := "_"; INC(i);
+	AppendDecimals(systemTime.wHour,1,10);
+	AppendDecimals(systemTime.wMinute,1,10);
+	AppendDecimals(systemTime.wSecond,1,10);
+	traceName[i] := "_"; INC(i);
+	AppendDecimals(systemTime.wMilliseconds,10,100);
+	j := 0;
+	REPEAT
+		ch := ext[j];
+		traceName[i] := ch;
+		INC(i); INC(j);
+	UNTIL ch = 0X;
+
+END SetupTraceName;
+
+PROCEDURE RemoveTraceFile;
+VAR res: LONGINT;
+BEGIN
+	IF traceName[0] # 0X THEN
+		Trace.String("removing "); Trace.String(traceName); Trace.Ln;
+		Trace.Char := LogChar;
+		res := Kernel32.CloseHandle(hout);
+		IF res = 0 THEN
+			res := Kernel32.GetLastError();
+			Trace.String("could not close "); Trace.String("; res = "); Trace.Int(res,1); Trace.Ln;
+		END;
+		res := Kernel32.DeleteFile(traceName);
+		IF res = 0 THEN
+			res := Kernel32.GetLastError();
+			Trace.String("could not delete "); Trace.String(traceName); Trace.String("; res = "); Trace.Int(res,1); Trace.Ln;
+		END;
+
+	END;
+END RemoveTraceFile;
+
+PROCEDURE ToExecutablePath(CONST name: ARRAY OF CHAR; VAR fullName: ARRAY OF CHAR);
+VAR i,j: LONGINT;
+BEGIN
+	Kernel32.GetModuleFileName(Kernel32.hInstance, fullName, LEN( fullName ) );
+	j := -1; i := 0;
+	WHILE fullName[i] # 0X DO
+		IF fullName[i] = '\' THEN j := i END;
+		INC( i )
+	END;
+	i := 0; INC(j);
+	WHILE name[i] # 0X DO
+		fullName[j] := name[i]; INC(i); INC(j);
+	END;
+	fullName[j] := 0X;
+END ToExecutablePath;
+
+PROCEDURE Append(VAR s: ARRAY OF CHAR; CONST t: ARRAY OF CHAR);
+VAR i,j: LONGINT;
+BEGIN
+	i := 0; 
+	WHILE(s[i] # 0X) DO INC(i) END;
+	j := 0;
+	WHILE (t[j] # 0X) DO
+		s[i] := t[j];
+		INC(i); INC(j);
+	END;
+	s[i] := 0X;
+END Append;
+
+PROCEDURE Init*;
+VAR vendor: Vendor; ver: LONGINT; hfile: Kernel32.HANDLE;
+BEGIN
+	Kernel32.Init;
+	Trace.String("Machine 1"); Trace.Ln;
+(*	trace[1] := 0X; Trace.Char := LogChar; Trace.Color := TraceColor; *)
+	InitLocks();
+	boottime:=GetTimer();
+
+	COPY( Version, version );
+	Append(version, SYSTEM.Date);
+	CPUID(vendor, ver, features,features2);	 SetupSSE2Ext;
+	fcr := (FCR() - {0,2,3,10,11}) + {0..5,8,9};	(* default FCR RC=00B *)
+
+	ReadCommandLine(commandLine);
+
+	IF Kernel32.Generic THEN
+		ToExecutablePath(DefaultGenericConfigFile, defaultConfigFile);
+	ELSE
+		ToExecutablePath(DefaultConfigFile, defaultConfigFile);
+	END;
+	COPY(UserConfigFile, userConfigFile);
+	hfile := Kernel32.CreateFile( userConfigFile, {Kernel32.GenericRead}, {Kernel32.FileShareRead}, NIL , Kernel32.OpenExisting, {Kernel32.FileAttributeNormal}, 0 );
+	IF hfile = Kernel32.InvalidHandleValue THEN
+		ToExecutablePath(UserConfigFile, userConfigFile);
+	ELSE
+		Kernel32.CloseHandle(hfile)
+	END;
+
+	(* ever used ? *)
+	ParseLine(commandLine, userConfigFile);
+
+
+	userConfigFile[Kernel32.GetFullPathName (userConfigFile, Kernel32.MaxPath, userConfigFile, 0)] := 0X;
+
+
+	Trace.String("config file = "); Trace.String(defaultConfigFile); Trace.Ln;
+	Trace.String("user config file = "); Trace.String(userConfigFile); Trace.Ln;
+
+	traceName[0] := 0X;
+	GetConfig("Trace",traceName);
+	Trace.String("traceName "); Trace.String(traceName); Trace.Ln;
+	IF traceName = "File" THEN
+		traceName := "SystemTrace.txt";
+		SetupTraceName(traceName);
+		Trace.String("trace file to "); Trace.String(traceName); Trace.Ln;
+		SetTraceFile(traceName);
+	ELSIF traceName = "Console" THEN SetTraceConsole
+	(* else trace is on kernel log *)
+	END;
+	Trace.String("Machine init done"); Trace.Ln;
+END Init;
+
+	PROCEDURE {INITIAL, NOPAF} Start;
+	BEGIN
+		Init; (* cannot allocate variables in here *)
+	END Start;
+
+	(* Initialize locks. *)
+	PROCEDURE InitLocks;
+	VAR i: LONGINT;
+	BEGIN
+		i := 0;
+		WHILE i < MaxLocks DO Kernel32.InitializeCriticalSection( cs[i] ); lock[i] := "N"; INC( i ) END;
+	END InitLocks;
+
+	PROCEDURE CleanupLocks*;
+	VAR i: LONGINT;
+	BEGIN
+		i := 0;
+		WHILE i < MaxLocks DO Kernel32.DeleteCriticalSection( cs[i] );  INC( i ) END;
+	END CleanupLocks;
+
+(** Acquire a spin-lock. *)
+	PROCEDURE Acquire*( level: LONGINT );   (* non reentrant lock  (non reentrance "ensured" by ASSERT statement ), CriticalSections are reentrant *)
+	BEGIN
+		Kernel32.EnterCriticalSection( cs[level] );
+		IF StrongChecks THEN
+			ASSERT ( lock[level] = "N", 1001 );
+		ELSIF lock[level] # "N" THEN
+			Trace.String("warning: reentered non-reentrant lock"); Trace.Ln;
+		END;
+		lock[level] := "Y";
+	END Acquire;
+
+(** Release a spin-lock. *)
+	PROCEDURE Release*( level: LONGINT );   (* release lock *)
+	BEGIN
+		IF StrongChecks THEN
+			ASSERT ( lock[level] ="Y", 1002 );
+		ELSIF lock[level] # "Y" THEN
+			Trace.String("warning: reentered non-reentrant lock"); Trace.Ln;
+		END;
+		lock[level] := "N";
+		Kernel32.LeaveCriticalSection( cs[level] )
+	END Release;
+
+
+	(* added by Alexey *)
+	PROCEDURE GetMemStatus(VAR stat: Kernel32.MemoryStatusEx): BOOLEAN;
+	BEGIN
+		stat.dwLength := 64;
+		IF Kernel32.GlobalMemoryStatusEx(stat) = 1 THEN
+			RETURN TRUE;
+		ELSE
+			RETURN FALSE;
+		END;
+	END GetMemStatus;
+
+(** dummy procedure to make GC work for both I386 and Win32 *)
+PROCEDURE GetKernelStacks*(VAR stack: ARRAY OF Stack);
+VAR i: LONGINT;
+BEGIN
+	FOR i := 0 TO MaxCPU-1 DO
+		stack[i].adr := NilVal;
+		stack[i].high := NilVal
+	END
+END GetKernelStacks;
+
+(* Set machine-dependent parameter gcThreshold *)
+PROCEDURE SetGCParams*;
+BEGIN
+	gcThreshold := 10*1024*1024; (* 10 MB *)
+END SetGCParams;
+
+(* expand heap by allocating a new memory block - called during GC *)
+PROCEDURE InitHeap(VAR memoryBlock: MemoryBlock; VAR beginBlockAdr, endBlockAdr: ADDRESS);
+CONST MemBlockHeaderSize = BlockHeaderSize + RecordDescSize + BlockHeaderSize;
+	TypeDescOffset = -AddressSize; (* see Heaps.Mod *)
+	HeapBlockOffset = - 2 * AddressSize; (* see Heaps.Mod *)
+	DataAdrOffset = AddressSize; (* offset of dataAdr field in Heaps.HeapBlockDesc *)
+VAR memDescSize, memBlkSize, alignOffset: SIZE; adr, memHeaderAdr, memBlockAdr, memBlockHeadAdr: ADDRESS;
+	memBlock {UNTRACED}: MemoryBlock; i: LONGINT; ch: CHAR; h: HUGEINT; size: LONGINT;
+	initVal: LONGINT;
+BEGIN
+
+	(*
+		HeapBlockPtr -- bootHeapAdr
+	4	Type
+	8	Mark
+	12	DataAdr
+	16	Size
+	20	HeapBlockPtr
+	24	Type
+	28	next  -- MemoryBlock
+	32	startAdr
+	36	size
+	40	beginBlockAdr
+	44	endBlockAdr
+	48		--beginBlockAdr
+	....
+			--endBlockAdr
+
+	*)
+	size := 1;
+	memDescSize := MemBlockHeaderSize + SIZEOF(MemoryBlockDesc);
+	INC(memDescSize, (-memDescSize) MOD StaticBlockSize); 	(* round up to multiple of StaticBlockSize *)
+	INC(size, (-size) MOD StaticBlockSize); (* round up to multiple of StaticBlockSize *)
+	memBlkSize := memDescSize + size + StaticBlockSize; 		(* add StaticBlockSize to account for alignments different from multiples of StaticBlockSize *)
+	IF memBlkSize < MemBlockSize THEN memBlkSize := MemBlockSize END; 	(* MemBlockSize implicitly multiple of StaticBlockSize *)
+
+	initVal := 8*1024*1024;
+	adr := Kernel32.VirtualAlloc(initVal, memBlkSize, {Kernel32.MEMCommit, Kernel32.MEMReserve}, {Kernel32.PageExecuteReadWrite});
+	IF adr = NilVal THEN (* allocation failed *)
+		adr := Kernel32.VirtualAlloc(NilVal, memBlkSize, {Kernel32.MEMCommit}, {Kernel32.PageExecuteReadWrite});
+	END;
+	Trace.String("first heap block intVal "); Trace.Int(initVal,1); Trace.Ln;
+	Trace.String("first heap block memBlkSize "); Trace.Int(memBlkSize,1); Trace.Ln;
+	Trace.String("first heap block adr "); Trace.Int(adr,1); Trace.Ln;
+	ASSERT(adr # 0);
+
+	alignOffset := (-adr) MOD StaticBlockSize;
+
+	memHeaderAdr := adr + alignOffset;  	(* force alignment of memory block start *)
+	memBlockAdr := memHeaderAdr + MemBlockHeaderSize;
+	memBlock := SYSTEM.VAL(MemoryBlock, memBlockAdr);
+	beginBlockAdr := memHeaderAdr + memDescSize;
+
+	memBlock.next := NIL;
+	memBlock.startAdr := adr;
+	memBlock.size := memBlkSize;
+
+	beginBlockAdr := memHeaderAdr + memDescSize;
+	endBlockAdr := adr + memBlkSize - alignOffset;
+	memBlock.beginBlockAdr := beginBlockAdr;
+	memBlock.endBlockAdr := endBlockAdr;
+
+	(* correct fields *)
+	SYSTEM.PUT(memBlockAdr + HeapBlockOffset, memHeaderAdr + BlockHeaderSize);	(* set reference to header part of memory block correctly *)
+	SYSTEM.PUT(memBlockAdr + TypeDescOffset, 0);										(* set type descriptor field of memory block to default value, memory blocks are not traced by GC *)
+	SYSTEM.PUT(memHeaderAdr + BlockHeaderSize + DataAdrOffset, memBlockAdr);		(* set dataAdr of RecordBlockDesc to correct value *)
+	SYSTEM.PUT(memHeaderAdr + BlockHeaderSize + 2*AddressSize , memBlkSize);
+
+	(* fill first heap block *)
+	SYSTEM.PUT(beginBlockAdr,0);
+	SYSTEM.PUT(beginBlockAdr+AddressSize,0);
+	SYSTEM.PUT(beginBlockAdr+2*AddressSize,0);
+	(* change this when Heaps.HeapBlock is modified *)
+	SYSTEM.PUT(beginBlockAdr+3*AddressSize,beginBlockAdr+7*AddressSize);
+	SYSTEM.PUT(beginBlockAdr+4*AddressSize,endBlockAdr-beginBlockAdr);
+	SYSTEM.PUT(beginBlockAdr+5*AddressSize,beginBlockAdr+2*AddressSize);
+	SYSTEM.PUT(beginBlockAdr+6*AddressSize,0);
+
+
+	memoryBlock := memBlock;
+END InitHeap;
+
+(** Get first memory block and first free address, the first free address is identical to memBlockHead.endBlockAdr *)
+PROCEDURE GetStaticHeap*(VAR beginBlockAdr, endBlockAdr, freeBlockAdr: ADDRESS);
+VAR memBlockAdr: ADDRESS;
+BEGIN
+	InitHeap(memBlockHead,beginBlockAdr, endBlockAdr);
+	memBlockTail := memBlockHead;
+
+	(*
+	SYSTEM.GET(bootHeapAdr + EndBlockOfs, freeBlockAdr);
+	ASSERT(freeBlockAdr MOD StaticBlockSize = 0);
+	memBlockAdr := bootHeapAdr + HeaderSize + MemoryBlockOfs;
+
+
+	memBlockHead := SYSTEM.VAL(MemoryBlock, memBlockAdr); (* this block will never be freed since there is a global reference (initBlock in Heaps.Mod) to it *)
+	memBlockHead.startAdr := bootHeapAdr;
+	memBlockHead.size := bootHeapSize;
+	ASSERT(memBlockHead.beginBlockAdr MOD StaticBlockSize = 0);
+	ASSERT((memBlockHead.endBlockAdr - memBlockHead.beginBlockAdr) MOD StaticBlockSize = 0);
+	memBlockTail := memBlockHead;
+	*)
+	beginBlockAdr := memBlockHead.beginBlockAdr;
+	endBlockAdr := memBlockHead.endBlockAdr;
+	freeBlockAdr := beginBlockAdr;
+END GetStaticHeap;
+
+(* returns if an address is a currently allocated heap address *)
+PROCEDURE ValidHeapAddress*(p: ADDRESS): BOOLEAN;
+BEGIN
+	RETURN (p >= memBlockHead.beginBlockAdr) & (p <= memBlockTail.endBlockAdr)
+		OR (p>=401000H) & (p<=ADDRESSOF(LastAddress))
+END ValidHeapAddress;
+
+
+PROCEDURE GetFreeK* (VAR total, lowFree, highFree: SIZE);
+VAR
+	stat: Kernel32.MemoryStatusEx;
+BEGIN
+	total := MAX(LONGINT); lowFree := 0; highFree := total;
+	(*<< added by Alexey *)
+	IF GetMemStatus(stat) THEN
+		total := SHORT(stat.ullTotalVirtual DIV 1024);
+		lowFree := 0;
+		highFree := SHORT(stat.ullAvailVirtual DIV 1024);
+	END;
+	(* added by Alexey >>*)
+END GetFreeK;
+
+(* ug *)
+PROCEDURE TraceMemBlocks*;
+VAR memBlock {UNTRACED}: MemoryBlock; i : LONGINT;
+BEGIN
+	memBlock := memBlockHead;
+	i := 0;
+	WHILE memBlock # NIL DO
+		Trace.String("block "); Trace.Int(i, 0); Trace.String(": startAdr = "); Trace.Hex(memBlock.startAdr, 0);
+		Trace.String(" size = "); Trace.Hex(memBlock.size, 0);
+		Trace.String(" beginBlockAdr = "); Trace.Hex(memBlock.beginBlockAdr, 0);
+		Trace.String(" endBlockAdr = "); Trace.Hex(memBlock.endBlockAdr, 0); Trace.Ln;
+		memBlock := memBlock.next;
+		INC(i)
+	END
+END TraceMemBlocks;
+
+(* insert given memory block in sorted list of memory blocks, sort key is startAdr field - called during GC *)
+PROCEDURE InsertMemoryBlock(memBlock: MemoryBlock);
+VAR cur {UNTRACED}, prev {UNTRACED}: MemoryBlock;
+BEGIN
+	cur := memBlockHead;
+	prev := NIL;
+	WHILE (cur # NIL) & (cur.startAdr < memBlock.startAdr) DO
+		prev := cur;
+		cur := cur.next
+	END;
+	IF prev = NIL THEN (* insert at head of list *)
+		memBlock.next := memBlockHead;
+		memBlockHead := memBlock
+	ELSE (* insert in middle or at end of list *)
+		memBlock.next := cur;
+		prev.next := memBlock;
+		IF cur = NIL THEN
+			memBlockTail := memBlock
+		END
+	END
+END InsertMemoryBlock;
+
+(* expand heap by allocating a new memory block - called during GC *)
+PROCEDURE ExpandHeap*(dummy: LONGINT; size: SIZE; VAR memoryBlock: MemoryBlock; VAR beginBlockAdr, endBlockAdr: ADDRESS);
+CONST MemBlockHeaderSize = BlockHeaderSize + RecordDescSize + BlockHeaderSize;
+	TypeDescOffset = -AddressSize; (* see Heaps.Mod *)
+	HeapBlockOffset = - 2 * AddressSize; (* see Heaps.Mod *)
+	DataAdrOffset = AddressSize; (* offset of dataAdr field in Heaps.HeapBlockDesc *)
+VAR memDescSize, memBlkSize, alignOffset: SIZE; adr, memHeaderAdr, memBlockAdr, memBlockHeadAdr: ADDRESS;
+	memBlock {UNTRACED}: MemoryBlock; i: LONGINT; ch: CHAR; h: HUGEINT; initVal: SIZE;
+	continue: BOOLEAN;
+BEGIN
+	memDescSize := MemBlockHeaderSize + SIZEOF(MemoryBlockDesc);
+	INC(memDescSize, (-memDescSize) MOD StaticBlockSize); 	(* round up to multiple of StaticBlockSize *)
+	INC(size, (-size) MOD StaticBlockSize); (* round up to multiple of StaticBlockSize *)
+	memBlkSize := memDescSize + size + StaticBlockSize; 		(* add StaticBlockSize to account for alignments different from multiples of StaticBlockSize *)
+	INC(memBlkSize, (-memBlkSize) MOD MemBlockSize);
+	initVal := memBlockTail.startAdr + memBlockTail.size;
+	adr := Kernel32.VirtualAlloc(initVal, memBlkSize, {Kernel32.MEMCommit, Kernel32.MEMReserve}, {Kernel32.PageExecuteReadWrite});
+	IF adr = NilVal THEN (* allocation failed *)
+		adr := Kernel32.VirtualAlloc(NilVal, memBlkSize, {Kernel32.MEMCommit}, {Kernel32.PageExecuteReadWrite});
+	END;
+	continue := adr = initVal;
+	Trace.String("expand heap block intVal "); Trace.Int(initVal,1); Trace.Ln;
+	Trace.String("expand heap block memBlkSize "); Trace.Int(memBlkSize,1); Trace.Ln;
+	Trace.String("expand heap block adr "); Trace.Int(adr,1); Trace.Ln;
+	ASSERT(adr # 0);
+
+	IF adr # 0 THEN
+
+		alignOffset := (-adr) MOD StaticBlockSize;
+
+		IF continue THEN
+			memBlock := memBlockTail;
+			memBlock.size := memBlock.size + memBlkSize;
+
+			beginBlockAdr := memBlockTail.endBlockAdr;
+			endBlockAdr := beginBlockAdr;
+			INC(endBlockAdr, memBlkSize);
+		ELSE
+			memHeaderAdr := adr + alignOffset;  	(* force alignment of memory block start *)
+			memBlockAdr := memHeaderAdr + MemBlockHeaderSize;
+			memBlock := SYSTEM.VAL(MemoryBlock, memBlockAdr);
+			memBlock.next := NIL;
+			memBlock.startAdr := adr;
+			memBlock.size := memBlkSize;
+
+			beginBlockAdr := memHeaderAdr + memDescSize;
+			endBlockAdr := adr + memBlkSize - alignOffset;
+			memBlock.beginBlockAdr := beginBlockAdr;
+			memBlock.endBlockAdr := beginBlockAdr;
+			(* upon memory block insertion memBlock.beginBlockAdr = memBlock.endBlockAdr to denote that the memory block has no valid heap blocks yet
+			     - necessary for real-time GC. Memory block end address is set by caller by using SetMemBlockEndAddress after fitting free block in. *)
+
+			(* copy header of memBlockHead to header of memBlock - byte by byte *)
+			memBlockHeadAdr := SYSTEM.VAL(ADDRESS, memBlockHead);
+			FOR i := 0 TO MemBlockHeaderSize - 1 DO
+				SYSTEM.GET(memBlockHeadAdr - MemBlockHeaderSize + i, ch);
+				SYSTEM.PUT(memBlockAdr - MemBlockHeaderSize + i, ch)
+			END;
+
+			(* correct fields *)
+			SYSTEM.PUT(memBlockAdr + HeapBlockOffset, memHeaderAdr + BlockHeaderSize);	(* set reference to header part of memory block correctly *)
+			SYSTEM.PUT(memBlockAdr + TypeDescOffset, 0);										(* set type descriptor field of memory block to default value, memory blocks are not traced by GC *)
+			SYSTEM.PUT(memHeaderAdr + BlockHeaderSize + DataAdrOffset, memBlockAdr);		(* set dataAdr of RecordBlockDesc to correct value *)
+
+			InsertMemoryBlock(memBlock);
+		END;
+
+		memoryBlock := memBlock;
+	ELSE
+		beginBlockAdr := 0; endBlockAdr := 0;
+	END;
+END ExpandHeap;
+
+(* Set memory block end address *)
+PROCEDURE SetMemoryBlockEndAddress*(memBlock: MemoryBlock; endBlockAdr: ADDRESS);
+BEGIN
+	ASSERT(endBlockAdr >= memBlock.beginBlockAdr);
+	memBlock.endBlockAdr := endBlockAdr
+END SetMemoryBlockEndAddress;
+
+(* Free unused memory block - called during GC *)
+PROCEDURE FreeMemBlock*(memBlock: MemoryBlock);
+VAR cur {UNTRACED}, prev {UNTRACED}: MemoryBlock;
+	startAdr: ADDRESS;
+BEGIN
+	cur := memBlockHead;
+	prev := NIL;
+	WHILE (cur # NIL) & (cur # memBlock) DO
+		prev := cur;
+		cur := cur.next
+	END;
+	IF cur = memBlock THEN
+		IF prev = NIL THEN
+			memBlockHead := cur.next;
+		ELSE
+			prev.next := cur.next;
+			IF prev.next = NIL THEN
+				memBlockTail := prev
+			END
+		END;
+		memBlock.next := NIL;
+		startAdr := memBlock.startAdr; (* this value must be cached for the second call of Kernel32.VirtualFree *)
+		Kernel32.VirtualFree(SYSTEM.VAL(LONGINT, memBlock.startAdr), memBlock.size, {Kernel32.MEMDecommit});
+		Kernel32.VirtualFree(SYSTEM.VAL(LONGINT, startAdr ), 0, {Kernel32.MEMRelease});
+	ELSE
+		HALT(535)	(* error in memory block management *)
+	END;
+END FreeMemBlock;
+
+PROCEDURE PhysicalAdr*(adr: ADDRESS; size: SIZE): ADDRESS;
+END PhysicalAdr;
+
+(* function returning the number of processors that are available to Aos *)
+PROCEDURE NumberOfProcessors*( ): LONGINT;
+VAR info: Kernel32.SystemInfo;
+BEGIN
+	Kernel32.GetSystemInfo( info );
+	RETURN info.dwNumberOfProcessors
+END NumberOfProcessors;
+
+(* function for changing byte order *)
+PROCEDURE ChangeByteOrder* (n: LONGINT): LONGINT;
+CODE { SYSTEM.Pentium }
+	MOV EAX, [EBP+n]				; load n in eax
+	BSWAP EAX						; swap byte order
+END ChangeByteOrder;
+
+PROCEDURE TraceColor (c: SHORTINT);
+END TraceColor;
+
+PROCEDURE LogChar (c: CHAR);
+VAR trace: ARRAY 2 OF CHAR;
+BEGIN trace[0] := c; trace[1] := 0X; Kernel32.OutputString (trace);
+END LogChar;
+
+PROCEDURE -GetEAX*(): LONGINT;
+CODE{SYSTEM.i386}
+END GetEAX;
+
+PROCEDURE -GetECX*(): LONGINT;
+CODE{SYSTEM.i386}
+	MOV EAX,ECX
+END GetECX;
+
+PROCEDURE -SetEAX*(n: LONGINT);
+CODE{SYSTEM.i386}	POP EAX
+END SetEAX;
+
+PROCEDURE -SetEBX*(n: LONGINT);
+CODE{SYSTEM.i386}
+	POP EBX
+END SetEBX;
+
+PROCEDURE -SetECX*(n: LONGINT);
+CODE{SYSTEM.i386}
+	POP ECX
+END SetECX;
+
+PROCEDURE -SetEDX*(n: LONGINT);
+CODE{SYSTEM.i386}
+	POP EDX
+END SetEDX;
+
+PROCEDURE -SetESI*(n: LONGINT);
+CODE{SYSTEM.i386}
+	POP ESI
+END SetESI;
+
+PROCEDURE -SetEDI*(n: LONGINT);
+CODE{SYSTEM.i386}
+	POP EDI
+END SetEDI;
+
+PROCEDURE Portin8*(port: LONGINT; VAR val: CHAR);
+CODE{SYSTEM.i386}
+	MOV EDX,[EBP+port]
+	IN AL, DX
+	MOV ECX, [EBP+val]
+	MOV [ECX], AL
+END Portin8;
+
+PROCEDURE Portin16*(port: LONGINT; VAR val: INTEGER);
+CODE{SYSTEM.i386}
+	MOV EDX,[EBP+port]
+	IN AX, DX
+	MOV ECX, [EBP+val]
+	MOV [ECX], AX
+END Portin16;
+
+PROCEDURE Portin32*(port: LONGINT; VAR val: LONGINT);
+CODE{SYSTEM.i386}
+	MOV EDX,[EBP+port]
+	IN EAX, DX
+	MOV ECX, [EBP+val]
+	MOV [ECX], EAX
+END Portin32;
+
+PROCEDURE Portout8*(port: LONGINT; val: CHAR);
+CODE{SYSTEM.i386}
+	MOV AL,[EBP+val]
+	MOV EDX,[EBP+port]
+	OUT DX,AL
+END Portout8;
+
+PROCEDURE Portout16*(port: LONGINT; val: INTEGER);
+CODE{SYSTEM.i386}
+	MOV AX,[EBP+val]
+	MOV EDX,[EBP+port]
+	OUT DX,AX
+END Portout16;
+
+PROCEDURE Portout32*(port: LONGINT; val: LONGINT);
+CODE{SYSTEM.i386}
+	MOV EAX,[EBP+val]
+	MOV EDX,[EBP+port]
+	OUT DX,EAX
+END Portout32;
+
+BEGIN
+	IF ~Kernel32.Generic THEN
+		Init
+	END;
+END Machine.

+ 1359 - 0
source/Win64.Objects.Mod

@@ -0,0 +1,1359 @@
+ (* Aos, Copyright 2001, Pieter Muller, ETH Zurich; this module ported for the windows version, fof. *)
+
+MODULE Objects;   (** AUTHOR "pjm, ejz, fof"; PURPOSE "Active object runtime support"; *)
+
+IMPORT SYSTEM, Trace, Kernel32, Machine, Modules, Heaps;
+
+CONST
+	HandleExcp = TRUE;   (* FALSE -> we asume that it is done correctly by Traps *)
+	TraceVerbose = FALSE;
+	StrongChecks = FALSE;  defaultStackSize = 0;
+	TraceOpenClose = FALSE;
+
+CONST
+	(* Process flags *)
+	Restart* = 0;   (* Restart/Destroy process on exception *)
+	PleaseHalt* = 10;   (* Process requested to Halt itself soon *)
+	Unbreakable* = 11;
+	SelfTermination* = 12;
+	Preempted* = 27;   (* Has been preempted. *)
+	Resistant* = 28;   (* Can only be destroyed by itself *)
+	PleaseStop* = 31;   (* Process requested to Terminate or Halt itself soon *)
+
+	InActive* = 26;   (* needed to prevent processes to call finalizers while in await or lock or unlock, see Kernel.GC *)
+
+	(** Process modes *)
+	Unknown* = 0; Ready* = 1; (* for compatibility with native A2 *)
+	Running* = 2; AwaitingLock* = 3; AwaitingCond* = 4; AwaitingEvent* = 5; Suspended* = 6; 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 *)
+
+	(* Process termination halt codes *)
+	halt* = 2222;
+	haltUnbreakable* = 2223;
+
+
+TYPE
+	CpuCyclesArray* = ARRAY Machine.MaxCPU OF HUGEINT;
+
+	ProtectedObject = POINTER TO RECORD END;   (* protected object (10000) *)
+
+	ProcessQueue = Heaps.ProcessQueue;
+
+	Body = PROCEDURE (self: ProtectedObject);
+	Condition = PROCEDURE (slink: ADDRESS): BOOLEAN;
+
+	EventHandler* = PROCEDURE {DELEGATE};
+	RealtimeEventHandler* = PROCEDURE {DELEGATE, REALTIME};
+
+	Timer* = POINTER TO RECORD
+		next, prev : Timer;
+		trigger: LONGINT;
+		handler: EventHandler
+	END;
+
+	RealtimeTimer* = POINTER TO RECORD
+		next, prev: RealtimeTimer;
+		trigger: LONGINT;
+		handler: RealtimeEventHandler
+	END;
+
+	Clock = OBJECT
+		VAR h: Timer;
+			ticks: LONGINT;
+			hevent: Kernel32.HANDLE;
+			res: Kernel32.BOOL;
+			mode: LONGINT;
+			process: Process;
+
+		PROCEDURE Wakeup;
+		VAR res: Kernel32.BOOL;
+		BEGIN {EXCLUSIVE}
+			res := Kernel32.SetEvent(hevent)
+		END Wakeup;
+
+		PROCEDURE Finalize(ptr: ANY);
+		VAR res: Kernel32.BOOL;
+		BEGIN
+			IF hevent # 0 THEN res := Kernel32.CloseHandle(hevent);  hevent := 0 END
+		END Finalize;
+
+		PROCEDURE &Init*;
+		VAR fn: Heaps.FinalizerNode;
+		BEGIN
+			hevent := Kernel32.CreateEvent(NIL, 0, 0, NIL);
+			ASSERT(hevent # 0);
+			NEW(fn); fn.finalizer := SELF.Finalize; Heaps.AddFinalizer(SELF, fn)
+		END Init;
+
+	BEGIN {ACTIVE, SAFE, PRIORITY(High)}
+		process := CurrentProcess();
+		mode := process.mode;
+		LOOP
+			Machine.Acquire(Machine.Objects);
+			process.mode := mode;
+			LOOP
+				h := event.next;  (* event: head of timer event queue *)
+				ticks := Kernel32.GetTickCount();
+				IF (h = event) OR (h.trigger - 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;
+			mode := process.mode;
+			process.mode := AwaitingEvent;
+			Machine.Release(Machine.Objects);
+			IF h = event THEN (* sentinel head of timer event queue: wait forever until a new event has been entered in queue *)
+				res := Kernel32.WaitForSingleObject(hevent, MAX(LONGINT));
+			ELSE
+				res := Kernel32.WaitForSingleObject(hevent, h.trigger - ticks);
+			END;
+		END
+	END Clock;
+
+TYPE
+
+	Win32Event = Kernel32.HANDLE;
+	
+	GCContext = RECORD
+		ebp: ADDRESS;
+	END;
+
+	Process* = OBJECT(Heaps.ProcessLink)
+	VAR
+		rootedNext : Process; (*  to prevent process to be GCed in WinAos *)
+		obj-: ProtectedObject;   (* associated active object *)
+		state-: Kernel32.Context;
+		(*
+		sse: SSEState;	(* fpu and sse state of preempted process (only valid if Preempted IN flag) *)
+		sseAdr: LONGINT;
+		*)
+		condition-: Condition;   (* awaited process' condition *)
+		condFP-: LONGINT;   (* awaited process' condition's context *)
+		mode-: LONGINT;   (* process state *)  (* only changed inside Objects lock ??? *)
+		procID-: LONGINT;   (* processor ID where running,  exported for compatibilty , useless in WinAos *)
+		waitingOn-: ProtectedObject;   (* obj this process is waiting on (for lock or condition) *)
+		id-: LONGINT;   (* unique process ID for tracing *)
+		flags*: SET;   (* process flags *)
+		priority-: LONGINT;   (* process priority *)
+		(*
+		currPri: LONGINT;
+		stack*: Machine.Stack; (** user-level stack of process *)
+		*)
+		stackBottom: ADDRESS;
+		handle-: Kernel32.HANDLE; (* handle to corresponding Windows thread *)
+		body: Body;
+		event: Win32Event;
+		restartPC-: ADDRESS;   (** entry point of body, for SAFE exception recovery *)
+		restartSP-: ADDRESS;   (** stack level at start of body, for SAFE exception recovery *)
+		(*
+		perfCyc*: ARRAY Machine.MaxCPU OF HUGEINT;
+		priInvCnt: LONGINT; (* counts the nummber of object locks hold that increased currPri of the process *)
+		exp*: Machine.ExceptionState;
+		oldReturnPC: LONGINT;
+		*)
+		lastThreadTimes: HUGEINT;   (*ALEX 2005.12.12*)
+		gcContext: GCContext;
+
+		PROCEDURE FindRoots;   (* override, called while GC, replaces Threads.CheckStacks *)
+		VAR sp: ADDRESS; res: Kernel32.BOOL; pc, bp: ADDRESS;
+			n,adr: ADDRESS; desc {UNTRACED}: Modules.ProcedureDescPointer; i: LONGINT; p {UNTRACED}: ANY;
+			context: Kernel32.Wow64Context;
+			a0,a1, obp, osb, osbp, opc, gbp: ADDRESS;
+			O: ANY; ID: LONGINT;
+			mod {UNTRACED}: Modules.Module;
+			proc {UNTRACED}: Modules.ProcedureDescPointer;
+			modName: ARRAY 128 OF CHAR;
+		BEGIN
+			O := obj; ID := id;
+			IF (handle = 0) OR (mode = Terminated) OR (mode < Ready) (* procedure Wrapper not yet started *)
+			OR (priority > High) (* stack of GC and realtime processes not traced *) THEN
+				RETURN
+			END;
+						
+			IF CurrentProcess() = SELF THEN
+				sp := Machine.CurrentSP();  bp :=Machine.CurrentBP(); pc := Machine.CurrentPC(); 
+			ELSE
+				IF mode # Suspended THEN
+					IF isWow64 THEN 
+						res := Kernel32.Wow64SuspendThread(handle);
+					ELSE
+						res := Kernel32.SuspendThread(handle);
+					END;
+					ASSERT(res # -1);
+				END;
+
+				state.ContextFlags := Kernel32.ContextControl + Kernel32.ContextInteger;
+				res := Kernel32.GetThreadContext( handle, state );
+				
+				context.ContextFlags := Kernel32.ContextControl + Kernel32.ContextInteger;
+				IF isWow64 THEN 
+					res := Kernel32.Wow64GetThreadContext( handle, context );
+				ELSE
+					res := Kernel32.GetThreadContext( handle, context );
+				END;
+				ASSERT(res # 0);
+				sp := context.SP; bp := context.BP; pc := context.PC;
+				
+				mod := Modules.ThisModuleByAdr0(pc);
+				IF mod # NIL THEN
+					COPY(mod.name, modName);
+					proc := Modules.FindProc(pc,mod.procTable);
+				END;
+				
+				obp := bp; osb := stackBottom; opc := pc;
+				osbp := state.BP;
+			END;
+			gbp := gcContext.ebp;
+			IF gbp # NIL THEN bp := gbp END;
+			
+			IF TraceProcessHook # NIL THEN
+				TraceProcessHook(SELF,pc,bp,sp,stackBottom);
+			END;
+			
+			(* stack garbage collection *)
+
+			IF Heaps.GCType= Heaps.HeuristicStackInspectionGC THEN
+				Heaps.Candidate( context.EDI );  Heaps.Candidate( context.ESI );
+				Heaps.Candidate( context.EBX ); Heaps.Candidate( context.EDX );
+				Heaps.Candidate( context.ECX ); Heaps.Candidate( context.EAX );
+				IF (stackBottom # 0) & (sp # 0) THEN
+					Heaps.RegisterCandidates( sp, stackBottom - sp );
+				END;
+			ELSIF Heaps.GCType = Heaps.MetaDataForStackGC THEN
+				IF bp < stackBottom THEN
+					WHILE (bp # Heaps.NilVal) & (bp < stackBottom)  DO (* do not test for bp >= sp: could be wrong temporarily! *)
+						SYSTEM.GET(bp, n);
+						IF ODD(n) THEN (* procedure descriptor at bp *)
+							desc := SYSTEM.VAL(Modules.ProcedureDescPointer, n-1);
+							IF desc # NIL THEN
+								a0 := ADDRESSOF(desc.offsets);
+								a1 :=  SYSTEM.VAL(ADDRESS, desc.offsets);
+								ASSERT(a0+SIZEOF(ADDRESS)=a1,54321);
+								FOR i := 0 TO LEN(desc.offsets)-1 DO
+									adr := bp + desc.offsets[i]; (* pointer at offset *)
+									SYSTEM.GET(adr, p); (* load pointer *)
+									IF p # NIL THEN 
+										Heaps.Mark(p);
+									END;
+								END;
+							END;
+							SYSTEM.GET(bp + SIZEOF(ADDRESS), bp);
+						ELSE (* classical stack frame *)
+							bp := n; 
+						END;
+					END;
+					
+					ASSERT((bp = stackBottom) OR (bp=0) ,12345);
+				END; 
+			END;
+			
+			IF (CurrentProcess() # SELF) & (mode # Suspended) THEN
+				res := Kernel32.ResumeThread(handle);
+				ASSERT(res # -1);
+			END;
+
+		END FindRoots;
+		
+	END Process;
+
+TYPE
+	ExceptionHandler* = PROCEDURE(	VAR context: Kernel32.Context;
+										VAR excpRec: Kernel32.ExceptionRecord;
+										VAR handled: BOOLEAN);
+
+
+	GCStatusExt = OBJECT(Heaps.GCStatus)
+	
+	(* 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: Heaps.ProcessLink; cur, r: Process; res: Kernel32.BOOL; num: LONGINT; time: LONGINT;
+		BEGIN (* serialize writers *)
+			IF value THEN
+				(* Low, Medium or High priority process calls this *)
+				time := Kernel32.GetTickCount();
+				Machine.Acquire(Machine.Objects);
+				Machine.Acquire(Machine.Heaps); (* to protect agains concurrent LazySweep *)
+				r := CurrentProcess();
+				num := 0;
+				p := ready.head;
+				WHILE p # NIL DO
+					cur := p(Process);
+					IF ((cur.mode = Ready) OR (cur.mode = Running)) & (cur.priority <= High) & (cur # r) THEN
+						IF isWow64 THEN 
+							res := Kernel32.Wow64SuspendThread(cur.handle);
+						ELSE
+							res := Kernel32.SuspendThread(cur.handle);
+						END;
+						ASSERT(res >= 0);
+						cur.mode := Suspended
+					ELSE INC(num);
+					END;
+					p := p.next
+				END;
+
+				Heaps.CollectGarbage(Modules.root);
+				p := ready.head;
+				WHILE (p # NIL) DO
+					cur := p(Process);
+					(* only suspended and awaiting processes of ready queue are resumed *)
+					IF cur.mode = Suspended THEN
+						res := Kernel32.ResumeThread(cur.handle);
+						ASSERT(res >= 0);
+						cur.mode := Running
+					END;
+					p := p.next
+				END;
+
+
+				Machine.Release(Machine.Heaps);
+				Machine.Release(Machine.Objects);
+				time := Kernel32.GetTickCount()-time;
+				IF Heaps.trace THEN Trace.String("GC Called -- duration "); Trace.Int(time,0); Trace.String(" ms."); Trace.Ln END;
+				IF finalizerCaller # NIL THEN finalizerCaller.Activate() END;
+			END;
+		END SetgcOngoing;
+
+	END GCStatusExt;
+
+	FinalizedCollection* = OBJECT
+		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;
+		event: Kernel32.HANDLE;
+		process: Process;
+
+		PROCEDURE &Init;
+		BEGIN
+			event := Kernel32.CreateEvent( NIL, Kernel32.False (* automatic *), Kernel32.False, NIL );
+			ASSERT(event # 0);
+		END Init;
+
+		PROCEDURE Wait;
+		VAR res: Kernel32.BOOL; mode: LONGINT;
+		BEGIN
+			mode := process.mode;
+			process.mode := AwaitingEvent;
+			res := Kernel32.WaitForSingleObject(event, Kernel32.Infinite);
+			ASSERT(res = Kernel32.WaitObject0);
+			process.mode := mode;
+		END Wait;
+
+		PROCEDURE Activate;
+		VAR res: Kernel32.BOOL;
+		BEGIN
+			res := Kernel32.SetEvent(event);
+		END Activate;
+
+	BEGIN {ACTIVE, SAFE, PRIORITY(High)}
+		process := CurrentProcess();
+		LOOP
+			Wait;
+			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;
+
+VAR
+	awc-, awl-: LONGINT;
+	oberonLoop*: ANY;   (* Oberon Loop Process temporary workaround for Threads.oberonLoop *)
+	break: ARRAY 16 OF CHAR;
+	terminateProc: PROCEDURE;
+	ready: ProcessQueue;	(* contains running processes in this implementation *)
+
+	numberOfProcessors: LONGINT; (* cached value of Machine.NumberOfProcessors() *)
+	finalizerCaller: FinalizerCaller; (* active object for finalizer process, regarded as aprt of GC *)
+
+	event: Timer; (* list of events *)
+	clock: Clock;
+	tlsIndex: LONGINT;
+	nProcs: LONGINT;
+
+	excplock: Kernel32.CriticalSection;  exceptionhandler: ExceptionHandler;
+	
+	isWow64: BOOLEAN; (* TRUE for WOW64 environment *)
+
+(* Set the current process' priority. *)
+PROCEDURE SetPriority*( priority: LONGINT );
+VAR r: Process; prio: LONGINT; res: Kernel32.BOOL;
+BEGIN
+	ASSERT((priority >= Low) & (priority <= Realtime));   (* priority in bounds *)
+	r := CurrentProcess();  r.priority := priority;
+	CASE priority OF
+	MinPriority:
+			prio := Kernel32.ThreadPriorityIdle
+	| Low:
+			prio := Kernel32.ThreadPriorityBelowNormal
+	| High:
+			prio := Kernel32.ThreadPriorityAboveNormal
+	| GCPriority, Realtime:
+			prio := Kernel32.ThreadPriorityTimeCritical
+	ELSE  (* Normal *)
+		prio := Kernel32.ThreadPriorityNormal
+	END;
+	res := Kernel32.SetThreadPriority( r.handle, prio );
+	ASSERT(r.handle # 0);
+	ASSERT(res # 0)
+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; res: BOOLEAN;
+BEGIN
+	SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, hdr);
+	ASSERT(hdr IS Heaps.ProtRecBlock);
+	Machine.Acquire(Machine.Objects);
+	res := (hdr.lockedBy = ActiveObject());
+	Machine.Release(Machine.Objects);
+	RETURN res
+END LockedByCurrent;
+
+PROCEDURE Yield*;
+BEGIN
+	Kernel32.Sleep(0)
+END Yield;
+
+(** Return current process. (DEPRECATED, use ActiveObject) *)
+PROCEDURE CurrentProcess*( ): Process;
+BEGIN{UNCHECKED} (* makes sure that Enter and Leave are not emitted *)
+	RETURN SYSTEM.VAL(Process, Kernel32.TlsGetValue(tlsIndex));
+END CurrentProcess;
+
+(* Return stack bottom of process. For compatibility WinAos/UnixAos/NativeAos  *)
+PROCEDURE GetStackBottom*(p: Process): ADDRESS;
+BEGIN
+	RETURN p.stackBottom
+END GetStackBottom;
+
+(** Return the active object currently executing. *)
+PROCEDURE ActiveObject* (): ANY;
+VAR r: Process;
+BEGIN
+	r := SYSTEM.VAL(Process, Kernel32.TlsGetValue(tlsIndex));
+	RETURN r.obj
+END ActiveObject;
+
+(** Return the ID of the active currently executing process. *)
+PROCEDURE GetProcessID* (): LONGINT;
+VAR r: Process;
+BEGIN
+	r := SYSTEM.VAL (Process, Kernel32.TlsGetValue( tlsIndex ));
+	RETURN r.id
+END GetProcessID;
+
+(* 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 & t.prev = NIL} *)
+	IF StrongChecks THEN
+		ASSERT((t.next = NIL) & (t.prev = NIL))
+	END;
+	t.next := NIL; t.prev := NIL; (* ug *)
+	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;
+
+(* starting address of user stack for current thread, called stack top in TIB.H *)
+PROCEDURE -StackBottom*( ): LONGINT;
+CODE {SYSTEM.i386}
+	DB	064H
+	DB	08BH
+	DB	005H
+	DB	004H
+	DB	000H
+	DB	000H
+	DB	000H
+END StackBottom;
+
+PROCEDURE {WINAPI} ExcpFrmHandler( VAR  excpRec: Kernel32.ExceptionRecord; excpFrame: Kernel32.ExcpFrmPtr;
+ 										VAR context: Kernel32.Context;  dispatch: LONGINT ): LONGINT;
+VAR m: Modules.Module;  eip, ebp, stack: ADDRESS;  pc, handler, fp, sp: ADDRESS;  handled: BOOLEAN;  t: Process;
+BEGIN
+	handled := FALSE;
+
+	Kernel32.EnterCriticalSection( excplock );
+
+	(*
+	fof: commenting this resolved a problem with multiple traps that a are catched with FINALLY statements in Windows Vista
+	in Windows XP not necessary if Kernel32.SetThreadContext is not used (better to return gracefully from this handler)
+	SetCurrent(excpFrame);
+	*)
+
+	t := CurrentProcess();
+
+	IF exceptionhandler = NIL THEN
+		Trace.StringLn ( "Objects: No exception handler installed" );
+		IF HandleExcp THEN
+
+			Trace.String( "EXCEPTION " );  Trace.Hex( excpRec.ExceptionCode, 1 );
+			Trace.String( " at " );  Trace.Hex( excpRec.ExceptionAddress, 1 );
+			Trace.Ln();  Trace.String( "EAX " );  Trace.Hex( context.EAX, 1 );
+			Trace.String( "  EBX " );  Trace.Hex( context.EBX, 1 );  Trace.Ln();
+			Trace.String( "ECX " );  Trace.Hex( context.ECX, 1 );  Trace.String( "  EDX " );
+			Trace.Hex( context.EDX, 1 );  Trace.Ln();  Trace.String( "EDI " );
+			Trace.Hex( context.EDI, 1 );  Trace.String( "  ESI " );
+			Trace.Hex( context.ESI, 1 );  Trace.Ln();  Trace.String( "EBP " );
+			Trace.Hex( context.BP, 1 );  Trace.String( "  ESP " );
+			Trace.Hex( context.SP, 1 );  Trace.Ln();  Trace.String( "EIP " );
+			Trace.Hex( context.PC, 1 );  Trace.Ln();  Trace.Ln();
+			eip := excpRec.ExceptionAddress;  ebp := context.BP;
+			IF eip = 0 THEN SYSTEM.GET( context.SP, eip ) END;
+			stack := StackBottom();
+			LOOP
+				Trace.String( "at ebp= " );  Trace.Hex( ebp, 1 );  Trace.String( "H : " );
+				m := Modules.ThisModuleByAdr( eip );
+				IF m # NIL THEN
+					Trace.String( m.name );  Trace.String( " " );
+					Trace.Hex( eip - SYSTEM.VAL( LONGINT, ADDRESSOF( m.code[0] ) ), 1 );
+				ELSE Trace.String( "EIP " );  Trace.Hex( eip, 1 )
+				END;
+				Trace.Ln();
+				IF (ebp # 0) & (ebp < stack) THEN  (* if ebp is 0 in first frame *)
+					SYSTEM.GET( ebp + 4, eip );   (* return addr from stack *)
+					SYSTEM.GET( ebp, ebp );   (* follow dynamic link *)
+				ELSE EXIT
+				END
+			END;
+			Trace.Ln();
+
+			handled := FALSE;  fp := context.BP;  sp := context.SP;
+			pc := context.PC;  handler := Modules.GetExceptionHandler( pc );
+			IF handler # -1 THEN  (* Handler in the current PAF *)
+				context.PC := handler;  handled := TRUE;
+				(*SetTrapVariable(pc, fp);  SetLastExceptionState(exc)*)
+			ELSE
+				WHILE (fp # 0) & (handler = -1) DO
+					SYSTEM.GET( fp + 4, pc );
+					pc := pc - 1;   (*  CALL instruction, machine dependant!!! *)
+					handler := Modules.GetExceptionHandler( pc );
+					sp := fp;   (* Save the old framepointer into the stack pointer *)
+					SYSTEM.GET( fp, fp ) (* Unwind PAF *)
+				END;
+				IF handler = -1 THEN handled := FALSE;
+				ELSE
+					context.PC := handler;  context.BP := fp;  context.SP := sp;
+					(* SetTrapVariable(pc, fp); SetLastExceptionState(exc);*)
+					handled := TRUE
+				END
+			END;
+		ELSE Trace.StringLn ( "Warning: FINALLY statement cannot be treated !" );
+		END
+	ELSE exceptionhandler( context, excpRec, handled );
+	END;
+	IF ~handled THEN
+		context.PC := t.restartPC;  context.SP := t.restartSP;
+		context.BP := t.stackBottom;
+	ELSIF TraceVerbose THEN Trace.StringLn ( "trying to jump to FINALLY pc..." );
+	END;
+	Kernel32.LeaveCriticalSection( excplock );
+
+	IF TraceVerbose THEN
+		Machine.Acquire (Machine.TraceOutput);
+		Trace.String( "recover process; eip=" );  Trace.Int( context.PC, 10 );
+		Trace.String( "; sp= " );  Trace.Int( context.SP, 10 );  Trace.String( "; ebp= " );
+		Trace.Int( context.BP, 10 ); Trace.Ln;
+		Machine.Release (Machine.TraceOutput);
+	END;
+
+	RETURN Kernel32.ExceptionContinueSearch; (* sets thread context and continues where specified in context *)
+END ExcpFrmHandler;
+
+(* get the currently installed execption frame *)
+(*	PROCEDURE -GetCur 64H, 8BH, 0DH, 0, 0, 0, 0;   (* MOV ECX, FS:[0] *) *)
+(* Better *)
+PROCEDURE -GetCur;
+CODE {SYSTEM.i386}
+	DB	064H, 08BH, 00DH, 000H, 000H, 000H, 000H
+END GetCur;
+
+PROCEDURE GetCurrent( ): Kernel32.ExcpFrmPtr;
+VAR cur: Kernel32.ExcpFrmPtr;
+BEGIN
+	GetCur;
+	cur := SYSTEM.VAL(Kernel32.ExcpFrmPtr,Machine.GetECX());
+	(* RETURN ECX *)
+	RETURN cur
+END GetCurrent;
+
+(* install a new exception frame *)
+(*	PROCEDURE -SetCur 64H, 0A3H, 0, 0, 0, 0;   (* MOV FS:[0], EAX *)*)
+(* Better *)
+PROCEDURE -SetCur;
+CODE {SYSTEM.i386}
+	DB	064H, 0A3H, 000H, 000H, 000H, 000H
+END SetCur;
+
+PROCEDURE SetCurrent( cur: Kernel32.ExcpFrmPtr );
+BEGIN
+	Machine.SetEAX(SYSTEM.VAL(LONGINT,cur));
+	 (* EAX := cur *)
+	SetCur
+END SetCurrent;
+
+PROCEDURE RemoveExcpFrm( VAR excpfrm: Kernel32.ExcpFrm );
+VAR this: Kernel32.ExcpFrmPtr;
+BEGIN
+	this := GetCurrent();
+	(* ASSERT ( this = ADDRESSOF( excpfrm ) );  *)
+	IF this # ADDRESSOF( excpfrm ) THEN Trace.StringLn ( "RemoveExcpFrm: Problem with excpfrm pointer" );
+	ELSE SetCurrent( excpfrm.link )
+	END;
+END RemoveExcpFrm;
+
+PROCEDURE InstallExcpFrm( VAR excpfrm: Kernel32.ExcpFrm );
+BEGIN
+	excpfrm.link := GetCurrent();  excpfrm.handler := ExcpFrmHandler;
+	SetCurrent( ADDRESSOF( excpfrm ) )
+END InstallExcpFrm;
+
+PROCEDURE InQueue( queue: ProcessQueue;  t: Process ): BOOLEAN;
+VAR p: Heaps.ProcessLink;
+BEGIN
+	p := queue.head;
+	WHILE (p # NIL ) & (p # t) DO p := p.next;  END;
+	RETURN (p = t);
+END InQueue;
+
+(* Remove a process from a queue that contains it. Caller must hold lock for specific queue. *)
+(* Not intended for frequent use. *)
+(* does not check if queue contained t ! *)
+PROCEDURE Remove( VAR queue: ProcessQueue;  t: Process );
+BEGIN
+	IF StrongChecks THEN
+		ASSERT(InQueue(queue, t));
+		ASSERT(t # NIL);
+	END;
+	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;
+
+PROCEDURE WriteType(obj: ANY);
+VAR type: LONGINT;
+BEGIN
+	IF obj = NIL THEN Trace.String(" > NIL");
+	ELSE
+		Trace.String(" > ");  SYSTEM.GET(SYSTEM.VAL(LONGINT, obj) + Heaps.TypeDescOffset, type);
+		Heaps.WriteType(type);
+	END;
+END WriteType;
+
+PROCEDURE terminate( t: Process );
+VAR hdr {UNTRACED}: Heaps.ProtRecBlock; res: Kernel32.BOOL; shutdown: BOOLEAN;
+BEGIN
+	IF t = NIL THEN RETURN END;
+	(* see Objects.TerminateThis *)
+	Machine.Acquire( Machine.Objects );
+
+	IF TraceVerbose OR TraceOpenClose THEN
+		Machine.Acquire (Machine.TraceOutput);
+		Trace.String( "Terminating process " );  Trace.Int( t.id, 1 );  WriteType( t.obj ); Trace.Ln;
+		Machine.Release (Machine.TraceOutput);
+	END;
+
+	IF (t.mode = Ready) OR (t.mode = Running) THEN Remove( ready, t );
+	ELSIF t.mode = AwaitingLock THEN
+		SYSTEM.GET(SYSTEM.VAL(ADDRESS, t.waitingOn) + Heaps.HeapBlockOffset, hdr);
+		ASSERT(hdr IS Heaps.ProtRecBlock);
+		Remove( hdr.awaitingLock, t );  Machine.Release( Machine.Objects );
+		HALT( 97 )
+	ELSIF t.mode = AwaitingCond THEN
+		SYSTEM.GET(SYSTEM.VAL(ADDRESS, t.waitingOn) + Heaps.HeapBlockOffset, hdr);
+		ASSERT(hdr IS Heaps.ProtRecBlock);
+		Remove( hdr.awaitingCond, t );  Machine.Release( Machine.Objects );
+		HALT( 98 )
+	ELSE Machine.Release( Machine.Objects );
+		HALT( 99 )
+	END;
+	t.mode := Terminated;   (* a process can also be "terminated" if the queue containing it is garbage collected *)
+	t.stackBottom := 0;  t.state.SP := 0;
+	t.restartPC := 0;
+	IF t.event # 0 THEN res := Kernel32.CloseHandle( t.event );  t.event := 0 END;
+	DEC( nProcs );  shutdown := (nProcs = 0);
+
+	Machine.Release( Machine.Objects );
+	IF shutdown THEN
+		Trace.StringLn ( " Objects: shutdown" ); Modules.Shutdown( -1 );
+		Kernel32.ExitProcess( 0 )
+	END
+END terminate;
+
+PROCEDURE {WINAPI} Wrapper( lpParameter: ANY ): LONGINT;
+VAR t: Process;  obj: ProtectedObject; res: Kernel32.BOOL; bp,sp: ADDRESS;
+	excpfrm: Kernel32.ExcpFrm;
+BEGIN
+	(* it may happen that the garbage collector runs right here and ignores this procedure.
+	    This is not a problem since lpParameter (being a reference to a process) is protected by the process lists *)
+
+	Machine.Acquire(Machine.Objects);
+
+	res := Kernel32.TlsSetValue(tlsIndex, SYSTEM.VAL(LONGINT, lpParameter));
+	t := lpParameter(Process);  obj := t.obj;
+	ASSERT(res # 0);
+	InstallExcpFrm(excpfrm);
+	SetPriority(t.priority);
+
+	bp := Machine.CurrentBP();
+	sp := Machine.CurrentSP();
+	t.restartSP := sp;
+	t.stackBottom := bp;
+	IF t.restartPC = SYSTEM.VAL(ADDRESS, terminateProc) THEN DEC(t.restartSP, 4)
+	ELSE DEC(t.restartSP, 8)
+	END;
+	IF TraceVerbose THEN
+		Machine.Acquire(Machine.TraceOutput);
+		Trace.String("New process; restartPC= "); Trace.Int(t.restartPC, 15);
+		Trace.String("; restartSP= "); Trace.Int(t.restartSP, 15); Trace.String("; stackBottom= ");
+		Trace.Int(t.stackBottom, 15); Trace.Ln;
+		Machine.Release(Machine.TraceOutput);
+	END;
+	t.mode := Running;
+	(* now gc is enabled for this process stack *)
+	Machine.Release(Machine.Objects);
+	(* loop all processes that the GC did not see during process suspending because they were in the very moment being generated (just before the locked section) *)
+
+	(*! should not be necessary any more as GC runs immediately and without scheduling decisions
+	WHILE (gcActivity # NIL) & (gcActivity.process # NIL) & (gcActivity.process.mode = Running) DO END;
+	*)
+	t.body(obj);
+	terminate(t);
+	RemoveExcpFrm(excpfrm);
+	RETURN 0
+END Wrapper;
+
+PROCEDURE FinalizeProcess(t: ANY);
+VAR p: Process;  res: Kernel32.BOOL;
+BEGIN
+	p := t(Process);
+
+	IF TraceVerbose THEN
+		Machine.Acquire (Machine.TraceOutput);
+		Trace.String("Finalizing Process"); Trace.Int(p.id, 1);
+		WriteType(p.obj); Trace.Ln;
+		Machine.Release (Machine.TraceOutput);
+	END;
+	IF p.mode # Terminated THEN
+		IF p.mode = AwaitingLock THEN DEC(awl);
+		ELSIF p.mode = AwaitingCond THEN DEC(awc);
+		END;
+		(* no reference to the object any more *)
+		Trace.String ("Closing unreferenced process"); (*Trace.Int(p.mode,20); Trace.Int( p.id, 20 ); *) Trace.Ln; (* Trace.Ln *)
+		(* this usually happens, when an objects process waits on its own objtec and no reference exists any more. Then the object is discarded and
+		consequently the process is unreferenced (except in the object). This cannot happen when there are still other references on the object.
+		example:
+			TYPE
+			Object= OBJECT VAR active: BOOLEAN; BEGIN{ACTIVE} active := FALSE; AWAIT(active) END Object;
+			VAR o: Object;
+			BEGIN NEW(o);
+			END;
+		 *)
+	END;
+	p.mode := Terminated; (* fof for GC problem *)
+
+	IF p.handle # 0 THEN
+		res := Kernel32.CloseHandle(p.handle); p.handle := 0
+	END
+END FinalizeProcess;
+
+PROCEDURE TerminateProc;
+BEGIN
+	terminate(CurrentProcess());
+	Kernel32.ExitThread(0);
+	Kernel32.Sleep(999999);   (* wait until dependent threads terminated *)
+END TerminateProc;
+
+(* Allocate a new process associated with "obj". Must be outside lock region, because of potential GC. *)
+PROCEDURE NewProcess(body: Body; priority: LONGINT;  flags: SET; obj: ProtectedObject; VAR new: Process);
+VAR t,r: Process;  fn: Heaps.FinalizerNode;
+BEGIN
+	NEW(t);
+	t.handle := 0;
+	IF priority = 0 THEN  (* no priority specified *)
+		r := CurrentProcess();
+		t.priority := r.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;
+
+	NEW(fn);   (* implicit call Heaps.NewRec -> might invoke GC *)
+
+	Machine.Acquire(Machine.Objects);
+	t.next := NIL; t.prev := NIL; t.rootedNext := NIL;
+	t.waitingOn := NIL; t.flags := flags; t.obj := obj; t.mode := Unknown;
+	t.body := body; t.event := 0; fn.finalizer := FinalizeProcess;
+	Heaps.AddFinalizer(t, fn);
+	IF Restart IN flags THEN  (* restart object body *)
+		t.restartPC := SYSTEM.VAL(ADDRESS, body);
+	ELSE  (* terminate process *)
+		t.restartPC := SYSTEM.VAL(ADDRESS, terminateProc);
+	END;
+
+	t.handle := Kernel32.CreateThread(0, defaultStackSize, Wrapper, t, {}, t.id);
+
+	IF TraceVerbose OR TraceOpenClose THEN
+		Machine.Acquire(Machine.TraceOutput);
+		Trace.String("NewProcess: " ); Trace.Int(t.id, 1); WriteType(obj); Trace.Ln;
+		Machine.Release(Machine.TraceOutput);
+	END;
+
+	ASSERT(t.handle # 0);
+	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; heapBlock {UNTRACED}: Heaps.HeapBlock;
+BEGIN
+	ASSERT(priority >= 0, 1000); ASSERT(priority <=Realtime, 1001);
+	SYSTEM.GET(SYSTEM.VAL(ADDRESS, obj) + Heaps.HeapBlockOffset, heapBlock);
+	ASSERT(heapBlock IS Heaps.ProtRecBlock); (* protected object *)
+	IF Restart IN flags THEN INCL(flags, Resistant) END;   (* SAFE => Restart & Resistant *)
+	NewProcess(body, priority, flags, obj, t);  INC(nProcs);  (* acquires Machine.Objects lock *)
+	t.mode := Ready; Put(ready, t);
+	Machine.Release(Machine.Objects)
+END CreateProcess;
+
+
+(* The procedure Lock, Unlock and Await do not use header locks since it turned out that the header locks sometimes were finalized
+     too early. *)
+PROCEDURE Lock*(obj: ProtectedObject; exclusive: BOOLEAN );
+VAR hdr {UNTRACED}: Heaps.ProtRecBlock; r: Process; res: LONGINT;
+BEGIN  (* {called from user level} *)
+	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;
+	r := CurrentProcess();
+	IF StrongChecks THEN
+		ASSERT(hdr # NIL, 1001);
+		ASSERT(r # NIL, 1002);
+	END;
+	Machine.Acquire(Machine.Objects);
+	IF hdr.count = 0 THEN  (* not locked *)
+		hdr.count := -1; hdr.lockedBy := r;
+		Machine.Release(Machine.Objects)
+	ELSE  (* already locked *)
+		IF hdr.lockedBy = r THEN
+			Machine.Release(Machine.Objects);
+			HALT(2203) (* nested locks not allowed *)
+		END;
+		ASSERT(r.waitingOn = NIL); (* sanity check *)
+		Remove(ready, r);
+		IF r.event = 0 THEN
+			r.event := Kernel32.CreateEvent( NIL, Kernel32.False (* auto *), Kernel32.False, NIL );   (* auto reset event with initial state = reset *)
+			ASSERT ( r.event # 0, 1239 );
+		END;
+		r.waitingOn := obj;  r.mode := AwaitingLock;
+		Put(hdr.awaitingLock, r); INC(awl);
+		Machine.Release(Machine.Objects);
+		res := Kernel32.WaitForSingleObject(r.event, Kernel32.Infinite); (* block execution *)
+		ASSERT(res = Kernel32.WaitObject0);
+		IF StrongChecks THEN
+			ASSERT(hdr.lockedBy = r); (* at this moment only this process can own the lock and only this process can release it*)
+		END;
+	END
+END Lock;
+
+(* 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
+	Get( q, first );
+	IF first.condition( first.condFP ) THEN RETURN first END;
+	Put( q, first );
+	WHILE q.head # first DO
+		Get( q, cand );
+		IF cand.condition( cand.condFP ) THEN RETURN cand END;
+		Put( q, cand )
+	END;
+	RETURN NIL
+END FindCondition;
+
+(* The procedure Lock, Unlock and Await do not use header locks since it turned out that the header locks sometimes were finalized
+     too early. *)
+PROCEDURE Unlock*( obj: ProtectedObject;  dummy: BOOLEAN );
+VAR hdr {UNTRACED}: Heaps.ProtRecBlock; t, c: Process; res: LONGINT;
+BEGIN
+	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 *)
+	Machine.Acquire(Machine.Objects);
+
+	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  (* no true condition found, check the lock queue *)
+		Get(hdr.awaitingLock, t);
+		IF t # NIL THEN
+			hdr.lockedBy := t;
+			t.waitingOn := NIL;
+		ELSE
+			hdr.lockedBy := NIL; hdr.count := 0
+		END
+	ELSE  (* true condition found, transfer the lock *)
+		c.waitingOn := NIL; hdr.lockedBy := c;
+		t := NIL
+	END;
+	IF c # NIL THEN
+		Put(ready, c); c.mode := Running; DEC(awc);
+		res := Kernel32.SetEvent(c.event);
+		ASSERT (res # 0, 1001);
+	ELSIF t # NIL THEN
+		Put(ready, t); t.mode := Running; DEC(awl);
+		res := Kernel32.SetEvent(t.event);
+		ASSERT (res # 0, 1002);
+	END;
+	Machine.Release( Machine.Objects )
+END Unlock;
+
+(* The procedure Lock, Unlock and Await do not use header locks since it turned out that the header locks sometimes were finalized
+     too early. *)
+PROCEDURE Await*( cond: Condition;  slink: LONGINT;  obj: ProtectedObject;  flags: SET );
+VAR hdr {UNTRACED}: Heaps.ProtRecBlock; r, c, t: Process;  res: LONGINT;
+BEGIN
+	IF 1 IN flags THEN  (* compiler did not generate IF *)
+		IF cond(slink) THEN
+			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;
+	r := CurrentProcess();
+	Machine.Acquire(Machine.Objects);
+	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;
+				t.waitingOn := NIL;
+				hdr.lockedBy := t;
+			END;
+		ELSE
+			c.waitingOn := NIL; hdr.lockedBy := 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;
+	r.condition := cond; r.condFP := slink;
+	r.waitingOn := obj; r.mode := AwaitingCond;
+	Remove(ready, r);
+	IF r.event = 0 THEN
+		r.event := Kernel32.CreateEvent( NIL, Kernel32.False (* auto *), Kernel32.False, NIL );   (* auto-reset event with initial state = reset *)
+		ASSERT ( r.event # 0, 1239 );
+	END;
+	IF c # NIL THEN
+		DEC(awc); Put(ready, c); c.mode := Running;
+		res := Kernel32.SetEvent(c.event); (* restart execution *)
+		ASSERT(res # 0, 1002);
+	END;
+	IF t # NIL THEN
+		DEC(awl); Put(ready, t);  t.mode := Running;
+		res := Kernel32.SetEvent( t.event ); (* restart execution *)
+		ASSERT(res # 0, 1003);
+	END;
+	Put(hdr.awaitingCond, r); INC(awc);
+	Machine.Release(Machine.Objects);
+	res := Kernel32.WaitForSingleObject(r.event, Kernel32.Infinite); (* block execution *)
+	ASSERT(res = Kernel32.WaitObject0);
+	IF StrongChecks THEN
+		ASSERT(cond(slink));
+		ASSERT(hdr.lockedBy = r) (* lock held again *)
+	END
+END Await;
+
+	PROCEDURE Break*( t: Process );
+	CONST MaxTry = 50;
+	VAR mod: Modules.Module;  try: LONGINT;  retBOOL: Kernel32.BOOL;   (* Dan 09.11.05 *)
+
+		PROCEDURE SafeForBreak( mod: Modules.Module ): BOOLEAN;
+		BEGIN
+			Trace.String( "Safe for break?: " );
+			IF mod # NIL THEN
+				Trace.StringLn ( mod.name );
+				IF (mod.name = "Trace") OR (mod.name = "Machine") OR
+					(mod.name = "Heaps") OR (mod.name = "Modules") OR
+					(mod.name = "Objects") OR (mod.name = "Kernel") THEN
+					Trace.StringLn ( " - no" );  RETURN FALSE
+				ELSE Trace.StringLn ( " - yes" );  RETURN TRUE
+				END
+			ELSE Trace.StringLn ( "unknown module" );  RETURN FALSE
+			END
+		END SafeForBreak;
+
+	BEGIN
+		IF CurrentProcess() # t THEN
+			Machine.Acquire( Machine.Objects );
+			LOOP
+				IF isWow64 THEN 
+					retBOOL := Kernel32.Wow64SuspendThread(t.handle);
+				ELSE
+					retBOOL := Kernel32.SuspendThread( t.handle );
+				END;
+				t.state.ContextFlags := Kernel32.ContextControl;
+				retBOOL := Kernel32.GetThreadContext( t.handle, t.state );
+				mod := Modules.ThisModuleByAdr( t.state.PC );  Trace.String( "Objects Break at adr: " );
+				Trace.Int( t.state.PC, 5 );  Trace.Ln;
+				IF mod # NIL THEN
+					Trace.String( "In module: " );  Trace.StringLn ( mod.name );
+				END;
+				IF ~SafeForBreak( mod ) (* we do not break Kernel modules *) THEN
+					retBOOL := Kernel32.ResumeThread( t.handle );  INC( try );
+					IF try > MaxTry THEN
+						Trace.StringLn ( "Threads.Break: failed " );
+						Machine.Release( Machine.Objects );
+						RETURN
+					END
+				ELSE EXIT
+				END;
+			END;
+			(* push cont.Eip *) break[0] := 68X;
+			SYSTEM.MOVE( ADDRESSOF( t.state.PC ), ADDRESSOF( break[1] ), 4 );
+			(* push ebp *) break[5] := 055X;
+			(* mov ebp, esp *) break[6] := 08BX;  break[7] := 0ECX;
+			(* push 13 *) break[8] := 06AX;  break[9] := 0DX;
+			(* int 3 *) break[10] := 0CCX;
+			(* mov esp, ebp *) break[11] := 08BX;  break[12] := 0E5X;
+			(* pop ebp *) break[13] := 05DX;
+			(* ret *) break[14] := 0C3X;  t.state.PC := ADDRESSOF( break[0] );
+			retBOOL := Kernel32.SetThreadContext( t.handle, t.state );
+			retBOOL := Kernel32.ResumeThread( t.handle );   (*  INC( Kernel.GClevel ); *)
+
+			Machine.Release( Machine.Objects );
+		ELSE HALT( 99 )
+		END;
+
+	END Break;
+
+(* Attempt to terminate a specific process (mostly ignoring its locks). DEPRECATED *)
+PROCEDURE TerminateThis*( t: Process;  halt: BOOLEAN );
+BEGIN
+	terminate(t);
+END TerminateThis;
+
+PROCEDURE Terminate*;
+BEGIN
+	TerminateProc();
+END Terminate;
+
+PROCEDURE Init;   (* can not use NEW *)
+VAR lock: PROCEDURE(obj: ProtectedObject; exclusive: BOOLEAN);
+	unlock: PROCEDURE(obj: ProtectedObject; dummy: BOOLEAN);
+	await: PROCEDURE(cond: Condition; slink: LONGINT; obj: ProtectedObject; flags: SET);
+	create: PROCEDURE(body: Body; priority: LONGINT; flags: SET; obj: ProtectedObject);
+VAR t: Process;  fn: Heaps.FinalizerNode;  proc: Kernel32.HANDLE;
+	res: Kernel32.BOOL;
+BEGIN
+	Kernel32.InitializeCriticalSection(excplock);
+	numberOfProcessors := Machine.NumberOfProcessors();
+	lock := Lock; unlock := Unlock; await := Await; create := CreateProcess;
+
+	NEW(t);  NEW(fn);
+
+	Machine.Acquire(Machine.Objects);
+	nProcs := 1;
+	t.next := NIL;  t.prev := NIL;
+	t.waitingOn := NIL; t.flags := {}; t.obj := NIL;
+	t.mode := Unknown; t.body := NIL;
+	t.priority := Normal;
+	fn.finalizer := FinalizeProcess;
+
+	Heaps.AddFinalizer(t, fn);
+	t.handle := Kernel32.GetCurrentThread();
+	t.id := Kernel32.GetCurrentThreadId();
+	proc := Kernel32.GetCurrentProcess();
+	res := Kernel32.DuplicateHandle(proc, t.handle, proc, t.handle, {}, 0, {Kernel32.DuplicateSameAccess});
+	ASSERT(res # 0);
+	res := Kernel32.TlsSetValue(tlsIndex, SYSTEM.VAL(LONGINT, t));
+	ASSERT(res # 0);
+	t.stackBottom := StackBottom(); t.mode := Running;
+	Put( ready, t );
+	ASSERT(t.handle # 0);
+	Machine.Release(Machine.Objects);
+	InitEventHandling; (* implicit call of NewProcess! *)
+	InitGCHandling; (* do. *)
+	Heaps.gcStatus := GCStatusFactory()
+END Init;
+
+(** Set (or reset) an event handler object's timeout value. *)
+PROCEDURE SetTimeout*(t: Timer; h: EventHandler;  ms: LONGINT );
+VAR e: Timer;  trigger: LONGINT;
+BEGIN
+	ASSERT(Machine.Second= 1000); (* assume milliseconds for now *)
+	ASSERT((t # NIL) & (h # NIL));
+	ASSERT(ms >= 0);
+	Machine.Acquire(Machine.Objects);
+	trigger := Kernel32.GetTickCount() + ms;   (* ignore overflow *)
+	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);
+	clock.Wakeup()
+END SetTimeout;
+
+(** Set (or reset) an event handler object's timeout value. Here ms is absolute *)
+PROCEDURE SetTimeoutAt*(t: Timer; h: EventHandler; ms: LONGINT);
+VAR e: Timer; trigger: LONGINT;
+BEGIN
+	ASSERT(Machine.Second= 1000);	(* assume milliseconds for now *)
+	ASSERT((t # NIL) & (h # NIL));
+	Machine.Acquire(Machine.Objects);
+	trigger := ms; (* ignore overflow *)
+	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);
+	clock.Wakeup()
+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;  
+		IF t.prev#NIL THEN t.prev.next := t.next; END;
+		t.next := NIL;
+		t.prev := NIL
+	END;
+	Machine.Release(Machine.Objects);
+END CancelTimeout;
+
+PROCEDURE InitEventHandling;
+BEGIN
+	NEW(event); event.next := event; event.prev := event;  (* event: head of timer event queue, only a sentinel *)
+	NEW(clock)
+END InitEventHandling;
+
+PROCEDURE InitGCHandling;
+BEGIN
+	NEW(finalizerCaller);
+END InitGCHandling;
+
+PROCEDURE GCStatusFactory(): Heaps.GCStatus;
+VAR gcStatusExt : GCStatusExt;
+BEGIN
+	ASSERT(Heaps.gcStatus = NIL);
+	NEW(gcStatusExt);
+	RETURN gcStatusExt
+END GCStatusFactory;
+
+PROCEDURE InstallExceptionHandler*( e: ExceptionHandler );
+BEGIN
+	exceptionhandler := e;
+END InstallExceptionHandler;
+
+PROCEDURE UpdateProcessState*( p: Process );
+VAR res: Kernel32.BOOL;
+BEGIN
+	res := Kernel32.GetThreadContext( p.handle, p.state );
+	ASSERT (p.handle # 0);
+END UpdateProcessState;
+
+(*ALEX 2005.12.12 added for WMPerfMon needs*)
+
+PROCEDURE NumReady*( ): LONGINT;
+VAR n: LONGINT; p: Heaps.ProcessLink;
+BEGIN
+	n := 0;
+	Machine.Acquire( Machine.Objects );
+	p := ready.head;
+	WHILE p # NIL DO INC( n );  p := p.next END;
+	Machine.Release( Machine.Objects );
+	RETURN n
+END NumReady;
+
+(** Return number of CPU cycles consumed by the specified process. 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 res : Kernel32.BOOL; temp : HUGEINT; 
+BEGIN
+	ASSERT(process # NIL);
+	IF (Kernel32.QueryThreadCycleTime # NIL) THEN
+		res := Kernel32.QueryThreadCycleTime(process.handle, cpuCycles[0]);
+	ELSE
+		cpuCycles[0] := Machine.GetTimer(); res := Kernel32.True;
+	END;
+
+	IF ~all & (res = Kernel32.True) THEN
+		temp := process.lastThreadTimes;
+		process.lastThreadTimes := cpuCycles[0];
+		cpuCycles[0] := cpuCycles[0] - temp;
+	END;
+END GetCpuCycles;
+
+PROCEDURE CurrentProcessTime*(): HUGEINT;
+VAR res: LONGINT; result: HUGEINT;
+BEGIN
+	IF (Kernel32.QueryThreadCycleTime # NIL) THEN
+		res := Kernel32.QueryThreadCycleTime(CurrentProcess().handle, result);
+	ELSE (* fallback *)
+		result := Machine.GetTimer();
+	END;
+	RETURN result;
+END CurrentProcessTime;
+
+PROCEDURE TimerFrequency*(): HUGEINT;
+BEGIN
+	RETURN 1000000000;
+END TimerFrequency;
+
+
+VAR GetProcedureName*: PROCEDURE (pc: ADDRESS; VAR n: ARRAY OF CHAR; VAR spc: ADDRESS);
+
+
+PROCEDURE LeaveA2;
+VAR cur: Process; ebp,n: ADDRESS;
+BEGIN
+	IF clock = NIL THEN RETURN END;
+	cur := CurrentProcess();
+	IF cur # NIL THEN 
+		ebp := Machine.CurrentBP();
+		SYSTEM.GET(ebp, n);
+		IF ODD(n) THEN SYSTEM.GET(ebp + SIZEOF(ADDRESS), ebp) ELSE ebp := n END;
+		cur.gcContext.ebp := ebp;
+	END;
+END LeaveA2;
+
+PROCEDURE ReenterA2;
+VAR cur: Process;
+BEGIN
+	IF clock = NIL THEN RETURN END;
+	cur := CurrentProcess();
+	IF cur # NIL THEN 
+		cur.gcContext.ebp := NIL;
+	END;	
+END ReenterA2;
+
+VAR
+	lpContext: Kernel32.Wow64Context;
+	TraceProcessHook*: PROCEDURE (prcoess: Process; pc, bp: ADDRESS; stacklow, stackhigh: ADDRESS);
+	
+BEGIN
+	TraceProcessHook := NIL;
+	exceptionhandler := NIL;
+	terminateProc := TerminateProc;
+	ready.head := NIL; ready.tail := NIL;
+	tlsIndex := Kernel32.TlsAlloc();
+	ASSERT ( tlsIndex # Kernel32.TLSOutOfIndexes );
+	Kernel32.SendToDebugger("Modules.root", ADDRESSOF(Modules.root));
+	
+	(* determine whether it is WOW64 environment *)
+	isWow64 := (Kernel32.Wow64GetThreadContext # NIL) & (Kernel32.Wow64GetThreadContext(Kernel32.GetCurrentThread(),lpContext) # 0); 
+	IF isWow64 THEN
+		Trace.String("Use Wow64"); Trace.Ln;
+	END;
+	Init
+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
+
+Stack invariant for GC:
+o if process is running, the processor registers contain its state
+o if process is not running, at least state.ESP is valid, and between stack.adr and stack.high (for GC)
+
+o when releasing the Ready lock, make sure the process state is up to date
+*)
+
+SystemTools.ShowStacks ~
+
+Heaps.SetMetaData 
+
+StaticLinker.Link --fileFormat=PE32 --fileName=A2GC.exe --extension=GofW --displacement=401000H Runtime Trace Kernel32 Machine Heaps Modules Objects Kernel KernelLog Streams Commands FIles WinFS Clock Dates Reals Strings Diagnostics BitSets StringPool ObjectFile GenericLinker Reflection  GenericLoader  BootConsole ~