From 8adc1c9b0c0c0206d849f05cae97e1e9d15fb9a9 Mon Sep 17 00:00:00 2001 From: florian Date: Sun, 3 Jul 2005 15:52:27 +0000 Subject: [PATCH] + RTL part of WinCE patches from Yuri Sidorov git-svn-id: trunk@572 - --- .gitattributes | 3 + rtl/arm/arm.inc | 2 + rtl/win/sysdir.inc | 10 + rtl/win/sysfile.inc | 4 + rtl/win/sysheap.inc | 6 +- rtl/win/sysos.inc | 58 ++- rtl/win/sysosh.inc | 9 + rtl/win/systhrd.inc | 65 +-- rtl/wince/Makefile.fpc | 241 +++++++++ rtl/wince/system.pp | 1126 ++++++++++++++++++++++++++++++++++++++++ rtl/wince/wprt0.as | 67 +++ 11 files changed, 1532 insertions(+), 59 deletions(-) create mode 100644 rtl/wince/Makefile.fpc create mode 100644 rtl/wince/system.pp create mode 100644 rtl/wince/wprt0.as diff --git a/.gitattributes b/.gitattributes index 7f423d8a10..b5fb4e045f 100644 --- a/.gitattributes +++ b/.gitattributes @@ -4176,6 +4176,9 @@ rtl/win32/wprt0_10.as -text rtl/win64/Makefile svneol=native#text/plain rtl/win64/Makefile.fpc svneol=native#text/plain rtl/win64/system.pp svneol=native#text/plain +rtl/wince/Makefile.fpc svneol=native#text/plain +rtl/wince/system.pp svneol=native#text/plain +rtl/wince/wprt0.as svneol=native#text/plain rtl/x86_64/int64p.inc svneol=native#text/plain rtl/x86_64/makefile.cpu -text rtl/x86_64/math.inc svneol=native#text/plain diff --git a/rtl/arm/arm.inc b/rtl/arm/arm.inc index c8639aa528..a40f0abc27 100644 --- a/rtl/arm/arm.inc +++ b/rtl/arm/arm.inc @@ -19,12 +19,14 @@ procedure fpc_cpuinit; begin +{$IFNDEF WINCE} asm rfs r0 and r0,r0,#0xffe0ffff orr r0,r0,#0x00020000 wfs r0 end; +{$ENDIF} end; {**************************************************************************** diff --git a/rtl/win/sysdir.inc b/rtl/win/sysdir.inc index 37d4eda150..43430a75ab 100644 --- a/rtl/win/sysdir.inc +++ b/rtl/win/sysdir.inc @@ -58,20 +58,27 @@ end; procedure chdir(const s:string);[IOCHECK]; begin +{$ifndef WINCE} If (s='') or (InOutRes <> 0) then exit; dirfn(TDirFnType(@SetCurrentDirectory),s); if Inoutres=2 then Inoutres:=3; +{$else WINCE} + InOutRes:=1; +{$endif WINCE} end; procedure GetDir (DriveNr: byte; var Dir: ShortString); +{$ifndef WINCE} const Drive:array[0..3]of char=(#0,':',#0,#0); +{$endif WINCE} var defaultdrive:boolean; DirBuf,SaveBuf:array[0..259] of Char; begin +{$ifndef WINCE} defaultdrive:=drivenr=0; if not defaultdrive then begin @@ -92,6 +99,9 @@ begin dir:=strpas(DirBuf); if not FileNameCaseSensitive then dir:=upcase(dir); +{$else WINCE} + Dir:='\'; +{$endif WINCE} end; { diff --git a/rtl/win/sysfile.inc b/rtl/win/sysfile.inc index c1e65851da..d6cc632b61 100644 --- a/rtl/win/sysfile.inc +++ b/rtl/win/sysfile.inc @@ -29,7 +29,11 @@ end; function do_isdevice(handle:thandle):boolean; begin +{$ifndef WINCE} do_isdevice:=(getfiletype(handle)=2); +{$else WINCE} + do_isdevice:=False; +{$endif WINCE} end; diff --git a/rtl/win/sysheap.inc b/rtl/win/sysheap.inc index e85a73135b..b9c4677af3 100644 --- a/rtl/win/sysheap.inc +++ b/rtl/win/sysheap.inc @@ -20,11 +20,11 @@ { memory functions } function GetProcessHeap : THandle; - stdcall;external 'kernel32' name 'GetProcessHeap'; + stdcall;external KernelDLL name 'GetProcessHeap'; function HeapAlloc(hHeap : DWord; dwFlags : DWord; dwBytes : SIZE_T) : pointer; - stdcall;external 'kernel32' name 'HeapAlloc'; + stdcall;external KernelDLL name 'HeapAlloc'; function HeapFree(hHeap : THandle; dwFlags : dword; lpMem: pointer) : boolean; - stdcall;external 'kernel32' name 'HeapFree'; + stdcall;external KernelDLL name 'HeapFree'; {$IFDEF SYSTEMDEBUG} function WinAPIHeapSize(hHeap : THandle; dwFlags : DWord; ptr : Pointer) : DWord; stdcall;external 'kernel32' name 'HeapSize'; diff --git a/rtl/win/sysos.inc b/rtl/win/sysos.inc index 3084723303..204ee55f27 100644 --- a/rtl/win/sysos.inc +++ b/rtl/win/sysos.inc @@ -171,76 +171,84 @@ threadvar { misc. functions } function GetLastError : DWORD; - stdcall;external 'kernel32' name 'GetLastError'; + stdcall;external KernelDLL name 'GetLastError'; { time and date functions } function GetTickCount : longint; - stdcall;external 'kernel32' name 'GetTickCount'; + stdcall;external KernelDLL name 'GetTickCount'; +{$ifndef WINCE} { process functions } procedure ExitProcess(uExitCode : UINT); - stdcall;external 'kernel32' name 'ExitProcess'; + stdcall;external KernelDLL name 'ExitProcess'; { Startup } procedure GetStartupInfo(p : pointer); - stdcall;external 'kernel32' name 'GetStartupInfoA'; + stdcall;external KernelDLL name 'GetStartupInfoA'; function GetStdHandle(nStdHandle:DWORD):THANDLE; - stdcall;external 'kernel32' name 'GetStdHandle'; + stdcall;external KernelDLL name 'GetStdHandle'; +{$endif WINCE} { command line/enviroment functions } function GetCommandLine : pchar; - stdcall;external 'kernel32' name 'GetCommandLineA'; + stdcall;external KernelDLL name 'GetCommandLine' + ApiSuffix; +{$ifndef WINCE} function GetCurrentProcessId:DWORD; - stdcall; external 'kernel32' name 'GetCurrentProcessId'; + stdcall; external KernelDLL name 'GetCurrentProcessId'; function Win32GetCurrentThreadId:DWORD; - stdcall; external 'kernel32' name 'GetCurrentThreadId'; + stdcall; external KernelDLL name 'GetCurrentThreadId'; +{$endif WINCE} { module functions } function GetModuleFileName(l1:longint;p:pointer;l2:longint):longint; - stdcall;external 'kernel32' name 'GetModuleFileNameA'; + stdcall;external KernelDLL name 'GetModuleFileName' + ApiSuffix; function GetModuleHandle(p : pointer) : longint; - stdcall;external 'kernel32' name 'GetModuleHandleA'; + stdcall;external KernelDLL name 'GetModuleHandle' + ApiSuffix; function GetCommandFile:pchar;forward; { file functions } function WriteFile(fh:thandle;buf:pointer;len:longint;var loaded:longint; overlap:pointer):longint; - stdcall;external 'kernel32' name 'WriteFile'; + stdcall;external KernelDLL name 'WriteFile'; function ReadFile(fh:thandle;buf:pointer;len:longint;var loaded:longint; overlap:pointer):longint; - stdcall;external 'kernel32' name 'ReadFile'; + stdcall;external KernelDLL name 'ReadFile'; function CloseHandle(h : thandle) : longint; - stdcall;external 'kernel32' name 'CloseHandle'; + stdcall;external KernelDLL name 'CloseHandle'; function DeleteFile(p : pchar) : longint; - stdcall;external 'kernel32' name 'DeleteFileA'; + stdcall;external KernelDLL name 'DeleteFile' + ApiSuffix; function MoveFile(old,_new : pchar) : longint; - stdcall;external 'kernel32' name 'MoveFileA'; + stdcall;external KernelDLL name 'MoveFile' + ApiSuffix; function SetFilePointer(l1,l2 : thandle;l3 : pointer;l4 : longint) : longint; - stdcall;external 'kernel32' name 'SetFilePointer'; + stdcall;external KernelDLL name 'SetFilePointer'; function GetFileSize(h:thandle;p:pointer) : longint; - stdcall;external 'kernel32' name 'GetFileSize'; + stdcall;external KernelDLL name 'GetFileSize'; function CreateFile(lpFileName:pchar; dwDesiredAccess:DWORD; dwShareMode:DWORD; lpSecurityAttributes:PSECURITYATTRIBUTES; dwCreationDisposition:DWORD; dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):longint; - stdcall;external 'kernel32' name 'CreateFileA'; + stdcall;external KernelDLL name 'CreateFile' + ApiSuffix; function SetEndOfFile(h : thandle) : longbool; - stdcall;external 'kernel32' name 'SetEndOfFile'; + stdcall;external KernelDLL name 'SetEndOfFile'; +{$ifndef WINCE} function GetFileType(Handle:thandle):DWord; - stdcall;external 'kernel32' name 'GetFileType'; + stdcall;external KernelDLL name 'GetFileType'; +{$endif WINCE} function GetFileAttributes(p : pchar) : dword; - stdcall;external 'kernel32' name 'GetFileAttributesA'; + stdcall;external KernelDLL name 'GetFileAttributes' + ApiSuffix; { Directory } function CreateDirectory(name : pointer;sec : pointer) : longbool; - stdcall;external 'kernel32' name 'CreateDirectoryA'; + stdcall;external KernelDLL name 'CreateDirectory' + ApiSuffix; function RemoveDirectory(name:pointer):longbool; - stdcall;external 'kernel32' name 'RemoveDirectoryA'; + stdcall;external KernelDLL name 'RemoveDirectory' + ApiSuffix; +{$ifndef WINCE} function SetCurrentDirectory(name : pointer) : longbool; - stdcall;external 'kernel32' name 'SetCurrentDirectoryA'; + stdcall;external KernelDLL name 'SetCurrentDirectory' + ApiSuffix; function GetCurrentDirectory(bufsize : longint;name : pchar) : longbool; - stdcall;external 'kernel32' name 'GetCurrentDirectoryA'; + stdcall;external KernelDLL name 'GetCurrentDirectory' + ApiSuffix; +{$endif WINCE} Procedure Errno2InOutRes; Begin diff --git a/rtl/win/sysosh.inc b/rtl/win/sysosh.inc index 6a592389f8..e22d24db8c 100644 --- a/rtl/win/sysosh.inc +++ b/rtl/win/sysosh.inc @@ -37,3 +37,12 @@ type LockSemaphore : THandle; SpinCount : ULONG_PTR; end; + +const +{$ifdef WINCE} + KernelDLL = 'coredll'; + ApiSuffix = 'W'; +{$else WINCE} + KernelDLL = 'kernel32'; + ApiSuffix = 'A'; +{$endif WINCE} diff --git a/rtl/win/systhrd.inc b/rtl/win/systhrd.inc index 112d7575c6..aa1b58b7cf 100644 --- a/rtl/win/systhrd.inc +++ b/rtl/win/systhrd.inc @@ -20,38 +20,41 @@ *****************************************************************************} const - { GlobalAlloc, GlobalFlags } - GMEM_FIXED = 0; - GMEM_ZEROINIT = 64; + { LocalAlloc flags } + LMEM_FIXED = 0; + LMEM_ZEROINIT = 64; +{$ifndef WINCE} function TlsAlloc : DWord; - stdcall;external 'kernel32' name 'TlsAlloc'; -function TlsGetValue(dwTlsIndex : DWord) : pointer; - stdcall;external 'kernel32' name 'TlsGetValue'; -function TlsSetValue(dwTlsIndex : DWord;lpTlsValue : pointer) : LongBool; - stdcall;external 'kernel32' name 'TlsSetValue'; + stdcall;external KernelDLL name 'TlsAlloc'; function TlsFree(dwTlsIndex : DWord) : LongBool; - stdcall;external 'kernel32' name 'TlsFree'; + stdcall;external KernelDLL name 'TlsFree'; +{$endif WINCE} +function TlsGetValue(dwTlsIndex : DWord) : pointer; + stdcall;external KernelDLL name 'TlsGetValue'; +function TlsSetValue(dwTlsIndex : DWord;lpTlsValue : pointer) : LongBool; + stdcall;external KernelDLL name 'TlsSetValue'; function CreateThread(lpThreadAttributes : pointer; dwStackSize : SIZE_T; lpStartAddress : pointer;lpParameter : pointer; dwCreationFlags : DWord;var lpThreadId : DWord) : THandle; - stdcall;external 'kernel32' name 'CreateThread'; + stdcall;external KernelDLL name 'CreateThread'; procedure ExitThread(dwExitCode : DWord); - stdcall;external 'kernel32' name 'ExitThread'; -function GlobalAlloc(uFlags:DWord; dwBytes:DWORD):Pointer; - stdcall;external 'kernel32' name 'GlobalAlloc'; -function GlobalFree(hMem : Pointer):Pointer; stdcall;external 'kernel32' name 'GlobalFree'; -procedure Sleep(dwMilliseconds: DWord); stdcall;external 'kernel32' name 'Sleep'; -function WinSuspendThread (threadHandle : THandle) : dword; stdcall;external 'kernel32' name 'SuspendThread'; -function WinResumeThread (threadHandle : THandle) : dword; stdcall;external 'kernel32' name 'ResumeThread'; -function TerminateThread (threadHandle : THandle; var exitCode : dword) : boolean; stdcall;external 'kernel32' name 'TerminateThread'; -function WaitForSingleObject (hHandle : THandle;Milliseconds: dword): dword; stdcall;external 'kernel32' name 'WaitForSingleObject'; -function WinThreadSetPriority (threadHandle : THandle; Prio: longint): boolean; stdcall;external 'kernel32' name 'SetThreadPriority'; -function WinThreadGetPriority (threadHandle : THandle): LongInt; stdcall;external 'kernel32' name 'GetThreadPriority'; -function WinGetCurrentThreadId : dword; stdcall;external 'kernel32' name 'GetCurrentThread'; -function CreateEvent(lpEventAttributes:pointer;bManualReset:longbool;bInitialState:longbool;lpName:pchar): THandle; stdcall; external 'kernel32' name 'CreateEventA'; -function ResetEvent(hEvent:THandle):LONGBOOL; stdcall; external 'kernel32' name 'ResetEvent'; -function SetEvent(hEvent:THandle):LONGBOOL; stdcall; external 'kernel32' name 'SetEvent'; + stdcall;external KernelDLL name 'ExitThread'; +function LocalAlloc(uFlags:DWord; dwBytes:DWORD):Pointer; + stdcall;external KernelDLL name 'LocalAlloc'; +function LocalFree(hMem : Pointer):Pointer; stdcall;external KernelDLL name 'LocalFree'; +procedure Sleep(dwMilliseconds: DWord); stdcall;external KernelDLL name 'Sleep'; +function WinSuspendThread (threadHandle : THandle) : dword; stdcall;external KernelDLL name 'SuspendThread'; +function WinResumeThread (threadHandle : THandle) : dword; stdcall;external KernelDLL name 'ResumeThread'; +function TerminateThread (threadHandle : THandle; var exitCode : dword) : boolean; stdcall;external KernelDLL name 'TerminateThread'; +function WaitForSingleObject (hHandle : THandle;Milliseconds: dword): dword; stdcall;external KernelDLL name 'WaitForSingleObject'; +function WinThreadSetPriority (threadHandle : THandle; Prio: longint): boolean; stdcall;external KernelDLL name 'SetThreadPriority'; +function WinThreadGetPriority (threadHandle : THandle): LongInt; stdcall;external KernelDLL name 'GetThreadPriority'; +function CreateEvent(lpEventAttributes:pointer;bManualReset:longbool;bInitialState:longbool;lpName:pchar): THandle; stdcall; external KernelDLL name 'CreateEvent' + ApiSuffix; +{$ifndef WINCE} +function ResetEvent(hEvent:THandle):LONGBOOL; stdcall; external KernelDLL name 'ResetEvent'; +function SetEvent(hEvent:THandle):LONGBOOL; stdcall; external KernelDLL name 'SetEvent'; +{$endif WINCE} CONST WAIT_OBJECT_0 = 0; @@ -94,14 +97,14 @@ CONST { exceptions which use threadvars but } { these aren't allocated yet ... } { allocate room on the heap for the thread vars } - dataindex:=pointer(GlobalAlloc(GMEM_FIXED or GMEM_ZEROINIT,threadvarblocksize)); + dataindex:=pointer(LocalAlloc(LMEM_FIXED or LMEM_ZEROINIT,threadvarblocksize)); TlsSetValue(tlskey,dataindex); end; procedure SysReleaseThreadVars; begin - GlobalFree(TlsGetValue(tlskey)); + LocalFree(TlsGetValue(tlskey)); end; @@ -244,16 +247,16 @@ CONST *****************************************************************************} procedure WinInitCriticalSection(var cs : TRTLCriticalSection); - stdcall;external 'kernel32' name 'InitializeCriticalSection'; + stdcall;external KernelDLL name 'InitializeCriticalSection'; procedure WinDoneCriticalSection(var cs : TRTLCriticalSection); - stdcall;external 'kernel32' name 'DeleteCriticalSection'; + stdcall;external KernelDLL name 'DeleteCriticalSection'; procedure WinEnterCriticalSection(var cs : TRTLCriticalSection); - stdcall;external 'kernel32' name 'EnterCriticalSection'; + stdcall;external KernelDLL name 'EnterCriticalSection'; procedure WinLeaveCriticalSection(var cs : TRTLCriticalSection); - stdcall;external 'kernel32' name 'LeaveCriticalSection'; + stdcall;external KernelDLL name 'LeaveCriticalSection'; procedure SySInitCriticalSection(var cs); begin diff --git a/rtl/wince/Makefile.fpc b/rtl/wince/Makefile.fpc new file mode 100644 index 0000000000..5dd9ead24c --- /dev/null +++ b/rtl/wince/Makefile.fpc @@ -0,0 +1,241 @@ +# +# Makefile.fpc for Free Pascal WinCE RTL +# + +[package] +main=rtl + +[target] +loaders= wprt0 #wdllprt0 gprt0 wcygprt0 +units=$(SYSTEMUNIT) objpas # ctypes objpas macpas strings \ +# lineinfo heaptrc matrix \ +# windows winsock initc cmem dynlibs signals \ +# dos crt objects graph messages \ +# rtlconsts sysconst sysutils math types \ +# strutils convutils dateutils varutils variants typinfo classes \ +# cpu mmx charset ucomplex getopts \ +# wincrt winmouse winevent sockets printer \ +# video mouse keyboard \ +# winsysut + +rsts=math varutils typinfo variants classes dateutils sysconst + +[require] +nortl=y + +[install] +fpcpackage=y + +[default] +fpcdir=../.. +target=wince + +[compiler] +includedir=$(INC) $(PROCINC) $(RTL)/win +sourcedir=$(INC) $(PROCINC) + + +[prerules] +RTL=.. +INC=$(RTL)/inc +PROCINC=$(RTL)/$(CPU_TARGET) +#WININC=wininc + +UNITPREFIX=rtl + +SYSTEMUNIT=system +PRT0=wprt0 + +# Use new feature from 1.0.5 version +# that generates release PPU files +# which will not be recompiled +ifdef RELEASE +override FPCOPT+=-Ur +endif + +# Paths +OBJPASDIR=$(RTL)/objpas +GRAPHDIR=$(INC)/graph + +# Files used by windows.pp +# include $(WININC)/makefile.inc + +#WINDOWS_SOURCE_FILES=$(addprefix $(WININC)/,$(addsuffix .inc,$(WINDOWS_FILES))) + + +[rules] +SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT)) + +# Get the system independent include file names. +# This will set the following variables : +# SYSINCNAMES +include $(INC)/makefile.inc +SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES)) + +# Get the processor dependent include file names. +# This will set the following variables : +# CPUINCNAMES +include $(PROCINC)/makefile.cpu +SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES)) + +# Put system unit dependencies together. +SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS) + + +# +# Loaders +# + +wprt0$(OEXT) : $(PRT0).as + $(AS) -o $(UNITTARGETDIRPREFIX)wprt0$(OEXT) $(PRT0).as + +gprt0$(OEXT) : gprt0.as + +wdllprt0$(OEXT) : wdllprt0.as + +wcygprt0$(OEXT) : wcygprt0.as + +# +# System Units (System, Objpas, Strings) +# + +$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS) + $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp #-Fi..\win + +objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT) + $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp + +strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\ + $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\ + $(SYSTEMUNIT)$(PPUEXT) + +# +# System Dependent Units +# + +#windows$(PPUEXT) : windows.pp $(WINDOWS_SOURCE_FILES) $(SYSTEMUNIT)$(PPUEXT) +# $(COMPILER) -I$(WININC) windows.pp + +#messages$(PPUEXT): messages.pp $(WININC)/messages.inc $(SYSTEMUNIT)$(PPUEXT) +# $(COMPILER) -I$(WININC) messages.pp + +#opengl32$(PPUEXT) : opengl32.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) + +#winsock$(PPUEXT) : winsock.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) + +#sockets$(PPUEXT) : sockets.pp windows$(PPUEXT) winsock$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \ +# $(INC)/sockets.inc $(INC)/socketsh.inc + +#initc$(PPUEXT) : initc.pp $(SYSTEMUNIT)$(PPUEXT) + +#wincrt$(PPUEXT) : wincrt.pp $(SYSTEMUNIT)$(PPUEXT) windows$(PPUEXT) graph$(PPUEXT) + +#winmouse$(PPUEXT) : winmouse.pp $(SYSTEMUNIT)$(PPUEXT) windows$(PPUEXT) graph$(PPUEXT) + +#dynlibs$(PPUEXT) : $(INC)/dynlibs.pp windows$(PPUEXT) + +# +# TP7 Compatible RTL Units +# + +#dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) + +#crt$(PPUEXT) : crt.pp $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) + +#objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT) + +# +# Graph +# + +#include $(GRAPHDIR)/makefile.inc +#GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES)) + +#graph$(PPUEXT) : graph.pp strings$(PPUEXT) windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \ +# $(GRAPHINCDEPS) +# $(COMPILER) -I$(GRAPHDIR) graph.pp + + +# +# Delphi Compatible Units +# + +#sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \ +# objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) sysconst$(PPUEXT) +# $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp + +#classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \ +# sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) sysconst$(PPUEXT) +# $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp + +#winsysut$(PPUEXT) : winsysut.pp sysutils$(PPUEXT) +# $(COMPILER) winsysut.pp + +#typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) +# $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp + +#math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT) +# $(COMPILER) $(OBJPASDIR)/math.pp + +#varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \ +# $(OBJPASDIR)/varutilh.inc varutils.pp sysutils$(PPUEXT) +# $(COMPILER) -Fi$(OBJPASDIR) varutils.pp + +#variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) sysutils$(PPUEXT) sysconst$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) +# $(COMPILER) -Fi$(INC) $(INC)/variants.pp + +#types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) +# $(COMPILER) $(OBJPASDIR)/types.pp + +#rtlconsts$(PPUEXT) : objpas$(PPUEXT) $(OBJPASDIR)/rtlconsts.pp +# $(COMPILER) $(OBJPASDIR)/rtlconsts.pp + +#sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) +# $(COMPILER) $(OBJPASDIR)/sysconst.pp + +#dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp +# $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp + +#convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp +# $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/convutils.pp + +#strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp +# $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/strutils.pp + +# +# Mac Pascal Model +# + +#macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT) +# $(COMPILER) $(INC)/macpas.pp $(REDIR) + +# +# Other system-independent RTL Units +# + +cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT) + +mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) + +getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT) + +heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT) + $(COMPILER) -Sg $(INC)/heaptrc.pp + +lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) + +charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT) + +cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT) + +ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) + +# +# Other system-dependent RTL Units +# + +#callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT) + +#ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT) + +#variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) typinfo$(PPUEXT) diff --git a/rtl/wince/system.pp b/rtl/wince/system.pp new file mode 100644 index 0000000000..48eea5efec --- /dev/null +++ b/rtl/wince/system.pp @@ -0,0 +1,1126 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 1999-2005 by Florian Klaempfl and Pavel Ozerski + and Yury Sidorov member of the Free Pascal development team. + + FPC Pascal system unit for the WinCE. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +unit System; +interface + +{$ifdef SYSTEMDEBUG} + {$define SYSTEMEXCEPTIONDEBUG} +{$endif SYSTEMDEBUG} + +{$ifdef cpui386} + {$define Set_i386_Exception_handler} +{$endif cpui386} + +{ include system-independent routine headers } +{$I systemh.inc} + +const + LineEnding = #13#10; + LFNSupport = true; + DirectorySeparator = '\'; + DriveSeparator = ':'; + PathSeparator = ';'; +{ FileNameCaseSensitive is defined separately below!!! } + maxExitCode = 65535; + MaxPathLen = 260; + +type + PEXCEPTION_FRAME = ^TEXCEPTION_FRAME; + TEXCEPTION_FRAME = record + next : PEXCEPTION_FRAME; + handler : pointer; + end; + +const +{ Default filehandles } + UnusedHandle : THandle = -1; + StdInputHandle : THandle = 0; + StdOutputHandle : THandle = 0; + StdErrorHandle : THandle = 0; + + FileNameCaseSensitive : boolean = true; + CtrlZMarksEOF: boolean = true; (* #26 not considered as end of file *) + + sLineBreak = LineEnding; + DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF; + + { Thread count for DLL } + Thread_count : longint = 0; + System_exception_frame : PEXCEPTION_FRAME =nil; + +var +{ C compatible arguments } + argc : longint; + argv : ppchar; +{ Win32 Info } + hprevinst, + HInstance, + MainInstance, + DLLreason,DLLparam:longint; + Win32StackTop : Dword; + +type + TDLL_Process_Entry_Hook = function (dllparam : longint) : longbool; + TDLL_Entry_Hook = procedure (dllparam : longint); + +const + Dll_Process_Attach_Hook : TDLL_Process_Entry_Hook = nil; + Dll_Process_Detach_Hook : TDLL_Entry_Hook = nil; + Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil; + Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil; + +type + HMODULE = THandle; + +{ Wrappers for some WinAPI calls } +function EventModify(h: THandle; func: DWORD): LONGBOOL; + stdcall; external KernelDLL name 'EventModify'; +function TlsCall(p1, p2: DWORD): DWORD; + stdcall; external KernelDLL name 'TlsCall'; +function ResetEvent(h: THandle): LONGBOOL; +function SetEvent(h: THandle): LONGBOOL; +function GetCurrentProcessId:DWORD; +function Win32GetCurrentThreadId:DWORD; +function TlsAlloc : DWord; +function TlsFree(dwTlsIndex : DWord) : LongBool; + +implementation + +{ used by wstrings.inc because wstrings.inc is included before sysos.inc + this is put here (FK) } +(* +function SysAllocStringLen(psz:pointer;len:dword):pointer;stdcall; + external 'oleaut32.dll' name 'SysAllocStringLen'; + +procedure SysFreeString(bstr:pointer);stdcall; + external 'oleaut32.dll' name 'SysFreeString'; + +function SysReAllocStringLen(var bstr:pointer;psz: pointer; + len:dword): Integer; stdcall;external 'oleaut32.dll' name 'SysReAllocStringLen'; +*) + +{ include system independent routines } +{$I system.inc} + +{***************************************************************************** + WinAPI wrappers implementation +*****************************************************************************} + +const + EVENT_PULSE = 1; + EVENT_RESET = 2; + EVENT_SET = 3; + +function ResetEvent(h: THandle): LONGBOOL; +begin + ResetEvent := EventModify(h,EVENT_RESET); +end; + +function SetEvent(h: THandle): LONGBOOL; +begin + SetEvent := EventModify(h,EVENT_SET); +end; + +const +{$ifdef CPUARM} + UserKData = $FFFFC800; +{$else CPUARM} + UserKData = $00005800; +{$endif CPUARM} + SYSHANDLE_OFFSET = $004; + SYS_HANDLE_BASE = 64; + SH_CURTHREAD = 1; + SH_CURPROC = 2; + +type + PHandle = ^THandle; + +function GetCurrentProcessId:DWORD; +var + p: PHandle; +begin + p:=PHandle(UserKData+SYSHANDLE_OFFSET + SH_CURPROC*SizeOf(THandle)); + GetCurrentProcessId := p^; +end; + +function Win32GetCurrentThreadId:DWORD; +var + p: PHandle; +begin + p:=PHandle(UserKData+SYSHANDLE_OFFSET + SH_CURTHREAD*SizeOf(THandle)); + Win32GetCurrentThreadId := p^; +end; + +const + TLS_FUNCALLOC = 0; + TLS_FUNCFREE = 1; + +function TlsAlloc : DWord; +begin + TlsAlloc := TlsCall(TLS_FUNCALLOC, 0); +end; + +function TlsFree(dwTlsIndex : DWord) : LongBool; +begin + TlsFree := LongBool(TlsCall(TLS_FUNCFREE, dwTlsIndex)); +end; + + +{***************************************************************************** + Parameter Handling +*****************************************************************************} + +var + ModuleName : array[0..255] of char; + +function GetCommandFile:pchar; +begin + GetModuleFileName(0,@ModuleName,255); + GetCommandFile:=@ModuleName; +end; + + +procedure setup_arguments; +var + arglen, + count : longint; + argstart, + pc,arg : pchar; + quote : char; + argvlen : longint; + + procedure allocarg(idx,len:longint); + var + oldargvlen : longint; + begin + if idx>=argvlen then + begin + oldargvlen:=argvlen; + argvlen:=(idx+8) and (not 7); + sysreallocmem(argv,argvlen*sizeof(pointer)); + fillchar(argv[oldargvlen],(argvlen-oldargvlen)*sizeof(pointer),0); + end; + { use realloc to reuse already existing memory } + { always allocate, even if length is zero, since } + { the arg. is still present! } + sysreallocmem(argv[idx],len+1); + end; + +begin + { create commandline, it starts with the executed filename which is argv[0] } + { Win32 passes the command NOT via the args, but via getmodulefilename} + count:=0; + argv:=nil; + argvlen:=0; + pc:=getcommandfile; + Arglen:=0; + repeat + Inc(Arglen); + until (pc[Arglen]=#0); + allocarg(count,arglen); + move(pc^,argv[count]^,arglen+1); + { Setup cmdline variable } + cmdline:=GetCommandLine; + { process arguments } + pc:=cmdline; +{$IfDef SYSTEM_DEBUG_STARTUP} + Writeln(stderr,'Win32 GetCommandLine is #',pc,'#'); +{$EndIf } + while pc^<>#0 do + begin + { skip leading spaces } + while pc^ in [#1..#32] do + inc(pc); + if pc^=#0 then + break; + { calc argument length } + quote:=' '; + argstart:=pc; + arglen:=0; + while (pc^<>#0) do + begin + case pc^ of + #1..#32 : + begin + if quote<>' ' then + inc(arglen) + else + break; + end; + '"' : + begin + if quote<>'''' then + begin + if pchar(pc+1)^<>'"' then + begin + if quote='"' then + quote:=' ' + else + quote:='"'; + end + else + inc(pc); + end + else + inc(arglen); + end; + '''' : + begin + if quote<>'"' then + begin + if pchar(pc+1)^<>'''' then + begin + if quote='''' then + quote:=' ' + else + quote:=''''; + end + else + inc(pc); + end + else + inc(arglen); + end; + else + inc(arglen); + end; + inc(pc); + end; + { copy argument } + { Don't copy the first one, it is already there.} + If Count<>0 then + begin + allocarg(count,arglen); + quote:=' '; + pc:=argstart; + arg:=argv[count]; + while (pc^<>#0) do + begin + case pc^ of + #1..#32 : + begin + if quote<>' ' then + begin + arg^:=pc^; + inc(arg); + end + else + break; + end; + '"' : + begin + if quote<>'''' then + begin + if pchar(pc+1)^<>'"' then + begin + if quote='"' then + quote:=' ' + else + quote:='"'; + end + else + inc(pc); + end + else + begin + arg^:=pc^; + inc(arg); + end; + end; + '''' : + begin + if quote<>'"' then + begin + if pchar(pc+1)^<>'''' then + begin + if quote='''' then + quote:=' ' + else + quote:=''''; + end + else + inc(pc); + end + else + begin + arg^:=pc^; + inc(arg); + end; + end; + else + begin + arg^:=pc^; + inc(arg); + end; + end; + inc(pc); + end; + arg^:=#0; + end; + {$IfDef SYSTEM_DEBUG_STARTUP} + Writeln(stderr,'dos arg ',count,' #',arglen,'#',argv[count],'#'); + {$EndIf SYSTEM_DEBUG_STARTUP} + inc(count); + end; + { get argc and create an nil entry } + argc:=count; + allocarg(argc,0); + { free unused memory } + sysreallocmem(argv,(argc+1)*sizeof(pointer)); +end; + + +function paramcount : longint; +begin + paramcount := argc - 1; +end; + +function paramstr(l : longint) : string; +begin + if (l>=0) and (l 0) then + dec(exceptLevel); + + eip:=exceptEip[exceptLevel]; + error:=exceptError[exceptLevel]; +{$ifdef SYSTEMEXCEPTIONDEBUG} + if IsConsole then + writeln(stderr,'In JumpToHandleErrorFrame error=',error); +{$endif SYSTEMEXCEPTIONDEBUG} + if resetFPU[exceptLevel] then asm + fninit + fldcw fpucw + end; + { build a fake stack } + asm +{$ifdef REGCALL} + movl ebp,%ecx + movl eip,%edx + movl error,%eax + pushl eip + movl ebp,%ebp // Change frame pointer +{$else} + movl ebp,%eax + pushl %eax + movl eip,%eax + pushl %eax + movl error,%eax + pushl %eax + movl eip,%eax + pushl %eax + movl ebp,%ebp // Change frame pointer +{$endif} + +{$ifdef SYSTEMEXCEPTIONDEBUG} + jmpl DebugHandleErrorAddrFrame +{$else not SYSTEMEXCEPTIONDEBUG} + jmpl HandleErrorAddrFrame +{$endif SYSTEMEXCEPTIONDEBUG} + end; +end; + +function syswin32_i386_exception_handler(excep : PExceptionPointers) : Longint;stdcall; +var + frame, + res : longint; + +function SysHandleErrorFrame(error, frame : Longint; must_reset_fpu : Boolean) : Longint; +begin + if (frame = 0) then + SysHandleErrorFrame:=EXCEPTION_CONTINUE_SEARCH + else begin + if (exceptLevel >= MaxExceptionLevel) then exit; + + exceptEip[exceptLevel] := excep^.ContextRecord^.Eip; + exceptError[exceptLevel] := error; + resetFPU[exceptLevel] := must_reset_fpu; + inc(exceptLevel); + + excep^.ContextRecord^.Eip := Longint(@JumpToHandleErrorFrame); + excep^.ExceptionRecord^.ExceptionCode := 0; + + SysHandleErrorFrame := EXCEPTION_CONTINUE_EXECUTION; +{$ifdef SYSTEMEXCEPTIONDEBUG} + if IsConsole then begin + writeln(stderr,'Exception Continue Exception set at ', + hexstr(exceptEip[exceptLevel],8)); + writeln(stderr,'Eip changed to ', + hexstr(longint(@JumpToHandleErrorFrame),8), ' error=', error); + end; +{$endif SYSTEMEXCEPTIONDEBUG} + end; +end; + +begin + if excep^.ContextRecord^.SegSs=_SS then + frame := excep^.ContextRecord^.Ebp + else + frame := 0; + res := EXCEPTION_CONTINUE_SEARCH; +{$ifdef SYSTEMEXCEPTIONDEBUG} + if IsConsole then Writeln(stderr,'Exception ', + hexstr(excep^.ExceptionRecord^.ExceptionCode, 8)); +{$endif SYSTEMEXCEPTIONDEBUG} + case cardinal(excep^.ExceptionRecord^.ExceptionCode) of + STATUS_INTEGER_DIVIDE_BY_ZERO, + STATUS_FLOAT_DIVIDE_BY_ZERO : + res := SysHandleErrorFrame(200, frame, true); + STATUS_ARRAY_BOUNDS_EXCEEDED : + res := SysHandleErrorFrame(201, frame, false); + STATUS_STACK_OVERFLOW : + res := SysHandleErrorFrame(202, frame, false); + STATUS_FLOAT_OVERFLOW : + res := SysHandleErrorFrame(205, frame, true); + STATUS_FLOAT_DENORMAL_OPERAND, + STATUS_FLOAT_UNDERFLOW : + res := SysHandleErrorFrame(206, frame, true); +{excep^.ContextRecord^.FloatSave.StatusWord := excep^.ContextRecord^.FloatSave.StatusWord and $ffffff00;} + STATUS_FLOAT_INEXACT_RESULT, + STATUS_FLOAT_INVALID_OPERATION, + STATUS_FLOAT_STACK_CHECK : + res := SysHandleErrorFrame(207, frame, true); + STATUS_INTEGER_OVERFLOW : + res := SysHandleErrorFrame(215, frame, false); + STATUS_ILLEGAL_INSTRUCTION: + res := SysHandleErrorFrame(216, frame, true); + STATUS_ACCESS_VIOLATION: + { Athlon prefetch bug? } + if is_prefetch(pointer(excep^.ContextRecord^.Eip)) then + begin + { if yes, then retry } + excep^.ExceptionRecord^.ExceptionCode := 0; + res:=EXCEPTION_CONTINUE_EXECUTION; + end + else + res := SysHandleErrorFrame(216, frame, true); + + STATUS_CONTROL_C_EXIT: + res := SysHandleErrorFrame(217, frame, true); + STATUS_PRIVILEGED_INSTRUCTION: + res := SysHandleErrorFrame(218, frame, false); + else + begin + if ((excep^.ExceptionRecord^.ExceptionCode and SEVERITY_ERROR) = SEVERITY_ERROR) then + res := SysHandleErrorFrame(217, frame, true) + else + res := SysHandleErrorFrame(255, frame, true); + end; + end; + syswin32_i386_exception_handler := res; +end; + + +procedure install_exception_handlers; +{$ifdef SYSTEMEXCEPTIONDEBUG} +var + oldexceptaddr, + newexceptaddr : Longint; +{$endif SYSTEMEXCEPTIONDEBUG} + +begin +{$ifdef SYSTEMEXCEPTIONDEBUG} + asm + movl $0,%eax + movl %fs:(%eax),%eax + movl %eax,oldexceptaddr + end; +{$endif SYSTEMEXCEPTIONDEBUG} + SetUnhandledExceptionFilter(@syswin32_i386_exception_handler); +{$ifdef SYSTEMEXCEPTIONDEBUG} + asm + movl $0,%eax + movl %fs:(%eax),%eax + movl %eax,newexceptaddr + end; + if IsConsole then + writeln(stderr,'Old exception ',hexstr(oldexceptaddr,8), + ' new exception ',hexstr(newexceptaddr,8)); +{$endif SYSTEMEXCEPTIONDEBUG} +end; + +procedure remove_exception_handlers; +begin + SetUnhandledExceptionFilter(nil); +end; + +{$else not cpui386 (Processor specific !!)} +procedure install_exception_handlers; +begin +end; + +procedure remove_exception_handlers; +begin +end; + +{$endif Set_i386_Exception_handler} + + +{**************************************************************************** + OS dependend widestrings +****************************************************************************} + +function CharUpperBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; stdcall; external KernelDLL name 'CharUpperBuffW'; +function CharLowerBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; stdcall; external KernelDLL name 'CharLowerBuffW'; + + +function Win32WideUpper(const s : WideString) : WideString; + begin + result:=s; + UniqueString(result); + if length(result)>0 then + CharUpperBuff(LPWSTR(result),length(result)); + end; + + +function Win32WideLower(const s : WideString) : WideString; + begin + result:=s; + UniqueString(result); + if length(result)>0 then + CharLowerBuff(LPWSTR(result),length(result)); + end; + + +{ there is a similiar procedure in sysutils which inits the fields which + are only relevant for the sysutils units } +procedure InitWin32Widestrings; + begin + widestringmanager.UpperWideStringProc:=@Win32WideUpper; + widestringmanager.LowerWideStringProc:=@Win32WideLower; + end; + + + +{**************************************************************************** + Error Message writing using messageboxes +****************************************************************************} + +function MessageBox(w1:longint;l1,l2:pointer;w2:longint):longint; + stdcall;external 'coredll' name 'MessageBoxW'; + +const + ErrorBufferLength = 1024; +var + ErrorBuf : array[0..ErrorBufferLength] of char; + ErrorLen : longint; + +Function ErrorWrite(Var F: TextRec): Integer; +{ + An error message should always end with #13#10#13#10 +} +var + p : pchar; + i : longint; +Begin + if F.BufPos>0 then + begin + if F.BufPos+ErrorLen>ErrorBufferLength then + i:=ErrorBufferLength-ErrorLen + else + i:=F.BufPos; + Move(F.BufPtr^,ErrorBuf[ErrorLen],i); + inc(ErrorLen,i); + ErrorBuf[ErrorLen]:=#0; + end; + if ErrorLen>3 then + begin + p:=@ErrorBuf[ErrorLen]; + for i:=1 to 4 do + begin + dec(p); + if not(p^ in [#10,#13]) then + break; + end; + end; + if ErrorLen=ErrorBufferLength then + i:=4; + if (i=4) then + begin + MessageBox(0,@ErrorBuf,pchar('Error'),0); + ErrorLen:=0; + end; + F.BufPos:=0; + ErrorWrite:=0; +End; + + +Function ErrorClose(Var F: TextRec): Integer; +begin + if ErrorLen>0 then + begin + MessageBox(0,@ErrorBuf,pchar('Error'),0); + ErrorLen:=0; + end; + ErrorLen:=0; + ErrorClose:=0; +end; + + +Function ErrorOpen(Var F: TextRec): Integer; +Begin + TextRec(F).InOutFunc:=@ErrorWrite; + TextRec(F).FlushFunc:=@ErrorWrite; + TextRec(F).CloseFunc:=@ErrorClose; + ErrorOpen:=0; +End; + + +procedure AssignError(Var T: Text); +begin + Assign(T,''); + TextRec(T).OpenFunc:=@ErrorOpen; + Rewrite(T); +end; + + +procedure SysInitStdIO; +begin + { Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be + displayed in and messagebox } + AssignError(stderr); + AssignError(stdout); + Assign(Output,''); + Assign(Input,''); + Assign(ErrOutput,''); +end; + +(* ProcessID cached to avoid repeated calls to GetCurrentProcess. *) + +var + ProcessID: SizeUInt; + +function GetProcessID: SizeUInt; +begin + GetProcessID := ProcessID; +end; + + +const + Exe_entry_code : pointer = @Exe_entry; + Dll_entry_code : pointer = @Dll_entry; + +begin + StackLength := InitialStkLen; + StackBottom := Sptr - StackLength; + { some misc Win32 stuff } + hprevinst:=0; + if not IsLibrary then + HInstance:=getmodulehandle(GetCommandFile); + MainInstance:=HInstance; + { Setup heap } + InitHeap; + SysInitExceptions; + SysInitStdIO; + { Arguments } + setup_arguments; + { Reset IO Error } + InOutRes:=0; + ProcessID := GetCurrentProcessID; + { threading } + InitSystemThreads; + { Reset internal error variable } + errno:=0; + initvariantmanager; + initwidestringmanager; + InitWin32Widestrings +end. diff --git a/rtl/wince/wprt0.as b/rtl/wince/wprt0.as new file mode 100644 index 0000000000..df42dd6eb4 --- /dev/null +++ b/rtl/wince/wprt0.as @@ -0,0 +1,67 @@ +/* +Startup code for WinCE port of Free Pascal +Written by Yury Sidorov 2005 +*/ + +.section .text + .balign 4 +.globl mainCRTStartup +mainCRTStartup: +.globl _mainCRTStartup +_mainCRTStartup: + mov r0,#1 + b do_start + +.globl WinMainCRTStartup +WinMainCRTStartup: +.globl _WinMainCRTStartup +_WinMainCRTStartup: + mov r0,#0 +do_start: + ldr r1, _PISCONSOLE + strb r0,[r1] + bl _FPC_EXE_Entry + +.globl asm_exit +asm_exit: + eor r0,r0,r0 + bl exitthread + +_PISCONSOLE: + .long U_SYSTEM_ISCONSOLE + +.globl exitthread +exitthread: + ldr ip,.L100 + ldr pc,[ip] +.L100: + .long .L10 + +.section .idata$2 + .rva .L7 + .long 0,0 + .rva .L6 + .rva .L8 + +.section .idata$4 +.L7: + .rva .L9 + .long 0 + +.section .idata$5 +.L8: + +.section .idata$5 +.L10: + .rva .L9 + .long 0 + +.section .idata$6 +.L9: + .short 0 + .ascii "ExitThread\000" + .balign 2,0 + +.section .idata$7 +.L6: + .ascii "coredll.dll\000"