paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-06 14:27:33 +01:00
Code Issues Packages Projects Releases Wiki Activity

* rtl code cleanup, compat fixes between clib and libc

Browse Source
This commit is contained in:
armin 2005-01-04 11:25:33 +00:00
parent 7deae72a31
commit 6f66b80ea8
9 changed files with 1496 additions and 1333 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
rtl/netware/Makefile
View File

@ -1,8 +1,8 @@
#
# Don't edit, this file is generated by FPCMake Version 1.1 [2004/12/20]
# Don't edit, this file is generated by FPCMake Version 1.1 [2004/12/30]
#
default: all
MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx watcom morphos netwlibc
MAKEFILETARGETS=netware
BSDs = freebsd netbsd openbsd darwin
UNIXs = linux $(BSDs) sunos qnx
LIMIT83fs = go32v2 os2 emx watcom
@ -1474,7 +1474,7 @@ winsock$(PPUEXT) : winsock.pp $(SYSTEMUNIT)$(PPUEXT)
sockets$(PPUEXT) : sockets.pp netware$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
$(INC)/sockets.inc $(INC)/socketsh.inc
initc$(PPUEXT) : initc.pp $(SYSTEMUNIT)$(PPUEXT)
dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) nwserv$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
crt$(PPUEXT) : crt.pp $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) dos$(PPUEXT)
objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
@ -1525,5 +1525,6 @@ keyboard$(PPUEXT) : $(INC)/keyboard.inc $(INC)/keybrdh.inc $(SYSTEMUNIT)$(PPUEXT
cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
aio$(PPUEXT) : aio.pp $(SYSTEMUNIT)$(PPUEXT)
nwsnut$(PPUEXT) : nwsnut.pp nwserv$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
override INSTALLPPUFILES+=$(IMPFILES)
override CLEANPPUFILES+=$(addprefix $(COMPILER_UNITTARGETDIR)/,$(IMPFILES))

4
rtl/netware/Makefile.fpc
View File

@ -149,7 +149,7 @@ initc$(PPUEXT) : initc.pp $(SYSTEMUNIT)$(PPUEXT)
# TP7 Compatible RTL Units
#
dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) nwserv$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
crt$(PPUEXT) : crt.pp $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) dos$(PPUEXT)
@ -250,6 +250,8 @@ callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
aio$(PPUEXT) : aio.pp $(SYSTEMUNIT)$(PPUEXT)
nwsnut$(PPUEXT) : nwsnut.pp nwserv$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
#
# Netware-.imp files need to be installed in the unit-dir
#

17
rtl/netware/nwserv.pp
View File

@ -996,12 +996,14 @@ type // libc compatible
scr_t = pointer;
TScr = scr_t;
PScr = Pscr_t;
PScreenStruct = PScr;
function getch:longint; cdecl; external 'clib' name 'getch';
function getche:longint; cdecl; external 'clib' name 'getche';
function kbhit:longint; cdecl; external 'clib' name 'kbhit';
function putch(c:longint):longint; cdecl; external 'clib' name 'putch';
function ungetch(c:longint):longint; cdecl; external 'clib' name 'ungetch';
function ungetcharacter(c:longint):longint; cdecl; external 'clib' name 'ungetch';
function cgets(buf:Pchar):Pchar; cdecl; external 'clib' name 'cgets';
function CheckIfScreenDisplayed(screenHandle,waitFlag:longint):longint; cdecl; external 'clib' name 'CheckIfScreenDisplayed';
function CheckIfScreenDisplayed(screenHandle:TScr;waitFlag:longint):longint; cdecl; external 'clib' name 'CheckIfScreenDisplayed';
@ -1118,12 +1120,12 @@ function GetConnectionInformation (connectionNumber:word;
objectName :Pchar;
objectType :PWORD;
objectID :Plongint;
loginTime :PBYTE):longint;cdecl;external 'clib' name 'GetConnectionInformation';
loginTime :pointer):longint;cdecl;external 'clib' name 'GetConnectionInformation';
function GetConnectionInformation (connectionNumber:word;
objectName :Pchar;
var objectType :word;
var objectID :longint;
var loginTime :byte):longint;cdecl;external 'clib' name 'GetConnectionInformation';
var loginTime):longint;cdecl;external 'clib' name 'GetConnectionInformation';
function GetConnectionList(objectID,lastConnection:longint;
numberOfConnections:Plongint;
@ -1965,6 +1967,10 @@ const
NOTMYCOMMAND = 1;
{$include npackoff.inc}
type
TRtag = longint;
PRtag = ^TRtag;
function AllocateResourceTag (NLMHandle:TNlmHandle;
descriptionString:PChar;
resourceType:longint):longint;cdecl;external 'clib' name 'AllocateResourceTag';
@ -2139,6 +2145,7 @@ type
var directoryNumber:longint;
outPathStringP:PChar;
var outPathCount:longint):longint;cdecl;
TVolumeNameString = String [17];
function FEConvertDirectoryNumber(sourceNameSpace:longint;
volumeNumber:longint;
@ -2192,6 +2199,7 @@ function FEMapVolumeAndDirectoryToPath(volumeNumber,directoryNumber:longint; pat
function FEMapVolumeAndDirectoryToPathForNS(volumeNumber,directoryNumber:longint; nameSpace:longint; pathString:PBYTE; pathCount:Plongint):longint;cdecl;external 'clib' name 'FEMapVolumeAndDirectoryToPathForNS';
function FEMapVolumeNumberToName(volumeNumber:longint; volumeName:PChar):longint;cdecl;external 'clib' name 'FEMapVolumeNumberToName';
function FEMapVolumeNumberToName(volumeNumber:longint; var volumeName:TVolumeNameString):longint;cdecl;external 'clib' name 'FEMapVolumeNumberToName';
function FEQuickClose(connection,task,fileHandle:longint):longint;cdecl;external 'clib' name 'FEQuickClose';
function FEQuickFileLength(connection,handle:longint; fileSize:Plongint):longint;cdecl;external 'clib' name 'FEQuickFileLength';
function FEQuickFileLength(connection,handle:longint; var fileSize:longint):longint;cdecl;external 'clib' name 'FEQuickFileLength';
@ -5377,7 +5385,10 @@ end.
{
$Log$
Revision 1.6 2004-12-29 13:01:42 armin
Revision 1.7 2005-01-04 11:25:33 armin
* rtl code cleanup, compat fixes between clib and libc
Revision 1.6 2004/12/29 13:01:42 armin
* made commandParser more compatible between clib and libc
Revision 1.5 2004/12/16 12:42:55 armin

1467
rtl/netware/nwsnut.pp
View File

File diff suppressed because it is too large Load Diff

1
rtl/netwlibc/Makefile
View File

@ -1465,6 +1465,7 @@ systhrds$(PPUEXT): systhrds.pp $(INC)/threadh.inc $(SYSTEMUNIT)$(PPUEXT) objpas$
netware$(PPUEXT) : netware.pp $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) -I$(WININC) netware.pp
winsock$(PPUEXT) : winsock.pp ../netware/winsock.pp $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT)
nwsnut$(PPUEXT) : nwsnut.pp ../netware/nwsnut.pp libc$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
sockets$(PPUEXT) : sockets.pp winsock$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
$(INC)/sockets.inc $(INC)/socketsh.inc
dynlibs$(PPUEXT) : $(INC)/dynlibs.pp libc$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)

2
rtl/netwlibc/Makefile.fpc
View File

@ -139,6 +139,8 @@ netware$(PPUEXT) : netware.pp $(SYSTEMUNIT)$(PPUEXT)
winsock$(PPUEXT) : winsock.pp ../netware/winsock.pp $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT)
nwsnut$(PPUEXT) : nwsnut.pp ../netware/nwsnut.pp libc$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
sockets$(PPUEXT) : sockets.pp winsock$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
$(INC)/sockets.inc $(INC)/socketsh.inc

1222
rtl/netwlibc/libc.pp
View File

File diff suppressed because it is too large Load Diff

47
rtl/netwlibc/system.pp
View File

@ -97,12 +97,12 @@ procedure NWSysSetThreadFunctions (atv:TSysReleaseThreadVars;
stdata:TSysSetThreadDataAreaPtr);
procedure ConsolePrintf (s :shortstring);
procedure ConsolePrintf (FormatStr : PCHAR; Param : LONGINT);
procedure ConsolePrintf (FormatStr : PCHAR; Param : pchar);
procedure ConsolePrintf (FormatStr : PCHAR; P1,P2 : LONGINT);
procedure ConsolePrintf (FormatStr : PCHAR; P1,P2,P3 : LONGINT);
procedure ConsolePrintf (FormatStr : PCHAR);
procedure _ConsolePrintf (s :shortstring);
procedure _ConsolePrintf (FormatStr : PCHAR; Param : LONGINT);
procedure _ConsolePrintf (FormatStr : PCHAR; Param : pchar);
procedure _ConsolePrintf (FormatStr : PCHAR; P1,P2 : LONGINT);
procedure _ConsolePrintf (FormatStr : PCHAR; P1,P2,P3 : LONGINT);
procedure _ConsolePrintf (FormatStr : PCHAR);
procedure __EnterDebugger;cdecl;external '!netware' name 'EnterDebugger';
function NWGetCodeStart : pointer; // needed for Lineinfo
@ -165,7 +165,7 @@ begin
if TerminatingThreadID <> dword(pthread_self) then
begin
{$ifdef DEBUG_MT}
ConsolePrintf ('Terminating Thread %x because halt was called while Thread %x terminates nlm'#13#10,dword(pthread_self),TerminatingThreadId);
_ConsolePrintf ('Terminating Thread %x because halt was called while Thread %x terminates nlm'#13#10,dword(pthread_self),TerminatingThreadId);
{$endif}
pthread_exit (nil);
// only for the case ExitThread fails
@ -269,7 +269,7 @@ var P2 : POINTER;
begin
if HeapSbrkReleased then
begin
ConsolePrintf ('Error: SysOSFree called after all heap memory was released'#13#10);
_ConsolePrintf ('Error: SysOSFree called after all heap memory was released'#13#10);
exit(nil);
end;
SysOSAlloc := _Alloc (size,HeapAllocResourceTag);
@ -341,7 +341,7 @@ var i : longint;
begin
if HeapSbrkReleased then
begin
ConsolePrintf ('Error: SysOSFree called after all heap memory was released'#13#10);
_ConsolePrintf ('Error: SysOSFree called after all heap memory was released'#13#10);
end else
if (HeapSbrkLastUsed > 0) then
for i := 1 to HeapSbrkLastUsed do
@ -867,7 +867,7 @@ procedure InitFPU;assembler;
function CheckFunction : longint; CDECL; [public,alias: '_NonAppCheckUnload'];
var oldPtr : pointer;
begin
//ConsolePrintf ('CheckFunction'#13#10);
//_ConsolePrintf ('CheckFunction'#13#10);
if assigned (NetwareCheckFunction) then
begin
if assigned (SetThreadDataAreaPtr) then
@ -884,15 +884,15 @@ begin
end;
procedure ConsolePrintf (s : shortstring);
procedure _ConsolePrintf (s : shortstring);
begin
if length(s) > 254 then
byte(s[0]) := 254;
s := s + #0;
ConsolePrintf (@s[1]);
_ConsolePrintf (@s[1]);
end;
procedure ConsolePrintf (FormatStr : PCHAR);
procedure _ConsolePrintf (FormatStr : PCHAR);
begin
if NWLoggerScreen = nil then
NWLoggerScreen := getnetwarelogger;
@ -900,7 +900,7 @@ begin
screenprintf (NWLoggerScreen,FormatStr);
end;
procedure ConsolePrintf (FormatStr : PCHAR; Param : LONGINT);
procedure _ConsolePrintf (FormatStr : PCHAR; Param : LONGINT);
begin
if NWLoggerScreen = nil then
NWLoggerScreen := getnetwarelogger;
@ -908,12 +908,12 @@ begin
screenprintf (NWLoggerScreen,FormatStr,Param);
end;
procedure ConsolePrintf (FormatStr : PCHAR; Param : pchar);
procedure _ConsolePrintf (FormatStr : PCHAR; Param : pchar);
begin
ConsolePrintf (FormatStr,longint(Param));
_ConsolePrintf (FormatStr,longint(Param));
end;
procedure ConsolePrintf (FormatStr : PCHAR; P1,P2 : LONGINT);
procedure _ConsolePrintf (FormatStr : PCHAR; P1,P2 : LONGINT);
begin
if NWLoggerScreen = nil then
NWLoggerScreen := getnetwarelogger;
@ -921,7 +921,7 @@ begin
screenprintf (NWLoggerScreen,FormatStr,P1,P2);
end;
procedure ConsolePrintf (FormatStr : PCHAR; P1,P2,P3 : LONGINT);
procedure _ConsolePrintf (FormatStr : PCHAR; P1,P2,P3 : LONGINT);
begin
if NWLoggerScreen = nil then
NWLoggerScreen := getnetwarelogger;
@ -1098,14 +1098,14 @@ function _DLLMain (hInstDLL:pointer; fdwReason:dword; DLLParam:longint):longbool
var res : longbool;
begin
{$ifdef DEBUG_MT}
ConsolePrintf ('_FPC_DLL_Entry called');
_ConsolePrintf ('_FPC_DLL_Entry called');
{$endif}
_DLLMain := false;
isLibrary := true;
case fdwReason of
DLL_ACTUAL_DLLMAIN : _DLLMain := true;
DLL_NLM_STARTUP : begin
//__ConsolePrintf ('DLL_NLM_STARTUP');
//_ConsolePrintf ('DLL_NLM_STARTUP');
if assigned(Dll_Process_Attach_Hook) then
begin
res:=Dll_Process_Attach_Hook(DllParam);
@ -1116,7 +1116,7 @@ begin
_DLLMain := true;
end;
DLL_NLM_SHUTDOWN : begin
//__ConsolePrintf ('DLL_NLM_SHUTDOWN');
//_ConsolePrintf ('DLL_NLM_SHUTDOWN');
TermSigHandler(0);
_DLLMain := true;
end;
@ -1190,7 +1190,10 @@ Begin
End.
{
$Log$
Revision 1.10 2004-12-07 11:40:43 armin
Revision 1.11 2005-01-04 11:25:34 armin
* rtl code cleanup, compat fixes between clib and libc
Revision 1.10 2004/12/07 11:40:43 armin
* implemented GetProcessId, defined TimeVal and TimeZone in addition to TTimeVal, TTimeZone, Makefile defaults to binutilsprefix i386-netware
Revision 1.9 2004/12/05 14:36:38 hajny

8
rtl/netwlibc/sysutils.pp
View File

@ -453,7 +453,7 @@ Begin
else
DiskSize:=-1;}
DiskSize := -1;
__ConsolePrintf ('warning: fpc sysutils.disksize not implemented'#13#10);
ConsolePrintf ('warning: fpc sysutils.disksize not implemented'#13#10);
{$warning DiskSize not implemented (does it make sense ?) }
End;
@ -699,7 +699,10 @@ end.
{
$Log$
Revision 1.7 2004-12-16 12:42:55 armin
Revision 1.8 2005-01-04 11:25:34 armin
* rtl code cleanup, compat fixes between clib and libc
Revision 1.7 2004/12/16 12:42:55 armin
* added NetWare Alert
* added sysutils.sleep
@ -731,4 +734,3 @@ end.
* first rtl version for netwlibc
}