mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-24 09:29:35 +02:00
+ Compiler,Comphook unit which are the new interface units to the
compiler
This commit is contained in:
peter
parent
3a6d38ad23
commit
6396267185
@ -57,7 +57,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
|
|||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
verbose,cobjects,systems,globals,files,
|
cobjects,verbose,comphook,systems,globals,files,
|
||||||
symtable,types,aasm,scanner,
|
symtable,types,aasm,scanner,
|
||||||
pass_1,hcodegen,temp_gen
|
pass_1,hcodegen,temp_gen
|
||||||
{$ifdef GDB}
|
{$ifdef GDB}
|
||||||
@ -474,7 +474,7 @@ implementation
|
|||||||
{ dummy }
|
{ dummy }
|
||||||
regsize:=S_W;
|
regsize:=S_W;
|
||||||
end;
|
end;
|
||||||
if (verbosity and v_debug)=v_debug then
|
if (status.verbosity and v_debug)=v_debug then
|
||||||
begin
|
begin
|
||||||
for i:=1 to maxvarregs do
|
for i:=1 to maxvarregs do
|
||||||
begin
|
begin
|
||||||
@ -507,7 +507,11 @@ implementation
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.45 1998-07-30 13:30:34 florian
|
Revision 1.46 1998-08-10 10:18:23 peter
|
||||||
|
+ Compiler,Comphook unit which are the new interface units to the
|
||||||
|
compiler
|
||||||
|
|
||||||
|
Revision 1.45 1998/07/30 13:30:34 florian
|
||||||
* final implemenation of exception support, maybe it needs
|
* final implemenation of exception support, maybe it needs
|
||||||
some fixes :)
|
some fixes :)
|
||||||
|
|
||||||
|
|||||||
300
compiler/comphook.pas
Normal file
300
compiler/comphook.pas
Normal file
@ -0,0 +1,300 @@
|
|||||||
|
{
|
||||||
|
$Id$
|
||||||
|
Copyright (c) 1998 by Peter Vreman
|
||||||
|
|
||||||
|
This unit handles the compilerhooks for output to external programs
|
||||||
|
|
||||||
|
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.
|
||||||
|
|
||||||
|
****************************************************************************
|
||||||
|
}
|
||||||
|
unit comphook;
|
||||||
|
interface
|
||||||
|
|
||||||
|
Const
|
||||||
|
{ <$10000 will show file and line }
|
||||||
|
V_Fatal = $0;
|
||||||
|
V_Error = $1;
|
||||||
|
V_Normal = $2; { doesn't show a text like Error: }
|
||||||
|
V_Warning = $4;
|
||||||
|
V_Note = $8;
|
||||||
|
V_Hint = $10;
|
||||||
|
V_Macro = $100;
|
||||||
|
V_Procedure = $200;
|
||||||
|
V_Conditional = $400;
|
||||||
|
V_Info = $10000;
|
||||||
|
V_Status = $20000;
|
||||||
|
V_Used = $40000;
|
||||||
|
V_Tried = $80000;
|
||||||
|
V_Debug = $100000;
|
||||||
|
|
||||||
|
V_ShowFile = $ffff;
|
||||||
|
V_All = $ffffffff;
|
||||||
|
V_Default = V_Fatal + V_Error + V_Normal;
|
||||||
|
|
||||||
|
type
|
||||||
|
PCompilerStatus = ^TCompilerStatus;
|
||||||
|
TCompilerStatus = record
|
||||||
|
{ Current status }
|
||||||
|
currentmodule,
|
||||||
|
currentsource : string; { filename }
|
||||||
|
currentline,
|
||||||
|
currentcolumn : longint; { current line and column }
|
||||||
|
{ Total Status }
|
||||||
|
compiledlines : longint; { the number of lines which are compiled }
|
||||||
|
errorcount : longint; { number of generated errors }
|
||||||
|
{ Settings for the output }
|
||||||
|
verbosity : longint;
|
||||||
|
maxerrorcount : longint;
|
||||||
|
use_stderr,
|
||||||
|
use_redir,
|
||||||
|
use_gccoutput : boolean;
|
||||||
|
{ Redirection support }
|
||||||
|
redirfile : text;
|
||||||
|
end;
|
||||||
|
var
|
||||||
|
status : tcompilerstatus;
|
||||||
|
|
||||||
|
{ Default Functions }
|
||||||
|
procedure def_stop;
|
||||||
|
Function def_status:boolean;
|
||||||
|
Function def_comment(Level:Longint;const s:string):boolean;
|
||||||
|
function def_internalerror(i:longint):boolean;
|
||||||
|
|
||||||
|
{ Function redirecting for IDE support }
|
||||||
|
type
|
||||||
|
tstopprocedure = procedure;
|
||||||
|
tstatusfunction = function:boolean;
|
||||||
|
tcommentfunction = function(Level:Longint;const s:string):boolean;
|
||||||
|
tinternalerrorfunction = function(i:longint):boolean;
|
||||||
|
const
|
||||||
|
do_stop : tstopprocedure = def_stop;
|
||||||
|
do_status : tstatusfunction = def_status;
|
||||||
|
do_comment : tcommentfunction = def_comment;
|
||||||
|
do_internalerror : tinternalerrorfunction = def_internalerror;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{****************************************************************************
|
||||||
|
Helper Routines
|
||||||
|
****************************************************************************}
|
||||||
|
|
||||||
|
function gccfilename(const s : string) : string;
|
||||||
|
var
|
||||||
|
i : longint;
|
||||||
|
begin
|
||||||
|
for i:=1to length(s) do
|
||||||
|
begin
|
||||||
|
case s[i] of
|
||||||
|
'\' : gccfilename[i]:='/';
|
||||||
|
'A'..'Z' : gccfilename[i]:=chr(ord(s[i])+32);
|
||||||
|
else
|
||||||
|
gccfilename[i]:=s[i];
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
gccfilename[0]:=s[0];
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function tostr(i : longint) : string;
|
||||||
|
var
|
||||||
|
hs : string;
|
||||||
|
begin
|
||||||
|
str(i,hs);
|
||||||
|
tostr:=hs;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{****************************************************************************
|
||||||
|
Predefined default Handlers
|
||||||
|
****************************************************************************}
|
||||||
|
|
||||||
|
{ predefined handler when then compiler stops }
|
||||||
|
procedure def_stop;
|
||||||
|
begin
|
||||||
|
Halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function def_status:boolean;
|
||||||
|
begin
|
||||||
|
def_status:=false; { never stop }
|
||||||
|
{ Status info?, Called every line }
|
||||||
|
if ((status.verbosity and V_Status)<>0) then
|
||||||
|
begin
|
||||||
|
if (status.compiledlines=1) then
|
||||||
|
WriteLn(memavail shr 10,' Kb Free');
|
||||||
|
if (status.currentline>0) and (status.currentline mod 100=0) then
|
||||||
|
{$ifdef FPC}
|
||||||
|
WriteLn(status.currentline,' ',memavail shr 10,'/',system.heapsize shr 10,' Kb Free');
|
||||||
|
{$else}
|
||||||
|
WriteLn(status.currentline,' ',memavail shr 10,' Kb Free');
|
||||||
|
{$endif}
|
||||||
|
end
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Function def_comment(Level:Longint;const s:string):boolean;
|
||||||
|
const
|
||||||
|
{ RHIDE expect gcc like error output }
|
||||||
|
rh_errorstr='error: ';
|
||||||
|
rh_warningstr='warning: ';
|
||||||
|
fatalstr='Fatal: ';
|
||||||
|
errorstr='Error: ';
|
||||||
|
warningstr='Warning: ';
|
||||||
|
notestr='Note: ';
|
||||||
|
hintstr='Hint: ';
|
||||||
|
var
|
||||||
|
hs : string;
|
||||||
|
begin
|
||||||
|
def_comment:=false; { never stop }
|
||||||
|
if (status.verbosity and Level)=Level then
|
||||||
|
begin
|
||||||
|
hs:='';
|
||||||
|
if not(status.use_gccoutput) then
|
||||||
|
begin
|
||||||
|
if (status.verbosity and Level)=V_Hint then
|
||||||
|
hs:=hintstr;
|
||||||
|
if (status.verbosity and Level)=V_Note then
|
||||||
|
hs:=notestr;
|
||||||
|
if (status.verbosity and Level)=V_Warning then
|
||||||
|
hs:=warningstr;
|
||||||
|
if (status.verbosity and Level)=V_Error then
|
||||||
|
hs:=errorstr;
|
||||||
|
if (status.verbosity and Level)=V_Fatal then
|
||||||
|
hs:=fatalstr;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if (status.verbosity and Level)=V_Hint then
|
||||||
|
hs:=rh_warningstr;
|
||||||
|
if (status.verbosity and Level)=V_Note then
|
||||||
|
hs:=rh_warningstr;
|
||||||
|
if (status.verbosity and Level)=V_Warning then
|
||||||
|
hs:=rh_warningstr;
|
||||||
|
if (status.verbosity and Level)=V_Error then
|
||||||
|
hs:=rh_errorstr;
|
||||||
|
if (status.verbosity and Level)=V_Fatal then
|
||||||
|
hs:=rh_errorstr;
|
||||||
|
end;
|
||||||
|
if (Level<=V_ShowFile) and (status.currentline>0) then
|
||||||
|
begin
|
||||||
|
{ Adding the column should not confuse RHIDE,
|
||||||
|
even if it does not yet use it PM }
|
||||||
|
if status.use_gccoutput then
|
||||||
|
hs:=gccfilename(status.currentsource)+':'+tostr(status.currentline)
|
||||||
|
+':'+tostr(status.currentcolumn)+': '+hs
|
||||||
|
else
|
||||||
|
hs:=status.currentsource+'('+tostr(status.currentline)
|
||||||
|
+','+tostr(status.currentcolumn)+') '+hs;
|
||||||
|
end;
|
||||||
|
{ add the message to the text }
|
||||||
|
hs:=hs+s;
|
||||||
|
{$ifdef FPC}
|
||||||
|
if status.use_stderr then
|
||||||
|
begin
|
||||||
|
writeln(stderr,hs);
|
||||||
|
flush(stderr);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
{$endif}
|
||||||
|
begin
|
||||||
|
if status.use_redir then
|
||||||
|
writeln(status.redirfile,hs)
|
||||||
|
else
|
||||||
|
writeln(hs);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function def_internalerror(i : longint) : boolean;
|
||||||
|
begin
|
||||||
|
do_comment(V_Fatal,'Internal error '+tostr(i));
|
||||||
|
def_internalerror:=true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
|
{
|
||||||
|
$Log$
|
||||||
|
Revision 1.1 1998-08-10 10:18:24 peter
|
||||||
|
+ Compiler,Comphook unit which are the new interface units to the
|
||||||
|
compiler
|
||||||
|
|
||||||
|
Revision 1.14 1998/08/04 13:22:48 pierre
|
||||||
|
* weird bug fixed :
|
||||||
|
a pchar ' ' (simple space or any other letter) was found to
|
||||||
|
be equal to a string of length zero !!!
|
||||||
|
thus printing out non sense
|
||||||
|
found that out while checking Control-C !!
|
||||||
|
+ added column info also in RHIDE format as
|
||||||
|
it might be usefull later
|
||||||
|
|
||||||
|
Revision 1.13 1998/07/14 14:47:12 peter
|
||||||
|
* released NEWINPUT
|
||||||
|
|
||||||
|
Revision 1.12 1998/07/07 11:20:19 peter
|
||||||
|
+ NEWINPUT for a better inputfile and scanner object
|
||||||
|
|
||||||
|
Revision 1.11 1998/06/19 15:40:00 peter
|
||||||
|
* bp7 fix
|
||||||
|
|
||||||
|
Revision 1.10 1998/06/16 11:32:19 peter
|
||||||
|
* small cosmetic fixes
|
||||||
|
|
||||||
|
Revision 1.9 1998/05/23 01:21:33 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.8 1998/05/21 19:33:38 peter
|
||||||
|
+ better procedure directive handling and only one table
|
||||||
|
|
||||||
|
Revision 1.7 1998/05/12 10:47:01 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.6 1998/05/11 13:07:58 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.5 1998/04/30 15:59:43 pierre
|
||||||
|
* GDB works again better :
|
||||||
|
correct type info in one pass
|
||||||
|
+ UseTokenInfo for better source position
|
||||||
|
* fixed one remaining bug in scanner for line counts
|
||||||
|
* several little fixes
|
||||||
|
|
||||||
|
Revision 1.4 1998/04/29 10:34:09 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
|
||||||
|
}
|
||||||
217
compiler/compiler.pas
Normal file
217
compiler/compiler.pas
Normal file
@ -0,0 +1,217 @@
|
|||||||
|
{
|
||||||
|
$Id$
|
||||||
|
Copyright (c) 1993-98 by Florian Klaempfl
|
||||||
|
|
||||||
|
This unit is the interface of the compiler which can be used by
|
||||||
|
external programs to link in the compiler
|
||||||
|
|
||||||
|
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:
|
||||||
|
-----------------------------------------------------------------
|
||||||
|
TP to compile the compiler with Turbo or Borland Pascal
|
||||||
|
I386 generate a compiler for the Intel i386+
|
||||||
|
M68K generate a compiler for the M68000
|
||||||
|
GDB support of the GNU Debugger
|
||||||
|
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
|
||||||
|
NOAG386INT no Intel Assembler output
|
||||||
|
NOAG386NSM no NASM output
|
||||||
|
-----------------------------------------------------------------
|
||||||
|
}
|
||||||
|
|
||||||
|
{$ifdef FPC}
|
||||||
|
{ 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}
|
||||||
|
|
||||||
|
unit compiler;
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$ifdef fpc}
|
||||||
|
{$ifdef GO32V2}
|
||||||
|
emu387,
|
||||||
|
dpmiexcp,
|
||||||
|
{$endif GO32V2}
|
||||||
|
{$ifdef LINUX}
|
||||||
|
catch,
|
||||||
|
{$endif LINUX}
|
||||||
|
{$endif}
|
||||||
|
{$ifdef TP}
|
||||||
|
tpexcept,
|
||||||
|
{$endif}
|
||||||
|
dos,verbose,comphook,systems,
|
||||||
|
globals,options,parser,symtable,link,import;
|
||||||
|
|
||||||
|
function Compile(const cmd:string):longint;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
var
|
||||||
|
CompilerInited : boolean;
|
||||||
|
recoverpos : jmp_buf;
|
||||||
|
|
||||||
|
procedure RecoverStop;{$ifndef FPC}far;{$endif}
|
||||||
|
begin
|
||||||
|
LongJmp(recoverpos,1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure DoneCompiler;
|
||||||
|
begin
|
||||||
|
if not CompilerInited then
|
||||||
|
exit;
|
||||||
|
{ Free memory }
|
||||||
|
DoneSymtable;
|
||||||
|
CompilerInited:=false;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure InitCompiler(const cmd:string);
|
||||||
|
begin
|
||||||
|
if CompilerInited then
|
||||||
|
DoneCompiler;
|
||||||
|
{ inits which need to be done before the arguments are parsed }
|
||||||
|
get_exepath;
|
||||||
|
InitVerbose;
|
||||||
|
InitGlobals;
|
||||||
|
InitSymtable;
|
||||||
|
linker.init;
|
||||||
|
{ read the arguments }
|
||||||
|
read_arguments(cmd);
|
||||||
|
{ inits which depend on arguments }
|
||||||
|
initparser;
|
||||||
|
initimport;
|
||||||
|
CompilerInited:=true;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function Compile(const cmd:string):longint;
|
||||||
|
|
||||||
|
function getrealtime : real;
|
||||||
|
var
|
||||||
|
h,m,s,s100 : word;
|
||||||
|
begin
|
||||||
|
gettime(h,m,s,s100);
|
||||||
|
getrealtime:=h*3600.0+m*60.0+s+s100/100.0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
starttime : real;
|
||||||
|
olddo_stop : tstopprocedure;
|
||||||
|
{$ifdef TP}
|
||||||
|
oldfreelist,
|
||||||
|
oldheapptr,
|
||||||
|
oldheaporg : pointer;
|
||||||
|
{$endif}
|
||||||
|
{$IfDef Extdebug}
|
||||||
|
EntryMemAvail : longint;
|
||||||
|
{$EndIf}
|
||||||
|
begin
|
||||||
|
{$Ifdef TP}
|
||||||
|
{ Save old heap }
|
||||||
|
oldfreelist:=freelist;
|
||||||
|
oldheapptr:=heapptr;
|
||||||
|
oldheaporg:=heaporg;
|
||||||
|
{ Create a new heap }
|
||||||
|
heaporg:=oldheapptr;
|
||||||
|
heapptr:=heaporg;
|
||||||
|
freelist:=heaporg;
|
||||||
|
{$endif}
|
||||||
|
{$ifdef EXTDEBUG}
|
||||||
|
EntryMemAvail:=MemAvail;
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
{ Initialize the compiler }
|
||||||
|
InitCompiler(cmd);
|
||||||
|
|
||||||
|
{ show some info }
|
||||||
|
Message1(general_i_compilername,FixFileName(paramstr(0)));
|
||||||
|
Message1(general_i_unitsearchpath,unitsearchpath);
|
||||||
|
Message1(general_d_sourceos,source_os.name);
|
||||||
|
Message1(general_i_targetos,target_os.name);
|
||||||
|
Message1(general_u_exepath,exepath);
|
||||||
|
Message1(general_u_gcclibpath,Linker.librarysearchpath);
|
||||||
|
{$ifdef TP}
|
||||||
|
Comment(V_Info,'Memory: '+tostr(MemAvail)+' Bytes Free');
|
||||||
|
{$endif}
|
||||||
|
|
||||||
|
olddo_stop:=do_stop;
|
||||||
|
do_stop:=recoverstop;
|
||||||
|
if setjmp(recoverpos)=0 then
|
||||||
|
begin
|
||||||
|
starttime:=getrealtime;
|
||||||
|
parser.compile(inputdir+inputfile+inputextension,false);
|
||||||
|
if status.errorcount=0 then
|
||||||
|
begin
|
||||||
|
starttime:=getrealtime-starttime;
|
||||||
|
Message2(general_i_abslines_compiled,tostr(status.compiledlines),tostr(trunc(starttime))+
|
||||||
|
'.'+tostr(trunc(frac(starttime)*10)));
|
||||||
|
end;
|
||||||
|
{ Stop the compiler, frees also memory }
|
||||||
|
DoneCompiler;
|
||||||
|
end;
|
||||||
|
{ Stop is always called, so we come here when a program is compiled or not }
|
||||||
|
do_stop:=olddo_stop;
|
||||||
|
{$ifdef EXTDEBUG}
|
||||||
|
Comment(V_Info,'Memory Lost = '+tostr(EntryMemAvail-MemAvail));
|
||||||
|
{$endif EXTDEBUG}
|
||||||
|
{$Ifdef TP}
|
||||||
|
{ Restore old heap }
|
||||||
|
freelist:=oldfreelist;
|
||||||
|
heapptr:=oldheapptr;
|
||||||
|
heaporg:=oldheaporg;
|
||||||
|
{$endIf TP}
|
||||||
|
{ Set the return value if an error has occurred }
|
||||||
|
if status.errorcount=0 then
|
||||||
|
Compile:=0
|
||||||
|
else
|
||||||
|
Compile:=1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
||||||
|
{
|
||||||
|
$Log$
|
||||||
|
Revision 1.1 1998-08-10 10:18:24 peter
|
||||||
|
+ Compiler,Comphook unit which are the new interface units to the
|
||||||
|
compiler
|
||||||
|
|
||||||
|
}
|
||||||
250
compiler/depend
250
compiler/depend
@ -1,54 +1,72 @@
|
|||||||
pp: pp.pas \
|
pp: pp.pas \
|
||||||
cobjects.ppu \
|
|
||||||
globals.ppu \
|
globals.ppu \
|
||||||
parser.ppu \
|
compiler.ppu
|
||||||
systems.ppu \
|
|
||||||
tree.ppu \
|
|
||||||
symtable.ppu \
|
|
||||||
options.ppu \
|
|
||||||
link.ppu \
|
|
||||||
import.ppu \
|
|
||||||
files.ppu \
|
|
||||||
verb_def.ppu \
|
|
||||||
verbose.ppu
|
|
||||||
$(COMPILER) pp.pas
|
$(COMPILER) pp.pas
|
||||||
|
|
||||||
cobjects.ppu: cobjects.pas
|
|
||||||
|
|
||||||
globals.ppu: globals.pas \
|
globals.ppu: globals.pas \
|
||||||
cobjects.ppu \
|
cobjects.ppu \
|
||||||
systems.ppu
|
systems.ppu
|
||||||
|
|
||||||
|
cobjects.ppu: cobjects.pas
|
||||||
|
|
||||||
systems.ppu: systems.pas
|
systems.ppu: systems.pas
|
||||||
|
|
||||||
parser.ppu: parser.pas \
|
compiler.ppu: compiler.pas \
|
||||||
systems.ppu \
|
|
||||||
cobjects.ppu \
|
|
||||||
globals.ppu \
|
|
||||||
verbose.ppu \
|
verbose.ppu \
|
||||||
|
comphook.ppu \
|
||||||
|
systems.ppu \
|
||||||
|
globals.ppu \
|
||||||
|
options.ppu \
|
||||||
|
parser.ppu \
|
||||||
symtable.ppu \
|
symtable.ppu \
|
||||||
files.ppu \
|
|
||||||
aasm.ppu \
|
|
||||||
hcodegen.ppu \
|
|
||||||
assemble.ppu \
|
|
||||||
link.ppu \
|
link.ppu \
|
||||||
script.ppu \
|
import.ppu
|
||||||
gendef.ppu \
|
|
||||||
scanner.ppu \
|
|
||||||
pbase.ppu \
|
|
||||||
pdecl.ppu \
|
|
||||||
psystem.ppu \
|
|
||||||
pmodules.ppu
|
|
||||||
|
|
||||||
verbose.ppu: verbose.pas \
|
verbose.ppu: verbose.pas \
|
||||||
messages.ppu \
|
messages.ppu \
|
||||||
|
files.ppu \
|
||||||
|
comphook.ppu \
|
||||||
globals.ppu
|
globals.ppu
|
||||||
|
|
||||||
messages.ppu: messages.pas
|
messages.ppu: messages.pas
|
||||||
|
|
||||||
|
files.ppu: files.pas \
|
||||||
|
cobjects.ppu \
|
||||||
|
globals.ppu \
|
||||||
|
ppu.ppu \
|
||||||
|
verbose.ppu \
|
||||||
|
systems.ppu
|
||||||
|
|
||||||
|
ppu.ppu: ppu.pas
|
||||||
|
|
||||||
|
comphook.ppu: comphook.pas
|
||||||
|
|
||||||
|
options.ppu: options.pas \
|
||||||
|
cobjects.ppu \
|
||||||
|
verbose.ppu \
|
||||||
|
comphook.ppu \
|
||||||
|
systems.ppu \
|
||||||
|
globals.ppu \
|
||||||
|
scanner.ppu \
|
||||||
|
link.ppu \
|
||||||
|
messages.ppu \
|
||||||
|
gendef.ppu \
|
||||||
|
opts386.ppu
|
||||||
|
|
||||||
|
scanner.ppu: scanner.pas \
|
||||||
|
cobjects.ppu \
|
||||||
|
globals.ppu \
|
||||||
|
verbose.ppu \
|
||||||
|
comphook.ppu \
|
||||||
|
files.ppu \
|
||||||
|
systems.ppu \
|
||||||
|
symtable.ppu \
|
||||||
|
switches.ppu
|
||||||
|
|
||||||
symtable.ppu: symtable.pas \
|
symtable.ppu: symtable.pas \
|
||||||
cobjects.ppu \
|
cobjects.ppu \
|
||||||
verbose.ppu \
|
verbose.ppu \
|
||||||
|
comphook.ppu \
|
||||||
systems.ppu \
|
systems.ppu \
|
||||||
globals.ppu \
|
globals.ppu \
|
||||||
aasm.ppu \
|
aasm.ppu \
|
||||||
@ -56,7 +74,8 @@ symtable.ppu: symtable.pas \
|
|||||||
gendef.ppu \
|
gendef.ppu \
|
||||||
i386.ppu \
|
i386.ppu \
|
||||||
gdb.ppu \
|
gdb.ppu \
|
||||||
types.ppu
|
types.ppu \
|
||||||
|
ppu.ppu
|
||||||
|
|
||||||
aasm.ppu: aasm.pas \
|
aasm.ppu: aasm.pas \
|
||||||
cobjects.ppu \
|
cobjects.ppu \
|
||||||
@ -65,12 +84,6 @@ aasm.ppu: aasm.pas \
|
|||||||
verbose.ppu \
|
verbose.ppu \
|
||||||
systems.ppu
|
systems.ppu
|
||||||
|
|
||||||
files.ppu: files.pas \
|
|
||||||
cobjects.ppu \
|
|
||||||
globals.ppu \
|
|
||||||
verbose.ppu \
|
|
||||||
systems.ppu
|
|
||||||
|
|
||||||
gendef.ppu: gendef.pas \
|
gendef.ppu: gendef.pas \
|
||||||
cobjects.ppu \
|
cobjects.ppu \
|
||||||
systems.ppu \
|
systems.ppu \
|
||||||
@ -95,6 +108,49 @@ types.ppu: types.pas \
|
|||||||
verbose.ppu \
|
verbose.ppu \
|
||||||
aasm.ppu
|
aasm.ppu
|
||||||
|
|
||||||
|
switches.ppu: switches.pas \
|
||||||
|
globals.ppu \
|
||||||
|
verbose.ppu \
|
||||||
|
files.ppu \
|
||||||
|
systems.ppu
|
||||||
|
|
||||||
|
link.ppu: link.pas \
|
||||||
|
cobjects.ppu \
|
||||||
|
script.ppu \
|
||||||
|
globals.ppu \
|
||||||
|
systems.ppu \
|
||||||
|
verbose.ppu
|
||||||
|
|
||||||
|
script.ppu: script.pas \
|
||||||
|
cobjects.ppu \
|
||||||
|
globals.ppu \
|
||||||
|
systems.ppu
|
||||||
|
|
||||||
|
opts386.ppu: opts386.pas \
|
||||||
|
options.ppu \
|
||||||
|
systems.ppu \
|
||||||
|
globals.ppu
|
||||||
|
|
||||||
|
parser.ppu: parser.pas \
|
||||||
|
cobjects.ppu \
|
||||||
|
verbose.ppu \
|
||||||
|
comphook.ppu \
|
||||||
|
systems.ppu \
|
||||||
|
globals.ppu \
|
||||||
|
symtable.ppu \
|
||||||
|
files.ppu \
|
||||||
|
aasm.ppu \
|
||||||
|
hcodegen.ppu \
|
||||||
|
assemble.ppu \
|
||||||
|
link.ppu \
|
||||||
|
script.ppu \
|
||||||
|
gendef.ppu \
|
||||||
|
scanner.ppu \
|
||||||
|
pbase.ppu \
|
||||||
|
pdecl.ppu \
|
||||||
|
psystem.ppu \
|
||||||
|
pmodules.ppu
|
||||||
|
|
||||||
hcodegen.ppu: hcodegen.pas \
|
hcodegen.ppu: hcodegen.pas \
|
||||||
aasm.ppu \
|
aasm.ppu \
|
||||||
tree.ppu \
|
tree.ppu \
|
||||||
@ -128,17 +184,12 @@ assemble.ppu: assemble.pas \
|
|||||||
ag386nsm.ppu \
|
ag386nsm.ppu \
|
||||||
ag386int.ppu
|
ag386int.ppu
|
||||||
|
|
||||||
script.ppu: script.pas \
|
|
||||||
cobjects.ppu \
|
|
||||||
globals.ppu \
|
|
||||||
systems.ppu
|
|
||||||
|
|
||||||
ag386att.ppu: ag386att.pas \
|
ag386att.ppu: ag386att.pas \
|
||||||
|
cobjects.ppu \
|
||||||
aasm.ppu \
|
aasm.ppu \
|
||||||
assemble.ppu \
|
assemble.ppu \
|
||||||
globals.ppu \
|
globals.ppu \
|
||||||
systems.ppu \
|
systems.ppu \
|
||||||
cobjects.ppu \
|
|
||||||
i386.ppu \
|
i386.ppu \
|
||||||
files.ppu \
|
files.ppu \
|
||||||
verbose.ppu \
|
verbose.ppu \
|
||||||
@ -166,28 +217,6 @@ ag386int.ppu: ag386int.pas \
|
|||||||
verbose.ppu \
|
verbose.ppu \
|
||||||
gdb.ppu
|
gdb.ppu
|
||||||
|
|
||||||
link.ppu: link.pas \
|
|
||||||
cobjects.ppu \
|
|
||||||
script.ppu \
|
|
||||||
globals.ppu \
|
|
||||||
systems.ppu \
|
|
||||||
verbose.ppu
|
|
||||||
|
|
||||||
scanner.ppu: scanner.pas \
|
|
||||||
cobjects.ppu \
|
|
||||||
globals.ppu \
|
|
||||||
files.ppu \
|
|
||||||
verbose.ppu \
|
|
||||||
systems.ppu \
|
|
||||||
symtable.ppu \
|
|
||||||
switches.ppu
|
|
||||||
|
|
||||||
switches.ppu: switches.pas \
|
|
||||||
globals.ppu \
|
|
||||||
verbose.ppu \
|
|
||||||
files.ppu \
|
|
||||||
systems.ppu
|
|
||||||
|
|
||||||
pbase.ppu: pbase.pas \
|
pbase.ppu: pbase.pas \
|
||||||
cobjects.ppu \
|
cobjects.ppu \
|
||||||
globals.ppu \
|
globals.ppu \
|
||||||
@ -220,9 +249,9 @@ pdecl.ppu: pdecl.pas \
|
|||||||
|
|
||||||
pass_1.ppu: pass_1.pas \
|
pass_1.ppu: pass_1.pas \
|
||||||
tree.ppu \
|
tree.ppu \
|
||||||
scanner.ppu \
|
|
||||||
cobjects.ppu \
|
cobjects.ppu \
|
||||||
verbose.ppu \
|
verbose.ppu \
|
||||||
|
comphook.ppu \
|
||||||
systems.ppu \
|
systems.ppu \
|
||||||
globals.ppu \
|
globals.ppu \
|
||||||
aasm.ppu \
|
aasm.ppu \
|
||||||
@ -336,8 +365,9 @@ temp_gen.ppu: temp_gen.pas \
|
|||||||
|
|
||||||
cgi386.ppu: cgi386.pas \
|
cgi386.ppu: cgi386.pas \
|
||||||
tree.ppu \
|
tree.ppu \
|
||||||
verbose.ppu \
|
|
||||||
cobjects.ppu \
|
cobjects.ppu \
|
||||||
|
verbose.ppu \
|
||||||
|
comphook.ppu \
|
||||||
systems.ppu \
|
systems.ppu \
|
||||||
globals.ppu \
|
globals.ppu \
|
||||||
files.ppu \
|
files.ppu \
|
||||||
@ -377,15 +407,18 @@ cgai386.ppu: cgai386.pas \
|
|||||||
tgeni386.ppu \
|
tgeni386.ppu \
|
||||||
temp_gen.ppu \
|
temp_gen.ppu \
|
||||||
hcodegen.ppu \
|
hcodegen.ppu \
|
||||||
|
ppu.ppu \
|
||||||
gdb.ppu
|
gdb.ppu
|
||||||
|
|
||||||
cg386con.ppu: cg386con.pas \
|
cg386con.ppu: cg386con.pas \
|
||||||
tree.ppu \
|
tree.ppu \
|
||||||
cobjects.ppu \
|
cobjects.ppu \
|
||||||
verbose.ppu \
|
verbose.ppu \
|
||||||
|
globals.ppu \
|
||||||
symtable.ppu \
|
symtable.ppu \
|
||||||
aasm.ppu \
|
aasm.ppu \
|
||||||
i386.ppu \
|
i386.ppu \
|
||||||
|
types.ppu \
|
||||||
hcodegen.ppu \
|
hcodegen.ppu \
|
||||||
cgai386.ppu \
|
cgai386.ppu \
|
||||||
temp_gen.ppu \
|
temp_gen.ppu \
|
||||||
@ -516,15 +549,37 @@ cg386flw.ppu: cg386flw.pas \
|
|||||||
hcodegen.ppu
|
hcodegen.ppu
|
||||||
|
|
||||||
aopt386.ppu: aopt386.pas \
|
aopt386.ppu: aopt386.pas \
|
||||||
|
aasm.ppu \
|
||||||
|
i386.ppu \
|
||||||
|
daopt386.ppu \
|
||||||
|
popt386.ppu \
|
||||||
|
csopt386.ppu
|
||||||
|
|
||||||
|
daopt386.ppu: daopt386.pas \
|
||||||
aasm.ppu \
|
aasm.ppu \
|
||||||
cobjects.ppu \
|
cobjects.ppu \
|
||||||
|
i386.ppu \
|
||||||
|
globals.ppu \
|
||||||
|
systems.ppu \
|
||||||
|
verbose.ppu \
|
||||||
|
hcodegen.ppu \
|
||||||
|
cgi386.ppu
|
||||||
|
|
||||||
|
popt386.ppu: popt386.pas \
|
||||||
|
aasm.ppu \
|
||||||
globals.ppu \
|
globals.ppu \
|
||||||
systems.ppu \
|
systems.ppu \
|
||||||
symtable.ppu \
|
|
||||||
verbose.ppu \
|
verbose.ppu \
|
||||||
hcodegen.ppu \
|
hcodegen.ppu \
|
||||||
i386.ppu \
|
i386.ppu \
|
||||||
cgi386.ppu
|
daopt386.ppu
|
||||||
|
|
||||||
|
csopt386.ppu: csopt386.pas \
|
||||||
|
aasm.ppu \
|
||||||
|
cobjects.ppu \
|
||||||
|
verbose.ppu \
|
||||||
|
i386.ppu \
|
||||||
|
daopt386.ppu
|
||||||
|
|
||||||
pstatmnt.ppu: pstatmnt.pas \
|
pstatmnt.ppu: pstatmnt.pas \
|
||||||
tree.ppu \
|
tree.ppu \
|
||||||
@ -539,6 +594,7 @@ pstatmnt.ppu: pstatmnt.pas \
|
|||||||
types.ppu \
|
types.ppu \
|
||||||
scanner.ppu \
|
scanner.ppu \
|
||||||
hcodegen.ppu \
|
hcodegen.ppu \
|
||||||
|
ppu.ppu \
|
||||||
pbase.ppu \
|
pbase.ppu \
|
||||||
pexpr.ppu \
|
pexpr.ppu \
|
||||||
pdecl.ppu \
|
pdecl.ppu \
|
||||||
@ -548,7 +604,30 @@ pstatmnt.ppu: pstatmnt.pas \
|
|||||||
ra386att.ppu \
|
ra386att.ppu \
|
||||||
ra386dir.ppu
|
ra386dir.ppu
|
||||||
|
|
||||||
ra386int.ppu: ra386int.pas
|
ra386int.ppu: ra386int.pas \
|
||||||
|
tree.ppu \
|
||||||
|
i386.ppu \
|
||||||
|
systems.ppu \
|
||||||
|
files.ppu \
|
||||||
|
aasm.ppu \
|
||||||
|
globals.ppu \
|
||||||
|
asmutils.ppu \
|
||||||
|
hcodegen.ppu \
|
||||||
|
scanner.ppu \
|
||||||
|
cobjects.ppu \
|
||||||
|
verbose.ppu \
|
||||||
|
types.ppu
|
||||||
|
|
||||||
|
asmutils.ppu: asmutils.pas \
|
||||||
|
symtable.ppu \
|
||||||
|
aasm.ppu \
|
||||||
|
hcodegen.ppu \
|
||||||
|
verbose.ppu \
|
||||||
|
systems.ppu \
|
||||||
|
globals.ppu \
|
||||||
|
files.ppu \
|
||||||
|
cobjects.ppu \
|
||||||
|
i386.ppu
|
||||||
|
|
||||||
ra386att.ppu: ra386att.pas \
|
ra386att.ppu: ra386att.pas \
|
||||||
i386.ppu \
|
i386.ppu \
|
||||||
@ -565,17 +644,6 @@ ra386att.ppu: ra386att.pas \
|
|||||||
symtable.ppu \
|
symtable.ppu \
|
||||||
types.ppu
|
types.ppu
|
||||||
|
|
||||||
asmutils.ppu: asmutils.pas \
|
|
||||||
symtable.ppu \
|
|
||||||
aasm.ppu \
|
|
||||||
hcodegen.ppu \
|
|
||||||
verbose.ppu \
|
|
||||||
systems.ppu \
|
|
||||||
globals.ppu \
|
|
||||||
files.ppu \
|
|
||||||
cobjects.ppu \
|
|
||||||
i386.ppu
|
|
||||||
|
|
||||||
ra386dir.ppu: ra386dir.pas \
|
ra386dir.ppu: ra386dir.pas \
|
||||||
tree.ppu \
|
tree.ppu \
|
||||||
files.ppu \
|
files.ppu \
|
||||||
@ -607,6 +675,7 @@ pmodules.ppu: pmodules.pas \
|
|||||||
files.ppu \
|
files.ppu \
|
||||||
cobjects.ppu \
|
cobjects.ppu \
|
||||||
verbose.ppu \
|
verbose.ppu \
|
||||||
|
comphook.ppu \
|
||||||
systems.ppu \
|
systems.ppu \
|
||||||
globals.ppu \
|
globals.ppu \
|
||||||
symtable.ppu \
|
symtable.ppu \
|
||||||
@ -615,6 +684,7 @@ pmodules.ppu: pmodules.pas \
|
|||||||
link.ppu \
|
link.ppu \
|
||||||
assemble.ppu \
|
assemble.ppu \
|
||||||
import.ppu \
|
import.ppu \
|
||||||
|
ppu.ppu \
|
||||||
i386.ppu \
|
i386.ppu \
|
||||||
scanner.ppu \
|
scanner.ppu \
|
||||||
pbase.ppu \
|
pbase.ppu \
|
||||||
@ -623,25 +693,3 @@ pmodules.ppu: pmodules.pas \
|
|||||||
psub.ppu \
|
psub.ppu \
|
||||||
parser.ppu
|
parser.ppu
|
||||||
|
|
||||||
options.ppu: options.pas \
|
|
||||||
cobjects.ppu \
|
|
||||||
globals.ppu \
|
|
||||||
systems.ppu \
|
|
||||||
verbose.ppu \
|
|
||||||
scanner.ppu \
|
|
||||||
link.ppu \
|
|
||||||
verb_def.ppu \
|
|
||||||
messages.ppu \
|
|
||||||
gendef.ppu \
|
|
||||||
opts386.ppu
|
|
||||||
|
|
||||||
verb_def.ppu: verb_def.pas \
|
|
||||||
verbose.ppu \
|
|
||||||
globals.ppu \
|
|
||||||
files.ppu
|
|
||||||
|
|
||||||
opts386.ppu: opts386.pas \
|
|
||||||
options.ppu \
|
|
||||||
systems.ppu \
|
|
||||||
globals.ppu
|
|
||||||
|
|
||||||
|
|||||||
@ -33,7 +33,7 @@ unit parser;
|
|||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
systems,cobjects,globals,verbose,
|
cobjects,verbose,comphook,systems,globals,
|
||||||
symtable,files,aasm,hcodegen,
|
symtable,files,aasm,hcodegen,
|
||||||
assemble,link,script,gendef,
|
assemble,link,script,gendef,
|
||||||
{$ifdef UseBrowser}
|
{$ifdef UseBrowser}
|
||||||
@ -390,7 +390,11 @@ done:
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.31 1998-07-14 21:46:46 peter
|
Revision 1.32 1998-08-10 10:18:28 peter
|
||||||
|
+ Compiler,Comphook unit which are the new interface units to the
|
||||||
|
compiler
|
||||||
|
|
||||||
|
Revision 1.31 1998/07/14 21:46:46 peter
|
||||||
* updated messages file
|
* updated messages file
|
||||||
|
|
||||||
Revision 1.30 1998/07/14 14:46:49 peter
|
Revision 1.30 1998/07/14 14:46:49 peter
|
||||||
|
|||||||
@ -35,8 +35,8 @@ unit pass_1;
|
|||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
scanner,cobjects,verbose,systems,globals,aasm,symtable,
|
cobjects,verbose,comphook,systems,globals,
|
||||||
types,strings,hcodegen,files
|
aasm,symtable,types,strings,hcodegen,files
|
||||||
{$ifdef i386}
|
{$ifdef i386}
|
||||||
,i386
|
,i386
|
||||||
,tgeni386
|
,tgeni386
|
||||||
@ -5177,7 +5177,11 @@ unit pass_1;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.50 1998-08-08 21:51:39 peter
|
Revision 1.51 1998-08-10 10:18:29 peter
|
||||||
|
+ Compiler,Comphook unit which are the new interface units to the
|
||||||
|
compiler
|
||||||
|
|
||||||
|
Revision 1.50 1998/08/08 21:51:39 peter
|
||||||
* small crash prevent is firstassignment
|
* small crash prevent is firstassignment
|
||||||
|
|
||||||
Revision 1.49 1998/07/30 16:07:08 florian
|
Revision 1.49 1998/07/30 16:07:08 florian
|
||||||
|
|||||||
@ -37,7 +37,7 @@ unit pmodules;
|
|||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
cobjects,verbose,systems,globals,
|
cobjects,verbose,comphook,systems,globals,
|
||||||
symtable,aasm,hcodegen,
|
symtable,aasm,hcodegen,
|
||||||
link,assemble,import
|
link,assemble,import
|
||||||
{$ifndef OLDPPU}
|
{$ifndef OLDPPU}
|
||||||
@ -1166,7 +1166,11 @@ unit pmodules;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.36 1998-07-14 14:46:54 peter
|
Revision 1.37 1998-08-10 10:18:31 peter
|
||||||
|
+ Compiler,Comphook unit which are the new interface units to the
|
||||||
|
compiler
|
||||||
|
|
||||||
|
Revision 1.36 1998/07/14 14:46:54 peter
|
||||||
* released NEWINPUT
|
* released NEWINPUT
|
||||||
|
|
||||||
Revision 1.35 1998/07/08 12:39:38 peter
|
Revision 1.35 1998/07/08 12:39:38 peter
|
||||||
|
|||||||
203
compiler/pp.pas
203
compiler/pp.pas
@ -2,6 +2,8 @@
|
|||||||
$Id$
|
$Id$
|
||||||
Copyright (c) 1993-98 by Florian Klaempfl
|
Copyright (c) 1993-98 by Florian Klaempfl
|
||||||
|
|
||||||
|
Commandline compiler for Free Pascal
|
||||||
|
|
||||||
This program is free software; you can redistribute it and/or modify
|
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
|
it under the terms of the GNU General Public License as published by
|
||||||
the Free Software Foundation; either version 2 of the License, or
|
the Free Software Foundation; either version 2 of the License, or
|
||||||
@ -27,8 +29,6 @@
|
|||||||
GDB* support of the GNU Debugger
|
GDB* support of the GNU Debugger
|
||||||
I386 generate a compiler for the Intel i386+
|
I386 generate a compiler for the Intel i386+
|
||||||
M68K generate a compiler for the M68000
|
M68K generate a compiler for the M68000
|
||||||
MULLER release special debug code of Pierre Muller
|
|
||||||
(needs some extra units)
|
|
||||||
USEOVERLAY compiles a TP version which uses overlays
|
USEOVERLAY compiles a TP version which uses overlays
|
||||||
EXTDEBUG some extra debug code is executed
|
EXTDEBUG some extra debug code is executed
|
||||||
SUPPORT_MMX only i386: releases the compiler switch
|
SUPPORT_MMX only i386: releases the compiler switch
|
||||||
@ -94,51 +94,20 @@ program pp;
|
|||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
{$ifdef FPC}
|
{$ifdef FPC}
|
||||||
{$UNDEF USEOVERLAY}
|
{$UNDEF USEOVERLAY}
|
||||||
{$UNDEF USEPMD}
|
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
uses
|
uses
|
||||||
{$ifdef fpc}
|
|
||||||
{$ifdef GO32V2}
|
|
||||||
emu387,
|
|
||||||
dpmiexcp,
|
|
||||||
{$endif GO32V2}
|
|
||||||
{$endif}
|
|
||||||
{$ifdef useoverlay}
|
{$ifdef useoverlay}
|
||||||
{$ifopt o+}
|
{$ifopt o+}
|
||||||
Overlay,ppovin,
|
Overlay,ppovin,
|
||||||
{$else}
|
{$else}
|
||||||
{$error You must compile with the $O+ switch}
|
{$error You must compile with the $O+ switch}
|
||||||
{$endif}
|
{$endif}
|
||||||
{$endif useoverlay}
|
{$endif useoverlay}
|
||||||
{$ifdef lock}
|
|
||||||
lock,
|
|
||||||
{$endif lock}
|
|
||||||
{$ifdef profile}
|
{$ifdef profile}
|
||||||
profile,
|
profile,
|
||||||
{$endif profile}
|
{$endif profile}
|
||||||
{$ifdef muller}
|
globals,compiler;
|
||||||
openfile,
|
|
||||||
{$ifdef usepmd}
|
|
||||||
usepmd,
|
|
||||||
{$endif usepmd}
|
|
||||||
{$endif}
|
|
||||||
{$ifdef LINUX}
|
|
||||||
catch,
|
|
||||||
{$endif LINUX}
|
|
||||||
{$IfDef PMD}
|
|
||||||
OpenFile,
|
|
||||||
BBError,
|
|
||||||
ObjMemory,
|
|
||||||
PMD, MemCheck,
|
|
||||||
{$EndIf}
|
|
||||||
{$ifdef TP}
|
|
||||||
objects,
|
|
||||||
{$endif}
|
|
||||||
|
|
||||||
dos,cobjects,
|
|
||||||
globals,parser,systems,tree,symtable,options,link,import,files,
|
|
||||||
verb_def,verbose;
|
|
||||||
|
|
||||||
{$ifdef useoverlay}
|
{$ifdef useoverlay}
|
||||||
{$O files}
|
{$O files}
|
||||||
@ -165,7 +134,7 @@ uses
|
|||||||
{$O script}
|
{$O script}
|
||||||
{$O switches}
|
{$O switches}
|
||||||
{$O temp_gen}
|
{$O temp_gen}
|
||||||
{$O verb_def}
|
{$O comphook}
|
||||||
{$O dos}
|
{$O dos}
|
||||||
{$O scanner}
|
{$O scanner}
|
||||||
{$O symtable}
|
{$O symtable}
|
||||||
@ -226,26 +195,12 @@ uses
|
|||||||
{$endif}
|
{$endif}
|
||||||
{$endif useoverlay}
|
{$endif useoverlay}
|
||||||
|
|
||||||
|
|
||||||
function getrealtime : real;
|
|
||||||
var
|
|
||||||
h,m,s,s100 : word;
|
|
||||||
begin
|
|
||||||
dos.gettime(h,m,s,s100);
|
|
||||||
getrealtime:=h*3600.0+m*60.0+s+s100/100.0;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
var
|
var
|
||||||
oldexit : pointer;
|
oldexit : pointer;
|
||||||
procedure myexit;{$ifndef FPC}far;{$endif}
|
procedure myexit;{$ifndef FPC}far;{$endif}
|
||||||
begin
|
begin
|
||||||
exitproc:=oldexit;
|
exitproc:=oldexit;
|
||||||
{$ifdef tp}
|
{ Show Runtime error if there was an error }
|
||||||
if use_big then
|
|
||||||
symbolstream.done;
|
|
||||||
{$endif}
|
|
||||||
if (erroraddr<>nil) then
|
if (erroraddr<>nil) then
|
||||||
begin
|
begin
|
||||||
case exitcode of
|
case exitcode of
|
||||||
@ -258,64 +213,10 @@ begin
|
|||||||
Writeln('Error: Out of memory');
|
Writeln('Error: Out of memory');
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
{when the module is assigned, then the messagefile is also loaded}
|
|
||||||
Writeln('Compilation aborted at line ',aktfilepos.line);
|
Writeln('Compilation aborted at line ',aktfilepos.line);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
{$ifdef tp}
|
|
||||||
procedure do_streamerror;
|
|
||||||
begin
|
|
||||||
if symbolstream.status=-2 then
|
|
||||||
WriteLn('Error: Not enough EMS memory')
|
|
||||||
else
|
|
||||||
WriteLn('Error: EMS Error ',symbolstream.status);
|
|
||||||
{$ifndef MULLER}
|
|
||||||
halt(1);
|
|
||||||
{$else MULLER}
|
|
||||||
runerror(190);
|
|
||||||
{$endif MULLER}
|
|
||||||
end;
|
|
||||||
|
|
||||||
{$ifdef USEOVERLAY}
|
|
||||||
function _heaperror(size:word):integer;far;
|
|
||||||
type
|
|
||||||
heaprecord=record
|
|
||||||
next:pointer;
|
|
||||||
values:longint;
|
|
||||||
end;
|
|
||||||
var
|
|
||||||
l,m:longint;
|
|
||||||
begin
|
|
||||||
l:=ovrgetbuf-ovrminsize;
|
|
||||||
if (size>maxavail) and (l>=size) then
|
|
||||||
begin
|
|
||||||
m:=((longint(size)+$3fff) and $ffffc000);
|
|
||||||
{Clear the overlay buffer.}
|
|
||||||
ovrclearbuf;
|
|
||||||
{Shrink it.}
|
|
||||||
ovrheapend:=ovrheapend-m shr 4;
|
|
||||||
heaprecord(ptr(ovrheapend,0)^).next:=freelist;
|
|
||||||
heaprecord(ptr(ovrheapend,0)^).values:=m shl 12;
|
|
||||||
heaporg:=ptr(ovrheapend,0);
|
|
||||||
freelist:=heaporg;
|
|
||||||
Writeln('Warning: Overlay buffer shrinked, because of memory shortage');
|
|
||||||
_heaperror:=2;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
_heaperror:=0;
|
|
||||||
end;
|
|
||||||
{$endif USEOVERLAY}
|
|
||||||
{$endif TP}
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
var
|
|
||||||
start : real;
|
|
||||||
{$IfDef Extdebug}
|
|
||||||
EntryMemAvail : longint;
|
|
||||||
{$EndIf}
|
|
||||||
begin
|
begin
|
||||||
oldexit:=exitproc;
|
oldexit:=exitproc;
|
||||||
exitproc:=@myexit;
|
exitproc:=@myexit;
|
||||||
@ -326,91 +227,29 @@ begin
|
|||||||
heapblocks:=true;
|
heapblocks:=true;
|
||||||
{$endif}
|
{$endif}
|
||||||
{$endif}
|
{$endif}
|
||||||
{$ifdef EXTDEBUG}
|
{$ifdef UseOverlay}
|
||||||
EntryMemAvail:=MemAvail;
|
InitOverlay;
|
||||||
{$endif}
|
|
||||||
{$ifdef MULLER}
|
|
||||||
{$ifdef DPMI}
|
|
||||||
HeapBlock:=$ff00;
|
|
||||||
{$endif DPMI}
|
|
||||||
{$endif MULLER}
|
|
||||||
{$ifdef TP}
|
|
||||||
{$IFDEF USEOVERLAY}
|
|
||||||
heaperror:=@_heaperror;
|
|
||||||
{$ENDIF USEOVERLAY}
|
|
||||||
if use_big then
|
|
||||||
begin
|
|
||||||
streamerror:=@do_streamerror;
|
|
||||||
{ symbolstream.init('TMPFILE',stcreate,16000); }
|
|
||||||
{$ifndef dpmi}
|
|
||||||
symbolstream.init(10000,4000000); {using ems streams}
|
|
||||||
{$else}
|
|
||||||
symbolstream.init(1000000,16000); {using memory streams}
|
|
||||||
{$endif}
|
|
||||||
if symbolstream.errorinfo=stiniterror then
|
|
||||||
do_streamerror;
|
|
||||||
{ write something, because pos 0 means nil pointer }
|
|
||||||
symbolstream.writestr(@inputfile);
|
|
||||||
end;
|
|
||||||
{$endif tp}
|
|
||||||
|
|
||||||
{ inits which need to be done before the arguments are parsed }
|
|
||||||
get_exepath;
|
|
||||||
init_tree;
|
|
||||||
globalsinit;
|
|
||||||
init_symtable;
|
|
||||||
linker.init;
|
|
||||||
|
|
||||||
{ read the arguments }
|
|
||||||
read_arguments;
|
|
||||||
|
|
||||||
{ inits which depend on arguments }
|
|
||||||
initparser;
|
|
||||||
initimport;
|
|
||||||
|
|
||||||
{show some info}
|
|
||||||
Message1(general_i_compilername,FixFileName(paramstr(0)));
|
|
||||||
Message1(general_i_unitsearchpath,unitsearchpath);
|
|
||||||
Message1(general_d_sourceos,source_os.name);
|
|
||||||
Message1(general_i_targetos,target_os.name);
|
|
||||||
Message1(general_u_exepath,exepath);
|
|
||||||
{$ifdef linux}
|
|
||||||
Message1(general_u_gcclibpath,Linker.librarysearchpath);
|
|
||||||
{$endif}
|
|
||||||
{$ifdef TP}
|
|
||||||
Comment(V_Info,'Memory: '+tostr(MemAvail)+' Bytes Free');
|
|
||||||
{$endif}
|
{$endif}
|
||||||
|
|
||||||
start:=getrealtime;
|
{ Call the compiler with empty command, so it will take the parameters }
|
||||||
compile(inputdir+inputfile+inputextension,false);
|
Halt(Compile(''));
|
||||||
if status.errorcount=0 then
|
|
||||||
begin
|
|
||||||
start:=getrealtime-start;
|
|
||||||
Message2(general_i_abslines_compiled,tostr(status.compiledlines),tostr(trunc(start))+'.'+tostr(trunc(frac(start)*10)));
|
|
||||||
end;
|
|
||||||
|
|
||||||
done_symtable;
|
|
||||||
|
|
||||||
{$ifdef TP}
|
|
||||||
Comment(V_Info,'Memory: '+tostr(MemAvail)+' Bytes Free');
|
|
||||||
{$endif}
|
|
||||||
{$ifdef EXTDEBUG}
|
|
||||||
Comment(V_Info,'Memory lost = '+tostr(EntryMemAvail-MemAvail));
|
|
||||||
{$endif EXTDEBUG}
|
|
||||||
{ exits with error 1 if no codegeneration }
|
|
||||||
if status.errorcount=0 then
|
|
||||||
halt(0)
|
|
||||||
else
|
|
||||||
halt(1);
|
|
||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.23 1998-08-05 16:00:16 florian
|
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
|
* some fixes for ansi strings
|
||||||
* $log$ to $Log$ changed
|
* $log$ to $Log$
|
||||||
|
* $log$ to Revision 1.24 1998-08-10 10:18:32 peter
|
||||||
|
* $log$ to + Compiler,Comphook unit which are the new interface units to the
|
||||||
|
* $log$ to compiler
|
||||||
|
* $log$ to changed
|
||||||
|
|
||||||
Revision 1.22 1998/08/04 16:28:40 jonas
|
Revision 1.22 1998/08/04 16:28:40 jonas
|
||||||
* added support for NoRa386* in the {$O ...} section
|
* added support for NoRa386* in the $O ... section
|
||||||
|
|
||||||
Revision 1.21 1998/07/18 17:11:12 florian
|
Revision 1.21 1998/07/18 17:11:12 florian
|
||||||
+ ansi string constants fixed
|
+ ansi string constants fixed
|
||||||
|
|||||||
@ -24,50 +24,72 @@ unit ppovin;
|
|||||||
|
|
||||||
interface
|
interface
|
||||||
|
|
||||||
var ovrminsize:longint;
|
var
|
||||||
|
ovrminsize:longint;
|
||||||
|
|
||||||
|
procedure InitOverlay;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
uses overlay;
|
||||||
|
|
||||||
uses overlay;
|
|
||||||
|
|
||||||
var s:string;
|
|
||||||
|
|
||||||
|
function _heaperror(size:word):integer;far;
|
||||||
|
type
|
||||||
|
heaprecord=record
|
||||||
|
next:pointer;
|
||||||
|
values:longint;
|
||||||
|
end;
|
||||||
|
var
|
||||||
|
l,m:longint;
|
||||||
begin
|
begin
|
||||||
s:=paramstr(0);
|
l:=ovrgetbuf-ovrminsize;
|
||||||
ovrinit(copy(s,1,length(s)-3)+'ovr');
|
if (size>maxavail) and (l>=size) then
|
||||||
if ovrresult=ovrok then
|
begin
|
||||||
begin
|
m:=((longint(size)+$3fff) and $ffffc000);
|
||||||
{May fail if no EMS memory is available. No need for error
|
{Clear the overlay buffer.}
|
||||||
checking, though, as the overlay manager happily runs without
|
ovrclearbuf;
|
||||||
EMS.}
|
{Shrink it.}
|
||||||
ovrinitEMS;
|
ovrheapend:=ovrheapend-m shr 4;
|
||||||
ovrminsize:=ovrgetbuf;
|
heaprecord(ptr(ovrheapend,0)^).next:=freelist;
|
||||||
ovrsetbuf(ovrminsize+$20000);
|
heaprecord(ptr(ovrheapend,0)^).values:=m shl 12;
|
||||||
end
|
heaporg:=ptr(ovrheapend,0);
|
||||||
else
|
freelist:=heaporg;
|
||||||
runerror($da);
|
Writeln('Warning: Overlay buffer shrinked, because of memory shortage');
|
||||||
|
_heaperror:=2;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
_heaperror:=0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure InitOverlay;
|
||||||
|
begin
|
||||||
|
heaperror:=@_heaperror;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
var
|
||||||
|
s:string;
|
||||||
|
begin
|
||||||
|
s:=paramstr(0);
|
||||||
|
ovrinit(copy(s,1,length(s)-3)+'ovr');
|
||||||
|
if ovrresult=ovrok then
|
||||||
|
begin
|
||||||
|
{May fail if no EMS memory is available. No need for error
|
||||||
|
checking, though, as the overlay manager happily runs without
|
||||||
|
EMS.}
|
||||||
|
ovrinitEMS;
|
||||||
|
ovrminsize:=ovrgetbuf;
|
||||||
|
ovrsetbuf(ovrminsize+$20000);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
runerror($da);
|
||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.1 1998-03-25 11:18:15 root
|
Revision 1.2 1998-08-10 10:18:33 peter
|
||||||
Initial revision
|
+ Compiler,Comphook unit which are the new interface units to the
|
||||||
|
compiler
|
||||||
|
|
||||||
Revision 1.5 1998/03/10 01:17:24 peter
|
|
||||||
* all files have the same header
|
|
||||||
* messages are fully implemented, EXTDEBUG uses Comment()
|
|
||||||
+ AG... files for the Assembler generation
|
|
||||||
|
|
||||||
|
|
||||||
Pre CVS Log:
|
|
||||||
|
|
||||||
FK Florian Klaempfl
|
|
||||||
DM Dani‰l Mantione
|
|
||||||
+ feature added
|
|
||||||
- removed
|
|
||||||
* bug fixed or changed
|
|
||||||
|
|
||||||
12th October 1997:
|
|
||||||
Rewritten (DM).
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@ -28,7 +28,7 @@ unit scanner;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
cobjects,globals,verbose,files;
|
cobjects,globals,verbose,comphook,files;
|
||||||
|
|
||||||
const
|
const
|
||||||
{$ifdef TP}
|
{$ifdef TP}
|
||||||
@ -510,11 +510,13 @@ implementation
|
|||||||
if closed then
|
if closed then
|
||||||
exit;
|
exit;
|
||||||
repeat
|
repeat
|
||||||
{ still more to read, then we have an illegal char }
|
{ still more to read?, then change the #0 to a space so its seen
|
||||||
|
as a seperator }
|
||||||
if (bufsize>0) and (inputpointer-inputbuffer<bufsize) then
|
if (bufsize>0) and (inputpointer-inputbuffer<bufsize) then
|
||||||
begin
|
begin
|
||||||
gettokenpos;
|
c:=' ';
|
||||||
Message(scan_f_illegal_char);
|
inc(longint(inputpointer));
|
||||||
|
exit;
|
||||||
end;
|
end;
|
||||||
{ can we read more from this file ? }
|
{ can we read more from this file ? }
|
||||||
if filenotatend then
|
if filenotatend then
|
||||||
@ -561,7 +563,7 @@ implementation
|
|||||||
begin
|
begin
|
||||||
lasttokenpos:=bufstart+(inputpointer-inputbuffer);
|
lasttokenpos:=bufstart+(inputpointer-inputbuffer);
|
||||||
tokenpos.line:=line_no;
|
tokenpos.line:=line_no;
|
||||||
tokenpos.column:=lasttokenpos-lastlinepos+1;
|
tokenpos.column:=lasttokenpos-lastlinepos;
|
||||||
tokenpos.fileindex:=current_module^.current_index;
|
tokenpos.fileindex:=current_module^.current_index;
|
||||||
aktfilepos:=tokenpos;
|
aktfilepos:=tokenpos;
|
||||||
end;
|
end;
|
||||||
@ -627,10 +629,10 @@ implementation
|
|||||||
end;
|
end;
|
||||||
plongint(longint(linebuf)+line_no*2)^:=lastlinepos;
|
plongint(longint(linebuf)+line_no*2)^:=lastlinepos;
|
||||||
{$endif SourceLine}
|
{$endif SourceLine}
|
||||||
{ update for status }
|
{ update for status and call the show status routine }
|
||||||
aktfilepos.line:=line_no; { update for v_status }
|
aktfilepos.line:=line_no; { update for v_status }
|
||||||
inc(status.compiledlines);
|
inc(status.compiledlines);
|
||||||
Comment(V_Status,'');
|
ShowStatus;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -729,10 +731,8 @@ implementation
|
|||||||
c:=inputpointer^;
|
c:=inputpointer^;
|
||||||
inc(longint(inputpointer));
|
inc(longint(inputpointer));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
#0 : reload;
|
#0 : reload;
|
||||||
#13,#10 : begin
|
#13,#10 : begin
|
||||||
|
|
||||||
linebreak;
|
linebreak;
|
||||||
break;
|
break;
|
||||||
end;
|
end;
|
||||||
@ -740,7 +740,6 @@ implementation
|
|||||||
break;
|
break;
|
||||||
end;
|
end;
|
||||||
until false;
|
until false;
|
||||||
|
|
||||||
orgpattern[0]:=chr(i);
|
orgpattern[0]:=chr(i);
|
||||||
pattern[0]:=chr(i);
|
pattern[0]:=chr(i);
|
||||||
end;
|
end;
|
||||||
@ -1549,7 +1548,11 @@ exit_label:
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.37 1998-07-23 12:40:41 michael
|
Revision 1.38 1998-08-10 10:18:34 peter
|
||||||
|
+ Compiler,Comphook unit which are the new interface units to the
|
||||||
|
compiler
|
||||||
|
|
||||||
|
Revision 1.37 1998/07/23 12:40:41 michael
|
||||||
No nested comments in Delphi mode.
|
No nested comments in Delphi mode.
|
||||||
|
|
||||||
Revision 1.36 1998/07/20 22:17:17 florian
|
Revision 1.36 1998/07/20 22:17:17 florian
|
||||||
|
|||||||
@ -467,24 +467,26 @@
|
|||||||
|
|
||||||
var
|
var
|
||||||
pd : pprocdef;
|
pd : pprocdef;
|
||||||
|
oldaktfilepos : tfileposinfo;
|
||||||
begin
|
begin
|
||||||
pd:=definition;
|
pd:=definition;
|
||||||
while assigned(pd) do
|
while assigned(pd) do
|
||||||
begin
|
begin
|
||||||
if pd^.forwarddef then
|
if pd^.forwarddef then
|
||||||
begin
|
begin
|
||||||
{$ifdef GDB}
|
oldaktfilepos:=aktfilepos;
|
||||||
|
aktfilepos:=fileinfo;
|
||||||
if assigned(pd^._class) then
|
if assigned(pd^._class) then
|
||||||
Message1(sym_e_forward_not_resolved,pd^._class^.name^+'.'+name+demangledparas(pd^.demangled_paras))
|
Message1(sym_e_forward_not_resolved,pd^._class^.name^+'.'+name+demangledparas(pd^.demangled_paras))
|
||||||
else
|
else
|
||||||
{$endif GDB}
|
Message1(sym_e_forward_not_resolved,name+pd^.demangled_paras);
|
||||||
Message1(sym_e_forward_not_resolved,name+pd^.demangled_paras)
|
aktfilepos:=oldaktfilepos;
|
||||||
end;
|
end;
|
||||||
pd:=pd^.nextoverloaded;
|
pd:=pd^.nextoverloaded;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure tprocsym.deref;
|
procedure tprocsym.deref;
|
||||||
var t : ttoken;
|
var t : ttoken;
|
||||||
last : pprocdef;
|
last : pprocdef;
|
||||||
@ -1650,7 +1652,11 @@
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.25 1998-07-30 11:18:19 florian
|
Revision 1.26 1998-08-10 10:18:35 peter
|
||||||
|
+ Compiler,Comphook unit which are the new interface units to the
|
||||||
|
compiler
|
||||||
|
|
||||||
|
Revision 1.25 1998/07/30 11:18:19 florian
|
||||||
+ first implementation of try ... except on .. do end;
|
+ first implementation of try ... except on .. do end;
|
||||||
* limitiation of 65535 bytes parameters for cdecl removed
|
* limitiation of 65535 bytes parameters for cdecl removed
|
||||||
|
|
||||||
|
|||||||
336
compiler/tpexcept.pas
Normal file
336
compiler/tpexcept.pas
Normal file
@ -0,0 +1,336 @@
|
|||||||
|
{
|
||||||
|
$Id$
|
||||||
|
Copyright (c) 1993-98 by Florian Klaempfl
|
||||||
|
|
||||||
|
SetJmp and LongJmp implementation for recovery handling of the
|
||||||
|
compiler
|
||||||
|
|
||||||
|
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.
|
||||||
|
|
||||||
|
****************************************************************************}
|
||||||
|
unit tpexcept;
|
||||||
|
interface
|
||||||
|
|
||||||
|
{$S-}
|
||||||
|
|
||||||
|
type
|
||||||
|
jmp_buf = record
|
||||||
|
{$ifdef TP}
|
||||||
|
_ax,_bx,_cx,_dx,_si,_di,_bp,_sp,_ip,flags : word;
|
||||||
|
_cs,_ds,_es,_ss : word;
|
||||||
|
{$else}
|
||||||
|
eax,ebx,ecx,edx,esi,edi,ebp,esp,eip,flags : longint;
|
||||||
|
cs,ds,es,fs,gs,ss : word;
|
||||||
|
{$endif TP}
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$ifdef TP}
|
||||||
|
function setjmp(var rec : jmp_buf) : integer;
|
||||||
|
procedure longjmp(const rec : jmp_buf;return_value : integer);
|
||||||
|
{$else}
|
||||||
|
function setjmp(var rec : jmp_buf) : longint;
|
||||||
|
procedure longjmp(const rec : jmp_buf;return_value : longint);
|
||||||
|
{$endif TP}
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
{*****************************************************************************
|
||||||
|
Exception Helpers
|
||||||
|
*****************************************************************************}
|
||||||
|
|
||||||
|
{$ifdef TP}
|
||||||
|
|
||||||
|
function setjmp(var rec : jmp_buf) : integer;
|
||||||
|
begin
|
||||||
|
asm
|
||||||
|
push di
|
||||||
|
push es
|
||||||
|
les di,rec
|
||||||
|
mov es:[di].jmp_buf._ax,ax
|
||||||
|
mov es:[di].jmp_buf._bx,bx
|
||||||
|
mov es:[di].jmp_buf._cx,cx
|
||||||
|
mov es:[di].jmp_buf._dx,dx
|
||||||
|
mov es:[di].jmp_buf._si,si
|
||||||
|
|
||||||
|
{ load di }
|
||||||
|
mov ax,[bp-4]
|
||||||
|
|
||||||
|
{ ... and store it }
|
||||||
|
mov es:[di].jmp_buf._di,ax
|
||||||
|
|
||||||
|
{ load es }
|
||||||
|
mov ax,[bp-6]
|
||||||
|
|
||||||
|
{ ... and store it }
|
||||||
|
mov es:[di].jmp_buf._es,ax
|
||||||
|
|
||||||
|
{ bp ... }
|
||||||
|
mov ax,[bp]
|
||||||
|
mov es:[di].jmp_buf._bp,ax
|
||||||
|
|
||||||
|
{ sp ... }
|
||||||
|
mov ax,bp
|
||||||
|
add ax,10
|
||||||
|
mov es:[di].jmp_buf._sp,ax
|
||||||
|
|
||||||
|
{ the return address }
|
||||||
|
mov ax,[bp+2]
|
||||||
|
mov es:[di].jmp_buf._ip,ax
|
||||||
|
mov ax,[bp+4]
|
||||||
|
mov es:[di].jmp_buf._cs,ax
|
||||||
|
|
||||||
|
{ flags ... }
|
||||||
|
pushf
|
||||||
|
pop word ptr es:[di].jmp_buf.flags
|
||||||
|
|
||||||
|
mov es:[di].jmp_buf._ds,ds
|
||||||
|
mov es:[di].jmp_buf._ss,ss
|
||||||
|
|
||||||
|
{ restore es:di }
|
||||||
|
pop es
|
||||||
|
pop di
|
||||||
|
|
||||||
|
{ we come from the initial call }
|
||||||
|
xor ax,ax
|
||||||
|
leave
|
||||||
|
retf 4
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure longjmp(const rec : jmp_buf;return_value : integer);
|
||||||
|
begin
|
||||||
|
asm
|
||||||
|
|
||||||
|
{ this is the address of rec }
|
||||||
|
lds di,rec
|
||||||
|
|
||||||
|
{ save return value }
|
||||||
|
mov ax,return_value
|
||||||
|
mov ds:[di].jmp_buf._ax,ax
|
||||||
|
|
||||||
|
{ restore compiler shit }
|
||||||
|
pop bp
|
||||||
|
|
||||||
|
{ restore some registers }
|
||||||
|
mov bx,ds:[di].jmp_buf._bx
|
||||||
|
mov cx,ds:[di].jmp_buf._cx
|
||||||
|
mov dx,ds:[di].jmp_buf._dx
|
||||||
|
mov bp,ds:[di].jmp_buf._bp
|
||||||
|
|
||||||
|
{ create a stack frame for the return }
|
||||||
|
mov es,ds:[di].jmp_buf._ss
|
||||||
|
mov si,ds:[di].jmp_buf._sp
|
||||||
|
|
||||||
|
sub si,12
|
||||||
|
|
||||||
|
{ store ds }
|
||||||
|
mov ax,ds:[di].jmp_buf._ds
|
||||||
|
mov es:[si],ax
|
||||||
|
|
||||||
|
{ store di }
|
||||||
|
mov ax,ds:[di].jmp_buf._di
|
||||||
|
mov es:[si+2],ax
|
||||||
|
|
||||||
|
{ store si }
|
||||||
|
mov ax,ds:[di].jmp_buf._si
|
||||||
|
mov es:[si+4],ax
|
||||||
|
|
||||||
|
{ store flags }
|
||||||
|
mov ax,ds:[di].jmp_buf.flags
|
||||||
|
mov es:[si+6],ax
|
||||||
|
|
||||||
|
{ store ip }
|
||||||
|
mov ax,ds:[di].jmp_buf._ip
|
||||||
|
mov es:[si+8],ax
|
||||||
|
|
||||||
|
{ store cs }
|
||||||
|
mov ax,ds:[di].jmp_buf._cs
|
||||||
|
mov es:[si+10],ax
|
||||||
|
|
||||||
|
{ load stack }
|
||||||
|
mov ax,es
|
||||||
|
mov ss,ax
|
||||||
|
mov sp,si
|
||||||
|
|
||||||
|
{ load return value }
|
||||||
|
mov ax,ds:[di].jmp_buf._ax
|
||||||
|
|
||||||
|
{ load old ES }
|
||||||
|
mov es,ds:[di].jmp_buf._es
|
||||||
|
|
||||||
|
pop ds
|
||||||
|
pop di
|
||||||
|
pop si
|
||||||
|
|
||||||
|
popf
|
||||||
|
retf
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$else}
|
||||||
|
|
||||||
|
function setjmp(var rec : jmp_buf) : longint;
|
||||||
|
begin
|
||||||
|
asm
|
||||||
|
pushl %edi
|
||||||
|
movl rec,%edi
|
||||||
|
movl %eax,(%edi)
|
||||||
|
movl %ebx,4(%edi)
|
||||||
|
movl %ecx,8(%edi)
|
||||||
|
movl %edx,12(%edi)
|
||||||
|
movl %esi,16(%edi)
|
||||||
|
|
||||||
|
{ load edi }
|
||||||
|
movl -4(%ebp),%eax
|
||||||
|
|
||||||
|
{ ... and store it }
|
||||||
|
movl %eax,20(%edi)
|
||||||
|
|
||||||
|
{ ebp ... }
|
||||||
|
movl (%ebp),%eax
|
||||||
|
movl %eax,24(%edi)
|
||||||
|
|
||||||
|
{ esp ... }
|
||||||
|
movl %esp,%eax
|
||||||
|
addl $12,%eax
|
||||||
|
movl %eax,28(%edi)
|
||||||
|
|
||||||
|
{ the return address }
|
||||||
|
movl 4(%ebp),%eax
|
||||||
|
movl %eax,32(%edi)
|
||||||
|
|
||||||
|
{ flags ... }
|
||||||
|
pushfl
|
||||||
|
popl 36(%edi)
|
||||||
|
|
||||||
|
{ !!!!! the segment registers, not yet needed }
|
||||||
|
{ you need them if the exception comes from
|
||||||
|
an interrupt or a seg_move }
|
||||||
|
movw %cs,40(%edi)
|
||||||
|
movw %ds,42(%edi)
|
||||||
|
movw %es,44(%edi)
|
||||||
|
movw %fs,46(%edi)
|
||||||
|
movw %gs,48(%edi)
|
||||||
|
movw %ss,50(%edi)
|
||||||
|
|
||||||
|
{ restore EDI }
|
||||||
|
pop %edi
|
||||||
|
|
||||||
|
{ we come from the initial call }
|
||||||
|
xorl %eax,%eax
|
||||||
|
|
||||||
|
leave
|
||||||
|
ret $4
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure longjmp(const rec : jmp_buf;return_value : longint);
|
||||||
|
begin
|
||||||
|
asm
|
||||||
|
{ restore compiler shit }
|
||||||
|
popl %ebp
|
||||||
|
{ this is the address of rec }
|
||||||
|
movl 4(%esp),%edi
|
||||||
|
|
||||||
|
{ save return value }
|
||||||
|
movl 8(%esp),%eax
|
||||||
|
movl %eax,0(%edi)
|
||||||
|
|
||||||
|
{ !!!!! load segment registers }
|
||||||
|
movw 46(%edi),%fs
|
||||||
|
movw 48(%edi),%gs
|
||||||
|
|
||||||
|
{ ... and some other registers }
|
||||||
|
movl 4(%edi),%ebx
|
||||||
|
movl 8(%edi),%ecx
|
||||||
|
movl 12(%edi),%edx
|
||||||
|
movl 24(%edi),%ebp
|
||||||
|
|
||||||
|
{ !!!!! movw 50(%edi),%es }
|
||||||
|
movl 28(%edi),%esi
|
||||||
|
|
||||||
|
{ create a stack frame for the return }
|
||||||
|
subl $16,%esi
|
||||||
|
|
||||||
|
{
|
||||||
|
movzwl 42(%edi),%eax
|
||||||
|
!!!!! es
|
||||||
|
movl %eax,(%esi)
|
||||||
|
}
|
||||||
|
|
||||||
|
{ edi }
|
||||||
|
movl 20(%edi),%eax
|
||||||
|
{ !!!!! es }
|
||||||
|
movl %eax,(%esi)
|
||||||
|
|
||||||
|
{ esi }
|
||||||
|
movl 16(%edi),%eax
|
||||||
|
{ !!!!! es }
|
||||||
|
movl %eax,4(%esi)
|
||||||
|
|
||||||
|
{ eip }
|
||||||
|
movl 32(%edi),%eax
|
||||||
|
{ !!!!! es }
|
||||||
|
movl %eax,12(%esi)
|
||||||
|
|
||||||
|
{ !!!!! cs
|
||||||
|
movl 40(%edi),%eax
|
||||||
|
es
|
||||||
|
movl %eax,16(%esi)
|
||||||
|
}
|
||||||
|
|
||||||
|
{ load and store flags }
|
||||||
|
movl 36(%edi),%eax
|
||||||
|
{ !!!!!
|
||||||
|
es
|
||||||
|
}
|
||||||
|
movl %eax,8(%esi)
|
||||||
|
|
||||||
|
{ load return value }
|
||||||
|
movl 0(%edi),%eax
|
||||||
|
|
||||||
|
{ load old ES
|
||||||
|
!!!!! movw 44(%edi),%es
|
||||||
|
}
|
||||||
|
|
||||||
|
{ load stack
|
||||||
|
!!!!! movw 50(%edi),%ss }
|
||||||
|
movl %esi,%esp
|
||||||
|
|
||||||
|
{ !!!!
|
||||||
|
popl %ds
|
||||||
|
}
|
||||||
|
popl %edi
|
||||||
|
popl %esi
|
||||||
|
|
||||||
|
popfl
|
||||||
|
ret
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$endif TP}
|
||||||
|
|
||||||
|
end.
|
||||||
|
{
|
||||||
|
$Log$
|
||||||
|
Revision 1.1 1998-08-10 10:18:36 peter
|
||||||
|
+ Compiler,Comphook unit which are the new interface units to the
|
||||||
|
compiler
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
@ -1,251 +0,0 @@
|
|||||||
{
|
|
||||||
$Id$
|
|
||||||
Copyright (c) 1998 by Peter Vreman
|
|
||||||
|
|
||||||
This unit handles the default verbose routines
|
|
||||||
|
|
||||||
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.
|
|
||||||
|
|
||||||
****************************************************************************
|
|
||||||
}
|
|
||||||
unit verb_def;
|
|
||||||
interface
|
|
||||||
|
|
||||||
procedure SetRedirectFile(const fn:string);
|
|
||||||
|
|
||||||
procedure _stop;
|
|
||||||
Function _comment(Level:Longint;const s:string):boolean;
|
|
||||||
function _internalerror(i : longint) : boolean;
|
|
||||||
|
|
||||||
implementation
|
|
||||||
uses
|
|
||||||
verbose,globals,
|
|
||||||
strings,dos;
|
|
||||||
|
|
||||||
const
|
|
||||||
{ RHIDE expect gcc like error output }
|
|
||||||
rh_errorstr='error: ';
|
|
||||||
rh_warningstr='warning: ';
|
|
||||||
fatalstr='Fatal: ';
|
|
||||||
errorstr='Error: ';
|
|
||||||
warningstr='Warning: ';
|
|
||||||
notestr='Note: ';
|
|
||||||
hintstr='Hint: ';
|
|
||||||
|
|
||||||
var
|
|
||||||
redirexitsave : pointer;
|
|
||||||
redirtext : boolean;
|
|
||||||
redirfile : text;
|
|
||||||
|
|
||||||
{****************************************************************************
|
|
||||||
Extra Handlers for default compiler
|
|
||||||
****************************************************************************}
|
|
||||||
|
|
||||||
procedure DoneRedirectFile;{$ifndef FPC}far;{$ENDIF}
|
|
||||||
begin
|
|
||||||
exitproc:=redirexitsave;
|
|
||||||
if redirtext then
|
|
||||||
close(redirfile);
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure SetRedirectFile(const fn:string);
|
|
||||||
begin
|
|
||||||
assign(redirfile,fn);
|
|
||||||
{$I-}
|
|
||||||
rewrite(redirfile);
|
|
||||||
{$I+}
|
|
||||||
redirtext:=(ioresult=0);
|
|
||||||
if redirtext then
|
|
||||||
begin
|
|
||||||
redirexitsave:=exitproc;
|
|
||||||
exitproc:=@DoneRedirectFile;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
{****************************************************************************
|
|
||||||
Predefined default Handlers
|
|
||||||
****************************************************************************}
|
|
||||||
|
|
||||||
|
|
||||||
{ predefined handler to stop the compiler }
|
|
||||||
procedure _stop;
|
|
||||||
begin
|
|
||||||
halt(1);
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
Function _comment(Level:Longint;const s:string):boolean;
|
|
||||||
var
|
|
||||||
hs : string;
|
|
||||||
begin
|
|
||||||
_comment:=false; { never stop }
|
|
||||||
if (verbosity and Level)=Level then
|
|
||||||
begin
|
|
||||||
{ Status info?, Called every line }
|
|
||||||
if ((Level and V_Status)<>0) and (s='') then
|
|
||||||
begin
|
|
||||||
if (status.compiledlines=1) then
|
|
||||||
WriteLn(memavail shr 10,' Kb Free');
|
|
||||||
if (status.currentline>0) and (status.currentline mod 100=0) then
|
|
||||||
{$ifdef FPC}
|
|
||||||
WriteLn(status.currentline,' ',memavail shr 10,'/',system.heapsize shr 10,' Kb Free');
|
|
||||||
{$else}
|
|
||||||
WriteLn(status.currentline,' ',memavail shr 10,' Kb Free');
|
|
||||||
{$endif}
|
|
||||||
end
|
|
||||||
else
|
|
||||||
{ Message }
|
|
||||||
begin
|
|
||||||
hs:='';
|
|
||||||
if not(use_rhide) then
|
|
||||||
begin
|
|
||||||
if (verbosity and Level)=V_Hint then
|
|
||||||
hs:=hintstr;
|
|
||||||
if (verbosity and Level)=V_Note then
|
|
||||||
hs:=notestr;
|
|
||||||
if (verbosity and Level)=V_Warning then
|
|
||||||
hs:=warningstr;
|
|
||||||
if (verbosity and Level)=V_Error then
|
|
||||||
hs:=errorstr;
|
|
||||||
if (verbosity and Level)=V_Fatal then
|
|
||||||
hs:=fatalstr;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
if (verbosity and Level)=V_Hint then
|
|
||||||
hs:=rh_warningstr;
|
|
||||||
if (verbosity and Level)=V_Note then
|
|
||||||
hs:=rh_warningstr;
|
|
||||||
if (verbosity and Level)=V_Warning then
|
|
||||||
hs:=rh_warningstr;
|
|
||||||
if (verbosity and Level)=V_Error then
|
|
||||||
hs:=rh_errorstr;
|
|
||||||
if (verbosity and Level)=V_Fatal then
|
|
||||||
hs:=rh_errorstr;
|
|
||||||
end;
|
|
||||||
if (Level<=V_ShowFile) and (status.currentline>0) then
|
|
||||||
begin
|
|
||||||
{ Adding the column should not confuse RHIDE,
|
|
||||||
even if it does not yet use it PM }
|
|
||||||
if Use_Rhide then
|
|
||||||
hs:=lower(bstoslash(status.currentsource))+':'+tostr(status.currentline)
|
|
||||||
+':'+tostr(status.currentcolumn)+': '+hs
|
|
||||||
else
|
|
||||||
hs:=status.currentsource+'('+tostr(status.currentline)
|
|
||||||
+','+tostr(status.currentcolumn)+') '+hs;
|
|
||||||
end;
|
|
||||||
{ add the message to the text }
|
|
||||||
hs:=hs+s;
|
|
||||||
{$ifdef FPC}
|
|
||||||
if UseStdErr then
|
|
||||||
begin
|
|
||||||
writeln(stderr,hs);
|
|
||||||
flush(stderr);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
{$endif}
|
|
||||||
begin
|
|
||||||
if redirtext then
|
|
||||||
writeln(redirfile,hs)
|
|
||||||
else
|
|
||||||
writeln(hs);
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
function _internalerror(i : longint) : boolean;
|
|
||||||
begin
|
|
||||||
_comment(V_Fatal,'Internal error '+tostr(i));
|
|
||||||
_internalerror:=true;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
begin
|
|
||||||
{$ifdef FPC}
|
|
||||||
do_stop:=@_stop;
|
|
||||||
do_comment:=@_comment;
|
|
||||||
do_internalerror:=@_internalerror;
|
|
||||||
{$else}
|
|
||||||
do_stop:=_stop;
|
|
||||||
do_comment:=_comment;
|
|
||||||
do_internalerror:=_internalerror;
|
|
||||||
{$endif}
|
|
||||||
end.
|
|
||||||
{
|
|
||||||
$Log$
|
|
||||||
Revision 1.14 1998-08-04 13:22:48 pierre
|
|
||||||
* weird bug fixed :
|
|
||||||
a pchar ' ' (simple space or any other letter) was found to
|
|
||||||
be equal to a string of length zero !!!
|
|
||||||
thus printing out non sense
|
|
||||||
found that out while checking Control-C !!
|
|
||||||
+ added column info also in RHIDE format as
|
|
||||||
it might be usefull later
|
|
||||||
|
|
||||||
Revision 1.13 1998/07/14 14:47:12 peter
|
|
||||||
* released NEWINPUT
|
|
||||||
|
|
||||||
Revision 1.12 1998/07/07 11:20:19 peter
|
|
||||||
+ NEWINPUT for a better inputfile and scanner object
|
|
||||||
|
|
||||||
Revision 1.11 1998/06/19 15:40:00 peter
|
|
||||||
* bp7 fix
|
|
||||||
|
|
||||||
Revision 1.10 1998/06/16 11:32:19 peter
|
|
||||||
* small cosmetic fixes
|
|
||||||
|
|
||||||
Revision 1.9 1998/05/23 01:21:33 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.8 1998/05/21 19:33:38 peter
|
|
||||||
+ better procedure directive handling and only one table
|
|
||||||
|
|
||||||
Revision 1.7 1998/05/12 10:47:01 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.6 1998/05/11 13:07:58 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.5 1998/04/30 15:59:43 pierre
|
|
||||||
* GDB works again better :
|
|
||||||
correct type info in one pass
|
|
||||||
+ UseTokenInfo for better source position
|
|
||||||
* fixed one remaining bug in scanner for line counts
|
|
||||||
* several little fixes
|
|
||||||
|
|
||||||
Revision 1.4 1998/04/29 10:34:09 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
|
|
||||||
}
|
|
||||||
@ -32,7 +32,6 @@ uses messages;
|
|||||||
{$i msgidx.inc}
|
{$i msgidx.inc}
|
||||||
|
|
||||||
Const
|
Const
|
||||||
MaxErrorCount : longint = 50;
|
|
||||||
{ <$10000 will show file and line }
|
{ <$10000 will show file and line }
|
||||||
V_Fatal = $0;
|
V_Fatal = $0;
|
||||||
V_Error = $1;
|
V_Error = $1;
|
||||||
@ -53,59 +52,60 @@ Const
|
|||||||
V_All = $ffffffff;
|
V_All = $ffffffff;
|
||||||
V_Default = V_Fatal + V_Error + V_Normal;
|
V_Default = V_Fatal + V_Error + V_Normal;
|
||||||
|
|
||||||
Verbosity : longint=V_Default;
|
|
||||||
|
|
||||||
type
|
|
||||||
TCompileStatus = record
|
|
||||||
currentmodule,
|
|
||||||
currentsource : string; { filename }
|
|
||||||
currentline,
|
|
||||||
currentcolumn : longint; { current line and column }
|
|
||||||
compiledlines : longint; { the number of lines which are compiled }
|
|
||||||
errorcount : longint; { number of generated errors }
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
var
|
var
|
||||||
status : tcompilestatus;
|
|
||||||
msg : pmessage;
|
msg : pmessage;
|
||||||
UseStdErr,
|
|
||||||
Use_Rhide : boolean;
|
|
||||||
lastfileidx,
|
lastfileidx,
|
||||||
lastmoduleidx : longint;
|
lastmoduleidx : longint;
|
||||||
|
|
||||||
procedure LoadMsgFile(const fn:string);
|
procedure SetRedirectFile(const fn:string);
|
||||||
function SetVerbosity(const s:string):boolean;
|
function SetVerbosity(const s:string):boolean;
|
||||||
|
|
||||||
procedure stop;
|
procedure LoadMsgFile(const fn:string);
|
||||||
procedure comment(l:longint;const s:string);
|
|
||||||
procedure internalerror(i:longint);
|
procedure Stop;
|
||||||
|
procedure ShowStatus;
|
||||||
|
procedure Internalerror(i:longint);
|
||||||
|
procedure Comment(l:longint;const s:string);
|
||||||
procedure Message(w:tmsgconst);
|
procedure Message(w:tmsgconst);
|
||||||
procedure Message1(w:tmsgconst;const s1:string);
|
procedure Message1(w:tmsgconst;const s1:string);
|
||||||
procedure Message2(w:tmsgconst;const s1,s2:string);
|
procedure Message2(w:tmsgconst;const s1,s2:string);
|
||||||
procedure Message3(w:tmsgconst;const s1,s2,s3:string);
|
procedure Message3(w:tmsgconst;const s1,s2,s3:string);
|
||||||
|
|
||||||
{ Function redirecting for IDE support }
|
procedure InitVerbose;
|
||||||
type
|
|
||||||
tstopprocedure = procedure;
|
|
||||||
tcommentfunction = function(Level:Longint;const s:string):boolean;
|
|
||||||
tinternalerrorfunction = function(i:longint):boolean;
|
|
||||||
var
|
|
||||||
do_stop : tstopprocedure;
|
|
||||||
do_comment : tcommentfunction;
|
|
||||||
do_internalerror : tinternalerrorfunction;
|
|
||||||
|
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
uses
|
uses
|
||||||
files,
|
files,comphook,
|
||||||
globals;
|
globals;
|
||||||
|
|
||||||
procedure LoadMsgFile(const fn:string);
|
var
|
||||||
|
redirexitsave : pointer;
|
||||||
|
|
||||||
|
{****************************************************************************
|
||||||
|
Extra Handlers for default compiler
|
||||||
|
****************************************************************************}
|
||||||
|
|
||||||
|
procedure DoneRedirectFile;{$ifndef FPC}far;{$ENDIF}
|
||||||
begin
|
begin
|
||||||
if not (msg=nil) then
|
exitproc:=redirexitsave;
|
||||||
dispose(msg,Done);
|
if status.use_redir then
|
||||||
msg:=new(pmessage,InitExtern(fn,ord(endmsgconst)));
|
close(status.redirfile);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure SetRedirectFile(const fn:string);
|
||||||
|
begin
|
||||||
|
assign(status.redirfile,fn);
|
||||||
|
{$I-}
|
||||||
|
rewrite(status.redirfile);
|
||||||
|
{$I+}
|
||||||
|
status.use_redir:=(ioresult=0);
|
||||||
|
if status.use_redir then
|
||||||
|
begin
|
||||||
|
redirexitsave:=exitproc;
|
||||||
|
exitproc:=@DoneRedirectFile;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -116,10 +116,10 @@ var
|
|||||||
inverse : boolean;
|
inverse : boolean;
|
||||||
c : char;
|
c : char;
|
||||||
begin
|
begin
|
||||||
setverbosity:=false;
|
Setverbosity:=false;
|
||||||
val(s,m,i);
|
val(s,m,i);
|
||||||
if (i=0) and (s<>'') then
|
if (i=0) and (s<>'') then
|
||||||
verbosity:=m
|
status.verbosity:=m
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
for i:=1 to length(s) do
|
for i:=1 to length(s) do
|
||||||
@ -134,78 +134,86 @@ begin
|
|||||||
inverse:=false;
|
inverse:=false;
|
||||||
case upcase(s[i]) of
|
case upcase(s[i]) of
|
||||||
{ Special cases }
|
{ Special cases }
|
||||||
'A' : Verbosity:=V_All;
|
'A' : status.verbosity:=V_All;
|
||||||
'0' : Verbosity:=V_Default;
|
'0' : status.verbosity:=V_Default;
|
||||||
'R' : begin
|
'R' : begin
|
||||||
if inverse then
|
if inverse then
|
||||||
begin
|
begin
|
||||||
Use_rhide:=false;
|
status.use_gccoutput:=false;
|
||||||
UseStdErr:=false;
|
status.use_stderr:=false;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
Use_rhide:=true;
|
status.use_gccoutput:=true;
|
||||||
UseStdErr:=true;
|
status.use_stderr:=true;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
{ Normal cases - do an or }
|
{ Normal cases - do an or }
|
||||||
'E' : if inverse then
|
'E' : if inverse then
|
||||||
Verbosity:=Verbosity and (not V_Error)
|
status.verbosity:=status.verbosity and (not V_Error)
|
||||||
else
|
else
|
||||||
Verbosity:=Verbosity or V_Error;
|
status.verbosity:=status.verbosity or V_Error;
|
||||||
'I' : if inverse then
|
'I' : if inverse then
|
||||||
Verbosity:=Verbosity and (not V_Info)
|
status.verbosity:=status.verbosity and (not V_Info)
|
||||||
else
|
else
|
||||||
Verbosity:=Verbosity or V_Info;
|
status.verbosity:=status.verbosity or V_Info;
|
||||||
'W' : if inverse then
|
'W' : if inverse then
|
||||||
Verbosity:=Verbosity and (not V_Warning)
|
status.verbosity:=status.verbosity and (not V_Warning)
|
||||||
else
|
else
|
||||||
Verbosity:=Verbosity or V_Warning;
|
status.verbosity:=status.verbosity or V_Warning;
|
||||||
'N' : if inverse then
|
'N' : if inverse then
|
||||||
Verbosity:=Verbosity and (not V_Note)
|
status.verbosity:=status.verbosity and (not V_Note)
|
||||||
else
|
else
|
||||||
Verbosity:=Verbosity or V_Note;
|
status.verbosity:=status.verbosity or V_Note;
|
||||||
'H' : if inverse then
|
'H' : if inverse then
|
||||||
Verbosity:=Verbosity and (not V_Hint)
|
status.verbosity:=status.verbosity and (not V_Hint)
|
||||||
else
|
else
|
||||||
Verbosity:=Verbosity or V_Hint;
|
status.verbosity:=status.verbosity or V_Hint;
|
||||||
'L' : if inverse then
|
'L' : if inverse then
|
||||||
Verbosity:=Verbosity and (not V_Status)
|
status.verbosity:=status.verbosity and (not V_Status)
|
||||||
else
|
else
|
||||||
Verbosity:=Verbosity or V_Status;
|
status.verbosity:=status.verbosity or V_Status;
|
||||||
'U' : if inverse then
|
'U' : if inverse then
|
||||||
Verbosity:=Verbosity and (not V_Used)
|
status.verbosity:=status.verbosity and (not V_Used)
|
||||||
else
|
else
|
||||||
Verbosity:=Verbosity or V_Used;
|
status.verbosity:=status.verbosity or V_Used;
|
||||||
'T' : if inverse then
|
'T' : if inverse then
|
||||||
Verbosity:=Verbosity and (not V_Tried)
|
status.verbosity:=status.verbosity and (not V_Tried)
|
||||||
else
|
else
|
||||||
Verbosity:=Verbosity or V_Tried;
|
status.verbosity:=status.verbosity or V_Tried;
|
||||||
'M' : if inverse then
|
'M' : if inverse then
|
||||||
Verbosity:=Verbosity and (not V_Macro)
|
status.verbosity:=status.verbosity and (not V_Macro)
|
||||||
else
|
else
|
||||||
Verbosity:=Verbosity or V_Macro;
|
status.verbosity:=status.verbosity or V_Macro;
|
||||||
'P' : if inverse then
|
'P' : if inverse then
|
||||||
Verbosity:=Verbosity and (not V_Procedure)
|
status.verbosity:=status.verbosity and (not V_Procedure)
|
||||||
else
|
else
|
||||||
Verbosity:=Verbosity or V_Procedure;
|
status.verbosity:=status.verbosity or V_Procedure;
|
||||||
'C' : if inverse then
|
'C' : if inverse then
|
||||||
Verbosity:=Verbosity and (not V_Conditional)
|
status.verbosity:=status.verbosity and (not V_Conditional)
|
||||||
else
|
else
|
||||||
Verbosity:=Verbosity or V_Conditional;
|
status.verbosity:=status.verbosity or V_Conditional;
|
||||||
'D' : if inverse then
|
'D' : if inverse then
|
||||||
Verbosity:=Verbosity and (not V_Debug)
|
status.verbosity:=status.verbosity and (not V_Debug)
|
||||||
else
|
else
|
||||||
Verbosity:=Verbosity or V_Debug;
|
status.verbosity:=status.verbosity or V_Debug;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
if Verbosity=0 then
|
if status.verbosity=0 then
|
||||||
Verbosity:=V_Default;
|
status.verbosity:=V_Default;
|
||||||
setverbosity:=true;
|
setverbosity:=true;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure LoadMsgFile(const fn:string);
|
||||||
|
begin
|
||||||
|
if not (msg=nil) then
|
||||||
|
dispose(msg,Done);
|
||||||
|
msg:=new(pmessage,InitExtern(fn,ord(endmsgconst)));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure stop;
|
procedure stop;
|
||||||
begin
|
begin
|
||||||
{$ifndef TP}
|
{$ifndef TP}
|
||||||
@ -216,6 +224,18 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ShowStatus;
|
||||||
|
begin
|
||||||
|
{$ifndef TP}
|
||||||
|
if do_status() then
|
||||||
|
stop;
|
||||||
|
{$else}
|
||||||
|
if do_status then
|
||||||
|
stop;
|
||||||
|
{$endif}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure internalerror(i : longint);
|
procedure internalerror(i : longint);
|
||||||
begin
|
begin
|
||||||
do_internalerror(i);
|
do_internalerror(i);
|
||||||
@ -242,7 +262,7 @@ begin
|
|||||||
lastfileidx:=current_module^.current_index;
|
lastfileidx:=current_module^.current_index;
|
||||||
end;
|
end;
|
||||||
{ show comment }
|
{ show comment }
|
||||||
if do_comment(l,s) or dostop or (status.errorcount>=maxerrorcount) then
|
if do_comment(l,s) or dostop or (status.errorcount>=status.maxerrorcount) then
|
||||||
stop
|
stop
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -267,6 +287,7 @@ begin
|
|||||||
case upcase(s[i]) of
|
case upcase(s[i]) of
|
||||||
'F' : begin
|
'F' : begin
|
||||||
v:=v or V_Fatal;
|
v:=v or V_Fatal;
|
||||||
|
inc(status.errorcount);
|
||||||
dostop:=true;
|
dostop:=true;
|
||||||
end;
|
end;
|
||||||
'E' : begin
|
'E' : begin
|
||||||
@ -305,7 +326,7 @@ begin
|
|||||||
lastfileidx:=current_module^.current_index;
|
lastfileidx:=current_module^.current_index;
|
||||||
end;
|
end;
|
||||||
{ show comment }
|
{ show comment }
|
||||||
if do_comment(v,s) or dostop or (status.errorcount>=maxerrorcount) then
|
if do_comment(v,s) or dostop or (status.errorcount>=status.maxerrorcount) then
|
||||||
stop;
|
stop;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -334,6 +355,14 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure InitVerbose;
|
||||||
|
begin
|
||||||
|
{ Init }
|
||||||
|
FillChar(Status,sizeof(TCompilerStatus),0);
|
||||||
|
status.verbosity:=V_Default;
|
||||||
|
Status.MaxErrorCount:=50;
|
||||||
|
end;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
{$IFNDEF EXTERN_MSG}
|
{$IFNDEF EXTERN_MSG}
|
||||||
msg:=new(pmessage,Init(@msgtxt,ord(endmsgconst)));
|
msg:=new(pmessage,Init(@msgtxt,ord(endmsgconst)));
|
||||||
@ -342,7 +371,11 @@ end.
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.11 1998-07-14 14:47:13 peter
|
Revision 1.12 1998-08-10 10:18:37 peter
|
||||||
|
+ Compiler,Comphook unit which are the new interface units to the
|
||||||
|
compiler
|
||||||
|
|
||||||
|
Revision 1.11 1998/07/14 14:47:13 peter
|
||||||
* released NEWINPUT
|
* released NEWINPUT
|
||||||
|
|
||||||
Revision 1.10 1998/07/07 12:32:56 peter
|
Revision 1.10 1998/07/07 12:32:56 peter
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user