From af83d903576d8ebe9049addad8a4bbbc7d10fba9 Mon Sep 17 00:00:00 2001 From: florian Date: Fri, 18 Sep 1998 16:03:37 +0000 Subject: [PATCH] * some changes to compile with Delphi --- compiler/cobjects.pas | 7 +- compiler/dmisc.pas | 854 ++++++++++++++++++++++++++++++++++++++++++ compiler/mppc386.bat | 2 +- compiler/msgtxt.inc | 350 +++++++++-------- compiler/pexpr.pas | 7 +- compiler/ppc.dpr | 356 ++++++++++++++++++ compiler/scandir.inc | 9 +- compiler/scanner.pas | 9 +- compiler/symsym.inc | 19 +- 9 files changed, 1426 insertions(+), 187 deletions(-) create mode 100644 compiler/dmisc.pas create mode 100644 compiler/ppc.dpr diff --git a/compiler/cobjects.pas b/compiler/cobjects.pas index 0e673ef1d3..b48a171adb 100644 --- a/compiler/cobjects.pas +++ b/compiler/cobjects.pas @@ -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 diff --git a/compiler/dmisc.pas b/compiler/dmisc.pas new file mode 100644 index 0000000000..14783bd674 --- /dev/null +++ b/compiler/dmisc.pas @@ -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 + +} diff --git a/compiler/mppc386.bat b/compiler/mppc386.bat index 67639ecd34..79e8ff5046 100644 --- a/compiler/mppc386.bat +++ b/compiler/mppc386.bat @@ -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 diff --git a/compiler/msgtxt.inc b/compiler/msgtxt.inc index ad11b13fbb..9a05837412 100644 --- a/compiler/msgtxt.inc +++ b/compiler/msgtxt.inc @@ -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 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] [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_ 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_set stack size to '#000+ '**2Ct_stack checking'#000+ - '3*2CS_create static library'#000+ + '3*2CS_create static l','ibrary'#000+ '3*2Cx_use smartlinking'#000+ '**1d_defines the symbol '#000+ '*O1D_generate a DEF file'#000+ '*O2Dd_set description to '#000+ '*O2Dw_PM application'#000+ - '**1e_set path to exec','utable'#000+ + '**1e_set path to executable'#000+ '**1E_same as -Cn'#000+ '**1F_set file names and paths'#000+ - '**2Fe_redirect error output to '#000+ + '**2Fe_redirect error',' output to '#000+ '*L2Fg_same as -Fl'#000+ '**2Fi_adds to include path'#000+ '**2Fl_adds to library path'#000+ '*L2FL_uses as dynamic linker'#000+ - '**2Fo_adds to ob','ject path'#000+ + '**2Fo_adds to object path'#000+ '**2Fr_load error message file '#000+ - '**2Fu_adds to unit path'#000+ + '**2Fu_adds 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_adds to include path'#000+ '**1k_Pass to the linker'#000+ '**1l_write logo'#000+ - '*','*1n_don'#039't read the default config file'#000+ - '**1o_change the name of the executable produced to '#000+ + '**1n_don'#039't read the default config file'#000+ + '**1o_change the name of the executa','ble produced to '#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_Target operating system'#000+ + '*','*1T_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_undefines the symbol '#000+ '**1U_unit options'#000+ '**2Un_don'#039't check the unit name'#000+ '**2Up_same as -Fu'#000+ - '**2Us_compile ','a system unit'#000+ - '**1v_Be verbose. is a combination of the following letters :'#000+ + '**2Us_compile a system unit'#000+ + '**1v_Be verbose. 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_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+ diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index c1f414bbda..a2420636c2 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -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 diff --git a/compiler/ppc.dpr b/compiler/ppc.dpr new file mode 100644 index 0000000000..44c9877351 --- /dev/null +++ b/compiler/ppc.dpr @@ -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) +} diff --git a/compiler/scandir.inc b/compiler/scandir.inc index 034d21e2cd..01d9c8f5a5 100644 --- a/compiler/scandir.inc +++ b/compiler/scandir.inc @@ -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 diff --git a/compiler/scanner.pas b/compiler/scanner.pas index f7e7d7a2c4..99ea86e51c 100644 --- a/compiler/scanner.pas +++ b/compiler/scanner.pas @@ -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 diff --git a/compiler/symsym.inc b/compiler/symsym.inc index 0cd84ce7b2..c035ab24e0 100644 --- a/compiler/symsym.inc +++ b/compiler/symsym.inc @@ -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)