|
|
@@ -1,974 +0,0 @@
|
|
|
-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
|
|
|
- StaticBlockSize = 8*SIZEOF(ADDRESS); (* static heap block size *)
|
|
|
-
|
|
|
-(** 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;
|
|
|
-
|
|
|
-
|
|
|
- MemBlockSize = 32*1024*1024; (* must be multiple of StaticBlockSize *)
|
|
|
-
|
|
|
- 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 {UNSAFE, UNTRACED} TO MemoryBlockDesc;
|
|
|
- MemoryBlockDesc* = RECORD
|
|
|
- next- : 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 BIOS.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;
|
|
|
- stackBottom-: ADDRESS;
|
|
|
-
|
|
|
- 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;
|
|
|
- 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 with one parameter. *)
|
|
|
-
|
|
|
- PROCEDURE -Inc*( VAR x: LONGINT );
|
|
|
- CODE {SYSTEM.i386}
|
|
|
- POP EAX
|
|
|
- LOCK
|
|
|
- INC DWORD[EAX]
|
|
|
- END Inc;
|
|
|
-
|
|
|
-(** Atomic EXCL. *)
|
|
|
-
|
|
|
- PROCEDURE Excl*( VAR s: SET; bit: LONGINT );
|
|
|
- CODE {SYSTEM.i386}
|
|
|
- MOV EAX, [EBP+bit]
|
|
|
- MOV EBX, [EBP+s]
|
|
|
- LOCK
|
|
|
- BTR [EBX], EAX
|
|
|
- END Excl;
|
|
|
- (** -- Miscellaneous -- *)
|
|
|
-
|
|
|
-(** This procedure should be called in all spin loops as a hint to the processor (e.g. Pentium 4). *)
|
|
|
-
|
|
|
- PROCEDURE -SpinHint*;
|
|
|
- CODE {SYSTEM.i386}
|
|
|
- XOR ECX, ECX ; just in case some processor interprets REP this way
|
|
|
- REP NOP ; PAUSE instruction (* NOP on pre-P4 processors, Spin Loop Hint on P4 and after *)
|
|
|
- END SpinHint;
|
|
|
-
|
|
|
-(* Return current instruction pointer *)
|
|
|
-PROCEDURE CurrentPC* (): ADDRESS;
|
|
|
-CODE {SYSTEM.i386}
|
|
|
- MOV EAX, [EBP+4]
|
|
|
-END CurrentPC;
|
|
|
-
|
|
|
-(* Return current frame pointer *)
|
|
|
-PROCEDURE -CurrentBP* (): ADDRESS;
|
|
|
-CODE {SYSTEM.i386}
|
|
|
- MOV EAX, EBP
|
|
|
-END CurrentBP;
|
|
|
-
|
|
|
-(* Set current frame pointer *)
|
|
|
-PROCEDURE -SetBP* (bp: ADDRESS);
|
|
|
-CODE {SYSTEM.i386}
|
|
|
- POP EBP
|
|
|
-END SetBP;
|
|
|
-
|
|
|
-(* Return current stack pointer *)
|
|
|
-PROCEDURE -CurrentSP* (): ADDRESS;
|
|
|
-CODE {SYSTEM.i386}
|
|
|
- MOV EAX, ESP
|
|
|
-END CurrentSP;
|
|
|
-
|
|
|
-(* Set current stack pointer *)
|
|
|
-PROCEDURE -SetSP* (sp: ADDRESS);
|
|
|
-CODE {SYSTEM.i386}
|
|
|
- POP ESP
|
|
|
-END SetSP;
|
|
|
-
|
|
|
-(** Fill "size" bytes at "destAdr" with "filler". "size" must be multiple of 4. *)
|
|
|
-
|
|
|
- PROCEDURE Fill32*( destAdr, size, filler: LONGINT );
|
|
|
- CODE {SYSTEM.i386}
|
|
|
- MOV EDI, [EBP+destAdr]
|
|
|
- MOV ECX, [EBP+size]
|
|
|
- MOV EAX, [EBP+filler]
|
|
|
- TEST ECX, 3
|
|
|
- JZ ok
|
|
|
- PUSH 8 ; ASSERT failure
|
|
|
- INT 3
|
|
|
- ok:
|
|
|
- SHR ECX, 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);
|
|
|
- IF Kernel32.GetPrivateProfileString (ConfigKey, name, "", val, LEN (val), userConfigFile) # 0 THEN
|
|
|
- ELSIF Kernel32.GetPrivateProfileString (ConfigKey, name, "", val, LEN (val), defaultConfigFile) # 0 THEN
|
|
|
- END;
|
|
|
- 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: WORD;
|
|
|
-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);
|
|
|
- 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: WORD;
|
|
|
-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[1] := 0X; Trace.Char := LogChar; Trace.Color := TraceColor;
|
|
|
- InitLocks();
|
|
|
- Trace.String("Machine");
|
|
|
- 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);
|
|
|
- IF traceName = "File" THEN
|
|
|
- traceName := "SystemTrace.txt";
|
|
|
- SetupTraceName(traceName);
|
|
|
- SetTraceFile(traceName);
|
|
|
- ELSIF traceName = "Console" THEN SetTraceConsole
|
|
|
- (* else trace is on kernel log *)
|
|
|
- END;
|
|
|
-END Init;
|
|
|
-
|
|
|
- PROCEDURE {INITIAL, NOPAF} Start*;
|
|
|
- BEGIN
|
|
|
- stackBottom := CurrentSP();
|
|
|
- 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;
|
|
|
-
|
|
|
-(** 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;
|
|
|
-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;
|
|
|
- END;
|
|
|
- IF cur = NIL THEN
|
|
|
- memBlockTail := memBlock
|
|
|
- END
|
|
|
-END InsertMemoryBlock;
|
|
|
-
|
|
|
- (* 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,initVal: ADDRESS; continue: BOOLEAN;
|
|
|
- BEGIN
|
|
|
- ASSERT(SIZEOF(MemoryBlockDesc) <= StaticBlockSize); (* make sure MemoryBlock contents fits into one StaticBlock *)
|
|
|
- alloc := size + StaticBlockSize;
|
|
|
- IF alloc < MemBlockSize THEN alloc := MemBlockSize END;
|
|
|
- INC( alloc, (-alloc) MOD StaticBlockSize );
|
|
|
-
|
|
|
- IF memBlockTail # NIL THEN
|
|
|
- initVal := memBlockTail.startAdr + memBlockTail.size;
|
|
|
- ELSE
|
|
|
- initVal := NIL
|
|
|
- END;
|
|
|
- adr := Kernel32.VirtualAlloc(initVal, alloc, {Kernel32.MEMCommit, Kernel32.MEMReserve}, {Kernel32.PageExecuteReadWrite});
|
|
|
- IF adr = NilVal THEN (* allocation failed *)
|
|
|
- adr := Kernel32.VirtualAlloc(NilVal, alloc, {Kernel32.MEMCommit}, {Kernel32.PageExecuteReadWrite});
|
|
|
- END;
|
|
|
- continue := adr = initVal;
|
|
|
- ASSERT(adr MOD StaticBlockSize = 0); (* is fulfilled because VirtualAlloc is on page granularity *)
|
|
|
-
|
|
|
- IF adr # 0 THEN
|
|
|
-
|
|
|
- IF continue THEN
|
|
|
- memoryBlock := memBlockTail;
|
|
|
- memoryBlock.size := memoryBlock.size + alloc;
|
|
|
-
|
|
|
- beginBlockAdr := memBlockTail.endBlockAdr;
|
|
|
- endBlockAdr := beginBlockAdr;
|
|
|
- INC(endBlockAdr, alloc);
|
|
|
- ELSE
|
|
|
- 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 );
|
|
|
-
|
|
|
- memoryBlock := mBlock;
|
|
|
- END;
|
|
|
- ELSE
|
|
|
- beginBlockAdr := 0; endBlockAdr := 0; memoryBlock := NIL;
|
|
|
- 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;
|
|
|
-
|
|
|
- (** -- Atomic operations -- *)
|
|
|
-
|
|
|
-(** Atomic INC(x). *)
|
|
|
-
|
|
|
- PROCEDURE -AtomicInc*( VAR x: LONGINT );
|
|
|
- CODE {SYSTEM.i386}
|
|
|
- POP EAX
|
|
|
- LOCK
|
|
|
- INC DWORD[EAX]
|
|
|
- END AtomicInc;
|
|
|
-
|
|
|
-(** Atomic DEC(x). *)
|
|
|
-
|
|
|
- PROCEDURE -AtomicDec*( VAR x: LONGINT );
|
|
|
- CODE {SYSTEM.i386}
|
|
|
- POP EAX
|
|
|
- LOCK
|
|
|
- DEC DWORD[EAX]
|
|
|
- END AtomicDec;
|
|
|
-
|
|
|
-(** Atomic INC(x, y). *)
|
|
|
-
|
|
|
- PROCEDURE -AtomicAdd*( VAR x: LONGINT; y: LONGINT );
|
|
|
- CODE {SYSTEM.i386}
|
|
|
- POP EBX
|
|
|
- POP EAX
|
|
|
- LOCK
|
|
|
- ADD DWORD[EAX], EBX
|
|
|
- END AtomicAdd;
|
|
|
-
|
|
|
-(** Atomic test-and-set. Set x = TRUE and return old value of x. *)
|
|
|
-
|
|
|
- PROCEDURE -AtomicTestSet*( VAR x: BOOLEAN ): BOOLEAN;
|
|
|
- CODE {SYSTEM.i386}
|
|
|
- POP EBX
|
|
|
- MOV AL, 1
|
|
|
- XCHG [EBX], 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.i386}
|
|
|
- POP EBX ; new
|
|
|
- POP EAX ; old
|
|
|
- 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
|
|
|
- END AtomicCAS;
|
|
|
-
|
|
|
-(* 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);
|
|
|
-BEGIN trace[0] := c; 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.
|
felixf