Sfoglia il codice sorgente

Removed SystemA2Up which seems to be obsolete

git-svn-id: https://svn.inf.ethz.ch/svn/lecturers/a2/trunk@8211 8c9fc860-2736-0410-a75d-ab315db34111
negelef 7 anni fa
parent
commit
9dd096d35d

+ 377 - 114
source/Coop.I386.Machine.Mod → source/Coop.Machine.Mod

@@ -40,7 +40,7 @@ TYPE
 	IDMap* = ARRAY 16 OF SHORTINT;
 	IDMap* = ARRAY 16 OF SHORTINT;
 
 
 	Range* = RECORD
 	Range* = RECORD
-		adr*, size*: LONGINT
+		adr*: ADDRESS; size*: SIZE;
 	END;
 	END;
 
 
 	MemoryBlock* = POINTER TO MemoryBlockDesc;
 	MemoryBlock* = POINTER TO MemoryBlockDesc;
@@ -109,27 +109,51 @@ VAR
 
 
 (** This procedure should be called in all spin loops as a hint to the processor (e.g. Pentium 4). *)
 (** This procedure should be called in all spin loops as a hint to the processor (e.g. Pentium 4). *)
 
 
-	PROCEDURE -SpinHint*;
-	CODE {SYSTEM.i386}
-		REP	NOP	;  PAUSE instruction (* NOP on pre-P4 processors, Spin Loop Hint on P4 and after *)
-	END SpinHint;
+PROCEDURE -SpinHint*;
+CODE
+#IF I386 THEN
+	PAUSE
+#ELSIF AMD64 THEN
+	PAUSE
+#ELSE
+	unimplemented
+#END
+END SpinHint;
 
 
 (* Return current instruction pointer *)
 (* Return current instruction pointer *)
 PROCEDURE CurrentPC* (): ADDRESS;
 PROCEDURE CurrentPC* (): ADDRESS;
-CODE {SYSTEM.i386}
+CODE
+#IF I386 THEN
 	MOV EAX, [EBP+4]
 	MOV EAX, [EBP+4]
+#ELSIF AMD64 THEN
+	MOV RAX, [RBP + 8]
+#ELSE
+	unimplemented
+#END
 END CurrentPC;
 END CurrentPC;
 
 
 (* Return current frame pointer *)
 (* Return current frame pointer *)
 PROCEDURE -CurrentBP* (): ADDRESS;
 PROCEDURE -CurrentBP* (): ADDRESS;
-CODE {SYSTEM.i386}
+CODE
+#IF I386 THEN
 	MOV EAX, EBP
 	MOV EAX, EBP
+#ELSIF AMD64 THEN
+	MOV RAX, RBP
+#ELSE
+	unimplemented
+#END
 END CurrentBP;
 END CurrentBP;
 
 
 (* Return current stack pointer *)
 (* Return current stack pointer *)
 PROCEDURE -CurrentSP* (): ADDRESS;
 PROCEDURE -CurrentSP* (): ADDRESS;
-CODE {SYSTEM.i386}
+CODE
+#IF I386 THEN
 	MOV EAX, ESP
 	MOV EAX, ESP
+#ELSIF AMD64 THEN
+	MOV RAX, RSP
+#ELSE
+	unimplemented
+#END
 END CurrentSP;
 END CurrentSP;
 
 
 PROCEDURE MapPhysical*(physAdr: ADDRESS; size: SIZE; VAR virtAdr: ADDRESS);
 PROCEDURE MapPhysical*(physAdr: ADDRESS; size: SIZE; VAR virtAdr: ADDRESS);
@@ -179,7 +203,8 @@ END GetInit;
 (** Fill "size" bytes at "destAdr" with "filler".  "size" must be multiple of 4. *)
 (** Fill "size" bytes at "destAdr" with "filler".  "size" must be multiple of 4. *)
 
 
 	PROCEDURE Fill32*(destAdr: ADDRESS; size: SIZE; filler: LONGINT);
 	PROCEDURE Fill32*(destAdr: ADDRESS; size: SIZE; filler: LONGINT);
-	CODE {SYSTEM.i386}
+	CODE
+	#IF I386 THEN
 		PUSH	ECX
 		PUSH	ECX
 		MOV	EDI, [EBP+destAdr]
 		MOV	EDI, [EBP+destAdr]
 		MOV	ECX, [EBP+size]
 		MOV	ECX, [EBP+size]
@@ -188,38 +213,76 @@ END GetInit;
 		JZ	ok
 		JZ	ok
 		PUSH	8	;  ASSERT failure
 		PUSH	8	;  ASSERT failure
 		INT	3
 		INT	3
-		ok:
-		SHR	ECX, 2
+	ok:	SHR	ECX, 2
 		CLD
 		CLD
 		REP	STOSD
 		REP	STOSD
 		POP	ECX
 		POP	ECX
+	#ELSIF AMD64 THEN
+		PUSH	RCX
+		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
+		POP	RCX
+	#ELSE
+		unimplemented
+	#END
 	END Fill32;
 	END Fill32;
 
 
 (** -- Processor initialization -- *)
 (** -- Processor initialization -- *)
 
 
 	PROCEDURE -SetFCR( s: SET );
 	PROCEDURE -SetFCR( s: SET );
-	CODE {SYSTEM.i386, SYSTEM.FPU}
+	CODE
+	#IF I386 THEN
 		FLDCW	[ESP]	;  parameter s
 		FLDCW	[ESP]	;  parameter s
 		POP	EAX
 		POP	EAX
+	#ELSIF AMD64 THEN
+		FLDCW	WORD [RSP]	; parameter s
+		POP	RAX
+	#ELSE
+		unimplemented
+	#END
 	END SetFCR;
 	END SetFCR;
 
 
 	PROCEDURE -FCR( ): SET;
 	PROCEDURE -FCR( ): SET;
-	CODE {SYSTEM.i386, SYSTEM.FPU}
+	CODE
+	#IF I386 THEN
 		PUSH	0
 		PUSH	0
 		FNSTCW	[ESP]
 		FNSTCW	[ESP]
 		FWAIT
 		FWAIT
 		POP	EAX
 		POP	EAX
+	#ELSIF AMD64 THEN
+		PUSH	0
+		FNSTCW	WORD [RSP]
+		FWAIT
+		POP	RAX
+	#ELSE
+		unimplemented
+	#END
 	END FCR;
 	END FCR;
 
 
 	PROCEDURE -InitFPU;
 	PROCEDURE -InitFPU;
-	CODE {SYSTEM.i386, SYSTEM.FPU}
+	CODE
+	#IF I386 THEN
 		FNINIT
 		FNINIT
+	#ELSIF AMD64 THEN
+		FNINIT
+	#ELSE
+		unimplemented
+	#END
 	END InitFPU;
 	END InitFPU;
 
 
 (** CPU identification. *)
 (** CPU identification. *)
 
 
 	PROCEDURE CPUID*( VAR vendor: Vendor;  VAR version: LONGINT;  VAR features1,features2: SET );
 	PROCEDURE CPUID*( VAR vendor: Vendor;  VAR version: LONGINT;  VAR features1,features2: SET );
-	CODE {SYSTEM.i386, SYSTEM.Pentium}
+	CODE
+	#IF I386 THEN
 		PUSH	ECX
 		PUSH	ECX
 		MOV	EAX, 0
 		MOV	EAX, 0
 		CPUID
 		CPUID
@@ -250,6 +313,40 @@ END GetInit;
 		MOV	[ESI], ECX
 		MOV	[ESI], ECX
 		end:
 		end:
 		POP	ECX
 		POP	ECX
+	#ELSIF AMD64 THEN
+		PUSH	RCX
+		MOV	EAX, 0
+		CPUID
+		CMP	EAX, 0
+		JNE	ok
+		MOV	RSI, [RBP+vendor]
+		MOV	[RSI], AL	;  AL = 0
+		MOV	RSI, [RBP+version]
+		MOV	[RSI], EAX	;  EAX = 0
+		MOV	RSI, [RBP+features1]
+		MOV	[RSI], EAX
+		MOV	RSI, [RBP+features2]
+		MOV	[RSI], EAX
+		JMP	end
+		ok:
+		MOV	RSI, [RBP+vendor]
+		MOV	[RSI], EBX
+		MOV	[RSI+4], EDX
+		MOV	[RSI+8], ECX
+		MOV	BYTE [RSI+12], 0
+		MOV	EAX, 1
+		CPUID
+		MOV	RSI, [RBP+version]
+		MOV	[RSI], EAX
+		MOV	RSI, [RBP+features1]
+		MOV	[RSI], EDX
+		MOV	RSI, [RBP+features2]
+		MOV	[RSI], RCX
+		end:
+		POP	RCX
+	#ELSE
+		unimplemented
+	#END
 	END CPUID;
 	END CPUID;
 
 
 	PROCEDURE GetConfig* ( CONST name: ARRAY OF CHAR;  VAR val: ARRAY OF CHAR );
 	PROCEDURE GetConfig* ( CONST name: ARRAY OF CHAR;  VAR val: ARRAY OF CHAR );
@@ -272,25 +369,48 @@ END Sti;
 
 
 (* Dan: from new Machine *)
 (* Dan: from new Machine *)
 PROCEDURE -GetTimer*(): HUGEINT;
 PROCEDURE -GetTimer*(): HUGEINT;
-CODE {SYSTEM.Pentium}
+CODE
+#IF I386 THEN
 	RDTSC	; set EDX:EAX
 	RDTSC	; set EDX:EAX
+#ELSIF AMD64 THEN
+	XOR RAX, RAX
+	RDTSC	; set EDX:EAX
+	SHL RDX, 32
+	OR RAX, RDX
+#ELSE
+	unimplemented
+#END
 END GetTimer;
 END GetTimer;
 
 
 (** Disable interrupts and return old interrupt state. *)
 (** Disable interrupts and return old interrupt state. *)
 PROCEDURE -DisableInterrupts* (): SET;
 PROCEDURE -DisableInterrupts* (): SET;
-CODE {SYSTEM.i386}
+CODE
+#IF I386 THEN
 	PUSHFD
 	PUSHFD
 	CLI
 	CLI
 	POP EAX
 	POP EAX
+#ELSIF AMD64 THEN
+	PUSHFQ
+	CLI
+	POP RAX
+#ELSE
+	unimplemented
+#END
 END DisableInterrupts;
 END DisableInterrupts;
 
 
 (** Restore interrupt state. Parameter s must be return value of earlier DisableInterrupts call on same processor. *)
 (** Restore interrupt state. Parameter s must be return value of earlier DisableInterrupts call on same processor. *)
 PROCEDURE -RestoreInterrupts* (s: SET);
 PROCEDURE -RestoreInterrupts* (s: SET);
-CODE {SYSTEM.i386}
+CODE
+#IF I386 THEN
 	POPFD
 	POPFD
+#ELSIF AMD64 THEN
+	POPFQ
+#ELSE
+	unimplemented
+#END
 END RestoreInterrupts;
 END RestoreInterrupts;
 
 
-PROCEDURE ID*(): LONGINT;
+PROCEDURE ID*(): SIZE;
 BEGIN
 BEGIN
 	RETURN Processors.GetCurrentIndex ();
 	RETURN Processors.GetCurrentIndex ();
 END ID;
 END ID;
@@ -298,11 +418,20 @@ END ID;
 (* setup MMX, SSE and SSE2..SSE5 and AVX extension *)
 (* setup MMX, SSE and SSE2..SSE5 and AVX extension *)
 
 
 PROCEDURE -InitSSE;
 PROCEDURE -InitSSE;
-CODE {SYSTEM.Pentium, SYSTEM.Privileged}
+CODE
+#IF I386 THEN
 	MOV	EAX, CR4
 	MOV	EAX, CR4
 	OR	EAX, 00000200H		; set bit 9 (OSFXSR)
 	OR	EAX, 00000200H		; set bit 9 (OSFXSR)
 	AND	EAX, 0FFFFFBFFH	; delete bit 10 (OSXMMEXCPT)
 	AND	EAX, 0FFFFFBFFH	; delete bit 10 (OSXMMEXCPT)
 	MOV	CR4, EAX
 	MOV	CR4, EAX
+#ELSIF AMD64 THEN
+	MOV	EAX, CR4
+	OR	EAX, 00000200H		; set bit 9 (OSFXSR)
+	AND	EAX, 0FFFFFBFFH	; delete bit 10 (OSXMMEXCPT)
+	MOV	CR4, EAX
+#ELSE
+	unimplemented
+#END
 END InitSSE;
 END InitSSE;
 
 
 PROCEDURE InitBootProcessor-;
 PROCEDURE InitBootProcessor-;
@@ -373,152 +502,286 @@ END PhysicalAdr;
 (** Atomic INC(x). *)
 (** Atomic INC(x). *)
 
 
 	PROCEDURE -AtomicInc*( VAR x: LONGINT );
 	PROCEDURE -AtomicInc*( VAR x: LONGINT );
-	CODE {SYSTEM.i386}
+	CODE
+	#IF I386 THEN
 		POP	EAX
 		POP	EAX
 		LOCK
 		LOCK
-		INC	DWORD[EAX]
+		INC	DWORD [EAX]
+	#ELSIF AMD64 THEN
+		POP	RAX
+		LOCK
+		INC	DWORD [RAX]
+	#ELSE
+		unimplemented
+	#END
 	END AtomicInc;
 	END AtomicInc;
 
 
 (** Atomic DEC(x). *)
 (** Atomic DEC(x). *)
 
 
 	PROCEDURE -AtomicDec*( VAR x: LONGINT );
 	PROCEDURE -AtomicDec*( VAR x: LONGINT );
-	CODE {SYSTEM.i386}
+	CODE
+	#IF I386 THEN
 		POP	EAX
 		POP	EAX
 		LOCK
 		LOCK
-		DEC	DWORD[EAX]
+		DEC	DWORD [EAX]
+	#ELSIF AMD64 THEN
+		POP	RAX
+		LOCK
+		DEC	DWORD [RAX]
+	#ELSE
+		unimplemented
+	#END
 	END AtomicDec;
 	END AtomicDec;
 
 
 (** Atomic INC(x, y). *)
 (** Atomic INC(x, y). *)
 
 
 	PROCEDURE -AtomicAdd*( VAR x: LONGINT;  y: LONGINT );
 	PROCEDURE -AtomicAdd*( VAR x: LONGINT;  y: LONGINT );
-	CODE {SYSTEM.i386}
+	CODE
+	#IF I386 THEN
 		POP	EBX
 		POP	EBX
 		POP	EAX
 		POP	EAX
 		LOCK
 		LOCK
-		ADD	DWORD[EAX], EBX
+		ADD	DWORD [EAX], EBX
+	#ELSIF AMD64 THEN
+		POP	EBX
+		POP	RAX
+		LOCK
+		ADD	DWORD [RAX], EBX
+	#ELSE
+		unimplemented
+	#END
 	END AtomicAdd;
 	END AtomicAdd;
 
 
 (** Atomic test-and-set.  Set x = TRUE and return old value of x. *)
 (** Atomic test-and-set.  Set x = TRUE and return old value of x. *)
 
 
 	PROCEDURE -AtomicTestSet*( VAR x: BOOLEAN ): BOOLEAN;
 	PROCEDURE -AtomicTestSet*( VAR x: BOOLEAN ): BOOLEAN;
-	CODE {SYSTEM.i386}
+	CODE
+	#IF I386 THEN
 		POP	EBX
 		POP	EBX
 		MOV	AL, 1
 		MOV	AL, 1
 		XCHG	[EBX], AL
 		XCHG	[EBX], AL
+	#ELSIF AMD64 THEN
+		POP	RBX
+		MOV	AL, 1
+		XCHG	[RBX], AL
+	#ELSE
+		unimplemented
+	#END
 	END AtomicTestSet;
 	END AtomicTestSet;
 
 
 (* Atomic compare-and-swap. Set x = new if x = old and return old value of x *)
 (* 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;
 	PROCEDURE -AtomicCAS* (VAR x: LONGINT; old, new: LONGINT): LONGINT;
-	CODE {SYSTEM.i386}
+	CODE
+	#IF I386 THEN
 		POP EBX		; new
 		POP EBX		; new
 		POP EAX		; old
 		POP EAX		; old
 		POP EDX		; address of x
 		POP EDX		; address of x
-		DB 0F0X, 00FX, 0B1X, 01AX	; LOCK CMPXCHG [EDX], EBX; atomicly compare x with old and set it to new if equal
+		LOCK CMPXCHG [EDX], EBX	; atomicly compare x with old and set it to new if equal
+	#ELSIF AMD64 THEN
+		POP EBX		; new
+		POP EAX		; old
+		POP RDX		; address of x
+		LOCK CMPXCHG [RDX], EBX	; atomicly compare x with old and set it to new if equal
+	#ELSE
+		unimplemented
+	#END
 	END AtomicCAS;
 	END AtomicCAS;
 
 
 (* function returning the number of processors that are available to Aos *)
 (* function returning the number of processors that are available to Aos *)
-PROCEDURE NumberOfProcessors*( ): LONGINT;
+PROCEDURE NumberOfProcessors*( ): SIZE;
 BEGIN
 BEGIN
 	RETURN Processors.count;
 	RETURN Processors.count;
 END NumberOfProcessors;
 END NumberOfProcessors;
 
 
 (* function for changing byte order *)
 (* function for changing byte order *)
 PROCEDURE ChangeByteOrder* (n: LONGINT): LONGINT;
 PROCEDURE ChangeByteOrder* (n: LONGINT): LONGINT;
-CODE { SYSTEM.Pentium }
+CODE
+#IF I386 THEN
 	MOV EAX, [EBP+n]				; load n in eax
 	MOV EAX, [EBP+n]				; load n in eax
 	BSWAP EAX						; swap byte order
 	BSWAP EAX						; swap byte order
+#ELSIF AMD64 THEN
+	MOV EAX, [RBP+n]				; load n in eax
+	BSWAP EAX						; swap byte order
+#ELSE
+	unimplemented
+#END
 END ChangeByteOrder;
 END ChangeByteOrder;
 
 
-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 EBX, [EBP+val]
-	MOV [EBX], AL
-END Portin8;
-
-PROCEDURE Portin16*(port: LONGINT; VAR val: INTEGER);
-CODE{SYSTEM.i386}
-	MOV EDX,[EBP+port]
-	IN AX, DX
-	MOV EBX, [EBP+val]
-	MOV [EBX], AX
-END Portin16;
-
-PROCEDURE Portin32*(port: LONGINT; VAR val: LONGINT);
-CODE{SYSTEM.i386}
-	MOV EDX,[EBP+port]
-	IN EAX, DX
-	MOV EBX, [EBP+val]
-	MOV [EBX], 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;
+#IF I386 THEN
+
+	PROCEDURE -GetEAX*(): LONGINT;
+	CODE
+	END GetEAX;
+
+	PROCEDURE -GetECX*(): LONGINT;
+	CODE MOV EAX,ECX
+	END GetECX;
+
+	PROCEDURE -SetEAX*(n: LONGINT);
+	CODE POP EAX
+	END SetEAX;
+
+	PROCEDURE -SetEBX*(n: LONGINT);
+	CODE POP EBX
+	END SetEBX;
+
+	PROCEDURE -SetECX*(n: LONGINT);
+	CODE POP ECX
+	END SetECX;
+
+	PROCEDURE -SetEDX*(n: LONGINT);
+	CODE POP EDX
+	END SetEDX;
+
+	PROCEDURE -SetESI*(n: LONGINT);
+	CODE POP ESI
+	END SetESI;
+
+	PROCEDURE -SetEDI*(n: LONGINT);
+	CODE POP EDI
+	END SetEDI;
+
+	PROCEDURE Portin8*(port: LONGINT; VAR val: CHAR);
+	CODE
+		MOV EDX, [EBP+port]
+		IN AL, DX
+		MOV EBX, [EBP+val]
+		MOV [EBX], AL
+	END Portin8;
+
+	PROCEDURE Portin16*(port: LONGINT; VAR val: INTEGER);
+	CODE
+		MOV EDX, [EBP+port]
+		IN AX, DX
+		MOV EBX, [EBP+val]
+		MOV [EBX], AX
+	END Portin16;
+
+	PROCEDURE Portin32*(port: LONGINT; VAR val: LONGINT);
+	CODE
+		MOV EDX, [EBP+port]
+		IN EAX, DX
+		MOV EBX, [EBP+val]
+		MOV [EBX], EAX
+	END Portin32;
+
+	PROCEDURE Portout8*(port: LONGINT; val: CHAR);
+	CODE
+		MOV AL, [EBP+val]
+		MOV EDX, [EBP+port]
+		OUT DX, AL
+	END Portout8;
+
+	PROCEDURE Portout16*(port: LONGINT; val: INTEGER);
+	CODE
+		MOV AX, [EBP+val]
+		MOV EDX, [EBP+port]
+		OUT DX, AX
+	END Portout16;
+
+	PROCEDURE Portout32*(port: LONGINT; val: LONGINT);
+	CODE
+		MOV EAX, [EBP+val]
+		MOV EDX, [EBP+port]
+		OUT DX, EAX
+	END Portout32;
+
+#ELSIF AMD64 THEN
+
+	PROCEDURE -GetRAX*(): HUGEINT;
+	CODE
+	END GetRAX;
+
+	PROCEDURE -GetRCX*(): HUGEINT;
+	CODE MOV RAX, RCX
+	END GetRCX;
+
+	PROCEDURE -SetRAX*(n: HUGEINT);
+	CODE POP RAX
+	END SetRAX;
+
+	PROCEDURE -SetRBX*(n: HUGEINT);
+	CODE POP RBX
+	END SetRBX;
+
+	PROCEDURE -SetRCX*(n: HUGEINT);
+	CODE POP RCX
+	END SetRCX;
+
+	PROCEDURE -SetRDX*(n: HUGEINT);
+	CODE POP RDX
+	END SetRDX;
+
+	PROCEDURE -SetRSI*(n: HUGEINT);
+	CODE POP RSI
+	END SetRSI;
+
+	PROCEDURE -SetRDI*(n: HUGEINT);
+	CODE POP EDI
+	END SetRDI;
+
+	PROCEDURE Portin8*(port: LONGINT; VAR val: CHAR);
+	CODE
+		MOV EDX, [RBP+port]
+		IN AL, DX
+		MOV RBX, [RBP+val]
+		MOV [RBX], AL
+	END Portin8;
+
+	PROCEDURE Portin16*(port: LONGINT; VAR val: INTEGER);
+	CODE
+		MOV EDX, [RBP+port]
+		IN AX, DX
+		MOV RBX, [RBP+val]
+		MOV [RBX], AX
+	END Portin16;
+
+	PROCEDURE Portin32*(port: LONGINT; VAR val: LONGINT);
+	CODE
+		MOV EDX, [RBP+port]
+		IN EAX, DX
+		MOV RBX, [RBP+val]
+		MOV [RBX], EAX
+	END Portin32;
+
+	PROCEDURE Portout8*(port: LONGINT; val: CHAR);
+	CODE
+		MOV AL, [RBP+val]
+		MOV EDX, [RBP+port]
+		OUT DX, AL
+	END Portout8;
+
+	PROCEDURE Portout16*(port: LONGINT; val: INTEGER);
+	CODE
+		MOV AX, [RBP+val]
+		MOV EDX, [RBP+port]
+		OUT DX, AX
+	END Portout16;
+
+	PROCEDURE Portout32*(port: LONGINT; val: LONGINT);
+	CODE
+		MOV EAX, [RBP+val]
+		MOV EDX, [RBP+port]
+		OUT DX, EAX
+	END Portout32;
+
+#END
 
 
 (* Delay for IO *)
 (* Delay for IO *)
 PROCEDURE -Wait*;
 PROCEDURE -Wait*;
-CODE {SYSTEM.i386}
+CODE
+#IF I386 THEN
+	JMP 0
+	JMP 0
+	JMP 0
+#ELSIF AMD64 THEN
 	JMP 0
 	JMP 0
 	JMP 0
 	JMP 0
 	JMP 0
 	JMP 0
+#ELSE
+	unimplemented
+#END
 END Wait;
 END Wait;
 
 
 (** Read a byte from the non-volatile setup memory. *)
 (** Read a byte from the non-volatile setup memory. *)

+ 24 - 10
source/FoxProfiler.Mod

@@ -43,23 +43,23 @@ TYPE
 		PROCEDURE Enter(moduleId, procedureId: LONGINT; enterTime: HUGEINT);
 		PROCEDURE Enter(moduleId, procedureId: LONGINT; enterTime: HUGEINT);
 		BEGIN
 		BEGIN
 			IF TraceEnter THEN log.String("stack position "); log.Int(stackPosition,1); log.Ln; END;
 			IF TraceEnter THEN log.String("stack position "); log.Int(stackPosition,1); log.Ln; END;
+			IF (moduleId < MaxModules) & (procedureId < MaxProcedures) THEN
+				INC(modules[moduleId,procedureId].calls);
+			END;
 			IF stackPosition < MaxStackSize THEN
 			IF stackPosition < MaxStackSize THEN
-				startTime[stackPosition] := GetTimer();
 				correcture[stackPosition] := 0;
 				correcture[stackPosition] := 0;
 
 
 				(* debugging *)
 				(* debugging *)
 				module[stackPosition] := moduleId;
 				module[stackPosition] := moduleId;
 				procedure[stackPosition] := procedureId;
 				procedure[stackPosition] := procedureId;
 
 
+				startTime[stackPosition] := GetTimer();
 				(* book keeping for caller *)
 				(* book keeping for caller *)
 				IF stackPosition > 0 THEN
 				IF stackPosition > 0 THEN
 					(* try to remove time spent in profiler *)
 					(* try to remove time spent in profiler *)
 					INC(correcture[stackPosition-1], startTime[stackPosition] -enterTime);
 					INC(correcture[stackPosition-1], startTime[stackPosition] -enterTime);
 				END;
 				END;
 			END;
 			END;
-			IF (moduleId < MaxModules) & (procedureId < MaxProcedures) THEN
-				INC(modules[moduleId,procedureId].calls);
-			END;
 			INC(stackPosition);
 			INC(stackPosition);
 		END Enter;
 		END Enter;
 
 
@@ -359,16 +359,30 @@ VAR
 		log.Update;
 		log.Update;
 	END Report;
 	END Report;
 
 
+	PROCEDURE CalibrateProc;
+	BEGIN
+		EnterProcedure(0,0);
+		ExitProcedure(0,0);
+	END CalibrateProc;
+	
+
 	PROCEDURE Calibrate;
 	PROCEDURE Calibrate;
+	VAR cal: LONGINT; i: SIZE; process: Process;
 	BEGIN
 	BEGIN
 		frequency := Objects.TimerFrequency();
 		frequency := Objects.TimerFrequency();
 		log.Ln;  log.String( "Timer reported Frequency: " ); log.FloatFix( frequency, 5, 1,0 );
 		log.Ln;  log.String( "Timer reported Frequency: " ); log.FloatFix( frequency, 5, 1,0 );
 		log.Ln;  log.Update;
 		log.Ln;  log.Update;
+		AddModule(cal,1,"@FoxProfiler");
+		AddProcedure(cal,0,"@ProfilerDelta");
+		process := GetProcess();
+		FOR i := 1 TO 1000 DO
+			CalibrateProc();
+		END;		
 	END Calibrate;
 	END Calibrate;
 
 
 	PROCEDURE Init;
 	PROCEDURE Init;
 	VAR i: LONGINT;
 	VAR i: LONGINT;
-	BEGIN{EXCLUSIVE}
+	BEGIN
 		FOR i := 0 TO LEN(modules)-1 DO	modules[i] := NIL	END;
 		FOR i := 0 TO LEN(modules)-1 DO	modules[i] := NIL	END;
 		FOR i := 0 TO LEN(table)-1 DO table[i].used := FALSE END;
 		FOR i := 0 TO LEN(table)-1 DO table[i].used := FALSE END;
 		numberModules := 0;
 		numberModules := 0;
@@ -397,11 +411,11 @@ BEGIN
 	Init;
 	Init;
 END FoxProfiler.
 END FoxProfiler.
 
 
-WMUtilities.Call --font=Courier FoxProfiler.Report ~
-WMUtilities.Call --font=Courier FoxProfiler.Report time ~
-WMUtilities.Call --font=Courier FoxProfiler.Report calls ~
-WMUtilities.Call --font=Courier FoxProfiler.Report name ~
-WMUtilities.Call --font=Courier FoxProfiler.Report brut ~
+WMUtilities.Call --font=VeraMo FoxProfiler.Report ~
+WMUtilities.Call --font=VeraMo FoxProfiler.Report time ~
+WMUtilities.Call --font=VeraMo FoxProfiler.Report calls ~
+WMUtilities.Call --font=VeraMo FoxProfiler.Report name ~
+WMUtilities.Call --font=VeraMo FoxProfiler.Report brut ~
 
 
 WMUtilities.Call --font=Courier FoxProfiler.Report time all ~
 WMUtilities.Call --font=Courier FoxProfiler.Report time all ~
 
 

+ 5 - 4
source/Release.Tool

@@ -266,7 +266,7 @@ PACKAGE Kernel ARCHIVE "Kernel.zip" SOURCE "KernelSrc.zip" DESCRIPTION "A2 Kerne
 	COOP { Counters.Mod }
 	COOP { Counters.Mod }
 	BIOS32C { I386.APIC.Mod APIC.Processors.Mod BIOS.ACPI.Mod ACPI.Timer.Mod }
 	BIOS32C { I386.APIC.Mod APIC.Processors.Mod BIOS.ACPI.Mod ACPI.Timer.Mod }
 	WIN32C { Coop.Windows.I386.Kernel32.Mod Windows.Processors.Mod Windows.Timer.Mod }
 	WIN32C { Coop.Windows.I386.Kernel32.Mod Windows.Processors.Mod Windows.Timer.Mod }
-	LINUX64C { Linux.AMD64.Glue.Mod Linux.AMD64.Unix.Mod Unix.Processors.Mod Unix.Timer.Mod }
+	LINUX64C { Linux.Glue.Mod Linux.AMD64.Unix.Mod Unix.Processors.Mod Unix.Timer.Mod }
 	RPIC { RPI.Processors.Mod RPI.Timer.Mod }
 	RPIC { RPI.Processors.Mod RPI.Timer.Mod }
 	ZYNQC { Zynq.Processors.Mod Zynq.Timer.Mod }
 	ZYNQC { Zynq.Processors.Mod Zynq.Timer.Mod }
 	COOP { Queues.Mod BaseTypes.Mod Activities.Mod ExclusiveBlocks.Mod Interrupts.Mod Runtime.Mod }
 	COOP { Queues.Mod BaseTypes.Mod Activities.Mod ExclusiveBlocks.Mod Interrupts.Mod Runtime.Mod }
@@ -274,6 +274,7 @@ PACKAGE Kernel ARCHIVE "Kernel.zip" SOURCE "KernelSrc.zip" DESCRIPTION "A2 Kerne
 	RPIC { HeapManager.Mod RPI.Environment.Mod }
 	RPIC { HeapManager.Mod RPI.Environment.Mod }
 	ZYNQC { HeapManager.Mod Zynq.Environment.Mod }
 	ZYNQC { HeapManager.Mod Zynq.Environment.Mod }
 	WIN32C { Windows.Environment.Mod }
 	WIN32C { Windows.Environment.Mod }
+	LINUX64C { Unix.Environment.Mod }
 
 
 	LINUX32 { Linux.Glue.Mod Linux.I386.Unix.Mod }
 	LINUX32 { Linux.Glue.Mod Linux.I386.Unix.Mod }
 	LINUX64 { Linux.Glue.Mod Linux.AMD64.Unix.Mod }
 	LINUX64 { Linux.Glue.Mod Linux.AMD64.Unix.Mod }
@@ -290,11 +291,11 @@ PACKAGE Kernel ARCHIVE "Kernel.zip" SOURCE "KernelSrc.zip" DESCRIPTION "A2 Kerne
 	WIN32 { Windows.I386.Machine.Mod }
 	WIN32 { Windows.I386.Machine.Mod }
 	WIN64 { Windows.AMD64.Machine.Mod }
 	WIN64 { Windows.AMD64.Machine.Mod }
 	COOP { Mutexes.Mod }
 	COOP { Mutexes.Mod }
-	BIOS32C, WIN32C { Coop.I386.Machine.Mod }
+	BIOS32C, WIN32C { Coop.Machine.Mod }
+	LINUX64C { Coop.Machine.Mod }
 	RPIC, ZYNQC { Coop.ARM.Machine.Mod }
 	RPIC, ZYNQC { Coop.ARM.Machine.Mod }
 
 
-	UNIX32 { Unix.I386.Machine.Mod }
-	UNIX64 { Unix.AMD64.Machine.Mod }
+	UNIX { Unix.Machine.Mod }
 
 
 	NATIVE, WIN, UNIX { Heaps.Mod }
 	NATIVE, WIN, UNIX { Heaps.Mod }
 	COOP { Coop.Heaps.Mod }
 	COOP { Coop.Heaps.Mod }

+ 0 - 833
source/Unix.AMD64.Machine.Mod

@@ -1,833 +0,0 @@
-MODULE Machine;	(** AUTHOR "pjm, G.F."; PURPOSE "Bootstrapping, configuration and machine interface"; *)
-
-IMPORT S := SYSTEM, Trace, Unix, Glue;
-
-CONST
-	DefaultConfig = "Color 0  StackSize 128";
-	
-	Version = "A2 Gen. 64-bit, ";
-
-	DefaultObjectFileExtension* = ".GofUu";
-	
-	Second* = 1000; (* frequency of ticks increments in Hz *)
-
-	(** bits in features variable *)
-	MTTR* = 12;  MMX* = 23; 
-	
-	
-	AddressSize = SIZEOF(ADDRESS);
-	StaticBlockSize = 8 * AddressSize;	(* static heap block size *)
-
-	MemBlockSize* = 64*1024*1024;
-	
-	TraceOutput* = 0;	(* Trace output *)
-	Memory* = 1;		(*!  Virtual memory management, stack and page allocation,  not used in UnixAos *)
-	Heaps* = 2;   		(* Storage allocation and Garbage collection *)
-	Interrupts* = 3;		(*!  Interrupt handling,  not used in UnixAos *)
-	Modules* = 4;		(* Module list *)
-	Objects* = 5;		(*!  Ready queue,  not used in UnixAos *)
-	Processors* = 6;	(*!  Interprocessor interrupts,  not used in UnixAos *)
-	KernelLog* = 7;		(* Atomic output *)
-	X11* = 8;				(* XWindows I/O *)
-	MaxLocks* = 9;   (* { <= 32 } *)
-	
-	MaxCPU* = 4;
-	IsCooperative* = FALSE;
-
-TYPE	
-	Vendor* = ARRAY 13 OF CHAR;	
-
-	MemoryBlock* = POINTER {UNSAFE, UNTRACED} TO MemoryBlockDesc;
-	MemoryBlockDesc* = RECORD
-		next- : MemoryBlock;
-		startAdr-: ADDRESS; 		(* sort key in linked list of memory blocks *)
-		size-: SIZE; 					
-		beginBlockAdr-, endBlockAdr-: ADDRESS
-	END;
-	
-	(** processor state *)
-	State* = RECORD	
-		PC*, BP*, SP*: ADDRESS
-	END;
-	
-	
-VAR
-	mtx	: ARRAY MaxLocks OF Unix.Mutex_t;
-	
-	version-: ARRAY 64 OF CHAR;	(** Aos version *)
-	
-	features-, features2 : SET;
-	MMXSupport-	: BOOLEAN;
-	SSESupport-	: BOOLEAN;
-	SSE2Support-	: BOOLEAN;
-	SSE3Support-	: BOOLEAN;
-	SSSE3Support-	: BOOLEAN;
-	SSE41Support-	: BOOLEAN;
-	SSE42Support-	: BOOLEAN;
-	SSE5Support-	: BOOLEAN;
-	AVXSupport-		: BOOLEAN;
-		
-	ticks-: LONGINT;	(** timer ticks. Use Kernel.GetTicks() to read, don't write *)
-	
-	prioLow-, prioHigh-: LONGINT;	(* permitted thread priorities *)
-	
-	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 *)
-	
-	gcThreshold-: SIZE;
-	memBlockHead-{UNTRACED}, memBlockTail-{UNTRACED}: MemoryBlock; (* head and tail of sorted list of memory blocks *)
-	
-	config: ARRAY 2048 OF CHAR;	(* config strings *)
-	
-	logname: ARRAY 32 OF CHAR;
-	logfile: LONGINT;
-	traceHeap: BOOLEAN;
-
-	timer0	: HUGEINT;
-
-	(** Return current processor ID (0 to MaxNum-1). *)
-	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;
-	
-	(* 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) & (ADDRESS OF cur^ < ADDRESS OF memBlock^) 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 *)
-			prev.next := memBlock;
-			memBlock.next := cur;
-		END;
-		IF cur = NIL THEN
-			memBlockTail := memBlock
-		END
-	END InsertMemoryBlock;
-
-		
-	(* Free unused memory block - called during GC *)
-	PROCEDURE FreeMemBlock*(memBlock: MemoryBlock);
-	VAR cur {UNTRACED}, prev {UNTRACED}: MemoryBlock;
-	BEGIN
-		cur := memBlockHead;
-		prev := NIL;
-		WHILE (cur # NIL) & (cur # memBlock) DO
-			prev := cur;
-			cur := cur.next
-		END;
-		IF cur = memBlock THEN 
-			IF traceHeap THEN  
-				Trace.String( "Release memory block " );  Trace.Hex( memBlock.startAdr, -8 );  Trace.Ln
-			END;
-			IF prev = NIL THEN
-				memBlockHead := cur.next
-			ELSE
-				prev.next := cur.next;
-				IF cur.next = NIL THEN
-					memBlockTail := prev
-				END
-			END;
-			Unix.free( memBlock.startAdr )
-		ELSE
-			HALT(535)	(* error in memory block management *)
-		END;
-	END FreeMemBlock;
-
-	
-
-	(* expand heap by allocating a new memory block *)
-	PROCEDURE ExpandHeap*( dummy: LONGINT; size: SIZE; VAR memoryBlock: MemoryBlock; VAR beginBlockAdr, endBlockAdr: ADDRESS );
-	VAR mBlock: MemoryBlock;  alloc: SIZE;  adr: ADDRESS; 
-	BEGIN 
-		ASSERT(SIZEOF(MemoryBlockDesc) <= StaticBlockSize); (* make sure MemoryBlock contents fits into one StaticBlock *)
-		alloc := size + StaticBlockSize;
-		IF alloc < MemBlockSize THEN alloc := MemBlockSize END;
-
-		ASSERT((Unix.PageSize > StaticBlockSize) & (Unix.PageSize MOD StaticBlockSize = 0));  (* alignment to Unix.PageSize implies alignment to StaticBlockSize *)
-		INC( alloc, (-alloc) MOD Unix.PageSize );
-
-		IF Unix.posix_memalign( adr, Unix.PageSize, alloc ) # 0 THEN
-			Unix.Perror( "Machine.ExpandHeap: posix_memalign" );
-			beginBlockAdr := 0;
-			endBlockAdr := 0;
-			memoryBlock := NIL;
-		ELSE
-			IF Unix.mprotect( adr, alloc, 7 (* READ WRITE EXEC *) ) # 0 THEN
-				Unix.Perror( "Machine.ExpandHeap: mprotect" )
-			END;			
-			mBlock := adr;  
-			mBlock.next := NIL;  
-			mBlock.startAdr := adr;
-			mBlock.size := alloc;  
-
-			beginBlockAdr := adr + StaticBlockSize;
-			endBlockAdr := beginBlockAdr + alloc - StaticBlockSize;
-
-			mBlock.beginBlockAdr := beginBlockAdr;  
-			mBlock.endBlockAdr := beginBlockAdr; (* block is still empty -- Heaps module will set the upper bound *)
-			
-			InsertMemoryBlock( mBlock );
-			IF traceHeap THEN TraceHeap( mBlock )  END;
-						
-			memoryBlock := mBlock;
-		END  
-	END ExpandHeap;
-		
-	(* Set memory block end address *)
-	PROCEDURE SetMemoryBlockEndAddress*(memBlock: MemoryBlock; endBlockAdr: ADDRESS);
-	BEGIN
-		ASSERT(endBlockAdr >= memBlock.beginBlockAdr);
-		memBlock.endBlockAdr := endBlockAdr
-	END SetMemoryBlockEndAddress;
-
-	PROCEDURE TraceHeap( new: MemoryBlock );
-	VAR cur{UNTRACED}: MemoryBlock;
-	BEGIN
-		Trace.Ln;
-		Trace.String( "Heap expanded" );  Trace.Ln;
-		Trace.String("Static Heap: "); Trace.Hex(Glue.baseAdr, -8); Trace.String(" - "); Trace.Hex(Glue.endAdr, -8); 
-		Trace.Ln;
-		cur := memBlockHead;
-		WHILE cur # NIL DO
-			Trace.Hex( cur.startAdr, -8 );  Trace.String( "   " );  Trace.Hex( cur.startAdr + cur.size, -8 );
-			IF cur = new THEN  Trace.String( "  (new)" )  END;
-			Trace.Ln;
-			cur := cur.next
-		END
-	END TraceHeap;
-
-	(** Get first memory block and first free address, the first free address is identical to memBlockHead.endBlockAdr *)
-	PROCEDURE GetStaticHeap*(VAR beginBlockAdr, endBlockAdr, freeBlockAdr: ADDRESS);
-	BEGIN
-		beginBlockAdr := NIL; endBlockAdr := NIL; freeBlockAdr := NIL;
-	END GetStaticHeap;
-
-
-	(* returns if an address is a currently allocated heap address *)
-	PROCEDURE ValidHeapAddress*( p: ADDRESS ): BOOLEAN;
-	VAR mb: MemoryBlock; 
-	BEGIN
-		IF (p>=Glue.baseAdr) & (p<=Glue.endAdr) THEN RETURN TRUE END;
-		mb := memBlockHead;  
-		WHILE mb # NIL DO
-			IF (p >= mb.beginBlockAdr) & (p <= mb.endBlockAdr) THEN  RETURN TRUE  END;  
-			mb := mb.next;  
-		END;  
-		RETURN FALSE;
-	END ValidHeapAddress;
-	
-
-	(** Return information on free memory in Kbytes. *)
-	PROCEDURE GetFreeK*(VAR total, lowFree, highFree: SIZE);
-	BEGIN
-		(*! meaningless in Unix port, for interface compatibility only *)
-		total := 0;
-		lowFree := 0;
-		highFree := 0
-	END GetFreeK;
-	
-	
-
-	(** 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;
-
-PROCEDURE  Portin8*(port: LONGINT; VAR val: CHAR);
-END Portin8;
-
-PROCEDURE  Portin16*(port: LONGINT; VAR val: INTEGER);
-END Portin16;
-
-PROCEDURE  Portin32*(port: LONGINT; VAR val: LONGINT);
-END Portin32;
-
-PROCEDURE  Portout8*(port: LONGINT; val: CHAR);
-END Portout8;
-
-PROCEDURE  Portout16*(port: LONGINT; val: INTEGER);
-END Portout16;
-
-PROCEDURE  Portout32*(port: LONGINT; val: LONGINT);
-END Portout32;
-
-
-(** -- 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 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 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 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;
-
-
-(* 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;
-
-PROCEDURE -GetRAX*(): HUGEINT;
-CODE{SYSTEM.AMD64}
-END GetRAX;
-
-PROCEDURE -GetRCX*(): HUGEINT;
-CODE{SYSTEM.AMD64}
-	MOV RAX,RCX
-END GetRCX;
-
-PROCEDURE -GetRSI*(): HUGEINT;
-CODE{SYSTEM.AMD64}
-	MOV RAX,RSI
-END GetRSI;
-
-PROCEDURE -GetRDI*(): HUGEINT;
-CODE{SYSTEM.AMD64}
-	MOV RAX,RDI
-END GetRDI;
-
-
-PROCEDURE -SetRAX*(n: HUGEINT);
-CODE{SYSTEM.AMD64}	
-	NOP
-	POP RAX
-END SetRAX;
-
-PROCEDURE -SetRBX*(n: HUGEINT);
-CODE{SYSTEM.AMD64}
-	NOP
-	POP RBX
-END SetRBX;
-
-PROCEDURE -SetRCX*(n: HUGEINT);
-CODE{SYSTEM.AMD64}
-	POP RCX
-END SetRCX;
-
-PROCEDURE -SetRDX*(n: HUGEINT);
-CODE{SYSTEM.AMD64}
-	POP RDX
-END SetRDX;
-
-PROCEDURE -SetRSI*(n: HUGEINT);
-CODE{SYSTEM.AMD64}
-	POP RSI
-END SetRSI;
-
-PROCEDURE -SetRDI*(n: HUGEINT);
-CODE{SYSTEM.AMD64}
-	POP RDI
-END SetRDI;
-
-
-PROCEDURE -GetTimer* (): HUGEINT;
-CODE {SYSTEM.AMD64}
-	XOR RAX, RAX
-	RDTSC	; set EDX:EAX
-	SHL RDX, 32
-	OR RAX, RDX
-END GetTimer;
-
-
-	(** -- Configuration and bootstrapping -- *)
-
-	(** Return the value of the configuration string specified by parameter name in parameter val. Returns val = "" if the string was not found, or has an empty value. *)
-	PROCEDURE GetConfig* (CONST name: ARRAY OF CHAR; VAR val: ARRAY OF CHAR);
-	VAR i, src: LONGINT; ch: CHAR;
-	BEGIN
-		ASSERT (name[0] # "=");	(* no longer supported, use GetInit instead *)
-		
-		src := -1;  val := "";
-		LOOP
-			REPEAT
-				INC( src );  ch := config[src]; 
-				IF ch = 0X THEN EXIT END;
-			UNTIL ch > ' ';
-			i := 0;
-			LOOP
-				ch := config[src];
-				IF (ch # name[i]) OR (name[i] = 0X) THEN EXIT END;
-				INC (i); INC (src)
-			END;
-			IF (ch <= ' ') & (name[i] = 0X) THEN	(* found *)
-				i := 0;
-				REPEAT
-					INC (src); ch := config[src]; val[i] := ch; INC (i);
-					IF i = LEN(val) THEN val[i - 1] := 0X; RETURN END	(* val too short *)
-				UNTIL ch <= ' ';
-				IF ch = ' ' THEN val[i -1] := 0X END; 
-				RETURN
-			ELSE
-				WHILE ch > ' ' DO	(* skip to end of name *)
-					INC (src); ch := config[src]
-				END;
-				INC (src);
-				REPEAT	(* skip to end of value *)
-					ch := config[src]; INC (src)
-				UNTIL ch <= ' '
-			END
-		END;
-		IF (name = "ObjectFileExtension") & (val = "") THEN  
-			val := DefaultObjectFileExtension
-		END;
-	END GetConfig;
-
-
-	(** 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;
-	
-
-	(* function returning the number of processors that are available to Aos *)
-	PROCEDURE NumberOfProcessors*( ): LONGINT;
-	VAR res: WORD;
-	BEGIN
-		res := Unix.getnprocs();
-		RETURN res;
-	END NumberOfProcessors;
-
-	(*! non portable code, for native Aos only *)
-	PROCEDURE SetNumberOfProcessors*( num: LONGINT );
-	BEGIN
-		(* numberOfProcessors := num; *)
-	END SetNumberOfProcessors;
-
-	(* function for changing byte order *)
-	PROCEDURE ChangeByteOrder* (n: LONGINT): LONGINT;
-	CODE {SYSTEM.AMD64}
-		MOV EAX, [RBP + n]				; load n in eax
-		BSWAP EAX						; swap byte order
-	END ChangeByteOrder;
-
-
-	(* Send and print character *)
-	PROCEDURE TraceChar *(c: CHAR);
-	BEGIN
-		Trace.Char( c )
-	END TraceChar;
-
-
-	(** CPU identification *)
-
-	PROCEDURE CPUID*( VAR vendor: Vendor;  VAR version: LONGINT;  VAR features1,features2: SET );
-	CODE {SYSTEM.AMD64}
-		MOV	EAX, 0
-		CPUID
-		CMP	EAX, 0
-		JNE	ok
-		MOV	RSI, [RBP+vendor]
-		MOV	[RSI], AL	;  AL = 0
-		MOV	RSI, [RBP+version]
-		MOV	[RSI], EAX	;  EAX = 0
-		MOV	RSI, [RBP+features1]
-		MOV	[RSI], EAX
-		MOV	RSI, [RBP+features2]
-		MOV	[RSI], EAX
-		JMP	end
-	ok:
-		MOV	RSI, [RBP+vendor]
-		MOV	[RSI], EBX
-		MOV	[RSI+4], EDX
-		MOV	[RSI+8], ECX
-		MOV	BYTE [RSI+12], 0
-		MOV	EAX, 1
-		CPUID
-		MOV	RSI, [RBP+version]
-		MOV	[RSI], EAX
-		MOV	RSI, [RBP+features1]
-		MOV	[RSI], EDX
-		MOV	RSI, [RBP+features2]
-		MOV	[RSI], ECX
-	end:
-	END CPUID;
-	
-
-	(* If the CPUID instruction is supported, the ID flag (bit 21) of the EFLAGS register is r/w *)
-	PROCEDURE CpuIdSupported( ) : BOOLEAN;
-	CODE {SYSTEM.AMD64}
-		PUSHFQ					; save RFLAGS
-		POP RAX				; store RFLAGS in RAX
-		MOV EBX, EAX			; save EBX for later testing
-		XOR EAX, 00200000H	; toggle bit 21
-		PUSH RAX				; push to stack
-		POPFQ					; save changed RAX to RFLAGS
-		PUSHFQ					; push RFLAGS to TOS
-		POP RAX				; store RFLAGS in RAX
-		CMP EAX, EBX			; see if bit 21 has changed
-		SETNE AL;				; return TRUE if bit 21 has changed, FALSE otherwise
-	END CpuIdSupported;
-
-	
-	(* 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 and Unix, not allowed *)
-		END;
-	END SetupSSE2Ext;
-	
-
-	(** -- Processor initialization -- *)
-	PROCEDURE -SetFCR( s: SET );
-	CODE {SYSTEM.AMD64, SYSTEM.FPU}
-		FLDCW WORD [RSP]	; parameter s
-		POP RAX
-	END SetFCR;
-
-	PROCEDURE -FCR( ): SET;
-	CODE {SYSTEM.AMD64, SYSTEM.FPU}
-		PUSH 0
-		FNSTCW WORD [RSP]
-		FWAIT
-		POP RAX
-	END FCR;
-
-	PROCEDURE -InitFPU;
-	CODE {SYSTEM.AMD64, SYSTEM.FPU}
-		FNINIT
-	END InitFPU;
-
-	(** Setup FPU control word of current processor. *)
-	PROCEDURE SetupFPU*;
-	BEGIN
-		InitFPU;  SetFCR( fcr )
-	END SetupFPU;
-
-
-	(* Initialize locks. *)
-	PROCEDURE InitLocks;  
-	VAR i: LONGINT; 
-	BEGIN 
-		i := 0;  
-		WHILE i < MaxLocks DO  mtx[i] := Unix.NewMtx( );  INC( i )  END;   
-	END InitLocks;  
-
-	PROCEDURE CleanupLocks*;  
-	VAR i: LONGINT;  
-	BEGIN 
-		i := 0;  
-		WHILE i < MaxLocks DO  Unix.MtxDestroy( mtx[i] );  INC( i ) END;  	
-	END CleanupLocks;  
-	
-	(** Acquire a spin-lock. *)
-	PROCEDURE  Acquire*( level: LONGINT );   (* non reentrant lock *)
-	BEGIN 
-		Unix.MtxLock( mtx[level] );
-	END Acquire;  
-
-	(** Release a spin-lock. *)
-	PROCEDURE  Release*( level: LONGINT );   
-	BEGIN 
-		Unix.MtxUnlock( mtx[level] );
-	END Release;  
-	
-	
-	PROCEDURE Shutdown*( reboot: BOOLEAN );
-	VAR r: LONGINT;  logstat: Unix.Status;
-	BEGIN
-		IF logfile > 0 THEN
-			r := Unix.fstat( logfile, logstat );
-			r := Unix.close( logfile );
-			IF logstat.size = 0 THEN  r := Unix.unlink( ADDRESSOF( logname) )  END;
-		END;
-		IF reboot THEN  Unix.exit( 0 )  ELSE  Unix.exit( 1 )  END;
-	END Shutdown;
-		
-
-		
-
-	(* Set machine-dependent parameter gcThreshold *)
-	PROCEDURE SetGCParams*;
-	BEGIN
-		gcThreshold := 10*1024*1024; (* 10 MB *)
-	END SetGCParams;
-
-	PROCEDURE InitConfig;
-	VAR a: ADDRESS;  i: LONGINT;  c: CHAR;
-	BEGIN
-		a := Unix.getenv( ADDRESSOF( "AOSCONFIG" ) );
-		IF a = 0 THEN  config := DefaultConfig
-		ELSE
-			REPEAT
-				S.GET( a, c );  INC( a );  config[i] := c;  INC( i )
-			UNTIL c = 0X
-		END
-	END InitConfig;
-	
-	
-	PROCEDURE UpdateTicks*;
-	BEGIN
-		ticks := SHORT( (GetTimer() - timer0) DIV (mhz * 1000) );
-	END UpdateTicks;
-	
-	
-	PROCEDURE InitThreads;
-	VAR res: BOOLEAN; 
-	BEGIN
-		res := Unix.ThrInitialize( prioLow, prioHigh );
-		IF ~res THEN
-			Trace.StringLn( "Machine.InitThreads: no threads support in boot environment.  teminating" ); 
-			Unix.exit( 1 )
-		END;
-		IF Glue.debug # {} THEN
-			Trace.String( "Threads initialized, priorities low, high: " ); 
-			Trace.Int( prioLow, 0 ); Trace.String( ", " ); Trace.Int( prioHigh, 0 );
-			Trace.Ln
-		END
-	END InitThreads;
-	
-	PROCEDURE CPUSpeed;
-	VAR t0, t1: HUGEINT; 
-	BEGIN
-		t0 := GetTimer();  Unix.ThrSleep( 100 );  t1 := GetTimer();
-		mhz := (t1 - t0) DIV 100000;
-		IF Glue.debug # {} THEN
-			Trace.String( "CPU speed: ~" );  Trace.Int( SHORT( mhz ), 0);  Trace.String( " MHz" );  Trace.Ln
-		END
-	END CPUSpeed;
-	
-	PROCEDURE Log( c: CHAR );
-	VAR ignore: SIZE;
-	BEGIN
-		ignore := Unix.write( 1, ADDRESSOF( c ), 1 );
-		ignore := Unix.write( logfile, ADDRESSOF( c ), 1 );
-	END Log;
-	
-	PROCEDURE LogFileOnly( c: CHAR );
-	VAR ignore: SIZE;
-	BEGIN
-		ignore := Unix.write( logfile, ADDRESSOF( c ), 1 );
-	END LogFileOnly;
-	
-	
-	PROCEDURE InitLog;
-	VAR pid, i: LONGINT; 
-	BEGIN
-		IF logfile > 0 THEN RETURN END;
-		logname := "AOS.xxxxx.Log";
-		pid := Unix.getpid();  i := 8;
-		REPEAT
-			logname[i] := CHR( pid MOD 10 + ORD( '0' ) );  DEC( i );
-			pid := pid DIV 10;		
-		UNTIL i = 3;
-		logfile := Unix.open( ADDRESSOF( logname ), Unix.rdwr + Unix.creat + Unix.trunc, Unix.rwrwr );
-	END InitLog;
-	
-	PROCEDURE SilentLog*;
-	BEGIN
-		InitLog;
-		Trace.Char := LogFileOnly
-	END SilentLog;
-	
-	PROCEDURE VerboseLog*;
-	BEGIN
-		InitLog;
-		Trace.Char := Log
-	END VerboseLog;
-
-	
-	PROCEDURE Append( VAR a: ARRAY OF CHAR; CONST this: ARRAY OF CHAR );
-	VAR i, j: LONGINT;
-	BEGIN
-		i := 0;  j := 0;  
-		WHILE a[i] # 0X DO  INC( i )  END;
-		WHILE (i < LEN( a ) - 1) & (this[j] # 0X) DO a[i] := this[j];  INC( i );  INC( j )  END;
-		a[i] := 0X
-	END Append;
-	
-
-	PROCEDURE Init;
-	VAR vendor: Vendor; ver: LONGINT;
-	BEGIN		
-		COPY( Unix.Version, version );  Append( version, Version ); Append(version, S.Date);
-		
-		timer0 := GetTimer( );  ticks := 0;
-		InitThreads;
-		InitLocks;
-		traceHeap := 1 IN Glue.debug;
-		InitConfig;
-		CPUSpeed;
-		IF CpuIdSupported() THEN
-			CPUID( vendor, ver, features, features2 );	 SetupSSE2Ext
-		END;
-		fcr := (FCR() - {0,2,3,10,11}) + {0..5,8,9};	(* default FCR RC=00B *)
-	END Init;
-
-	PROCEDURE {INITIAL} Init0*;
-	BEGIN
-		Init;
-	END Init0;
-	
-END Machine.
-
-(*
-03.03.1998	pjm	First version
-30.06.1999	pjm	ProcessorID moved to AosProcessor
-*)
-
-(**
-Notes
-
-This module defines an interface to the boot environment of the system. The facilities provided here are only intended for the lowest levels of the system, and should never be directly imported by user modules (exceptions are noted below). They are highly specific to the system hardware and firmware architecture.
-
-Typically a machine has some type of firmware that performs initial testing and setup of the system. The firmware initiates the operating system bootstrap loader, which loads the boot file. This module is the first module in the statically linked boot file that gets control.
-
-There are two more-or-less general procedures in this module: GetConfig and StrToInt. GetConfig is used to query low-level system settings, e.g., the location of the boot file system. StrToInt is a utility procedure that parses numeric strings.
-
-Config strings:
-
-ExtMemSize	Specifies size of extended memory (above 1MB) in MB. This value is not checked for validity. Setting it false may cause the system to fail, possible after running for some time. The memory size is usually detected automatically, but if the detection does not work for some reason, or if you want to limit the amount of memory detected, this string can be set. For example, if the machine has 64MB of memory, this value can be set as ExtMemSize="63".
-*)
-

+ 79 - 0
source/Unix.Environment.Mod

@@ -0,0 +1,79 @@
+(* Runtime environment for Unix *)
+(* Copyright (C) Florian Negele *)
+
+MODULE Environment;
+
+IMPORT SYSTEM, Activities, Counters, Unix, Processors, Queues, Timer, Trace;
+
+CONST IsNative* = FALSE;
+
+CONST Running* = 0; ShuttingDown* = 1; Rebooting* = 2;
+
+VAR status* := 0: WORD;
+VAR clock: Timer.Counter;
+VAR milliseconds: Timer.Counter;
+VAR sleepingQueue: Queues.Queue;
+
+PROCEDURE {NORETURN} Abort-;
+BEGIN {UNCOOPERATIVE, UNCHECKED}
+	IF Activities.GetCurrentActivity () # NIL THEN Activities.TerminateCurrentActivity END;
+	Exit (1);
+END Abort;
+
+PROCEDURE Shutdown*;
+BEGIN {UNCOOPERATIVE, UNCHECKED}
+	Trace.StringLn ("system: shutting down...");
+	Trace.StringLn ("system: shutting down...");
+END Shutdown;
+
+PROCEDURE Reboot*;
+BEGIN {UNCOOPERATIVE, UNCHECKED}
+	Shutdown;
+	ASSERT (CAS (status, ShuttingDown, Rebooting) = ShuttingDown);
+END Reboot;
+
+PROCEDURE {NORETURN} Exit- (status: WORD);
+BEGIN {UNCOOPERATIVE, UNCHECKED}
+	Unix.exit (status);
+END Exit;
+
+PROCEDURE Clock- (): LONGINT;
+BEGIN {UNCOOPERATIVE, UNCHECKED}
+	RETURN LONGINT ((Timer.GetCounter () - clock) / milliseconds);
+END Clock;
+
+PROCEDURE Sleep- (milliseconds: LONGINT);
+VAR nextActivity: Activities.Activity;
+BEGIN {UNCOOPERATIVE, UNCHECKED}
+	INC (milliseconds, Clock ());
+	Counters.Inc (Activities.awaiting);
+	WHILE Clock () - milliseconds < 0 DO
+		IF Activities.Select (nextActivity, Activities.IdlePriority) THEN
+			Activities.SwitchTo (nextActivity, Enqueue, NIL);
+			Activities.FinalizeSwitch;
+		END;
+	END;
+	Counters.Dec (Activities.awaiting);
+END Sleep;
+
+PROCEDURE Enqueue (previous {UNTRACED}: Activities.Activity; argument: ADDRESS);
+VAR item: Queues.Item;
+BEGIN {UNCOOPERATIVE, UNCHECKED}
+	Queues.Enqueue (previous, sleepingQueue);
+END Enqueue;
+
+PROCEDURE GetInit- (n: SIZE; VAR val: LONGINT);
+BEGIN val := 0;
+END GetInit;
+
+PROCEDURE Initialize-;
+BEGIN {UNCOOPERATIVE, UNCHECKED}
+	clock := Timer.GetCounter ();
+	milliseconds := Timer.GetFrequency () DIV 1000;
+END Initialize;
+
+PROCEDURE Terminate-;
+BEGIN {UNCOOPERATIVE, UNCHECKED}
+END Terminate;
+
+END Environment.

+ 272 - 64
source/Unix.I386.Machine.Mod → source/Unix.Machine.Mod

@@ -4,10 +4,14 @@ IMPORT S := SYSTEM, Trace, Unix, Glue;
 
 
 CONST
 CONST
 	DefaultConfig = "Color 0  StackSize 128";
 	DefaultConfig = "Color 0  StackSize 128";
-	
-	Version = "A2 Gen. 32-bit, ";
 
 
-	DefaultObjectFileExtension* = ".GofU";
+	#IF I386 THEN
+		Version = "A2 Gen. 32-bit, ";
+		DefaultObjectFileExtension* = ".GofU";
+	#ELSIF AMD64 THEN
+		Version = "A2 Gen. 64-bit, ";
+		DefaultObjectFileExtension* = ".GofUu";
+	#END
 	
 	
 	Second* = 1000; (* frequency of ticks increments in Hz *)
 	Second* = 1000; (* frequency of ticks increments in Hz *)
 
 
@@ -263,7 +267,8 @@ VAR
 
 
 	(** Fill "size" bytes at "destAdr" with "filler". "size" must be multiple of 4. *)
 	(** Fill "size" bytes at "destAdr" with "filler". "size" must be multiple of 4. *)
 	PROCEDURE  Fill32* (destAdr: ADDRESS; size: SIZE; filler: LONGINT);
 	PROCEDURE  Fill32* (destAdr: ADDRESS; size: SIZE; filler: LONGINT);
-	CODE {SYSTEM.i386}
+	CODE
+	#IF I386 THEN
 		MOV EDI, [EBP+destAdr]
 		MOV EDI, [EBP+destAdr]
 		MOV ECX, [EBP+size]
 		MOV ECX, [EBP+size]
 		MOV EAX, [EBP+filler]
 		MOV EAX, [EBP+filler]
@@ -275,6 +280,21 @@ VAR
 		SHR ECX, 2
 		SHR ECX, 2
 		CLD
 		CLD
 		REP STOSD
 		REP STOSD
+	#ELSIF AMD64 THEN
+		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
+	#ELSE
+		unimpemented
+	#END
 	END Fill32;
 	END Fill32;
 
 
 PROCEDURE  Portin8*(port: LONGINT; VAR val: CHAR);
 PROCEDURE  Portin8*(port: LONGINT; VAR val: CHAR);
@@ -300,142 +320,249 @@ END Portout32;
 
 
 (** Atomic INC(x). *)
 (** Atomic INC(x). *)
 PROCEDURE -AtomicInc*(VAR x: LONGINT);
 PROCEDURE -AtomicInc*(VAR x: LONGINT);
-CODE {SYSTEM.i386}
+CODE
+#IF I386 THEN
 	POP EAX
 	POP EAX
 	LOCK
 	LOCK
 	INC DWORD [EAX]
 	INC DWORD [EAX]
+#ELSIF AMD64 THEN
+	POP RAX
+	LOCK
+	INC DWORD [RAX]
+#ELSE
+	unimplemented
+#END
 END AtomicInc;
 END AtomicInc;
 
 
 (** Atomic DEC(x). *)
 (** Atomic DEC(x). *)
 PROCEDURE -AtomicDec*(VAR x: LONGINT);
 PROCEDURE -AtomicDec*(VAR x: LONGINT);
-CODE {SYSTEM.i386}
+CODE
+#IF I386 THEN
 	POP EAX
 	POP EAX
 	LOCK
 	LOCK
 	DEC DWORD [EAX]
 	DEC DWORD [EAX]
+#ELSIF AMD64 THEN
+	POP RAX
+	LOCK
+	DEC DWORD [RAX]
+#ELSE
+	unimplemented
+#END
 END AtomicDec;
 END AtomicDec;
 
 
 (** Atomic INC(x, y). *)
 (** Atomic INC(x, y). *)
 PROCEDURE -AtomicAdd*(VAR x: LONGINT; y: LONGINT);
 PROCEDURE -AtomicAdd*(VAR x: LONGINT; y: LONGINT);
-CODE {SYSTEM.i386}
+CODE
+#IF I386 THEN
 	POP EBX
 	POP EBX
 	POP EAX
 	POP EAX
 	LOCK
 	LOCK
 	ADD DWORD [EAX], EBX
 	ADD DWORD [EAX], EBX
+#ELSIF AMD64 THEN
+	POP EBX
+	POP RAX
+	LOCK
+	ADD DWORD [RAX], EBX
+#ELSE
+	unimplemented
+#END
 END AtomicAdd;
 END AtomicAdd;
 
 
 
 
 (** Atomic EXCL. *)
 (** Atomic EXCL. *)
 PROCEDURE AtomicExcl* (VAR s: SET; bit: LONGINT);
 PROCEDURE AtomicExcl* (VAR s: SET; bit: LONGINT);
-CODE {SYSTEM.i386}
+CODE
+#IF I386 THEN
 	MOV EAX, [EBP+bit]
 	MOV EAX, [EBP+bit]
 	MOV EBX, [EBP+s]
 	MOV EBX, [EBP+s]
 	LOCK
 	LOCK
 	BTR [EBX], EAX
 	BTR [EBX], EAX
+#ELSIF AMD64 THEN
+	MOV EAX, [RBP + bit]
+	MOV RBX, [RBP + s]
+	LOCK
+	BTR [RBX], EAX
+#ELSE
+	unimplemented
+#END
 END AtomicExcl;
 END AtomicExcl;
 
 
 
 
 (** Atomic test-and-set. Set x = TRUE and return old value of x. *)
 (** Atomic test-and-set. Set x = TRUE and return old value of x. *)
 PROCEDURE -AtomicTestSet*(VAR x: BOOLEAN): BOOLEAN;
 PROCEDURE -AtomicTestSet*(VAR x: BOOLEAN): BOOLEAN;
-CODE {SYSTEM.i386}
+CODE
+#IF I386 THEN
 	POP EBX
 	POP EBX
 	MOV AL, 1
 	MOV AL, 1
 	XCHG [EBX], AL
 	XCHG [EBX], AL
+#ELSIF AMD64 THEN
+	POP RBX
+	MOV AL, 1
+	XCHG [RBX], AL
+#ELSE
+	unimplemented
+#END
 END AtomicTestSet;
 END AtomicTestSet;
 
 
 (* Atomic compare-and-swap. Set x = new if x = old and return old value of x *)
 (* 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;
 PROCEDURE  -AtomicCAS* (VAR x: LONGINT; old, new: LONGINT): LONGINT;
-CODE {SYSTEM.i386}
+CODE
+#IF I386 THEN
 	POP EBX		; new
 	POP EBX		; new
 	POP EAX		; old
 	POP EAX		; old
 	POP ECX		; address of x
 	POP ECX		; address of x
-	DB 0F0X, 00FX, 0B1X, 019X	; LOCK CMPXCHG [ECX], EBX; atomicly compare x with old and set it to new if equal
+	LOCK CMPXCHG [ECX], EBX; atomicly compare x with old and set it to new if equal
+#ELSIF AMD64 THEN
+	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
+#ELSE
+	unimplemented
+#END
 END AtomicCAS;
 END AtomicCAS;
 
 
 
 
 (* Return current instruction pointer *)
 (* Return current instruction pointer *)
 PROCEDURE  CurrentPC* (): ADDRESS;
 PROCEDURE  CurrentPC* (): ADDRESS;
-CODE {SYSTEM.i386}
+CODE
+#IF I386 THEN
 	MOV EAX, [EBP+4]
 	MOV EAX, [EBP+4]
+#ELSIF AMD64 THEN
+	MOV RAX, [RBP + 8]
+#ELSE
+	unimplemented
+#END
 END CurrentPC;
 END CurrentPC;
 
 
 (* Return current frame pointer *)
 (* Return current frame pointer *)
 PROCEDURE  -CurrentBP* (): ADDRESS;
 PROCEDURE  -CurrentBP* (): ADDRESS;
-CODE {SYSTEM.i386}
+CODE
+#IF I386 THEN
 	MOV EAX, EBP
 	MOV EAX, EBP
+#ELSIF AMD64 THEN
+	MOV RAX, RBP
+#ELSE
+	unimplemented
+#END
 END CurrentBP;
 END CurrentBP;
 
 
 (* Set current frame pointer *)
 (* Set current frame pointer *)
 PROCEDURE  -SetBP* (bp: ADDRESS);
 PROCEDURE  -SetBP* (bp: ADDRESS);
-CODE {SYSTEM.i386}
+CODE
+#IF I386 THEN
 	POP EBP
 	POP EBP
+#ELSIF AMD64 THEN
+	POP RBP
+#ELSE
+	unimplemented
+#END
 END SetBP;
 END SetBP;
 
 
 (* Return current stack pointer *)
 (* Return current stack pointer *)
 PROCEDURE  -CurrentSP* (): ADDRESS;
 PROCEDURE  -CurrentSP* (): ADDRESS;
-CODE {SYSTEM.i386}
+CODE
+#IF I386 THEN
 	MOV EAX, ESP
 	MOV EAX, ESP
+#ELSIF AMD64 THEN
+	MOV RAX, RSP
+#ELSE
+	unimplemented
+#END
 END CurrentSP;
 END CurrentSP;
 
 
 (* Set current stack pointer *)
 (* Set current stack pointer *)
 PROCEDURE  -SetSP* (sp: ADDRESS);
 PROCEDURE  -SetSP* (sp: ADDRESS);
-CODE {SYSTEM.i386}
+CODE
+#IF I386 THEN
 	POP ESP
 	POP ESP
+#ELSIF AMD64 THEN
+	POP RSP
+#ELSE
+	unimplemented
+#END
 END SetSP;
 END SetSP;
 
 
-PROCEDURE  -GetEAX*(): LONGINT;
-CODE{SYSTEM.i386}
-END GetEAX;
+#IF I386 THEN
 
 
-PROCEDURE  -GetECX*(): LONGINT;
-CODE{SYSTEM.i386}
-	MOV EAX,ECX	
-END GetECX;
+	PROCEDURE -GetEAX*(): LONGINT;
+	CODE
+	END GetEAX;
 
 
-PROCEDURE  -GetESI*(): LONGINT;
-CODE{SYSTEM.i386}
-	MOV EAX,ESI	
-END GetESI;
+	PROCEDURE -GetECX*(): LONGINT;
+	CODE MOV EAX,ECX
+	END GetECX;
 
 
-PROCEDURE  -GetEDI*(): LONGINT;
-CODE{SYSTEM.i386}
-	MOV EAX,EDI	
-END GetEDI;
+	PROCEDURE -SetEAX*(n: LONGINT);
+	CODE POP EAX
+	END SetEAX;
 
 
+	PROCEDURE -SetEBX*(n: LONGINT);
+	CODE POP EBX
+	END SetEBX;
 
 
-PROCEDURE  -SetEAX*(n: LONGINT);
-CODE{SYSTEM.i386}	
-	POP EAX
-END SetEAX;
+	PROCEDURE -SetECX*(n: LONGINT);
+	CODE POP ECX
+	END SetECX;
 
 
-PROCEDURE  -SetEBX*(n: LONGINT);
-CODE{SYSTEM.i386}
-	POP EBX
-END SetEBX;
+	PROCEDURE -SetEDX*(n: LONGINT);
+	CODE POP EDX
+	END SetEDX;
+
+	PROCEDURE -SetESI*(n: LONGINT);
+	CODE POP ESI
+	END SetESI;
+
+	PROCEDURE -SetEDI*(n: LONGINT);
+	CODE POP EDI
+	END SetEDI;
 
 
-PROCEDURE  -SetECX*(n: LONGINT);
-CODE{SYSTEM.i386}
-	POP ECX
-END SetECX;
+#ELSIF AMD64 THEN
 
 
-PROCEDURE  -SetEDX*(n: LONGINT);
-CODE{SYSTEM.i386}
-	POP EDX
-END SetEDX;
+	PROCEDURE -GetRAX*(): HUGEINT;
+	CODE
+	END GetRAX;
 
 
-PROCEDURE  -SetESI*(n: LONGINT);
-CODE{SYSTEM.i386}
-	POP ESI
-END SetESI;
+	PROCEDURE -GetRCX*(): HUGEINT;
+	CODE MOV RAX, RCX
+	END GetRCX;
 
 
-PROCEDURE  -SetEDI*(n: LONGINT);
-CODE{SYSTEM.i386}
-	POP EDI
-END SetEDI;
+	PROCEDURE -SetRAX*(n: HUGEINT);
+	CODE POP RAX
+	END SetRAX;
 
 
+	PROCEDURE -SetRBX*(n: HUGEINT);
+	CODE POP RBX
+	END SetRBX;
+
+	PROCEDURE -SetRCX*(n: HUGEINT);
+	CODE POP RCX
+	END SetRCX;
+
+	PROCEDURE -SetRDX*(n: HUGEINT);
+	CODE POP RDX
+	END SetRDX;
+
+	PROCEDURE -SetRSI*(n: HUGEINT);
+	CODE POP RSI
+	END SetRSI;
+
+	PROCEDURE -SetRDI*(n: HUGEINT);
+	CODE POP EDI
+	END SetRDI;
+
+#END
 
 
 PROCEDURE -GetTimer* (): HUGEINT;
 PROCEDURE -GetTimer* (): HUGEINT;
-CODE {SYSTEM.Pentium}
+CODE
+#IF I386 THEN
 	RDTSC	; set EDX:EAX
 	RDTSC	; set EDX:EAX
+#ELSIF AMD64 THEN
+	XOR RAX, RAX
+	RDTSC	; set EDX:EAX
+	SHL RDX, 32
+	OR RAX, RDX
+#END
 END GetTimer;
 END GetTimer;
 
 
 
 
@@ -519,9 +646,16 @@ END GetTimer;
 
 
 	(* function for changing byte order *)
 	(* function for changing byte order *)
 	PROCEDURE ChangeByteOrder* (n: LONGINT): LONGINT;
 	PROCEDURE ChangeByteOrder* (n: LONGINT): LONGINT;
-	CODE { SYSTEM.i486 }
+	CODE
+	#IF I386 THEN
 		MOV EAX, [EBP+n]				; load n in eax
 		MOV EAX, [EBP+n]				; load n in eax
 		BSWAP EAX						; swap byte order
 		BSWAP EAX						; swap byte order
+	#ELSIF AMD64 THEN
+		MOV EAX, [RBP+n]				; load n in eax
+		BSWAP EAX						; swap byte order
+	#ELSE
+		unimplemented
+	#END
 	END ChangeByteOrder;
 	END ChangeByteOrder;
 
 
 
 
@@ -535,7 +669,9 @@ END GetTimer;
 	(** CPU identification *)
 	(** CPU identification *)
 
 
 	PROCEDURE CPUID*( VAR vendor: Vendor;  VAR version: LONGINT;  VAR features1,features2: SET );
 	PROCEDURE CPUID*( VAR vendor: Vendor;  VAR version: LONGINT;  VAR features1,features2: SET );
-	CODE {SYSTEM.i386, SYSTEM.Pentium}
+	CODE
+	#IF I386 THEN
+		PUSH	ECX
 		MOV	EAX, 0
 		MOV	EAX, 0
 		CPUID
 		CPUID
 		CMP	EAX, 0
 		CMP	EAX, 0
@@ -549,7 +685,7 @@ END GetTimer;
 		MOV	ESI, [EBP+features2]
 		MOV	ESI, [EBP+features2]
 		MOV	[ESI], EAX
 		MOV	[ESI], EAX
 		JMP	end
 		JMP	end
-	ok:
+		ok:
 		MOV	ESI, [EBP+vendor]
 		MOV	ESI, [EBP+vendor]
 		MOV	[ESI], EBX
 		MOV	[ESI], EBX
 		MOV	[ESI+4], EDX
 		MOV	[ESI+4], EDX
@@ -563,13 +699,49 @@ END GetTimer;
 		MOV	[ESI], EDX
 		MOV	[ESI], EDX
 		MOV	ESI, [EBP+features2]
 		MOV	ESI, [EBP+features2]
 		MOV	[ESI], ECX
 		MOV	[ESI], ECX
-	end:
+		end:
+		POP	ECX
+	#ELSIF AMD64 THEN
+		PUSH	RCX
+		MOV	EAX, 0
+		CPUID
+		CMP	EAX, 0
+		JNE	ok
+		MOV	RSI, [RBP+vendor]
+		MOV	[RSI], AL	;  AL = 0
+		MOV	RSI, [RBP+version]
+		MOV	[RSI], EAX	;  EAX = 0
+		MOV	RSI, [RBP+features1]
+		MOV	[RSI], EAX
+		MOV	RSI, [RBP+features2]
+		MOV	[RSI], EAX
+		JMP	end
+		ok:
+		MOV	RSI, [RBP+vendor]
+		MOV	[RSI], EBX
+		MOV	[RSI+4], EDX
+		MOV	[RSI+8], ECX
+		MOV	BYTE [RSI+12], 0
+		MOV	EAX, 1
+		CPUID
+		MOV	RSI, [RBP+version]
+		MOV	[RSI], EAX
+		MOV	RSI, [RBP+features1]
+		MOV	[RSI], EDX
+		MOV	RSI, [RBP+features2]
+		MOV	[RSI], RCX
+		end:
+		POP	RCX
+	#ELSE
+		unimplemented
+	#END
 	END CPUID;
 	END CPUID;
 	
 	
 
 
 	(* If the CPUID instruction is supported, the ID flag (bit 21) of the EFLAGS register is r/w *)
 	(* If the CPUID instruction is supported, the ID flag (bit 21) of the EFLAGS register is r/w *)
 	PROCEDURE CpuIdSupported( ) : BOOLEAN;
 	PROCEDURE CpuIdSupported( ) : BOOLEAN;
-	CODE {SYSTEM.i386}	
+	CODE
+	#IF I386 THEN
 		PUSHFD				; save EFLAGS
 		PUSHFD				; save EFLAGS
 		POP EAX				; store EFLAGS in EAX
 		POP EAX				; store EFLAGS in EAX
 		MOV EBX, EAX		; save EBX for later testing
 		MOV EBX, EAX		; save EBX for later testing
@@ -580,6 +752,20 @@ END GetTimer;
 		POP EAX				; store EFLAGS in EAX
 		POP EAX				; store EFLAGS in EAX
 		CMP EAX, EBX		; see if bit 21 has changed
 		CMP EAX, EBX		; see if bit 21 has changed
 		SETNE AL;			; return TRUE if bit 21 has changed, FALSE otherwise
 		SETNE AL;			; return TRUE if bit 21 has changed, FALSE otherwise
+	#ELSIF AMD64 THEN
+		PUSHFQ				; save RFLAGS
+		POP RAX				; store RFLAGS in EAX
+		MOV RBX, RAX		; save RBX for later testing
+		XOR RAX, 00200000H	; toggle bit 21
+		PUSH RAX				; push to stack
+		POPFQ					; save changed EAX to EFLAGS
+		PUSHFQ				; push EFLAGS to TOS
+		POP RAX				; store EFLAGS in EAX
+		CMP RAX, RBX		; see if bit 21 has changed
+		SETNE AL;			; return TRUE if bit 21 has changed, FALSE otherwise
+	#ELSE
+		unimplemented
+	#END
 	END CpuIdSupported;
 	END CpuIdSupported;
 
 
 	
 	
@@ -616,22 +802,44 @@ END GetTimer;
 
 
 	(** -- Processor initialization -- *)
 	(** -- Processor initialization -- *)
 	PROCEDURE -SetFCR( s: SET );
 	PROCEDURE -SetFCR( s: SET );
-	CODE {SYSTEM.i386, SYSTEM.FPU}
+	CODE
+	#IF I386 THEN
 		FLDCW	[ESP]	;  parameter s
 		FLDCW	[ESP]	;  parameter s
 		POP	EAX
 		POP	EAX
+	#ELSIF AMD64 THEN
+		FLDCW	WORD [RSP]	; parameter s
+		POP	RAX
+	#ELSE
+		unimplemented
+	#END
 	END SetFCR;
 	END SetFCR;
 
 
 	PROCEDURE -FCR( ): SET;
 	PROCEDURE -FCR( ): SET;
-	CODE {SYSTEM.i386, SYSTEM.FPU}
+	CODE
+	#IF I386 THEN
 		PUSH	0
 		PUSH	0
 		FNSTCW	[ESP]
 		FNSTCW	[ESP]
 		FWAIT
 		FWAIT
 		POP	EAX
 		POP	EAX
+	#ELSIF AMD64 THEN
+		PUSH	0
+		FNSTCW	WORD [RSP]
+		FWAIT
+		POP	RAX
+	#ELSE
+		unimplemented
+	#END
 	END FCR;
 	END FCR;
 
 
 	PROCEDURE -InitFPU;
 	PROCEDURE -InitFPU;
-	CODE {SYSTEM.i386, SYSTEM.FPU}
+	CODE
+	#IF I386 THEN
+		FNINIT
+	#ELSIF AMD64 THEN
 		FNINIT
 		FNINIT
+	#ELSE
+		unimplemented
+	#END
 	END InitFPU;
 	END InitFPU;
 
 
 	(** Setup FPU control word of current processor. *)
 	(** Setup FPU control word of current processor. *)

+ 0 - 9
source/Unix.Objects.Mod

@@ -44,7 +44,6 @@ VAR
 	timerStopped: BOOLEAN;
 	timerStopped: BOOLEAN;
 	
 	
 	(* processes *)
 	(* processes *)
-	SystemA2Up- 	: BOOLEAN;
 	root-	: Process;	(*!  Anchor of all instantiated threads in system *)
 	root-	: Process;	(*!  Anchor of all instantiated threads in system *)
 	stacksize: LONGINT;		(* stack size of active objects, adjustable via boot parameter *)
 	stacksize: LONGINT;		(* stack size of active objects, adjustable via boot parameter *)
 	
 	
@@ -805,15 +804,8 @@ TYPE
 		the signals SIGHUP, SIGINT and SIGQUIT don't branch into SignalHandler
 		the signals SIGHUP, SIGINT and SIGQUIT don't branch into SignalHandler
 		but terminate A2 (at least in Solaris).		
 		but terminate A2 (at least in Solaris).		
 		*)
 		*)
-		SystemA2Up := TRUE;
 		LOOP Sleep( 100 ) END
 		LOOP Sleep( 100 ) END
 	END GCLoop;		
 	END GCLoop;		
-
-	(* in order to get the traps running correctly without a BootConsole *)
-	PROCEDURE SystemA2IsUp*;
-	BEGIN
-		SystemA2Up := TRUE;		
-	END SystemA2IsUp;
 			
 			
 	PROCEDURE CurrentProcessTime*(): HUGEINT;
 	PROCEDURE CurrentProcessTime*(): HUGEINT;
 	BEGIN
 	BEGIN
@@ -946,7 +938,6 @@ VAR
 	
 	
 BEGIN
 BEGIN
 	TraceProcessHook := NIL;
 	TraceProcessHook := NIL;
-	SystemA2Up := FALSE;
 	Init;
 	Init;
 END Objects.
 END Objects.
 
 

+ 1 - 5
source/Unix.Traps.Mod

@@ -107,8 +107,6 @@ VAR
 			(* ignore *) RETURN
 			(* ignore *) RETURN
 		END;
 		END;
 		
 		
-		IF ~Objects.SystemA2Up THEN  Machine.VerboseLog( )  END;
-		
 		LockTrap;
 		LockTrap;
 		
 		
 		INC( trapHandlingLevel );
 		INC( trapHandlingLevel );
@@ -192,9 +190,7 @@ VAR
 			RETURN  (*! to exception handler !! *)
 			RETURN  (*! to exception handler !! *)
 		END;
 		END;
 
 
-		IF Objects.SystemA2Up THEN  Objects.ExitTrap( )
-		ELSE  Machine.Shutdown( FALSE )
-		END
+		Objects.ExitTrap;
 	END Trap;
 	END Trap;