paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-05 09:47:25 +01:00
Code Issues Packages Projects Releases Wiki Activity

* some changes to compile with Delphi

Browse Source
This commit is contained in:
florian 1998-09-18 16:03:37 +00:00
parent d337790969
commit af83d90357
9 changed files with 1426 additions and 187 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
compiler/cobjects.pas
View File

@ -284,7 +284,7 @@ unit cobjects;
i : longint;
begin
w:=ord(p^[0]);
w:=length(p^[0]);
for i:=1 to w do
p^[i-1]:=p^[i];
p^[w]:=#0;
@ -1142,7 +1142,10 @@ end;
end.
{
$Log$
Revision 1.13 1998-08-12 19:28:16 peter
Revision 1.14 1998-09-18 16:03:37 florian
* some changes to compile with Delphi
Revision 1.13 1998/08/12 19:28:16 peter
* better libc support
Revision 1.12 1998/07/14 14:46:47 peter

854
compiler/dmisc.pas Normal file
View File

@ -0,0 +1,854 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1993,97 by the Free Pascal development team.
Dos unit for BP7 compatible RTL
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 dmisc;
interface
uses
windows,sysutils;
Const
Max_Path = 255;
{Bitmasks for CPU Flags}
fcarry = $0001;
fparity = $0004;
fauxiliary = $0010;
fzero = $0040;
fsign = $0080;
foverflow = $0800;
{Bitmasks for file attribute}
readonly = $01;
hidden = $02;
sysfile = $04;
volumeid = $08;
directory = $10;
archive = $20;
anyfile = $3F;
{File Status}
fmclosed = $D7B0;
fminput = $D7B1;
fmoutput = $D7B2;
fminout = $D7B3;
Type
{ Needed for Win95 LFN Support }
ComStr = String[255];
PathStr = String[255];
DirStr = String[255];
NameStr = String[255];
ExtStr = String[255];
FileRec = TFileRec;
DateTime = packed record
Year,
Month,
Day,
Hour,
Min,
Sec : word;
End;
PWin32FindData = ^TWin32FindData;
TWin32FindData = packed record
dwFileAttributes: Cardinal;
ftCreationTime: TFileTime;
ftLastAccessTime: TFileTime;
ftLastWriteTime: TFileTime;
nFileSizeHigh: Cardinal;
nFileSizeLow: Cardinal;
dwReserved0: Cardinal;
dwReserved1: Cardinal;
cFileName: array[0..MAX_PATH - 1] of Char;
cAlternateFileName: array[0..13] of Char;
end;
Searchrec = Packed Record
FindHandle : THandle;
W32FindData : TWin32FindData;
time : longint;
size : longint;
attr : longint;
name : string;
end;
registers = packed record
case i : integer of
0 : (ax,f1,bx,f2,cx,f3,dx,f4,bp,f5,si,f51,di,f6,ds,f7,es,f8,flags,fs,gs : word);
1 : (al,ah,f9,f10,bl,bh,f11,f12,cl,ch,f13,f14,dl,dh : byte);
2 : (eax, ebx, ecx, edx, ebp, esi, edi : longint);
end;
Var
DosError : integer;
{Interrupt}
Procedure Intr(intno: byte; var regs: registers);
Procedure MSDos(var regs: registers);
{Info/Date/Time}
Function DosVersion: Word;
Procedure GetDate(var year, month, mday, wday: word);
Procedure GetTime(var hour, minute, second, sec100: word);
procedure SetDate(year,month,day: word);
Procedure SetTime(hour,minute,second,sec100: word);
Procedure UnpackTime(p: longint; var t: datetime);
Procedure PackTime(var t: datetime; var p: longint);
{Exec}
Procedure Exec(const path: pathstr; const comline: comstr);
Function DosExitCode: word;
{Disk}
Function DiskFree(drive: byte) : longint;
Function DiskSize(drive: byte) : longint;
Procedure FindFirst(const path: pathstr; attr: word; var f: searchRec);
Procedure FindNext(var f: searchRec);
Procedure FindClose(Var f: SearchRec);
{File}
Procedure GetFAttr(var f; var attr: word);
Procedure GetFTime(var f; var time: longint);
Function FSearch(path: pathstr; dirlist: string): pathstr;
Function FExpand(const path: pathstr): pathstr;
Procedure FSplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr);
{Environment}
Function EnvCount: longint;
Function EnvStr(index: integer): string;
Function GetEnv(envvar: string): string;
{Misc}
Procedure SetFAttr(var f; attr: word);
Procedure SetFTime(var f; time: longint);
Procedure GetCBreak(var breakvalue: boolean);
Procedure SetCBreak(breakvalue: boolean);
Procedure GetVerify(var verify: boolean);
Procedure SetVerify(verify: boolean);
{Do Nothing Functions}
Procedure SwapVectors;
Procedure GetIntVec(intno: byte; var vector: pointer);
Procedure SetIntVec(intno: byte; vector: pointer);
Procedure Keep(exitcode: word);
implementation
uses strings,globals;
{******************************************************************************
--- Conversion ---
******************************************************************************}
function GetLastError : DWORD;
external 'kernel32' name 'GetLastError';
function FileTimeToDosDateTime(const ft :TFileTime;var data,time : word) : boolean;
external 'kernel32' name 'FileTimeToDosDateTime';
function DosDateTimeToFileTime(date,time : word;var ft :TFileTime) : boolean;
external 'kernel32' name 'DosDateTimeToFileTime';
function FileTimeToLocalFileTime(const ft : TFileTime;var lft : TFileTime) : boolean;
external 'kernel32' name 'FileTimeToLocalFileTime';
function LocalFileTimeToFileTime(const lft : TFileTime;var ft : TFileTime) : boolean;
external 'kernel32' name 'LocalFileTimeToFileTime';
type
Longrec=packed record
lo,hi : word;
end;
function Last2DosError(d:dword):integer;
begin
Last2DosError:=d;
end;
Function DosToWinAttr (Const Attr : Longint) : longint;
begin
DosToWinAttr:=Attr;
end;
Function WinToDosAttr (Const Attr : Longint) : longint;
begin
WinToDosAttr:=Attr;
end;
Function DosToWinTime (DTime:longint;Var Wtime : TFileTime):boolean;
var
lft : TFileTime;
begin
DosToWinTime:=DosDateTimeToFileTime(longrec(dtime).hi,longrec(dtime).lo,lft) and
LocalFileTimeToFileTime(lft,Wtime);
end;
Function WinToDosTime (Const Wtime : TFileTime;var DTime:longint):boolean;
var
lft : TFileTime;
begin
WinToDosTime:=FileTimeToLocalFileTime(WTime,lft) and
FileTimeToDosDateTime(lft,longrec(dtime).hi,longrec(dtime).lo);
end;
{******************************************************************************
--- Dos Interrupt ---
******************************************************************************}
procedure intr(intno : byte;var regs : registers);
begin
{ !!!!!!!! }
end;
procedure msdos(var regs : registers);
begin
{ !!!!!!!! }
end;
{******************************************************************************
--- Info / Date / Time ---
******************************************************************************}
function GetVersion : longint;
external 'kernel32' name 'GetVersion';
procedure GetLocalTime(var t : TSystemTime);
external 'kernel32' name 'GetLocalTime';
function SetLocalTime(const t : TSystemTime) : boolean;
external 'kernel32' name 'SetLocalTime';
function dosversion : word;
begin
dosversion:=GetVersion;
end;
procedure getdate(var year,month,mday,wday : word);
var
t : TSystemTime;
begin
GetLocalTime(t);
year:=t.wYear;
month:=t.wMonth;
mday:=t.wDay;
wday:=t.wDayOfWeek;
end;
procedure setdate(year,month,day : word);
var
t : TSystemTime;
begin
{ we need the time set privilege }
{ so this function crash currently }
{!!!!!}
GetLocalTime(t);
t.wYear:=year;
t.wMonth:=month;
t.wDay:=day;
{ only a quite good solution, we can loose some ms }
SetLocalTime(t);
end;
procedure gettime(var hour,minute,second,sec100 : word);
var
t : TSystemTime;
begin
GetLocalTime(t);
hour:=t.wHour;
minute:=t.wMinute;
second:=t.wSecond;
sec100:=t.wMilliSeconds div 10;
end;
procedure settime(hour,minute,second,sec100 : word);
var
t : TSystemTime;
begin
{ we need the time set privilege }
{ so this function crash currently }
{!!!!!}
GetLocalTime(t);
t.wHour:=hour;
t.wMinute:=minute;
t.wSecond:=second;
t.wMilliSeconds:=sec100*10;
SetLocalTime(t);
end;
Procedure packtime(var t : datetime;var p : longint);
Begin
p:=(t.sec shr 1)+(t.min shl 5)+(t.hour shl 11)+(t.day shl 16)+(t.month shl 21)+((t.year-1980) shl 25);
End;
Procedure unpacktime(p : longint;var t : datetime);
Begin
with t do
begin
sec:=(p and 31) shl 1;
min:=(p shr 5) and 63;
hour:=(p shr 11) and 31;
day:=(p shr 16) and 31;
month:=(p shr 21) and 15;
year:=(p shr 25)+1980;
end;
End;
{******************************************************************************
--- Exec ---
******************************************************************************}
var
lastdosexitcode : word;
procedure exec(const path : pathstr;const comline : comstr);
var
SI: TStartupInfo;
PI: TProcessInformation;
Proc : THandle;
l : Longint;
AppPath,
AppParam : array[0..255] of char;
begin
FillChar(SI, SizeOf(SI), 0);
SI.cb:=SizeOf(SI);
SI.wShowWindow:=1;
Move(Path[1],AppPath,length(Path));
AppPath[Length(Path)]:=#0;
AppParam[0]:='-';
AppParam[1]:=' ';
Move(ComLine[1],AppParam[2],length(Comline));
AppParam[Length(ComLine)+2]:=#0;
if not CreateProcess(PChar(@AppPath), PChar(@AppParam), Nil, Nil, False,$20, Nil, Nil, SI, PI) then
begin
DosError:=Last2DosError(GetLastError);
exit;
end;
Proc:=PI.hProcess;
CloseHandle(PI.hThread);
if WaitForSingleObject(Proc, Infinite) <> $ffffffff then
GetExitCodeProcess(Proc,l)
else
l:=-1;
CloseHandle(Proc);
LastDosExitCode:=l;
end;
function dosexitcode : word;
begin
dosexitcode:=lastdosexitcode;
end;
procedure getcbreak(var breakvalue : boolean);
begin
{ !! No Win32 Function !! }
end;
procedure setcbreak(breakvalue : boolean);
begin
{ !! No Win32 Function !! }
end;
procedure getverify(var verify : boolean);
begin
{ !! No Win32 Function !! }
end;
procedure setverify(verify : boolean);
begin
{ !! No Win32 Function !! }
end;
{******************************************************************************
--- Disk ---
******************************************************************************}
function diskfree(drive : byte) : longint;
var
disk : array[1..4] of char;
secs,bytes,
free,total : longint;
begin
if drive=0 then
begin
disk[1]:='\';
disk[2]:=#0;
end
else
begin
disk[1]:=chr(drive+64);
disk[2]:=':';
disk[3]:='\';
disk[4]:=#0;
end;
if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
diskfree:=free*secs*bytes
else
diskfree:=-1;
end;
function disksize(drive : byte) : longint;
var
disk : array[1..4] of char;
secs,bytes,
free,total : longint;
begin
if drive=0 then
begin
disk[1]:='\';
disk[2]:=#0;
end
else
begin
disk[1]:=chr(drive+64);
disk[2]:=':';
disk[3]:='\';
disk[4]:=#0;
end;
if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
disksize:=total*secs*bytes
else
disksize:=-1;
end;
{******************************************************************************
--- Findfirst FindNext ---
******************************************************************************}
{ Needed kernel calls }
function FindFirstFile (lpFileName: PChar; var lpFindFileData: TWIN32FindData): THandle;
external 'kernel32' name 'FindFirstFileA';
function FindNextFile (hFindFile: THandle; var lpFindFileData: TWIN32FindData): Boolean;
external 'kernel32' name 'FindNextFileA';
function FindCloseFile (hFindFile: THandle): Boolean;
external 'kernel32' name 'FindClose';
Procedure StringToPchar (Var S : String);
Var L : Longint;
begin
L:=ord(S[0]);
Move (S[1],S[0],L);
S[L]:=#0;
end;
procedure FindMatch(var f:searchrec);
Var
TheAttr : Longint;
begin
TheAttr:=DosToWinAttr(F.Attr);
{ Find file with correct attribute }
While (F.W32FindData.dwFileAttributes and TheAttr)=0 do
begin
if not FindNextFile (F.FindHandle,F.W32FindData) then
begin
DosError:=Last2DosError(GetLastError);
exit;
end;
end;
{ Convert some attributes back }
f.size:=F.W32FindData.NFileSizeLow;
f.attr:=WinToDosAttr(F.W32FindData.dwFileAttributes);
WinToDosTime(F.W32FindData.ftLastWriteTime,f.Time);
f.Name:=StrPas(@F.W32FindData.cFileName);
end;
procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
begin
{ no error }
doserror:=0;
F.Name:=Path;
F.Attr:=attr;
StringToPchar(f.name);
{ FindFirstFile is a Win32 Call. }
F.FindHandle:=FindFirstFile (pchar(@f.Name),F.W32FindData);
If longint(F.FindHandle)=Invalid_Handle_value then
begin
DosError:=Last2DosError(GetLastError);
exit;
end;
{ Find file with correct attribute }
FindMatch(f);
end;
procedure findnext(var f : searchRec);
begin
{ no error }
doserror:=0;
if not FindNextFile (F.FindHandle,F.W32FindData) then
begin
DosError:=Last2DosError(GetLastError);
exit;
end;
{ Find file with correct attribute }
FindMatch(f);
end;
procedure swapvectors;
begin
end;
Procedure FindClose(Var f: SearchRec);
begin
If longint(F.FindHandle)<>Invalid_Handle_value then
FindCloseFile(F.FindHandle);
end;
{******************************************************************************
--- File ---
******************************************************************************}
function GetFileTime(h : longint;creation,lastaccess,lastwrite : PFileTime) : boolean;
external 'kernel32' name 'GetFileTime';
function SetFileTime(h : longint;creation,lastaccess,lastwrite : PFileTime) : boolean;
external 'kernel32' name 'SetFileTime';
function SetFileAttributes(lpFileName : pchar;dwFileAttributes : longint) : boolean;
external 'kernel32' name 'SetFileAttributesA';
function GetFileAttributes(lpFileName : pchar) : longint;
external 'kernel32' name 'GetFileAttributesA';
procedure fsplit(path : pathstr;var dir : dirstr;var name : namestr;var ext : extstr);
var
p1,i : longint;
begin
{ allow slash as backslash }
for i:=1 to length(path) do
if path[i]='/' then path[i]:='\';
{ get drive name }
p1:=pos(':',path);
if p1>0 then
begin
dir:=path[1]+':';
delete(path,1,p1);
end
else
dir:='';
{ split the path and the name, there are no more path informtions }
{ if path contains no backslashes }
while true do
begin
p1:=pos('\',path);
if p1=0 then
break;
dir:=dir+copy(path,1,p1);
delete(path,1,p1);
end;
{ try to find out a extension }
p1:=pos('.',path);
if p1>0 then
begin
ext:=copy(path,p1,4);
delete(path,p1,length(path)-p1+1);
end
else
ext:='';
name:=path;
end;
function fexpand(const path : pathstr) : pathstr;
var
s,pa : string[79];
i,j : longint;
begin
getdir(0,s);
pa:=upper(path);
{ allow slash as backslash }
for i:=1 to length(pa) do
if pa[i]='/' then
pa[i]:='\';
if (length(pa)>1) and (pa[1] in ['A'..'Z']) and (pa[2]=':') then
begin
{ we must get the right directory }
getdir(ord(pa[1])-ord('A')+1,s);
if (ord(pa[0])>2) and (pa[3]<>'\') then
if pa[1]=s[1] then
pa:=s+'\'+copy (pa,3,length(pa))
else
pa:=pa[1]+':\'+copy (pa,3,length(pa))
end
else
if pa[1]='\' then
pa:=s[1]+':'+pa
else if s[0]=#3 then
pa:=s+pa
else
pa:=s+'\'+pa;
{ Turbo Pascal gives current dir on drive if only drive given as parameter! }
if length(pa) = 2 then
begin
getdir(byte(pa[1])-64,s);
pa := s;
end;
{First remove all references to '\.\'}
while pos ('\.\',pa)<>0 do
delete (pa,pos('\.\',pa),2);
{Now remove also all references to '\..\' + of course previous dirs..}
repeat
i:=pos('\..\',pa);
if i<>0 then
begin
j:=i-1;
while (j>1) and (pa[j]<>'\') do
dec (j);
if pa[j+1] = ':' then j := 3;
delete (pa,j,i-j+3);
end;
until i=0;
{ Turbo Pascal gets rid of a \.. at the end of the path }
{ Now remove also any reference to '\..' at end of line
+ of course previous dir.. }
i:=pos('\..',pa);
if i<>0 then
begin
if i = length(pa) - 2 then
begin
j:=i-1;
while (j>1) and (pa[j]<>'\') do
dec (j);
delete (pa,j,i-j+3);
end;
pa := pa + '\';
end;
{ Remove End . and \}
if (length(pa)>0) and (pa[length(pa)]='.') then
dec(byte(pa[0]));
{ if only the drive + a '\' is left then the '\' should be left to prevtn the program
accessing the current directory on the drive rather than the root!}
{ if the last char of path = '\' then leave it in as this is what TP does! }
if ((length(pa)>3) and (pa[length(pa)]='\')) and (path[length(path)] <> '\') then
dec(byte(pa[0]));
{ if only a drive is given in path then there should be a '\' at the
end of the string given back }
if length(path) = 2 then pa := pa + '\';
fexpand:=pa;
end;
Function FSearch(path: pathstr; dirlist: string): pathstr;
var
i,p1 : longint;
s : searchrec;
newdir : pathstr;
begin
{ No wildcards allowed in these things }
if (pos('?',path)<>0) or (pos('*',path)<>0) then
fsearch:=''
else
begin
{ allow slash as backslash }
for i:=1 to length(dirlist) do
if dirlist[i]='/' then dirlist[i]:='\';
repeat
p1:=pos(';',dirlist);
if p1=0 then
begin
newdir:=copy(dirlist,1,p1-1);
delete(dirlist,1,p1);
end
else
begin
newdir:=dirlist;
dirlist:='';
end;
if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
newdir:=newdir+'\';
findfirst(newdir+path,anyfile,s);
if doserror=0 then
newdir:=newdir+path
else
newdir:='';
until (dirlist='') or (newdir<>'');
fsearch:=newdir;
end;
end;
procedure getftime(var f;var time : longint);
var
ft : TFileTime;
begin
if GetFileTime(filerec(f).Handle,nil,nil,@ft) and
WinToDosTime(ft,time) then
exit
else
time:=0;
end;
procedure setftime(var f;time : longint);
var
ft : TFileTime;
begin
if DosToWinTime(time,ft) then
SetFileTime(filerec(f).Handle,nil,nil,@ft);
end;
procedure getfattr(var f;var attr : word);
var
l : longint;
begin
l:=GetFileAttributes(filerec(f).name);
if l=$ffffffff then
doserror:=getlasterror;
attr:=l;
end;
procedure setfattr(var f;attr : word);
begin
doserror:=0;
if not(SetFileAttributes(filerec(f).name,attr)) then
doserror:=getlasterror;
end;
{******************************************************************************
--- Environment ---
******************************************************************************}
{
The environment is a block of zero terminated strings
terminated by a #0
}
function GetEnvironmentStrings : pchar;
external 'kernel32' name 'GetEnvironmentStringsA';
function FreeEnvironmentStrings(p : pchar) : boolean;
external 'kernel32' name 'FreeEnvironmentStringsA';
function envcount : longint;
var
hp,p : pchar;
count : longint;
begin
p:=GetEnvironmentStrings;
hp:=p;
count:=0;
while hp^<>#0 do
begin
{ next string entry}
hp:=hp+strlen(hp)+1;
inc(count);
end;
FreeEnvironmentStrings(p);
envcount:=count;
end;
Function EnvStr(index: integer): string;
var
hp,p : pchar;
count,i : longint;
begin
{ envcount takes some time in win32 }
count:=envcount;
{ range checking }
if (index<=0) or (index>count) then
begin
envstr:='';
exit;
end;
p:=GetEnvironmentStrings;
hp:=p;
{ retrive the string with the given index }
for i:=2 to index do
hp:=hp+strlen(hp)+1;
envstr:=strpas(hp);
FreeEnvironmentStrings(p);
end;
Function GetEnv(envvar: string): string;
var
s : string;
i : longint;
hp,p : pchar;
begin
getenv:='';
p:=GetEnvironmentStrings;
hp:=p;
while hp^<>#0 do
begin
s:=strpas(hp);
i:=pos('=',s);
if copy(s,1,i-1)=envvar then
begin
getenv:=copy(s,i+1,length(s)-i);
break;
end;
{ next string entry}
hp:=hp+strlen(hp)+1;
end;
FreeEnvironmentStrings(p);
end;
{******************************************************************************
--- Not Supported ---
******************************************************************************}
Procedure keep(exitcode : word);
Begin
End;
Procedure getintvec(intno : byte;var vector : pointer);
Begin
End;
Procedure setintvec(intno : byte;vector : pointer);
Begin
End;
end.
{
$Log$
Revision 1.1 1998-09-18 16:03:38 florian
* some changes to compile with Delphi
}

2
compiler/mppc386.bat
View File

@ -1,4 +1,4 @@
ppc386 -al -OGp22 -Ch8000000 -dI386 -dGDB -a -Sg pp.pas %1 %2 %3 %4 %5 %6 %7 %8 %9
ppc386 -OG2p2 -al -Ch8000000 -dI386 -dGDB -a -Sg pp.pas %1 %2 %3 %4 %5 %6 %7 %8 %9
if errorlevel 0 goto success
goto failed
:success

350
compiler/msgtxt.inc
View File

@ -39,425 +39,424 @@ const msgtxt : array[0..00087,1..240] of char=(+
'I_User defined: $1'#000+
'E_Keyword redefined as macro has no effect'#000+
'F_Macro buffer overflow while reading or expanding a macro'#000+
'W_Ex','tension of macros exceeds a deep of 16, perhaps there is a recur'+
'sive macro definition (crashes the compiler)'#000+
'W_Ex','tension of macros exceeds a deep of 16.'#000+
'E_compiler switches aren'#039't allowed in (* ... *) styled comments'#000+
'D_Handling switch "$1"'#000+
'C_ENDIF $1 found'#000+
'C_IFDEF $1 found, $2'#000+
'C_IFOP','T $1 found, $2'#000+
'C_IFOPT $1 found, $2'#000+
'C_IF $1 found, $2'#000+
'C_IFNDEF $1 found, $2'#000+
'C_ELSE $1 found, $2'#000+
'C_ELSE $1 foun','d, $2'#000+
'C_Skipping until...'#000+
'I_Press <return> to continue'#000+
'W_Unsupported switch $1'#000+
'W_Illegal compiler directive $1'#000+
'D_Back in $1'#000+
'W_Unsupported assembler style specified $1'#000+
'E_Wr','ong switch toggle, use ON/OFF or +/-'#000+
'E_Wrong switch toggle, use ON/OFF or +/-'#000+
'E_Parser - Syntax Error'#000+
'W_Procedure type FAR ignored'#000+
'W_Proced','ure type FAR ignored'#000+
'W_Procedure type NEAR ignored'#000+
'E_No DLL File specified'#000+
'E_Constructor name must be INIT'#000+
'E_Destructor name must be DONE'#000+
'E_Illegal open parameter'#000+
'E_Proced','ure type INLINE not supported'#000+
'W_Private methods shouldn'#039't be VIRTUAL'#000+
'E_Procedure type INLINE not supported'#000+
'W_Private methods shouldn'#039't be VIRTUAL'#000,+
'W_Constructor should be public'#000+
'W_Destructor should be public'#000+
'N_Class should have one destructor only'#000+
'E_Local class definitions are not allowed'#000+
'E_Anonym class definitions a','re not allowed'#000+
'E_Anonym class definitions are not allowed'#000+
'E_Illegal parameter list'#000+
'E_Wrong parameter type specified'#000+
'E_Wrong parameter type specif','ied'#000+
'E_Wrong amount of parameters specified'#000+
'E_overloaded identifier isn'#039't a function identifier'#000+
'E_overloaded functions have the same parameter list'#000+
'E_function header doesn'#039,'t match the forward declaration $1'#000+
'N_only values can be jumped over in enumeration types'#000+
'E_function header doesn'#039't match the forward declaration $1'#000+
'N_only values can be jumped over i','n enumeration types'#000+
'N_Interface and implementation names are different !'#000+
'E_function nesting > 31'#000+
'E_range check error while evaluating constants'#000+
'E_duplicate case label'#000+
'E_ty','ped constants of classes are not allowed'#000+
'E_functions variables of overloaded functions are not allowed'#000+
'E_typed constants of classes are not allowed'#000+
'E_functions variables of ove','rloaded functions are not allowed'#000+
'E_string length must be a value from 1 to 255'#000+
'W_use extended syntax of DISPOSE and NEW to generate instances of obje'+
'cts'#000+
'E_class identifie','r expected'#000+
'E_class identifier expected'#000+
'E_method identifier expected'#000+
'E_function header doesn'#039't match any method of this class'#000+
'E_function header doesn'#039't mat','ch any method of this class'#000+
'P_procedure/function $1'#000+
'E_Illegal floating point constant'#000+
'E_FAIL can be used in constructors only'#000+
'E_Destructors can'#039't have parameters'#000+
'E_Only cl','ass methods can be referred with class references'#000+
'E_Only class methods can be accessed in class methods'#000+
'E_Only class methods can be referred with class references'#000+
'E_Only class method','s can be accessed in class methods'#000+
'E_Constant and CASE types do not match'#000+
'E_The symbol can'#039't be exported from a library'#000+
'W_A inherited method is hidden by $1'#000+
'E_There is no ','method in an ancestor class to be overridden: $1'#000+
'E_No member is provided to access property'#000+
'E_There is no method in an ancestor class to be overridden: $1'#000+
'E_No member is provi','ded to access property'#000+
'E_Illegal symbol for property access'#000+
'E_Cannot access a protected field of an object here'#000+
'E_Cannot access a private field of an object here'#000+
'W_overloa','ded of virtual method must be virtual: $1'#000+
'E_overloaded methods which are virtual must have the same return type:'+
' $1'#000+
'W_overloaded of virtual method must be virtual: $1'#000+
'E_overloaded methods which ','are virtual must have the same return typ'+
'e: $1'#000+
'E_EXPORT declared functions can'#039't be nested'#000+
'E_methods can'#039't be EXPORTed'#000+
'E_call by var parameters have to match exactly'#000+
'E_Cla','ss isn'#039't a super class of the current class'#000+
'E_SELF is only allowed in methods'#000+
'E_Class isn'#039't a parent class of the current class'#000+
'E_SELF is only allowed i','n methods'#000+
'E_methods can be only in other methods called direct with type identif'+
'ier of the class'#000+
'E_Illegal use of '#039':'#039#000+
'E_range check error in set constructor or duplicate se','t element'#000+
'E_Pointer to class expected'#000+
'E_Expression must be constructor call'#000+
'E_range check error in set constructor or duplicate set element'#000+
'E_Pointer to object expected'#000+
'E_Expression must be construc','tor call'#000+
'E_Expression must be destructor call'#000+
'E_Illegal order of record elements'#000+
'E_Expression type must by class or record type'#000+
'E_Functions with void return value can'#039't retu','rn any value'#000+
'E_Expression type must be class or record type'#000+
'E_Functions with void return value can'#039't return any value'#000+
'E_constructors and destructors must be methods'#000+
'E_Operator is not overloaded'#000+
'E_Opera','tor is not overloaded'#000+
'E_Re-raise isn'#039't possible there'#000+
'E_The extended syntax of new or dispose isn'#039't allowed for a class'#000+
'E_Assembler incompatible with function return value'#000+
'E','_Procedure overloading is switched off'#000+
'E_It is not possible to overload this operator (overload = instead)'#000+
'E_Procedure overloading is switched off'#000+
'E_It is not possible to over','load this operator (overload = instead)'#000+
'E_Comparative operator must return a boolean value'#000+
'E_Only virtual methods can be abstract'#000+
'F_Use of unsupported feature!'#000+
'E_The mix of ','CLASSES and OBJECTS isn'#039't allowed'#000+
'W_Unknown procedure directive had to be ignored: $1'#000+
'E_The mix of CLASSES and OBJECTS isn'#039't allowed'#000+
'W_Unknown procedure directive had',' to be ignored: $1'#000+
'E_absolute can only be associated to ONE variable'#000+
'E_absolute can only be associated a var or const'#000+
'E_Abtract methods shouldn'#039't have any definition (with f','unction b'+
'ody)'#000+
'E_This overloaded function can'#039't be local (must be exported)'#000+
'E_Abtract methods shouldn'#039't have any definition (with function bod'+
'y)'#000+
'E_This overloaded function can'#039't be local (must be ex','ported)'#000+
'W_Virtual methods are used without a constructor in $1'#000+
'M_Macro defined: $1'#000+
'M_Macro undefined: $1'#000+
'M_Macro $1 set to $2'#000+
'I_Compiling $1'#000+
'D_Compiling $1 for the second ti','me'#000+
'D_Compiling $1 for the second time'#000+
'E_Array properties aren'#039't allowed at this point'#000+
'E_No property found to override'#000+
'E_No property fo','und to override'#000+
'E_Only one default property is allowed, found inherited default proper'+
'ty in class %1'#000+
'ty in class $1'#000+
'E_The default property must be an array property'#000+
'E_Virtual constructors ','are only supported in class object model'#000+
'E_No default property available'#000+
'E_Virtual constructors are only supported in class object model'#000+
'E_No default property avai','lable'#000+
'E_The class can'#039't have a published section, use the {$M+} switch'#000+
'E_Forward declaration of class $1 must be resolved here to use the cla'+
'ss as anchestor'#000+
'E_Local operator','s not supported'#000+
'E_Procedure directive $1 not allowed in interface section'#000+
'ss as ancestor'#000+
'E_Local operators not supported'#000+
'E_Procedure directive $1 not allowed in interface se','ction'#000+
'E_Procedure directive $1 not allowed in implementation section'#000+
'E_Procedure directive $1 not allowed in procvar declaration'#000+
'E_Function is already declared Public/Forwa','rd $1'#000+
'E_Function is already declared Public/Forward $1'#000+
'E_Can'#039't use both EXPORT and EXTERNAL'#000+
'E_NAME keyword expected'#000+
'W_$1 not yet supported inside inline procedure/function'#000+
'W','_$1 not yet supported inside inline procedure/function'#000+
'W_Inlining disabled'#000+
'I_Writing Browser log $1'#000+
'H_may be pointer deref ^ is missing'#000+
'F_Selected assembler reader not supp','orted'#000+
'E_Procedure directive $1 has conflicts with other directives'#000+
'H_may be pointer dereference is missing'#000+
'F_Selected assembler reader not supported'#000+
'E_Procedure directive $1 has conflicts with other directiv','es'#000+
'E_Calling convention doesn'#039't match forward'#000+
'E_Register calling (fastcall) not supported'#000+
'E_Property can'#039't have a default value'#000+
'E_The default value of a property must be consta','nt'#000+
'E_The default value of a property must be constant'#000+
'E_Symbol can'#039't be published, can be only a class'#000+
'E_That kind of property can'#039't be published'#000+
'E_That kind ','of property can'#039't be published'#000+
'E_Type mismatch'#000+
'E_Integer expression expected'#000+
'E_Ordinal expression expected'#000+
'E_Type identifier expected'#000+
'E_Variable identifier expected'#000+
'E_pointer t','ype expected'#000+
'E_pointer type expected'#000+
'E_class type expected'#000+
'E_Variable or type indentifier expected'#000+
'E_Variable or type indentifie','r expected'#000+
'E_Can'#039't evaluate constant expression'#000+
'E_Set elements are not compatible'#000+
'W_Automatic type conversion from floating type to COMP which is an int'+
'eger type'#000+
'W_Using / will',' give a floating point result'#000+
'H_use DIV instead to get an integer result'#000+
'W_Using / will give a floating point result'#000+
'H_use DIV instead to get an intege','r result'#000+
'E_string types doesn'#039't match, because of $V+ mode'#000+
'E_succ or pred on enums with assignments not possible'#000+
'E_Can'#039't read or write variables of this type'#000+
'E_Type conflict be','tween set elements'#000+
'E_Type conflict between set elements'#000+
'E_Integer or real expression expected'#000+
'E_Identifier not found $1'#000+
'E_Ident','ifier not found $1'#000+
'F_Internal Error in SymTableStack()'#000+
'E_Duplicate identifier $1'#000+
'E_Unknown identifier $1'#000+
'E_Forward declaration not solved: $1'#000+
'F_Identifier type already defined ','as type'#000+
'F_Identifier type already defined as type'#000+
'E_Error in type defenition'#000+
'E_Type identifier not defined'#000+
'E_Type identifier not defined',#000+
'E_Only static variables can be used in static methods or outside metho'+
'ds'#000+
'E_Invalid call to tvarsym.mangledname()'#000+
'F_record or class type expected'#000+
'E_To generate an instance of a',' class or an object with an abtract me'+
'thod isn'#039't allowed'#000+
'E_Label not defined $1'#000+
'E_Instances of classes or objects with an abtsract method are not allo'+
'wed'#000+
'E_Label not defined ','$1'#000+
'E_Illegal label declaration'#000+
'E_GOTO und LABEL are not supported (use command line switch -Sg)'#000+
'E_Label not found'#000+
'E_identifier isn'#039't a label'#000+
'E_label already define','d'#000+
'E_label already defined'#000+
'E_illegal type declaration of set elements'#000+
'E_Forward class definition not resolved $1'#000+
'E_Forward class definition not r','esolved $1'#000+
'H_Parameter not used $1'#000+
'W_Local variable not used $1'#000+
'E_Set type expected'#000+
'W_Function result does not seem to be set'#000+
'E_Unknown field identifier'#000+
'W_Local va','riable $1 does not seem to be initialized'#000+
'W_Local variable $1 does not seem to be initialized'#000+
'E_identifier idents no member $1'#000+
'B_Found declaration: $1'#000+
'B_','Found declaration: $1'#000+
'E_BREAK not allowed'#000+
'E_CONTINUE not allowed'#000+
'E_Expression too complicated - FPU stack overflow'#000+
'E_Illegal expression'#000+
'E_Invalid integer'#000+
'E_Illegal',' qualifier'#000+
'E_Illegal qualifier'#000+
'E_High range limit < low range limit'#000+
'E_Illegal counter variable'#000+
'E_Can'#039't determine which overloaded function to call'#000+
'E_','Can'#039't determine which overloaded function to call'#000+
'E_Parameter list size exceeds 65535 bytes'#000+
'E_Illegal type conversion'#000+
'E_File types must be var parameters'#000+
'E_The use',' of a far pointer isn'#039't allowed there'#000+
'E_illegal call by reference parameters'#000+
'E_The use of a far pointer isn'#039't allowed there'#000+
'E_illegal call by reference parameters'#000,+
'E_EXPORT declared functions can'#039't be called'#000+
'W_Possible illegal call of constructor or destructor (doesn'#039't matc'+
'h to this context)'#000+
'N_Inefficient code'#000+
'W_unreachable c','ode'#000+
'W_unreachable code'#000+
'E_procedure call with stackframe ESP/SP'#000+
'E_Abstract methods can'#039't be called directly'#000+
'E_Abstract methods can'#039't be calle','d directly'#000+
'F_Internal Error in getfloatreg(), allocation failure'#000+
'F_Unknown float type'#000+
'F_SecondVecn() base defined twice'#000+
'F_Extended cg68k not supported'#000+
'F_32-bit uns','igned not supported in MC68000 mode'#000+
'F_32-bit unsigned not supported in MC68000 mode'#000+
'F_Internal Error in secondinline()'#000+
'D_Register $1 weight $2 $3'#000+
'D_Regi','ster $1 weight $2 $3'#000+
'E_Stack limit excedeed in local routine'#000+
'D_Stack frame is omited'#000+
'E_Unable to inline object methods'#000+
'E_Unable to inline procvar calls'#000+
'E_No code f','or inline procedure stored'#000+
'E_No code for inline procedure stored'#000+
'F_Divide by zero in asm evaluator'#000+
'F_Evaluator stack overflow'#000+
'F_Evaluator stac','k overflow'#000+
'F_Evaluator stack underflow'#000+
'F_Invalid numeric format in asm evaluator'#000+
'F_Invalid Operator in asm evaluator'#000+
'F_Unknown error in asm evaluator'#000+
'W_Invalid num','eric value'#000+
'W_Invalid numeric value'#000+
'E_escape sequence ignored: $1'#000+
'E_Asm syntax error - Prefix not found'#000+
'E_Asm syntax error - Prefix not foun','d'#000+
'E_Asm syntax error - Trying to add more than one prefix'#000+
'E_Asm syntax error - Opcode not found'#000+
'E_Invalid symbol reference'#000+
'W_Calling an overload function in an asm',#000+
'W_Calling an overload function in an asm'#000+
'E_Constant value out of bounds'#000+
'E_Non-label pattern contains @'#000+
'E_Invalid Operand: $1'#000+
'E_Invalid Oper','and: $1'#000+
'W_Override operator not supported'#000+
'E_Error in binary constant: $1'#000+
'E_Error in octal constant: $1'#000+
'E_Error in hexadecimal constant: $1'#000+
'E_Error in integer const','ant: $1'#000+
'E_Error in integer constant: $1'#000+
'E_Invalid labeled opcode'#000+
'F_Internal error in Findtype()'#000+
'E_Invalid size for MOVSX/MOVZX'#000+
'E_Invalid siz','e for MOVSX/MOVZX'#000+
'E_16-bit base in 32-bit segment'#000+
'E_16-bit index in 32-bit segment'#000+
'E_Invalid Opcode'#000+
'E_Constant reference not allowed'#000+
'W_Fwait can cause emulation pr','oblems with emu387'#000+
'W_Fwait can cause emulation problems with emu387'#000+
'E_Invalid combination of opcode and operands'#000+
'W_Opcode $1 not in table, operands not checked'#000+
'W_Opcode $1 n','ot in table, operands not checked'#000+
'F_Internal Error in ConcatOpcode()'#000+
'E_Invalid size in reference'#000+
'E_Invalid middle sized operand'#000+
'E_Invalid three operand opcode'#000+
'E_As','sembler syntax error'#000+
'E_Assembler syntax error'#000+
'E_Invalid operand type'#000+
'E_Segment overrides not supported'#000+
'E_Segment overrides not supported',#000+
'E_Invalid constant symbol $1'#000+
'F_Internal Errror converting binary'#000+
'F_Internal Errror converting hexadecimal'#000+
'F_Internal Errror converting octal'#000+
'E_Invalid constant ex','pression'#000+
'E_Invalid constant expression'#000+
'E_Unknown identifier: $1'#000+
'E_Trying to define an index register more than once'#000+
'E_Trying to define an index register more t','han once'#000+
'E_Invalid field specifier'#000+
'F_Internal Error in BuildScaling()'#000+
'E_Invalid scaling factor'#000+
'E_Invalid scaling value'#000+
'E_Scaling value only allowed with index'#000+
'E_In','valid assembler syntax. No ref with brackets)'#000+
'E_Expressions of the form [sreg:reg...] are currently not supported'#000+
'E_Invalid assembler syntax. No ref with brackets)'#000+
'E_Expressions of the form [sreg',':reg...] are currently not supported'#000+
'E_Trying to define a segment register twice'#000+
'E_Trying to define a base register twice'#000+
'E_Trying to use a negative index register',#000+
'E_Trying to use a negative index register'#000+
'E_Asm syntax error - error in reference'#000+
'E_Local symbols not allowed as references'#000+
'E_Local symbols not allowed as refer','ences'#000+
'E_Invalid operand in bracket expression'#000+
'E_Invalid symbol name: $1'#000+
'E_Invalid Reference syntax'#000+
'E_Invalid string as opcode operand: $1'#000+
'W_@CODE and @DATA not sup','ported'#000+
'W_@CODE and @DATA not supported'#000+
'E_Null label references are not allowed'#000+
'W_Calling of an overloaded function in direct assembler'#000+
'W_Calling of an overloaded fun','ction in direct assembler'#000+
'E_Cannot use SELF outside a method'#000+
'E_Asm syntax error - Should start with bracket'#000+
'E_Asm syntax error - register: $1'#000+
'E_SEG and OFFSET not ','supported'#000+
'E_SEG and OFFSET not supported'#000+
'E_Asm syntax error - in opcode operand'#000+
'E_Invalid String expression'#000+
'E_Invalid String expression'#000,+
'E_Constant expression out of bounds'#000+
'F_Internal Error in BuildConstant()'#000+
'W_A repeat prefix and a segment override on <= i386 may result in erro'+
'rs if an interrupt oc','curs'#000+
'rs if an interrupt occurs'#000+
'E_Invalid or missing opcode'#000+
'E_Invalid combination of prefix and opcode: $1'#000+
'E_Invalid combination of prefix and opcode: ','$1'#000+
'E_Invalid combination of override and opcode: $1'#000+
'E_Too many operands on line'#000+
'E_Duplicate local symbol: $1'#000+
'E_Unknown label identifer: $1'#000+
'E_Assemble node syntax e','rror'#000+
'E_Assemble node syntax error'#000+
'E_Undefined local symbol: $1'#000+
'D_Starting intel styled assembler parsing...'#000+
'D_Starting intel styled assembler parsing..','.'#000+
'D_Finished intel styled assembler parsing...'#000+
'E_Not a directive or local symbol: $1'#000+
'E_/ at beginning of line not allowed'#000+
'E_NOR not supported'#000+
'E_Invalid floating po','int register name'#000+
'E_Invalid floating point register name'#000+
'W_Modulo not supported'#000+
'E_Invalid floating point constant: $1'#000+
'E_Invalid floating point constant: $','1'#000+
'E_Size suffix and destination register do not match'#000+
'E_Internal error in ConcatLabeledInstr()'#000+
'W_Floating point binary representation ignored'#000+
'W_Floating point hexa','decimal representation ignored'#000+
'W_Floating point octal representation ignored'#000+
'W_Floating point hexadecimal representation ignored'#000+
'W_Floating point octal representation ignored'#000,+
'E_Invalid real constant expression'#000+
'E_Parenthesis are not allowed'#000+
'E_Invalid Reference'#000+
'E_Cannot use __SELF outside a method'#000+
'E_Cannot use __OLDEBP outside a nested pr','ocedure'#000+
'E_Cannot use __OLDEBP outside a nested procedure'#000+
'W_Identifier $1 supposed external'#000+
'E_Invalid segment override expression'#000+
'E_Invalid segment override expressi','on'#000+
'E_Strings not allowed as constants'#000+
'D_Starting AT&T styled assembler parsing...'#000+
'D_Finished AT&T styled assembler parsing...'#000+
'E_Switching sections is not allowed i','n an assembler block'#000+
'E_Switching sections is not allowed in an assembler block'#000+
'E_Invalid global definition'#000+
'E_Line separator expected'#000+
'W_globl not supported'#000+
'W_','globl not supported'#000+
'W_align not supported'#000+
'W_lcomm not supported'#000+
'W_comm not supported'#000+
'E_Invalid local common definition'#000+
'E_Invalid global common definition'#000+
'E_local s','ymbol: $1 not found inside asm statement'#000+
'E_assembler code not returned to text'#000+
'E_local symbol: $1 not found inside asm statement'#000+
'E_assembler code not returned to tex','t'#000+
'F_internal error in BuildReference()'#000+
'E_invalid opcode size'#000+
'W_NEAR ignored'#000+
'W_FAR ignored'#000+
'D_Creating inline asm lookup tables'#000+
'W_Using a defined name as a local lab','el'#000+
'W_Using a defined name as a local label'#000+
'F_internal error in HandleExtend()'#000+
'E_Invalid character: <'#000+
'E_Invalid character: >'#000+
'E_Invalid charac','ter: >'#000+
'E_Unsupported opcode'#000+
'E_Increment and Decrement mode not allowed together'#000+
'E_Invalid Register list in movem/fmovem'#000+
'E_Invalid Register list for opcode'#000+
'E_68020+',' mode required to assemble'#000+
'E_68020+ mode required to assemble'#000+
'D_Starting Motorola styled assembler parsing...'#000+
'D_Finished Motorola styled assembler parsing...'#000+
'D_','Finished Motorola styled assembler parsing...'#000+
'W_XDEF not supported'#000+
'W_Functions with void return value can'#039't return any value in asm c'+
'ode'#000+
'E_Invalid suffix for intel',' assembler'#000+
'E_Invalid suffix for intel assembler'#000+
'E_Extended not supported in this mode'#000+
'E_Comp not supported in this mode'#000+
'E_Comp not supported in this',' mode'#000+
'W_You need GNU as version >= 2.81 to compile this MMX code'#000+
'F_Too many assembler files'#000+
'F_Selected assembler output not supported'#000+
'E_Unsupported symbol type for',' operand'#000+
'E_Unsupported symbol type for operand'#000+
'I_Assembling (pipe) $1'#000+
'E_Can'#039't create assember file $1'#000+
'W_Assembler $1 not found, switching to external assembling'#000+
'W_Assembler $','1 not found, switching to external assembling'#000+
'U_Using assembler: $1'#000+
'W_Error while assembling exitcode $1'#000+
'W_Can'#039't call the assembler, error $1 switching to external',' assem'+
'bling'#000+
'W_Can'#039't call the assembler, error $1 switching to external assembl'+
'ing'#000+
'I_Assembling $1'#000+
'W_Linker $1 not found, switching to external linking'#000+
'W_Linker $1 not found, switching to external link','ing'#000+
'U_Using linker: $1'#000+
'W_Object $1 not found, Linking may fail !'#000+
'W_Library $1 not found, Linking may fail !'#000+
'W_Error while linking'#000+
'W_Can'#039't call the linker, switchin','g to external linking'#000+
'W_Can'#039't call the linker, switching to external linking'#000+
'I_Linking $1'#000+
'W_binder not found, switching to external binding'#000+
'W_binder not found, switching to external ','binding'#000+
'W_ar not found, switching to external ar'#000+
'E_Dynamic Libraries not supported'#000+
'I_Closing script $1'#000+
'U_PPU Loading $1'#000+
'D_PPU Time: $1'#000+
'D_PPU File too short'#000+
'D_PPU I','nvalid Header (no PPU at the begin)'#000+
'D_PPU Invalid Header (no PPU at the begin)'#000+
'D_PPU Invalid Version $1'#000+
'D_PPU Flags: $1'#000+
'D_PPU Flags: $1'#000,+
'D_PPU Crc: $1'#000+
'T_PPU Source: $1'#000+
'D_objectfile and assemblerfile are older than ppufile'#000+
'D_objectfile is older than assemblerfile'#000+
'T_Unitsearch: $1'#000+
'U_Writing $1'#000+
'F_Can'#039't',' Write PPU-File'#000+
'F_Can'#039't Write PPU-File'#000+
'F_reading PPU-File'#000+
'F_Invalid PPU-File entry: $1'#000+
'F_PPU Dbx count problem'#000+
'F_PPU Dbx cou','nt problem'#000+
'E_Illegal unit name: $1'#000+
'F_Too much units'#000+
'F_Circular unit reference'#000+
'F_Can'#039't compile unit $1, no sources available'#000+
'W_Compiling the system unit requires th','e -Us switch'#000+
'W_Compiling the system unit requires the -Us switch'#000+
'F_There were $1 errors compiling module, stopping'#000+
'$1 [options] <inputfile> [options]'#000+
'$1 [options] <','inputfile> [options]'#000+
'W_Only one source file supported'#000+
'W_DEF file can be created only for OS/2'#000+
'E_nested response files are not supported'#000+
'F_No source file name in co','mmand line'#000+
'F_No source file name in command line'#000+
'E_Illegal parameter: $1'#000+
'H_-? writes help pages'#000+
'F_Too many config files nested'#000+
'F_Too many config f','iles nested'#000+
'F_Unable to open file $1'#000+
'N_Reading further options from $1'#000+
'W_Target is already set to: $1'#000+
'W_Shared libs not supported on DOS platform, reverting to sta','tic'#000+
'W_Shared libs not supported on DOS platform, reverting to static'#000+
'F_too many IF(N)DEFs'#000+
'F_too many ENDIFs'#000+
'F_open conditional at the end of the file'#000+
'F_open conditional at the end of t','he file'#000+
'W_Debug information generation is not supported by this executable'#000+
'H_Try recompiling with -dGDB'#000+
'Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTAR','GET'#000+
'Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#000+
'Copyright (c) 1993-98 by Florian Klaempfl'#000+
'Free Pascal Compiler version $FPCVER'#000+
'Free Pascal Compiler version $F','PCVER'#000+
#000+
'Compiler Date : $FPCDATE'#000+
'Compiler Target: $FPCTARGET'#000+
@ -465,39 +464,39 @@ const msgtxt : array[0..00087,1..240] of char=(+
'This program comes under the GNU General Public Licence'#000+
'For more information read COPYING.FPC'#000+
#000+
'Report',' bugs,suggestions etc to:'#000+
'Report bugs,suggestions etc to:'#000+
' fpc-devel@mail.tolna.hungary.net'#000+
'**0*_+ switch option on, - off'#000+
'**','0*_+ switch option on, - off'#000+
'**1a_the compiler doesn'#039't delete the generated assembler file'#000+
'**2al_list sourcecode lines in assembler file (still BETA !!)'#000+
'*t1b_use ','EMS'#000+
'*t1b_use EMS'#000+
'**1B_build all modules'#000+
'**1C_code generation options'#000+
'3*2CD_create dynamic library'#000+
'3*2CD_create dynamic ','library'#000+
'**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#000+
'**2Ci_IO-checking'#000+
'**2Cn_omit linking stage'#000+
'**2Co_check overflow of integer operations'#000+
'**2Cr_range check','ing'#000+
'**2Cr_range checking'#000+
'**2Cs<n>_set stack size to <n>'#000+
'**2Ct_stack checking'#000+
'3*2CS_create static library'#000+
'3*2CS_create static l','ibrary'#000+
'3*2Cx_use smartlinking'#000+
'**1d<x>_defines the symbol <x>'#000+
'*O1D_generate a DEF file'#000+
'*O2Dd<x>_set description to <x>'#000+
'*O2Dw_PM application'#000+
'**1e<x>_set path to exec','utable'#000+
'**1e<x>_set path to executable'#000+
'**1E_same as -Cn'#000+
'**1F_set file names and paths'#000+
'**2Fe<x>_redirect error output to <x>'#000+
'**2Fe<x>_redirect error',' output to <x>'#000+
'*L2Fg<x>_same as -Fl'#000+
'**2Fi<x>_adds <x> to include path'#000+
'**2Fl<x>_adds <x> to library path'#000+
'*L2FL<x>_uses <x> as dynamic linker'#000+
'**2Fo<x>_adds <x> to ob','ject path'#000+
'**2Fo<x>_adds <x> to object path'#000+
'**2Fr<x>_load error message file <x>'#000+
'**2Fu<x>_adds <x> to unit path'#000+
'**2Fu<x>_adds <x> to unit path',#000+
'*g1g_generate debugger information'#000+
'*g2gg_use gsym'#000+
'*g2gd_use dbx'#000+
@ -505,90 +504,89 @@ const msgtxt : array[0..00087,1..240] of char=(+
'**1I<x>_adds <x> to include path'#000+
'**1k<x>_Pass <x> to the linker'#000+
'**1l_write logo'#000+
'*','*1n_don'#039't read the default config file'#000+
'**1o<x>_change the name of the executable produced to <x>'#000+
'**1n_don'#039't read the default config file'#000+
'**1o<x>_change the name of the executa','ble produced to <x>'#000+
'**1pg_generate profile code for gprof'#000+
'*L1P_use pipes instead of creating temporary assembler files'#000+
'**1S_syntax options'#000+
'**2S2_switch some Delphi',' 2 extensions on'#000+
'**2S2_switch some Delphi 2 extensions on'#000+
'**2Sc_supports operators like C (*=,+=,/= and -=)'#000+
'**2Sd_compiler disposes asm lists (uses less memory but slower)'#000+
'**2Sd_comp','iler disposes asm lists (uses less memory but slower)'#000+
'**2Se_compiler stops after the first error'#000+
'**2Sg_allow LABEL and GOTO'#000+
'**2Si_support C++ stlyed INLINE'#000+
'**2Sm_s','upport macros like C (global)'#000+
'**2Sm_support macros like C (global)'#000+
'**2So_tries to be TP/BP 7.0 compatible'#000+
'**2Sp_tries to be gpc compatible'#000+
'**2Sp_tr','ies to be gpc compatible'#000+
'**2Ss_constructor name must be init (destructor must be done)'#000+
'**2St_allow static keyword in objects'#000+
'**2Sv_allow variable directives (cvar,','external,public,export)'#000+
'**2Sv_allow variable directives (cvar,external,public,export)'#000+
'**1s_don'#039't call assembler and linker (only with -a)'#000+
'**1T<x>_Target operating system'#000+
'*','*1T<x>_Target operating system'#000+
'3*2TGO32V1_version 1 of DJ Delorie DOS extender'#000+
'3*2TGO32V2_version 2 of DJ Delorie DOS extender'#000+
'3*2TLINUX_Linux'#000+
'3*2TOS2_OS/2 2.x'#000+
'3*2','TWin32_Windows 32 Bit'#000+
'3*2TWin32_Windows 32 Bit'#000+
'6*2TAMIGA_Commodore Amiga'#000+
'6*2TATARI_Atari ST/STe/TT'#000+
'6*2TMACOS_Macintosh m68k'#000+
'6*2','TMACOS_Macintosh m68k'#000+
'6*2TLINUX_Linux-68k'#000+
'**1u<x>_undefines the symbol <x>'#000+
'**1U_unit options'#000+
'**2Un_don'#039't check the unit name'#000+
'**2Up<x>_same as -Fu<x>'#000+
'**2Us_compile ','a system unit'#000+
'**1v<x>_Be verbose. <x> is a combination of the following letters :'#000+
'**2Us_compile a system unit'#000+
'**1v<x>_Be verbose. <x> is a combination of the following lette','rs :'#000+
'**2*_e : Show errors (default) d : Show debug info'#000+
'**2*_w : Show warnings u : Show used files'#000+
'**2*_n : Show notes t : Sho','w tried files'#000+
'**2*_n : Show notes t : Show tried files'#000+
'**2*_h : Show hints m : Show defined macros'#000+
'**2*_i : Show general info p : Show compiled procedures'#000+
'**','2*_i : Show general info p : Show compiled procedures'#000+
'**2*_l : Show linenumbers c : Show conditionals'#000+
'**2*_a : Show everything 0 :',' Show nothing (except errors'+
')'#000+
'**2*_a : Show everything 0 : Show nothing (except errors)'#000+
'**2*_b : Show all procedure'#000+
'**2*_ declarations if an error'#000+
'**2*_ declaratio','ns if an error'#000+
'**2*_ occurs'#000+
'**1X_executable options'#000+
'*L2Xc_link with the c library'#000+
'**2XD_link with dynamic libraries (defines FPC_LINK_DYNAMIC)'#000+
'**2Xs_strip all s','ymbols from executable'#000+
'**2XS_link with static libraries (defines FPC_LINK_STATIC)'#000+
'**2Xs_strip all symbols from executable'#000+
'**2XS_link with static libraries (defines FPC_LINK_STA','TIC)'#000+
'**0*_Processor specific options:'#000+
'3*1A_output format'#000+
'3*2Ao_coff file using GNU AS'#000+
'3*2Anasmcoff_coff file using Nasm'#000+
'3*2Anasmelf_elf32 (linux) file using Nasm'#000+
'3','*2Anasmobj_obj file using Nasm'#000+
'3*2Anasmobj_obj file using Nasm'#000+
'3*2Amasm_obj using Masm (Mircosoft)'#000+
'3*2Atasm_obj using Tasm (Borland)'#000+
'3*2Atasm_o','bj using Tasm (Borland)'#000+
'3*1R_assembler reading style'#000+
'3*2Ratt_read AT&T style assembler'#000+
'3*2Rintel_read Intel style assembler'#000+
'3*2Rdirect_copy assembler text directly',' to assembler file'#000+
'3*2Rdirect_copy assembler text directly to assembler file'#000+
'3*1O<x>_optimizations'#000+
'3*2Og_generate smaller code'#000+
'3*2OG_generate faster code (default)'#000+
'3*2OG_ge','nerate faster code (default)'#000+
'3*2Or_keep certain variables in registers (still BUGGY!!!)'#000+
'3*2Ou_enable uncertain optimizations (see docs)'#000+
'3*2O1_level 1 optimizations',' (quick optimizations)'#000+
'3*2O2_level 2 optimizations (-O1 + slower optimizations)'#000+
'3*2O1_level 1 optimizations (quick optimizations)'#000+
'3*2O2_level 2 optimizations (-O1 + slower optimization','s)'#000+
'3*2O3_level 3 optimizations (same as -O2u)'#000+
'3*2Op_target processor'#000+
'3*3Op1_set target processor to 386/486'#000+
'3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#000,+
'3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#000+
'3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#000+
'6*1A_output format'#000+
'6*2Ao_Unix o-file using GNU AS'#000+
'6*2A','o_Unix o-file using GNU AS'#000+
'6*2Agas_GNU Motorola assembler'#000+
'6*2Amit_MIT Syntax (old GAS)'#000+
'6*2Amot_Standard Motorola assembler'#000+
'6*1O_optimizations'#000+
'6*2Oa_turn on the opt','imizer'#000+
'6*2Oa_turn on the optimizer'#000+
'6*2Og_generate smaller code'#000+
'6*2OG_generate faster code (default)'#000+
'6*2Ox_optimize maximum (still BUGGY!!!)'#000+
'6*2Ox','_optimize maximum (still BUGGY!!!)'#000+
'6*2O2_set target processor to a MC68020+'#000+
'**1*_'#000+
'**1?_shows this help'#000+

7
compiler/pexpr.pas
View File

@ -655,7 +655,7 @@ unit pexpr;
l : longint;
oldp1,
p1,p2,p3 : ptree;
code : word;
code : integer;
pd,pd2 : pdef;
possible_error,
unit_specific,
@ -1856,7 +1856,10 @@ unit pexpr;
end.
{
$Log$
Revision 1.50 1998-09-17 13:41:18 pierre
Revision 1.51 1998-09-18 16:03:43 florian
* some changes to compile with Delphi
Revision 1.50 1998/09/17 13:41:18 pierre
sizeof(TPOINT) problem
Revision 1.49.2.1 1998/09/17 08:42:31 pierre

356
compiler/ppc.dpr Normal file
View File

@ -0,0 +1,356 @@
{$MINSTACKSIZE $00004000}
{$MAXSTACKSIZE $00100000}
{$IMAGEBASE $00400000}
{$APPTYPE CONSOLE}
{
$Id$
Copyright (c) 1993-98 by Florian Klaempfl
Commandline compiler for Free Pascal
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
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. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************}
{
possible compiler switches (* marks a currently required switch):
-----------------------------------------------------------------
USE_RHIDE generates errors and warning in an format recognized
by rhide
TP to compile the compiler with Turbo or Borland Pascal
GDB* support of the GNU Debugger
I386 generate a compiler for the Intel i386+
M68K generate a compiler for the M68000
USEOVERLAY compiles a TP version which uses overlays
EXTDEBUG some extra debug code is executed
SUPPORT_MMX only i386: releases the compiler switch
MMX which allows the compiler to generate
MMX instructions
EXTERN_MSG Don't compile the msgfiles in the compiler, always
use external messagefiles, default for TP
NOAG386INT no Intel Assembler output
NOAG386NSM no NASM output
-----------------------------------------------------------------
Required switches for a i386 compiler be compiled by Free Pascal Compiler:
GDB;I386
Required switches for a i386 compiler be compiled by Turbo Pascal:
GDB;I386;TP
Required switches for a 68000 compiler be compiled by Turbo Pascal:
GDB;M68k;TP
To compile the compiler with Delphi do the following:
}
{$ifdef FPC}
{$ifndef GDB}
{ people can try to compile without GDB }
{ $error The compiler switch GDB must be defined}
{$endif GDB}
{ but I386 or M68K must be defined }
{ and only one of the two }
{$ifndef I386}
{$ifndef M68K}
{$fatal One of the switches I386 or M68K must be defined}
{$endif M68K}
{$endif I386}
{$ifdef I386}
{$ifdef M68K}
{$fatal ONLY one of the switches I386 or M68K must be defined}
{$endif M68K}
{$endif I386}
{$ifdef support_mmx}
{$ifndef i386}
{$fatal I386 switch must be on for MMX support}
{$endif i386}
{$endif support_mmx}
{$endif}
{$ifdef TP}
{$IFNDEF DPMI}
{$M 24000,0,655360}
{$ELSE}
{$M 65000}
{$ENDIF DPMI}
{$E+,N+,F+,S-,R-}
{$endif TP}
program pp;
{$IFDEF TP}
{$UNDEF PROFILE}
{$IFDEF DPMI}
{$UNDEF USEOVERLAY}
{$ENDIF}
{$ENDIF}
{$ifdef FPC}
{$UNDEF USEOVERLAY}
{$ENDIF}
uses
{$ifdef useoverlay}
{$ifopt o+}
Overlay,ppovin,
{$else}
{$error You must compile with the $O+ switch}
{$endif}
{$endif useoverlay}
{$ifdef profile}
profile,
{$endif profile}
globals,compiler;
{$ifdef useoverlay}
{$O files}
{$O globals}
{$O hcodegen}
{$O pass_1}
{$O tree}
{$O types}
{$O objects}
{$O options}
{$O cobjects}
{$O globals}
{$O systems}
{$O parser}
{$O pbase}
{$O pdecl}
{$O pexports}
{$O pexpr}
{$O pmodules}
{$O pstatmnt}
{$O psub}
{$O psystem}
{$O ptconst}
{$O script}
{$O switches}
{$O temp_gen}
{$O comphook}
{$O dos}
{$O scanner}
{$O symtable}
{$O objects}
{$O aasm}
{$O link}
{$O assemble}
{$O messages}
{$O gendef}
{$O import}
{$O os2_targ}
{$O win_targ}
{$O asmutils}
{$ifdef gdb}
{$O gdb}
{$endif gdb}
{$ifdef i386}
{$O opts386}
{$O cgi386}
{$O cg386add}
{$O cg386cal}
{$O cg386cnv}
{$O cg386con}
{$O cg386flw}
{$O cg386ld}
{$O cg386mat}
{$O cg386set}
{$ifndef NOOPT}
{$O aopt386}
{$endif NOOPT}
{$O cgai386}
{$O i386}
{$IfNDef Nora386dir}
{$O ra386dir}
{$endif Nora386dir}
{$IfNDef Nora386int}
{$O ra386int}
{$endif Nora386int}
{$IfNDef Nora386att}
{$O ra386att}
{$endif Nora386att}
{$O tgeni386}
{$ifndef NoAg386Int}
{$O ag386int}
{$endif NoAg386Int}
{$O ag386att}
{$ifndef NoAg386Nsm}
{$O ag386nsm}
{$endif}
{$endif}
{$ifdef m68k}
{$O opts68k}
{$O cg68k}
{$O ra68kmot}
{$O ag68kgas}
{$O ag68kmot}
{$O ag68kmit}
{$endif}
{$endif useoverlay}
var
oldexit : pointer;
procedure myexit;{$ifndef FPC}far;{$endif}
begin
exitproc:=oldexit;
{ Show Runtime error if there was an error }
if (erroraddr<>nil) then
begin
case exitcode of
202 : begin
erroraddr:=nil;
Writeln('Error: Stack Overflow');
end;
203 : begin
erroraddr:=nil;
Writeln('Error: Out of memory');
end;
end;
Writeln('Compilation aborted at line ',aktfilepos.line);
end;
end;
begin
oldexit:=exitproc;
exitproc:=@myexit;
{$ifndef VER0_99_5}
{$ifndef TP}
heapblocks:=true;
{$endif}
{$endif}
{$ifdef UseOverlay}
InitOverlay;
{$endif}
{ Call the compiler with empty command, so it will take the parameters }
Halt(Compile(''));
end.
{
$Log$
Revision 1.1 1998-09-18 16:03:44 florian
* some changes to compile with Delphi
Revision 1.28 1998/08/26 15:31:17 peter
* heapblocks for >0.99.5
Revision 1.27 1998/08/11 00:00:00 peter
* fixed dup log
Revision 1.26 1998/08/10 15:49:40 peter
* small fixes for 0.99.5
Revision 1.25 1998/08/10 14:50:16 peter
+ localswitches, moduleswitches, globalswitches splitting
Revision 1.24 1998/08/10 10:18:32 peter
+ Compiler,Comphook unit which are the new interface units to the
compiler
Revision 1.23 1998/08/05 16:00:16 florian
* some fixes for ansi strings
Revision 1.22 1998/08/04 16:28:40 jonas
* added support for NoRa386* in the $O ... section
Revision 1.21 1998/07/18 17:11:12 florian
+ ansi string constants fixed
+ switch $H partial implemented
Revision 1.20 1998/07/14 14:46:55 peter
* released NEWINPUT
Revision 1.19 1998/07/07 11:20:04 peter
+ NEWINPUT for a better inputfile and scanner object
Revision 1.18 1998/06/24 14:06:33 peter
* fixed the name changes
Revision 1.17 1998/06/23 08:59:22 daniel
* Recommitted.
Revision 1.16 1998/06/17 14:10:17 peter
* small os2 fixes
* fixed interdependent units with newppu (remake3 under linux works now)
Revision 1.15 1998/06/16 11:32:18 peter
* small cosmetic fixes
Revision 1.14 1998/06/15 13:43:45 daniel
* Updated overlays.
Revision 1.12 1998/05/23 01:21:23 peter
+ aktasmmode, aktoptprocessor, aktoutputformat
+ smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+ $LIBNAME to set the library name where the unit will be put in
* splitted cgi386 a bit (codeseg to large for bp7)
* nasm, tasm works again. nasm moved to ag386nsm.pas
Revision 1.11 1998/05/20 09:42:35 pierre
+ UseTokenInfo now default
* unit in interface uses and implementation uses gives error now
* only one error for unknown symbol (uses lastsymknown boolean)
the problem came from the label code !
+ first inlined procedures and function work
(warning there might be allowed cases were the result is still wrong !!)
* UseBrower updated gives a global list of all position of all used symbols
with switch -gb
Revision 1.10 1998/05/12 10:47:00 peter
* moved printstatus to verb_def
+ V_Normal which is between V_Error and V_Warning and doesn't have a
prefix like error: warning: and is included in V_Default
* fixed some messages
* first time parameter scan is only for -v and -T
- removed old style messages
Revision 1.9 1998/05/11 13:07:56 peter
+ $ifdef NEWPPU for the new ppuformat
+ $define GDB not longer required
* removed all warnings and stripped some log comments
* no findfirst/findnext anymore to remove smartlink *.o files
Revision 1.8 1998/05/08 09:21:57 michael
+ Librarysearchpath is now a linker object field;
Revision 1.7 1998/05/04 17:54:28 peter
+ smartlinking works (only case jumptable left todo)
* redesign of systems.pas to support assemblers and linkers
+ Unitname is now also in the PPU-file, increased version to 14
Revision 1.6 1998/04/29 13:40:23 peter
+ heapblocks:=true
Revision 1.5 1998/04/29 10:33:59 pierre
+ added some code for ansistring (not complete nor working yet)
* corrected operator overloading
* corrected nasm output
+ started inline procedures
+ added starstarn : use ** for exponentiation (^ gave problems)
+ started UseTokenInfo cond to get accurate positions
Revision 1.3 1998/04/21 10:16:48 peter
* patches from strasbourg
* objects is not used anymore in the fpc compiled version
Revision 1.2 1998/04/07 13:19:47 pierre
* bugfixes for reset_gdb_info
in MEM parsing for go32v2
better external symbol creation
support for rhgdb.exe (lowercase file names)
}

9
compiler/scandir.inc
View File

@ -218,7 +218,7 @@ const
hs1,hs2 : string;
b : boolean;
t : ttoken;
w : word;
w : integer;
l1,l2 : longint;
begin
hs1:=read_simple_expr;
@ -622,7 +622,9 @@ const
1 : aktpackrecords:=1;
2 : aktpackrecords:=2;
4 : aktpackrecords:=4;
8 : aktpackrecords:=8;
16 : aktpackrecords:=16;
32 : aktpackrecords:=32;
else
Message(scan_w_only_pack_records);
end;
@ -903,7 +905,10 @@ const
{
$Log$
Revision 1.30 1998-09-16 16:41:47 peter
Revision 1.31 1998-09-18 16:03:44 florian
* some changes to compile with Delphi
Revision 1.30 1998/09/16 16:41:47 peter
* merged fixes
Revision 1.28.2.1 1998/09/16 16:09:51 peter

9
compiler/scanner.pas
View File

@ -738,7 +738,7 @@ implementation
function tscannerfile.readval:longint;
var
l : longint;
w : word;
w : integer;
begin
readnumber;
valint(pattern,l,w);
@ -947,7 +947,7 @@ implementation
function tscannerfile.yylex : ttoken;
var
y : ttoken;
code : word;
code : integer;
l : longint;
mac : pmacrosym;
asciinr : string[3];
@ -1510,7 +1510,10 @@ exit_label:
end.
{
$Log$
Revision 1.51 1998-09-16 16:41:49 peter
Revision 1.52 1998-09-18 16:03:45 florian
* some changes to compile with Delphi
Revision 1.51 1998/09/16 16:41:49 peter
* merged fixes
Revision 1.50.2.1 1998/09/16 16:09:49 peter

19
compiler/symsym.inc
View File

@ -1024,12 +1024,26 @@
address:=owner^.datasize;
inc(owner^.datasize,l);
end
else
if (l<=8) or (aktpackrecords=8) then
begin
owner^.datasize:=(owner^.datasize+7) and (not 7);
address:=owner^.datasize;
inc(owner^.datasize,l);
end
else
if (l<=16) or (aktpackrecords=16) then
begin
owner^.datasize:=(owner^.datasize+15) and (not 15);
address:=owner^.datasize;
inc(owner^.datasize,l);
end
else
if (l<=32) or (aktpackrecords=32) then
begin
owner^.datasize:=(owner^.datasize+31) and (not 31);
address:=owner^.datasize;
inc(owner^.datasize,l);
end;
end;
parasymtable : begin
@ -1655,7 +1669,10 @@
{
$Log$
Revision 1.43 1998-09-18 08:01:38 pierre
Revision 1.44 1998-09-18 16:03:47 florian
* some changes to compile with Delphi
Revision 1.43 1998/09/18 08:01:38 pierre
+ improvement on the usebrowser part
(does not work correctly for now)