diff --git a/compiler/aopt386.pas b/compiler/aopt386.pas index f0d6f7186f..61abfb3dde 100644 --- a/compiler/aopt386.pas +++ b/compiler/aopt386.pas @@ -548,7 +548,7 @@ End; imul 6, reg1 to lea (reg1,reg1,2), reg1 add reg1, reg1} - If (aktoptprocessor <= i486) + If (aktoptprocessor <= int486) Then Begin TmpRef^.Index := TRegister(Pai386(p)^.op2); @@ -618,7 +618,7 @@ End; imul 10, reg1 to lea (reg1,reg1,4), reg1 add reg1, reg1} - If (aktoptprocessor <= i486) Then + If (aktoptprocessor <= int486) Then Begin If (Pai386(p)^.op3t = Top_Reg) Then @@ -653,7 +653,7 @@ End; imul 12, reg1 to lea (reg1,reg1,2), reg1 lea (,reg1,4), reg1} - If (aktoptprocessor <= i486) + If (aktoptprocessor <= int486) Then Begin TmpRef^.Index := TRegister(Pai386(p)^.op2); @@ -1631,7 +1631,11 @@ end; End. { $Log$ - Revision 1.14 1998-05-30 14:31:02 peter + Revision 1.15 1998-06-16 08:56:17 peter + + targetcpu + * cleaner pmodules for newppu + + Revision 1.14 1998/05/30 14:31:02 peter + $ASMMODE Revision 1.13 1998/05/24 18:42:37 jonas diff --git a/compiler/cg386set.pas b/compiler/cg386set.pas index 67c2ed2299..a05c743687 100644 --- a/compiler/cg386set.pas +++ b/compiler/cg386set.pas @@ -715,7 +715,7 @@ implementation else max_linear_list:=2; { a jump table crashes the pipeline! } - if aktoptprocessor=i486 then + if aktoptprocessor=int486 then inc(max_linear_list,3); if aktoptprocessor=pentium then inc(max_linear_list,6); @@ -765,7 +765,11 @@ implementation end. { $Log$ - Revision 1.1 1998-06-05 17:44:13 peter + Revision 1.2 1998-06-16 08:56:18 peter + + targetcpu + * cleaner pmodules for newppu + + Revision 1.1 1998/06/05 17:44:13 peter * splitted cgi386 } diff --git a/compiler/files.pas b/compiler/files.pas index 57f8956359..0ed06a22fa 100644 --- a/compiler/files.pas +++ b/compiler/files.pas @@ -122,6 +122,7 @@ unit files; { used in firstpass for faster settings } current_index : word; + path, { path where the module is find/created } modulename, { name of the module in uppercase } objfilename, { fullname of the objectfile } asmfilename, { fullname of the assemblerfile } @@ -132,9 +133,9 @@ unit files; constructor init(const s:string;_is_unit:boolean); destructor special_done;virtual; { this is to be called only when compiling again } - procedure setfilename(const path,name:string); + procedure setfilename(const _path,name:string); {$ifdef NEWPPU} - function openppu(const unit_path:string):boolean; + function openppu:boolean; {$else} function load_ppu(const unit_path,n,ext:string):boolean; {$endif} @@ -143,12 +144,22 @@ unit files; pused_unit = ^tused_unit; tused_unit = object(tlinkedlist_item) - u : pmodule; + unitid : word; +{$ifdef NEWPPU} + name : pstring; + checksum : longint; + loaded : boolean; +{$endif NEWPPU} in_uses, in_interface, is_stab_written : boolean; - unitid : word; + u : pmodule; +{$ifdef NEWPPU} + constructor init(_u : pmodule;intface:boolean); + constructor init_to_load(const n:string;c:longint;intface:boolean); +{$else NEWPPU} constructor init(_u : pmodule;f : byte); +{$endif NEWPPU} destructor done;virtual; end; @@ -225,6 +236,9 @@ unit files; var main_module : pmodule; current_module : pmodule; +{$ifdef NEWPPU} + current_ppu : pppufile; +{$endif} global_unit_count : word; loaded_units : tlinkedlist; @@ -349,7 +363,7 @@ unit files; TMODULE ****************************************************************************} - procedure tmodule.setfilename(const path,name:string); + procedure tmodule.setfilename(const _path,name:string); var s : string; begin @@ -357,7 +371,9 @@ unit files; stringdispose(asmfilename); stringdispose(ppufilename); stringdispose(libfilename); - s:=FixFileName(FixPath(path)+name); + stringdispose(path); + path:=stringdup(FixPath(_path)); + s:=FixFileName(FixPath(_path)+name); objfilename:=stringdup(s+target_info.objext); asmfilename:=stringdup(s+target_info.asmext); ppufilename:=stringdup(s+target_info.unitext); @@ -366,29 +382,18 @@ unit files; {$ifdef NEWPPU} - function tmodule.openppu(const unit_path:string):boolean; + function tmodule.openppu:boolean; var - temp,hs : string; - b : byte; - incfile_found : boolean; objfiletime, ppufiletime, - asmfiletime, - source_time : longint; -{$ifdef UseBrowser} - hp : pextfile; - _d : dirstr; - _n : namestr; - _e : extstr; -{$endif UseBrowser} - + asmfiletime : longint; begin openppu:=false; { Get ppufile time (also check if the file exists) } ppufiletime:=getnamedfiletime(ppufilename^); if ppufiletime=-1 then exit; - + { Open the ppufile } Message1(unit_u_ppu_loading,ppufilename^); ppufile:=new(pppufile,init(ppufilename^)); if not ppufile^.open then @@ -411,6 +416,21 @@ unit files; Message1(unit_d_ppu_invalid_version,tostr(ppufile^.GetPPUVersion)); exit; end; + { check the target processor } + if ttargetcpu(ppufile^.header.cpu)<>target_cpu then + begin + dispose(ppufile,done); + Comment(V_Debug,'unit is compiled for an other processor'); + exit; + end; + { check target } + if ttarget(ppufile^.header.target)<>target_info.target then + begin + dispose(ppufile,done); + Comment(V_Debug,'unit is compiled for an other target'); + exit; + end; +{!!!!!!!!!!!!!!!!!!! } { Load values to be access easier } flags:=ppufile^.header.flags; crc:=ppufile^.header.checksum; @@ -418,83 +438,9 @@ unit files; Message1(unit_d_ppu_time,filetimestring(ppufiletime)); Message1(unit_d_ppu_flags,tostr(flags)); Message1(unit_d_ppu_crc,tostr(ppufile^.header.checksum)); - { Unitname } - b:=ppufile^.readentry; - if b=ibmodulename then - begin - stringdispose(modulename); - modulename:=stringdup(ppufile^.getstring); - b:=ppufile^.readentry; - end; - - { search source files there is at least one source file } + { check the object and assembler file to see if we need only to + assemble, only if it's not in a library } do_compile:=false; - sources_avail:=true; - if b=ibsourcefiles then - begin - while not ppufile^.endofentry do - begin - hs:=ppufile^.getstring; - temp:=''; - if (flags and uf_in_library)<>0 then - begin - sources_avail:=false; - temp:=' library'; - end - else if pos('Macro ',hs)=1 then - begin - { we don't want to find this file } - { but there is a problem with file indexing !! } - temp:=''; - end - else - begin - { check the date of the source files } - Source_Time:=GetNamedFileTime(unit_path+hs); - if Source_Time=-1 then - begin - { search for include files in the includepathlist } - if b<>ibend then - begin - temp:=search(hs,includesearchpath,incfile_found); - if incfile_found then - begin - hs:=temp+hs; - Source_Time:=GetNamedFileTime(hs); - end; - end; - end - else - hs:=unit_path+hs; - if Source_Time=-1 then - begin - sources_avail:=false; - temp:=' not found'; - end - else - begin - temp:=' time '+filetimestring(source_time); - if (source_time>ppufiletime) then - begin - do_compile:=true; - temp:=temp+' *' - end; - end; - end; - Message1(unit_t_ppu_source,hs+temp); - {$ifdef UseBrowser} - fsplit(hs,_d,_n,_e); - new(hp,init(_d,_n,_e)); - { the indexing should match what is done in writeasunit } - sourcefiles.register_file(hp); - {$endif UseBrowser} - end; - end; - { main source is always the last } - stringdispose(mainsource); - mainsource:=stringdup(hs); - - { check the object and assembler file if not a library } if (flags and uf_in_library)=0 then begin if (flags and uf_smartlink)<>0 then @@ -532,7 +478,7 @@ unit files; var ext : string[8]; singlepathstring, - Path, + unitPath, filename : string; found : boolean; start,i : longint; @@ -546,15 +492,15 @@ unit files; begin start:=1; filename:=FixFileName(n); - path:=UnitSearchPath; + unitpath:=UnitSearchPath; Found:=false; repeat { Create current path to check } - i:=pos(';',path); + i:=pos(';',unitpath); if i=0 then - i:=length(path)+1; - singlepathstring:=FixPath(copy(path,start,i-start)); - delete(path,start,i-start+1); + i:=length(unitpath)+1; + singlepathstring:=FixPath(copy(unitpath,start,i-start)); + delete(unitpath,start,i-start+1); { Check for PPL file } if not (cs_link_static in aktswitches) then begin @@ -562,7 +508,7 @@ unit files; if Found then Begin SetFileName(SinglePathString,FileName); - Found:=OpenPPU(singlepathstring); + Found:=OpenPPU; End; end; { Check for PPU file } @@ -572,7 +518,7 @@ unit files; if Found then Begin SetFileName(SinglePathString,FileName); - Found:=OpenPPU(singlepathstring); + Found:=OpenPPU; End; end; { Check for Sources } @@ -602,7 +548,7 @@ unit files; else sources_avail:=false; end; - until Found or (path=''); + until Found or (unitpath=''); search_unit:=Found; end; @@ -779,7 +725,7 @@ unit files; var ext : string[8]; singlepathstring, - Path, + UnitPath, filename : string; found : boolean; start,i : longint; @@ -793,15 +739,15 @@ unit files; begin start:=1; filename:=FixFileName(n); - path:=UnitSearchPath; + unitpath:=UnitSearchPath; Found:=false; repeat {Create current path to check} - i:=pos(';',path); + i:=pos(';',unitpath); if i=0 then - i:=length(path)+1; - singlepathstring:=FixPath(copy(path,start,i-start)); - delete(path,start,i-start+1); + i:=length(unitpath)+1; + singlepathstring:=FixPath(copy(unitpath,start,i-start)); + delete(unitpath,start,i-start+1); { Check for PPL file } if not (cs_link_static in aktswitches) then begin @@ -849,7 +795,7 @@ unit files; else sources_avail:=false; end; - until Found or (path=''); + until Found or (unitpath=''); search_unit:=Found; end; @@ -874,6 +820,7 @@ unit files; asmfilename:=nil; libfilename:=nil; ppufilename:=nil; + path:=nil; setfilename(p,n); used_units.init; sourcefiles.init; @@ -932,26 +879,65 @@ unit files; TUSED_UNIT ****************************************************************************} +{$ifdef NEWPPU} - constructor tused_unit.init(_u : pmodule;f : byte); - + constructor tused_unit.init(_u : pmodule;intface:boolean); begin - u:=_u; - in_interface:=false; - in_uses:=false; - is_stab_written:=false; - unitid:=f; + u:=_u; + in_interface:=intface; + in_uses:=false; + is_stab_written:=false; + loaded:=true; + name:=stringdup(_u^.modulename^); + checksum:=_u^.crc; + unitid:=0; + end; + + constructor tused_unit.init_to_load(const n:string;c:longint;intface:boolean); + begin + u:=nil; + in_interface:=intface; + in_uses:=false; + is_stab_written:=false; + loaded:=false; + name:=stringdup(n); + checksum:=c; + unitid:=0; end; destructor tused_unit.done; begin - inherited done; + stringdispose(name); + inherited done; end; +{$else NEWPPU} + + constructor tused_unit.init(_u : pmodule;f : byte); + begin + u:=_u; + in_interface:=false; + in_uses:=false; + is_stab_written:=false; + unitid:=f; + end; + + destructor tused_unit.done; + begin + inherited done; + end; + +{$endif NEWPPU} + + end. { $Log$ - Revision 1.23 1998-06-15 14:44:36 daniel + Revision 1.24 1998-06-16 08:56:20 peter + + targetcpu + * cleaner pmodules for newppu + + Revision 1.23 1998/06/15 14:44:36 daniel * BP updates. diff --git a/compiler/opts386.pas b/compiler/opts386.pas index f3ba716198..77b3c9183a 100644 --- a/compiler/opts386.pas +++ b/compiler/opts386.pas @@ -60,8 +60,8 @@ begin 'x' : initswitches:=initswitches+[cs_optimize,cs_maxoptimieren]; 'z' : initswitches:=initswitches+[cs_optimize,cs_uncertainopts]; '2' : initoptprocessor:=pentium2; - '3' : initoptprocessor:=systems.i386; - '4' : initoptprocessor:=i486; + '3' : initoptprocessor:=int386; + '4' : initoptprocessor:=int486; '5' : initoptprocessor:=pentium; '6' : initoptprocessor:=pentiumpro; '7' : initoptprocessor:=cx6x86; @@ -89,7 +89,11 @@ end; end. { $Log$ - Revision 1.7 1998-05-30 14:31:05 peter + Revision 1.8 1998-06-16 08:56:22 peter + + targetcpu + * cleaner pmodules for newppu + + Revision 1.7 1998/05/30 14:31:05 peter + $ASMMODE Revision 1.6 1998/05/28 17:26:48 peter diff --git a/compiler/parser.pas b/compiler/parser.pas index f2df5f2ff3..41cda6373b 100644 --- a/compiler/parser.pas +++ b/compiler/parser.pas @@ -75,8 +75,6 @@ unit parser; procedure compile(const filename:string;compile_system:boolean); var - hp : pmodule; - { some variables to save the compiler state } oldtoken : ttoken; oldtokenpos : tfileposinfo; @@ -85,6 +83,7 @@ unit parser; oldpreprocstack : ppreprocstack; oldorgpattern,oldprocprefix : string; old_block_type : tblock_type; + oldcurrlinepos, oldlastlinepos, oldinputbuffer, oldinputpointer : pchar; @@ -200,6 +199,7 @@ unit parser; oldinputbuffer:=inputbuffer; oldinputpointer:=inputpointer; + oldcurrlinepos:=currlinepos; oldlastlinepos:=lastlinepos; olds_point:=s_point; oldc:=c; @@ -273,35 +273,7 @@ unit parser; {$endif UseBrowser} end; - { if the current file isn't a system unit } - { the the system unit will be loaded } - if not(cs_compilesystem in aktswitches) then - begin - { should be done in unit system (changing the field system_unit) - FK - } - hp:=loadunit(upper(target_info.system_unit),true,true); - systemunit:=hp^.symtable; - make_ref:=false; - readconstdefs; - { we could try to overload caret by default } - symtablestack:=systemunit; - { if POWER is defined in the RTL then use it for starstar overloading } - getsym('POWER',false); - if assigned(srsym) and (srsym^.typ=procsym) and - (overloaded_operators[STARSTAR]=nil) then - begin - overloaded_operators[STARSTAR]:= - new(pprocsym,init(overloaded_names[STARSTAR])); - overloaded_operators[STARSTAR]^.definition:=pprocsym(srsym)^.definition; - end; - make_ref:=true; - end - else - begin - createconstdefs; - systemunit:=nil; - end; + loadsystemunit; registerdef:=true; make_ref:=true; @@ -418,6 +390,7 @@ done: inputbuffer:=oldinputbuffer; inputpointer:=oldinputpointer; lastlinepos:=oldlastlinepos; + currlinepos:=oldcurrlinepos; s_point:=olds_point; c:=oldc; comment_level:=oldcomment_level; @@ -470,7 +443,11 @@ done: end. { $Log$ - Revision 1.25 1998-06-15 15:38:07 pierre + Revision 1.26 1998-06-16 08:56:23 peter + + targetcpu + * cleaner pmodules for newppu + + Revision 1.25 1998/06/15 15:38:07 pierre * small bug in systems.pas corrected + operators in different units better hanlded diff --git a/compiler/pass_1.pas b/compiler/pass_1.pas index d8b12025e5..b2bc8d9b35 100644 --- a/compiler/pass_1.pas +++ b/compiler/pass_1.pas @@ -5018,7 +5018,11 @@ unit pass_1; end. { $Log$ - Revision 1.32 1998-06-14 18:23:57 peter + Revision 1.33 1998-06-16 08:56:24 peter + + targetcpu + * cleaner pmodules for newppu + + Revision 1.32 1998/06/14 18:23:57 peter * fixed xor bug (from mailinglist) Revision 1.31 1998/06/13 00:10:09 peter @@ -5048,9 +5052,8 @@ end. to a procedure Revision 1.26 1998/06/04 09:55:39 pierre - * demangled name of procsym reworked to become independant of the mangling scheme - - Come test_funcret improvements (not yet working)S: ---------------------------------------------------------------------- + * demangled name of procsym reworked to become independant + of the mangling scheme Revision 1.25 1998/06/03 22:48:57 peter + wordbool,longbool diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index 96acaa5c6e..9531c011fb 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -30,7 +30,7 @@ unit pmodules; files; procedure addlinkerfiles(hp:pmodule); - function loadunit(const s : string;compile_system, in_uses : boolean) : pmodule; + procedure loadsystemunit; procedure proc_unit; procedure proc_program(islibrary : boolean); @@ -141,103 +141,234 @@ unit pmodules; end; +{$ifdef NEWPPU} + + function loadunit(const s : string;compile_system:boolean) : pmodule;forward; + + procedure load_usedunits(compile_system:boolean); + var + pu : pused_unit; + loaded_unit : pmodule; + nextmapentry : longint; + begin + { init the map } + new(current_module^.map); + nextmapentry:=1; + { load the used units from interface } + pu:=pused_unit(current_module^.used_units.first); + while assigned(pu) do + begin + if (not pu^.loaded) and (pu^.in_interface) then + begin + loaded_unit:=loadunit(pu^.name^,false); + pu^.u:=loaded_unit; + pu^.loaded:=true; + if current_module^.compiled then + exit; + if loaded_unit^.crc<>pu^.checksum then + begin + current_module^.do_compile:=true; + exit; + end; + { setup the map entry for deref } + current_module^.map^[nextmapentry]:=loaded_unit^.symtable; + inc(nextmapentry); + if nextmapentry>maxunits then + Message(unit_f_too_much_units); + end; + pu:=pused_unit(pu^.next); + end; + { ok, now load the unit } + current_module^.symtable:=new(punitsymtable,loadasunit); + { if this is the system unit insert the intern symbols } + if compile_system then + begin + make_ref:=false; + insertinternsyms(psymtable(current_module^.symtable)); + make_ref:=true; + end; + { now only read the implementation part } + current_module^.in_implementation:=true; + { load the used units from implementation } + pu:=pused_unit(current_module^.used_units.first); + while assigned(pu) do + begin + if (not pu^.loaded) and (not pu^.in_interface) then + begin + loaded_unit:=loadunit(pu^.name^,false); + if current_module^.compiled then + exit; + if loaded_unit^.crc<>pu^.checksum then + begin + current_module^.do_compile:=true; + exit; + end; + { setup the map entry for deref } +{ current_module^.map^[nextmapentry]:=loaded_unit^.symtable; + inc(nextmapentry); + if nextmapentry>maxunits then + Message(unit_f_too_much_units); } + end; + pu:=pused_unit(pu^.next); + end; + { remove the map, it's not needed anymore } + dispose(current_module^.map); + current_module^.map:=nil; + end; + + + function loadunit(const s : string;compile_system:boolean) : pmodule; + var + st : punitsymtable; + old_current_ppu : pppufile; + old_current_module,hp,nextmodule : pmodule; + hs : pstring; + begin + old_current_module:=current_module; + old_current_ppu:=current_ppu; + { be sure not to mix lines from different files } + { update_line; } + { unit not found } + st:=nil; + { search all loaded units } + hp:=pmodule(loaded_units.first); + while assigned(hp) do + begin + if hp^.modulename^=s then + begin + { the unit is already registered } + { and this means that the unit } + { is already compiled } + { else there is a cyclic unit use } + if assigned(hp^.symtable) then + st:=punitsymtable(hp^.symtable) + else + begin + { recompile the unit ? } + if (not current_module^.in_implementation) and (hp^.in_implementation) then + Message(unit_f_circular_unit_reference); + end; + break; + end; + { the next unit } + hp:=pmodule(hp^.next); + end; + { the unit is not in the symtable stack } + if (not assigned(st)) then +{ ((not current_module^.in_implementation) and (hp^.in_implementation)) then } + begin + { load the unit, it's not loaded yet } + if not assigned(hp) then + begin + { generates a new unit info record } + current_module:=new(pmodule,init(s,true)); + current_ppu:=current_module^.ppufile; + { now we can register the unit } + loaded_units.insert(current_module); + { load interface section } + if not current_module^.do_compile then + load_interface; + { only load units when we don't recompile } + if not current_module^.do_compile then + load_usedunits(compile_system); + { recompile if set } + if current_module^.do_compile then + begin + { we needn't the ppufile } + if assigned(current_module^.ppufile) then + begin + dispose(current_module^.ppufile,done); + current_module^.ppufile:=nil; + end; + if not(current_module^.sources_avail) then + Message1(unit_f_cant_compile_unit,current_module^.modulename^) + else + begin + if assigned(old_current_module^.current_inputfile) then + old_current_module^.current_inputfile^.tempclose; + compile(current_module^.mainsource^,compile_system); + if (not old_current_module^.compiled) and assigned(old_current_module^.current_inputfile) then + old_current_module^.current_inputfile^.tempreopen; + end; + end + else + begin + { only reassemble ? } + if (current_module^.do_assemble) then + OnlyAsm(current_module^.asmfilename^); + { add the files for the linker } + addlinkerfiles(current_module); + end; + { register the unit _once_ } + usedunits.concat(new(pused_unit,init(current_module,true))); + end + else + { we have to compile the unit again, but it is already inserted !!} + { we may have problem with the lost symtable !! } + begin + current_module:=hp; + { we must preserve the unit chain } + nextmodule:=pmodule(current_module^.next); + { we have to cleanup a little } + current_module^.special_done; + new(hs); + hs^:=current_module^.mainsource^; + current_module^.init(hs^,true); + dispose(hs); + { we must preserve the unit chain } + current_module^.next:=nextmodule; + if assigned(current_module^.ppufile) then + begin + current_ppu:=current_module^.ppufile; + load_interface; + load_usedunits(compile_system) + end + else + begin +{$ifdef UseBrowser} + { here we need to remove the names ! } + current_module^.sourcefiles.done; + current_module^.sourcefiles.init; +{$endif UseBrowser} + if assigned(old_current_module^.current_inputfile) then + old_current_module^.current_inputfile^.tempclose; + Message1(parser_d_compiling_second_time,current_module^.mainsource^); + compile(current_module^.mainsource^,compile_system); + if (not old_current_module^.compiled) and assigned(old_current_module^.current_inputfile) then + old_current_module^.current_inputfile^.tempreopen; + end; + current_module^.compiled:=true; + end; + hp:=current_module; + end; + { set the old module } + current_ppu:=old_current_ppu; + current_module:=old_current_module; + loadunit:=hp; + end; + +{$else NEWPPU} + +{***************************************************************************** + + Old PPU + +*****************************************************************************} + + function loadunit(const s : string;compile_system, in_uses : boolean) : pmodule;forward; procedure load_ppu(oldhp,hp : pmodule;compile_system : boolean); var loaded_unit : pmodule; b : byte; checksum, -{$ifndef NEWPPU} count, -{$endif NEWPPU} nextmapentry : longint; hs : string; begin { init the map } new(hp^.map); nextmapentry:=1; - -{$ifdef NEWPPU} - { load the used units from interface } - b:=hp^.ppufile^.readentry; - if b=ibloadunit_int then - begin - while not hp^.ppufile^.endofentry do - begin - hs:=hp^.ppufile^.getstring; - checksum:=hp^.ppufile^.getlongint; - loaded_unit:=loadunit(hs,false,false); - if hp^.compiled then - exit; - { if the crc of a used unit is the same as written to the - PPU file, we needn't to recompile the current unit } - if (loaded_unit^.crc<>checksum) then - begin - { we have to compile the current unit remove stuff which isn't - needed } - { forget the map } - dispose(hp^.map); - hp^.map:=nil; - { remove the ppufile } - dispose(hp^.ppufile,done); - hp^.ppufile:=nil; - { recompile or give an fatal error } - if not(hp^.sources_avail) then - Message1(unit_f_cant_compile_unit,hp^.modulename^) - else - begin - if assigned(oldhp^.current_inputfile) then - oldhp^.current_inputfile^.tempclose; - compile(hp^.mainsource^,compile_system); - if (not oldhp^.compiled) and assigned(oldhp^.current_inputfile) then - oldhp^.current_inputfile^.tempreopen; - end; - exit; - end; - { setup the map entry for deref } - hp^.map^[nextmapentry]:=loaded_unit^.symtable; - inc(nextmapentry); - if nextmapentry>maxunits then - Message(unit_f_too_much_units); - end; - { ok, now load the unit } - hp^.symtable:=new(punitsymtable,load(hp)); - { if this is the system unit insert the intern symbols } - if compile_system then - begin - make_ref:=false; - insertinternsyms(psymtable(hp^.symtable)); - make_ref:=true; - end; - end; - { now only read the implementation part } - hp^.in_implementation:=true; - { load the used units from implementation } - b:=hp^.ppufile^.readentry; - if b=ibloadunit_imp then - begin - while not hp^.ppufile^.endofentry do - begin - hs:=hp^.ppufile^.getstring; - checksum:=hp^.ppufile^.getlongint; - loaded_unit:=loadunit(hs,false,false); - if hp^.compiled then - exit; - end; - end; -{$ifdef NEWPPU} - { The next entry should be an ibendimplementation } - b:=hp^.ppufile^.readentry; - if b <> ibendimplementation then - Message1(unit_f_ppu_invalid_entry,tostr(b)); - { The next entry should be an ibend } - b:=hp^.ppufile^.readentry; - if b <> ibend then - Message1(unit_f_ppu_invalid_entry,tostr(b)); -{$endif} - hp^.ppufile^.close; -{! dispose(hp^.ppufile,done);} -{$else} { load the used units from interface } hp^.ppufile^.read_data(b,1,count); while (b=ibloadunit) do @@ -283,7 +414,7 @@ unit pmodules; hp^.ppufile^.read_data(b,1,count); end; { ok, now load the unit } - hp^.symtable:=new(punitsymtable,load(hp)); + hp^.symtable:=new(punitsymtable,load(hp^.modulename^)); { if this is the system unit insert the intern } { symbols } make_ref:=false; @@ -334,7 +465,6 @@ unit pmodules; hp^.ppufile^.read_data(b,1,count); end; hp^.ppufile^.close; -{$endif} dispose(hp^.map); hp^.map:=nil; end; @@ -410,11 +540,7 @@ unit pmodules; OnlyAsm(hp^.asmfilename^); { we should know there the PPU file else it's an error and we can't load the unit } -{$ifdef NEWPPU} -{ if hp^.ppufile^.name^<>'' then} -{$else} if hp^.ppufile^.name^<>'' then -{$endif} load_ppu(old_current_module,hp,compile_system); { add the files for the linker } addlinkerfiles(hp); @@ -460,7 +586,7 @@ unit pmodules; { here we need to remove the names ! } hp^.sourcefiles.done; hp^.sourcefiles.init; -{$endif not UseBrowser} +{$endif UseBrowser} if assigned(old_current_module^.current_inputfile) then old_current_module^.current_inputfile^.tempclose; Message1(parser_d_compiling_second_time,hp^.mainsource^); @@ -480,6 +606,47 @@ unit pmodules; loadunit:=hp; end; +{$endif NEWPPU} + + + procedure loadsystemunit; + var + hp : pmodule; + begin + { if the current file isn't a system unit the the system unit + will be loaded } + if not(cs_compilesystem in aktswitches) then + begin +{$ifdef NEWPPU} + hp:=loadunit(upper(target_info.system_unit),true); + systemunit:=hp^.symtable; + { add to the used units } + current_module^.used_units.concat(new(pused_unit,init(hp,true))); +{$else NEWPPU} + hp:=loadunit(upper(target_info.system_unit),true,true); + systemunit:=hp^.symtable; + { add to the used units } + current_module^.used_units.concat(new(pused_unit,init(hp,0))); +{$endif NEWPPU} + { read default constant definitions } + make_ref:=false; + readconstdefs; + { we could try to overload caret by default } + symtablestack:=systemunit; + { if POWER is defined in the RTL then use it for starstar overloading } + getsym('POWER',false); + if assigned(srsym) and (srsym^.typ=procsym) and + (overloaded_operators[STARSTAR]=nil) then + overloaded_operators[STARSTAR]:=pprocsym(srsym); + make_ref:=true; + end + else + begin + createconstdefs; + systemunit:=nil; + end; + end; + procedure loadunits; var @@ -497,7 +664,14 @@ unit pmodules; repeat s:=pattern; consume(ID); +{$ifdef NEWPPU} + hp2:=loadunit(s,false); + { the current module uses the unit hp2 } + current_module^.used_units.concat(new(pused_unit,init(hp2,not current_module^.in_implementation))); + pused_unit(current_module^.used_units.last)^.in_uses:=true; +{$else NEWPPU} hp2:=loadunit(s,false,true); +{$endif NEWPPU} if current_module^.compiled then exit; refsymtable^.insert(new(punitsym,init(s,hp2^.symtable))); @@ -512,10 +686,11 @@ unit pmodules; until false; consume(SEMICOLON); - { now insert the units in the symtablestack } - hp:=pused_unit(current_module^.used_units.first); { set the symtable to systemunit so it gets reorderd correctly } symtablestack:=systemunit; + + { now insert the units in the symtablestack } + hp:=pused_unit(current_module^.used_units.first); while assigned(hp) do begin {$IfDef GDB} @@ -700,7 +875,6 @@ unit pmodules; consume(_IMPLEMENTATION); parse_only:=false; - refsymtable^.number_defs; {$ifdef GDB} { add all used definitions even for implementation} @@ -733,6 +907,10 @@ unit pmodules; { to reinsert it after loading the implementation units } symtablestack:=unitst^.next; + { number the definitions, so a deref from other units works } + numberunits; + refsymtable^.number_defs; + { Read the implementation units } parse_implementation_uses(unitst); @@ -968,7 +1146,11 @@ unit pmodules; end. { $Log$ - Revision 1.28 1998-06-13 00:10:10 peter + Revision 1.29 1998-06-16 08:56:25 peter + + targetcpu + * cleaner pmodules for newppu + + Revision 1.28 1998/06/13 00:10:10 peter * working browser and newppu * some small fixes against crashes which occured in bp7 (but not in fpc?!) diff --git a/compiler/ppu.pas b/compiler/ppu.pas index 694ccce474..60cd1a439b 100644 --- a/compiler/ppu.pas +++ b/compiler/ppu.pas @@ -82,12 +82,10 @@ const ibsetdef = 50; ibprocvardef = 51; ibfloatdef = 52; - ibextsymref = 53; - ibextdefref = 54; - ibclassrefdef = 55; - iblongstringdef = 56; - ibansistringdef = 57; - ibwidestringdef = 58; + ibclassrefdef = 53; + iblongstringdef = 54; + ibansistringdef = 55; + ibwidestringdef = 56; { unit flags } uf_init = $1; @@ -106,6 +104,7 @@ type id : array[1..3] of char; { = 'PPU' } ver : array[1..3] of char; compiler : word; + cpu : word; target : word; flags : longint; size : longint; { size of the ppufile without header } @@ -750,7 +749,11 @@ end; end. { $Log$ - Revision 1.5 1998-06-13 00:10:12 peter + Revision 1.6 1998-06-16 08:56:26 peter + + targetcpu + * cleaner pmodules for newppu + + Revision 1.5 1998/06/13 00:10:12 peter * working browser and newppu * some small fixes against crashes which occured in bp7 (but not in fpc?!) diff --git a/compiler/rai386.pas b/compiler/rai386.pas index bc06417e65..bfe11106ce 100644 --- a/compiler/rai386.pas +++ b/compiler/rai386.pas @@ -1347,8 +1347,8 @@ var { this makes cpu.pp uncompilable, but i think this code should be } { inserted in the system unit anyways. } - if (instruc >= lastop_in_table) and - ((cs_compilesystem in aktswitches) or (aktoptprocessor > systems.i386)) then + if (instruc >= lastop_in_table) then +{ ((cs_compilesystem in aktswitches) or (aktoptprocessor > systems.i386)) then } begin Message(assem_w_opcode_not_in_table); fits:=true; @@ -3376,7 +3376,11 @@ Begin end. { $Log$ - Revision 1.10 1998-06-12 10:32:33 pierre + Revision 1.11 1998-06-16 08:56:28 peter + + targetcpu + * cleaner pmodules for newppu + + Revision 1.10 1998/06/12 10:32:33 pierre * column problem hopefully solved + C vars declaration changed diff --git a/compiler/ratti386.pas b/compiler/ratti386.pas index a17f818bd1..e144c8637c 100644 --- a/compiler/ratti386.pas +++ b/compiler/ratti386.pas @@ -1539,7 +1539,7 @@ const { the att version only if the processor > i386 or we are compiling } { the system unit then this will be allowed... } if (instruc >= lastop_in_table) and - ((cs_compilesystem in aktswitches) or (aktoptprocessor >systems.i386)) then + ((cs_compilesystem in aktswitches) or (aktoptprocessor>int386)) then begin Message1(assem_w_opcode_not_in_table,att_op2str[instruc]); fits:=true; @@ -3691,7 +3691,11 @@ end. { $Log$ - Revision 1.12 1998-06-12 10:32:35 pierre + Revision 1.13 1998-06-16 08:56:29 peter + + targetcpu + * cleaner pmodules for newppu + + Revision 1.12 1998/06/12 10:32:35 pierre * column problem hopefully solved + C vars declaration changed diff --git a/compiler/scanner.pas b/compiler/scanner.pas index fbabb68c6c..ea399e8ed7 100644 --- a/compiler/scanner.pas +++ b/compiler/scanner.pas @@ -147,6 +147,7 @@ unit scanner; orgpattern, pattern : string; macrobuffer : pmacrobuffer; + currlinepos, lastlinepos, lasttokenpos, inputbuffer, @@ -336,7 +337,7 @@ unit scanner; end; inputbuffer[readsize]:=#0; inputpointer:=inputbuffer; - lastlinepos:=inputpointer; + currlinepos:=inputpointer; { Set EOF when main source and at endoffile } if eof(current_module^.current_inputfile^.f) then begin @@ -354,8 +355,9 @@ unit scanner; status.currentsource:=current_module^.current_inputfile^.name^+current_module^.current_inputfile^.ext^; inputbuffer:=current_module^.current_inputfile^.buf; inputpointer:=inputbuffer+current_module^.current_inputfile^.bufpos; - lastlinepos:=inputpointer; + currlinepos:=inputpointer; end; + lastlinepos:=currlinepos; { load next char } c:=inputpointer^; inc(longint(inputpointer)); @@ -387,7 +389,7 @@ unit scanner; inc(current_module^.current_inputfile^.true_line); status.currentline:=current_module^.current_inputfile^.true_line; inc(status.compiledlines); - lastlinepos:=inputpointer; + currlinepos:=inputpointer; end; @@ -709,6 +711,7 @@ unit scanner; until false; { Save current token position } + lastlinepos:=currlinepos; lasttokenpos:=inputpointer; tokenpos.line:=current_module^.current_inputfile^.true_line; tokenpos.column:=get_file_col; @@ -1173,6 +1176,7 @@ unit scanner; comment_level:=0; lasttokenpos:=inputpointer; lastlinepos:=inputpointer; + currlinepos:=inputpointer; s_point:=false; block_type:=bt_general; end; @@ -1263,7 +1267,11 @@ unit scanner; end. { $Log$ - Revision 1.25 1998-06-13 00:10:15 peter + Revision 1.26 1998-06-16 08:56:30 peter + + targetcpu + * cleaner pmodules for newppu + + Revision 1.25 1998/06/13 00:10:15 peter * working browser and newppu * some small fixes against crashes which occured in bp7 (but not in fpc?!) diff --git a/compiler/symdef.inc b/compiler/symdef.inc index e32503079e..922736e04a 100644 --- a/compiler/symdef.inc +++ b/compiler/symdef.inc @@ -406,10 +406,10 @@ writelong(len); {$ifdef NEWPPU} case string_typ of - shortstring : ppufile^.writeentry(ibstringdef); - longstring : ppufile^.writeentry(iblongstringdef); - ansistring : ppufile^.writeentry(ibansistringdef); - widestring : ppufile^.writeentry(ibwidestringdef); + shortstring : current_ppu^.writeentry(ibstringdef); + longstring : current_ppu^.writeentry(iblongstringdef); + ansistring : current_ppu^.writeentry(ibansistringdef); + widestring : current_ppu^.writeentry(ibwidestringdef); end; {$endif} end; @@ -535,7 +535,7 @@ tdef.write; writelong(max); {$ifdef NEWPPU} - ppufile^.writeentry(ibenumdef); + current_ppu^.writeentry(ibenumdef); {$endif} end; @@ -699,7 +699,7 @@ writelong(low); writelong(high); {$ifdef NEWPPU} - ppufile^.writeentry(iborddef); + current_ppu^.writeentry(iborddef); {$endif} end; @@ -772,7 +772,7 @@ tdef.write; writebyte(byte(typ)); {$ifdef NEWPPU} - ppufile^.writeentry(ibfloatdef); + current_ppu^.writeentry(ibfloatdef); {$endif} end; @@ -892,7 +892,7 @@ if filetype=ft_typed then writedefref(typed_as); {$ifdef NEWPPU} - ppufile^.writeentry(ibfiledef); + current_ppu^.writeentry(ibfiledef); {$endif} end; @@ -1013,7 +1013,7 @@ tdef.write; writedefref(definition); {$ifdef NEWPPU} - ppufile^.writeentry(ibpointerdef); + current_ppu^.writeentry(ibpointerdef); {$endif} end; @@ -1099,7 +1099,7 @@ tdef.write; writedefref(definition); {$ifdef NEWPPU} - ppufile^.writeentry(ibclassrefdef); + current_ppu^.writeentry(ibclassrefdef); {$endif} end; @@ -1177,7 +1177,7 @@ if settype=varset then writelong(savesize); {$ifdef NEWPPU} - ppufile^.writeentry(ibsetdef); + current_ppu^.writeentry(ibsetdef); {$endif} end; @@ -1240,7 +1240,7 @@ {$endif} tdef.write; {$ifdef NEWPPU} - ppufile^.writeentry(ibformaldef); + current_ppu^.writeentry(ibformaldef); {$endif} end; @@ -1327,7 +1327,7 @@ writelong(lowrange); writelong(highrange); {$ifdef NEWPPU} - ppufile^.writeentry(ibarraydef); + current_ppu^.writeentry(ibarraydef); {$endif} end; @@ -1483,7 +1483,7 @@ tdef.write; writelong(savesize); {$ifdef NEWPPU} - ppufile^.writeentry(ibrecorddef); + current_ppu^.writeentry(ibrecorddef); {$endif} self.symtable^.writeasstruct; read_member:=oldread_member; @@ -1862,8 +1862,6 @@ lastwritten:=nil; defref:=nil; refcount:=0; - if (current_module^.flags and uf_has_browser)<>0 then - load_references; {$endif UseBrowser} end; @@ -1875,7 +1873,7 @@ var pos : tfileposinfo; begin - while (not ppufile^.endofentry) do + while (not current_ppu^.endofentry) do begin readposinfo(pos); inc(refcount); @@ -1904,7 +1902,7 @@ writeposinfo(ref^.posinfo); ref:=ref^.nextref; end; - ppufile^.writeentry(ibdefref); + current_ppu^.writeentry(ibdefref); lastwritten:=lastref; end; @@ -2051,7 +2049,7 @@ } end; {$ifdef NEWPPU} - ppufile^.writeentry(ibprocdef); + current_ppu^.writeentry(ibprocdef); {$endif} end; @@ -2219,7 +2217,7 @@ {$endif StoreFPULevel} inherited write; {$ifdef NEWPPU} - ppufile^.writeentry(ibprocvardef); + current_ppu^.writeentry(ibprocvardef); {$endif} end; @@ -2471,7 +2469,7 @@ writedefref(childof); writelong(options); {$ifdef NEWPPU} - ppufile^.writeentry(ibobjectdef); + current_ppu^.writeentry(ibobjectdef); {$endif} if (options and (oo_hasprivate or oo_hasprotected))<>0 then object_options:=true; @@ -2646,7 +2644,11 @@ { $Log$ - Revision 1.13 1998-06-15 15:38:09 pierre + Revision 1.14 1998-06-16 08:56:31 peter + + targetcpu + * cleaner pmodules for newppu + + Revision 1.13 1998/06/15 15:38:09 pierre * small bug in systems.pas corrected + operators in different units better hanlded diff --git a/compiler/symppu.inc b/compiler/symppu.inc index 19107686c7..fe956486d1 100644 --- a/compiler/symppu.inc +++ b/compiler/symppu.inc @@ -31,45 +31,46 @@ {$ENDIF} {$ENDIF} + +{$ifdef NEWPPU} + {***************************************************************************** PPU Writing *****************************************************************************} -{$ifdef NEWPPU} - procedure writebyte(b:byte); begin - ppufile^.putbyte(b); + current_ppu^.putbyte(b); end; procedure writeword(w:word); begin - ppufile^.putword(w); + current_ppu^.putword(w); end; procedure writelong(l:longint); begin - ppufile^.putlongint(l); + current_ppu^.putlongint(l); end; procedure writedouble(d:double); begin - ppufile^.putdata(d,sizeof(double)); + current_ppu^.putdata(d,sizeof(double)); end; procedure writestring(const s:string); begin - ppufile^.putstring(s); + current_ppu^.putstring(s); end; procedure writeset(var s); {You cannot pass an array[0..31] of byte!} begin - ppufile^.putdata(s,32); + current_ppu^.putdata(s,32); end; @@ -83,11 +84,11 @@ while not p.empty do begin s:=p.get; - ppufile^.putstring(s); + current_ppu^.putstring(s); if hold then hcontainer.insert(s); end; - ppufile^.writeentry(id); + current_ppu^.writeentry(id); if hold then p:=hcontainer; end; @@ -95,23 +96,23 @@ procedure writeposinfo(const p:tfileposinfo); begin - writeword(p.fileindex); - writelong(p.line); - writeword(p.column); + current_ppu^.putword(p.fileindex); + current_ppu^.putlongint(p.line); + current_ppu^.putword(p.column); end; procedure writedefref(p : pdef); begin if p=nil then - ppufile^.putlongint($ffffffff) + current_ppu^.putlongint($ffffffff) else begin if (p^.owner^.symtabletype in [recordsymtable,objectsymtable]) then - ppufile^.putword($ffff) + current_ppu^.putword($ffff) else - ppufile^.putword(p^.owner^.unitid); - ppufile^.putword(p^.indexnb); + current_ppu^.putword(p^.owner^.unitid); + current_ppu^.putword(p^.indexnb); end; end; @@ -119,18 +120,56 @@ procedure writesymref(p : psym); begin if p=nil then - writelong($ffffffff) + current_ppu^.putlongint($ffffffff) else begin if (p^.owner^.symtabletype in [recordsymtable,objectsymtable]) then - writeword($ffff) + current_ppu^.putword($ffff) else - writeword(p^.owner^.unitid); - writeword(p^.indexnb); + current_ppu^.putword(p^.owner^.unitid); + current_ppu^.putword(p^.indexnb); end; end; + procedure writesourcefiles; + var + hp2 : pextfile; + index : longint; + begin + { second write the used source files } + hp2:=current_module^.sourcefiles.files; + index:=current_module^.sourcefiles.last_ref_index; + while assigned(hp2) do + begin + { only name and extension } + current_ppu^.putstring(hp2^.name^+hp2^.ext^); + { index in that order } + hp2^.ref_index:=index; + dec(index); + hp2:=hp2^._next; + end; + current_ppu^.writeentry(ibsourcefiles); + end; + + + procedure writeusedunit; + var + hp : pused_unit; + begin + numberunits; + hp:=pused_unit(current_module^.used_units.first); + while assigned(hp) do + begin + current_ppu^.putstring(hp^.name^); + current_ppu^.putlongint(hp^.checksum); + current_ppu^.putbyte(byte(hp^.in_interface)); + hp:=pused_unit(hp^.next); + end; + current_ppu^.writeentry(ibloadunit_int); + end; + + procedure writeunitas(const s : string;unittable : punitsymtable); begin Message1(unit_u_ppu_write,s); @@ -155,33 +194,357 @@ end; { open ppufile } - ppufile:=new(pppufile,init(s)); - ppufile^.change_endian:=source_os.endian<>target_os.endian; - if not ppufile^.create then + current_ppu:=new(pppufile,init(s)); + current_ppu^.change_endian:=source_os.endian<>target_os.endian; + if not current_ppu^.create then Message(unit_f_ppu_cannot_write); { write symbols and definitions } unittable^.writeasunit; { flush to be sure } - ppufile^.flush; + current_ppu^.flush; { create and write header } - ppufile^.header.size:=ppufile^.size; - ppufile^.header.checksum:=ppufile^.crc; - ppufile^.header.compiler:=wordversion; - ppufile^.header.target:=word(target_info.target); - ppufile^.header.flags:=current_module^.flags; - ppufile^.writeheader; + current_ppu^.header.size:=current_ppu^.size; + current_ppu^.header.checksum:=current_ppu^.crc; + current_ppu^.header.compiler:=wordversion; + current_ppu^.header.cpu:=word(target_cpu); + current_ppu^.header.target:=word(target_info.target); + current_ppu^.header.flags:=current_module^.flags; + current_ppu^.writeheader; { save crc in current_module also } - current_module^.crc:=ppufile^.crc; + current_module^.crc:=current_ppu^.crc; { close } - ppufile^.close; - dispose(ppufile,done); + current_ppu^.close; + dispose(current_ppu,done); + end; + + +{***************************************************************************** + PPU Reading +*****************************************************************************} + + function readbyte:byte; + begin + readbyte:=current_ppu^.getbyte; + if current_ppu^.error then + Message(unit_f_ppu_read_error); + end; + + + function readword:word; + begin + readword:=current_ppu^.getword; + if current_ppu^.error then + Message(unit_f_ppu_read_error); + end; + + + function readlong:longint; + begin + readlong:=current_ppu^.getlongint; + if current_ppu^.error then + Message(unit_f_ppu_read_error); + end; + + + function readdouble : double; + var + d : double; + begin + current_ppu^.getdata(d,sizeof(double)); + if current_ppu^.error then + Message(unit_f_ppu_read_error); + readdouble:=d; + end; + + + function readstring : string; + begin + readstring:=current_ppu^.getstring; + if current_ppu^.error then + Message(unit_f_ppu_read_error); + end; + + + procedure readset(var s); {You cannot pass an array [0..31] of byte.} + begin + current_ppu^.getdata(s,32); + if current_ppu^.error then + Message(unit_f_ppu_read_error); + end; + + + procedure readcontainer(var p:tstringcontainer); + begin + while not current_ppu^.endofentry do + p.insert(current_ppu^.getstring); + end; + + + procedure readposinfo(var p:tfileposinfo); + begin + p.fileindex:=current_ppu^.getword; + p.line:=current_ppu^.getlongint; + p.column:=current_ppu^.getword; + end; + + + function readdefref : pdef; + var + hd : pdef; + begin + longint(hd):=current_ppu^.getword; + longint(hd):=longint(hd) or (longint(current_ppu^.getword) shl 16); + readdefref:=hd; + end; + + +{$ifdef UseBrowser} + function readsymref : psym; + var + hd : psym; + begin + longint(hd):=current_ppu^.getword; + longint(hd):=longint(hd) or (longint(current_ppu^.getword) shl 16); + readsymref:=hd; + end; +{$endif} + + + procedure readsourcefiles; + var + temp,hs : string; + incfile_found : boolean; + ppufiletime, + source_time : longint; +{$ifdef UseBrowser} + hp : pextfile; + _d,_n,_e : string; +{$endif UseBrowser} + begin + ppufiletime:=getnamedfiletime(current_module^.ppufilename^); + current_module^.sources_avail:=true; + while not current_ppu^.endofentry do + begin + hs:=current_ppu^.getstring; + temp:=''; + if (current_module^.flags and uf_in_library)<>0 then + begin + current_module^.sources_avail:=false; + temp:=' library'; + end + else if pos('Macro ',hs)=1 then + begin + { we don't want to find this file } + { but there is a problem with file indexing !! } + temp:=''; + end + else + begin + { check the date of the source files } + Source_Time:=GetNamedFileTime(current_module^.path^+hs); + if Source_Time=-1 then + begin + { search for include files in the includepathlist } + temp:=search(hs,includesearchpath,incfile_found); + if incfile_found then + begin + hs:=temp+hs; + Source_Time:=GetNamedFileTime(hs); + end; + end + else + hs:=current_module^.path^+hs; + if Source_Time=-1 then + begin + current_module^.sources_avail:=false; + temp:=' not found'; + end + else + begin + temp:=' time '+filetimestring(source_time); + if (source_time>ppufiletime) then + begin + current_module^.do_compile:=true; + temp:=temp+' *' + end; + end; + end; + Message1(unit_t_ppu_source,hs+temp); +{$ifdef UseBrowser} + fsplit(hs,_d,_n,_e); + new(hp,init(_d,_n,_e)); + { the indexing should match what is done in writeasunit } + current_module^.sourcefiles.register_file(hp); +{$endif UseBrowser} + end; + { main source is always the last } + stringdispose(current_module^.mainsource); + current_module^.mainsource:=stringdup(hs); + { check if we want to rebuild every unit, only if the sources are + available } + if do_build and current_module^.sources_avail then + current_module^.do_compile:=true; + end; + + + procedure readloadunit; + var + hs : string; + checksum : longint; + in_interface : boolean; + begin + while not current_ppu^.endofentry do + begin + hs:=current_ppu^.getstring; + checksum:=current_ppu^.getlongint; + in_interface:=(current_ppu^.getbyte<>0); + current_module^.used_units.concat(new(pused_unit,init_to_load(hs,checksum,in_interface))); + end; + end; + + + procedure load_interface; + var + b : byte; + begin + { read interface part } + repeat + b:=current_ppu^.readentry; + case b of + { ibinitunit : usedunits^.insert(readstring); } + ibmodulename : begin + stringdispose(current_module^.modulename); + current_module^.modulename:=stringdup(current_ppu^.getstring); + end; + ibsourcefiles : readsourcefiles; + ibloadunit_int : readloadunit; + iblinksharedlibs : readcontainer(current_module^.LinkSharedLibs); + iblinkstaticlibs : readcontainer(current_module^.LinkStaticLibs); + iblinkofiles : readcontainer(current_module^.LinkOFiles); + ibendinterface : break; + else + Message1(unit_f_ppu_invalid_entry,tostr(b)); + end; + until false; end; {$else NEWPPU} + +{***************************************************************************** + + Old PPU + +*****************************************************************************} + + function readbyte : byte; + + var + count : longint; + b : byte; + + begin + current_module^.ppufile^.read_data(b,sizeof(byte),count); + readbyte:=b; + if count<>1 then + Message(unit_f_ppu_read_error); + end; + + function readword : word; + + var + count : longint; + w : word; + + begin + current_module^.ppufile^.read_data(w,sizeof(word),count); + readword:=w; + if count<>sizeof(word) then + Message(unit_f_ppu_read_error); + end; + + function readlong : longint; + + var + count,l : longint; + + begin + current_module^.ppufile^.read_data(l,sizeof(longint),count); + readlong:=l; + if count<>sizeof(longint) then + Message(unit_f_ppu_read_error); + end; + + function readdouble : double; + + var + count : longint; + d : double; + + begin + current_module^.ppufile^.read_data(d,sizeof(double),count); + readdouble:=d; + if count<>sizeof(double) then + Message(unit_f_ppu_read_error); + end; + + function readstring : string; + + var + s : string; + count : longint; + + begin + s[0]:=char(readbyte); + current_module^.ppufile^.read_data(s[1],ord(s[0]),count); + if count<>ord(s[0]) then + Message(unit_f_ppu_read_error); + readstring:=s; + end; + +{***SETCONST} + procedure readset(var s); {You cannot pass an array [0..31] of byte.} + + var count:longint; + + begin + current_module^.ppufile^.read_data(s,32,count); + if count<>32 then + Message(unit_f_ppu_read_error); + end; +{***} + + procedure readposinfo(var p:tfileposinfo); + begin + p.fileindex:=readword; + p.line:=readlong; + p.column:=readword; + end; + + + function readdefref : pdef; + var + hd : pdef; + begin + longint(hd):=readword; + longint(hd):=longint(hd) or (longint(readword) shl 16); + readdefref:=hd; + end; + +{$ifdef UseBrowser} + function readsymref : psym; + var + hd : psym; + begin + longint(hd):=readword; + longint(hd):=longint(hd) or (longint(readword) shl 16); + readsymref:=hd; + end; +{$endif UseBrowser} + procedure writebyte(b:byte); begin ppufile.write_data(b,1); @@ -328,205 +691,17 @@ ppufile.done; end; -{$endif NEWPPU} -{***************************************************************************** - PPU Reading -*****************************************************************************} - -{$ifdef NEWPPU} - function readbyte:byte; - begin - readbyte:=ppufile^.getbyte; - if ppufile^.error then - Message(unit_f_ppu_read_error); - end; - - function readword:word; - begin - readword:=ppufile^.getword; - if ppufile^.error then - Message(unit_f_ppu_read_error); - end; - - function readlong:longint; - begin - readlong:=ppufile^.getlongint; - if ppufile^.error then - Message(unit_f_ppu_read_error); - end; - - function readdouble : double; - var - d : double; - begin - ppufile^.getdata(d,sizeof(double)); - if ppufile^.error then - Message(unit_f_ppu_read_error); - readdouble:=d; - end; - - function readstring : string; - begin - readstring:=ppufile^.getstring; - if ppufile^.error then - Message(unit_f_ppu_read_error); - end; - - procedure readset(var s); {You cannot pass an array [0..31] of byte.} - begin - ppufile^.getdata(s,32); - if ppufile^.error then - Message(unit_f_ppu_read_error); - end; - - procedure readcontainer(var p:tstringcontainer); - begin - while not current_module^.ppufile^.endofentry do - p.insert(current_module^.ppufile^.getstring); - end; - - procedure readposinfo(var p:tfileposinfo); - begin - p.fileindex:=readword; - p.line:=readlong; - p.column:=readword; - end; - - function readdefref : pdef; - var - hd : pdef; - begin - longint(hd):=readword; - longint(hd):=longint(hd) or (longint(readword) shl 16); - readdefref:=hd; - end; - -{$ifdef UseBrowser} - function readsymref : psym; - var - hd : psym; - begin - longint(hd):=readword; - longint(hd):=longint(hd) or (longint(readword) shl 16); - readsymref:=hd; - end; -{$endif} - - -{$else NEWPPU} - - - function readbyte : byte; - - var - count : longint; - b : byte; - - begin - current_module^.ppufile^.read_data(b,sizeof(byte),count); - readbyte:=b; - if count<>1 then - Message(unit_f_ppu_read_error); - end; - - function readword : word; - - var - count : longint; - w : word; - - begin - current_module^.ppufile^.read_data(w,sizeof(word),count); - readword:=w; - if count<>sizeof(word) then - Message(unit_f_ppu_read_error); - end; - - function readlong : longint; - - var - count,l : longint; - - begin - current_module^.ppufile^.read_data(l,sizeof(longint),count); - readlong:=l; - if count<>sizeof(longint) then - Message(unit_f_ppu_read_error); - end; - - function readdouble : double; - - var - count : longint; - d : double; - - begin - current_module^.ppufile^.read_data(d,sizeof(double),count); - readdouble:=d; - if count<>sizeof(double) then - Message(unit_f_ppu_read_error); - end; - - function readstring : string; - - var - s : string; - count : longint; - - begin - s[0]:=char(readbyte); - current_module^.ppufile^.read_data(s[1],ord(s[0]),count); - if count<>ord(s[0]) then - Message(unit_f_ppu_read_error); - readstring:=s; - end; - -{***SETCONST} - procedure readset(var s); {You cannot pass an array [0..31] of byte.} - - var count:longint; - - begin - current_module^.ppufile^.read_data(s,32,count); - if count<>32 then - Message(unit_f_ppu_read_error); - end; -{***} - - procedure readposinfo(var p:tfileposinfo); - begin - p.fileindex:=readword; - p.line:=readlong; - p.column:=readword; - end; - - - function readdefref : pdef; - var - hd : pdef; - begin - longint(hd):=readword; - longint(hd):=longint(hd) or (longint(readword) shl 16); - readdefref:=hd; - end; - -{$ifdef UseBrowser} - function readsymref : psym; - var - hd : psym; - begin - longint(hd):=readword; - longint(hd):=longint(hd) or (longint(readword) shl 16); - readsymref:=hd; - end; -{$endif UseBrowser} {$endif NEWPPU} { $Log$ - Revision 1.3 1998-06-13 00:10:17 peter + Revision 1.4 1998-06-16 08:56:32 peter + + targetcpu + * cleaner pmodules for newppu + + Revision 1.3 1998/06/13 00:10:17 peter * working browser and newppu * some small fixes against crashes which occured in bp7 (but not in fpc?!) diff --git a/compiler/symsym.inc b/compiler/symsym.inc index 606957a373..36792fbe28 100644 --- a/compiler/symsym.inc +++ b/compiler/symsym.inc @@ -82,7 +82,7 @@ var pos : tfileposinfo; begin - while (not ppufile^.endofentry) do + while (not current_ppu^.endofentry) do begin readposinfo(pos); inc(refcount); @@ -113,7 +113,7 @@ ref:=ref^.nextref; end; lastwritten:=lastref; - ppufile^.writeentry(ibsymref); + current_ppu^.writeentry(ibsymref); { when it's a procsym then write also the refs to the definition due the overloading } if typ=procsym then @@ -515,7 +515,7 @@ tsym.write; writedefref(pdef(definition)); {$ifdef NEWPPU} - ppufile^.writeentry(ibprocsym); + current_ppu^.writeentry(ibprocsym); {$endif} end; @@ -673,7 +673,7 @@ writedefref(readaccessdef); writedefref(writeaccessdef); {$ifdef NEWPPU} - ppufile^.writeentry(ibpropertysym); + current_ppu^.writeentry(ibpropertysym); {$endif} end; @@ -756,7 +756,7 @@ toaddr : writelong(address); end; {$ifdef NEWPPU} - ppufile^.writeentry(ibabsolutesym); + current_ppu^.writeentry(ibabsolutesym); {$endif} end; @@ -900,9 +900,9 @@ end; {$ifdef NEWPPU} if (var_options and vo_is_C_var)<>0 then - ppufile^.writeentry(ibvarsym_C) + current_ppu^.writeentry(ibvarsym_C) else - ppufile^.writeentry(ibvarsym); + current_ppu^.writeentry(ibvarsym); {$endif} end; @@ -1239,7 +1239,7 @@ writedefref(definition); writestring(prefix^); {$ifdef NEWPPU} - ppufile^.writeentry(ibtypedconstsym); + current_ppu^.writeentry(ibtypedconstsym); {$endif} end; @@ -1387,7 +1387,7 @@ else internalerror(13); end; {$ifdef NEWPPU} - ppufile^.writeentry(ibconstsym); + current_ppu^.writeentry(ibconstsym); {$endif} end; @@ -1497,7 +1497,7 @@ writedefref(definition); writelong(value); {$ifdef NEWPPU} - ppufile^.writeentry(ibenumsym); + current_ppu^.writeentry(ibenumsym); {$endif} end; @@ -1573,7 +1573,7 @@ tsym.write; writedefref(definition); {$ifdef NEWPPU} - ppufile^.writeentry(ibtypesym); + current_ppu^.writeentry(ibtypesym); {$endif} end; @@ -1680,7 +1680,11 @@ { $Log$ - Revision 1.13 1998-06-15 15:38:10 pierre + Revision 1.14 1998-06-16 08:56:34 peter + + targetcpu + * cleaner pmodules for newppu + + Revision 1.13 1998/06/15 15:38:10 pierre * small bug in systems.pas corrected + operators in different units better hanlded diff --git a/compiler/systems.pas b/compiler/systems.pas index b3b1dbd2c7..834d732a9b 100644 --- a/compiler/systems.pas +++ b/compiler/systems.pas @@ -28,9 +28,11 @@ unit systems; type tendian = (endian_little,en_big_endian); + ttargetcpu = (i386,m68k,alpha); + tprocessors = ( {$ifdef i386} - i386,i486,pentium,pentiumpro,cx6x86,pentium2,amdk6 + int386,int486,pentium,pentiumpro,cx6x86,pentium2,amdk6 {$endif} {$ifdef m68k} MC68000,MC68020 @@ -44,7 +46,7 @@ unit systems; {$endif} {$ifdef m68k} M68K_MOT - {$endif} + {$endif} ); @@ -164,6 +166,14 @@ unit systems; idtxt : string[8]; end; + const +{$ifdef i386} + target_cpu = i386; +{$endif i386} +{$ifdef m68k} + target_cpu = m68k; +{$endif m68k} + var target_info : ttargetinfo; target_os : tosinfo; @@ -844,7 +854,11 @@ begin end. { $Log$ - Revision 1.20 1998-06-15 15:38:14 pierre + Revision 1.21 1998-06-16 08:56:36 peter + + targetcpu + * cleaner pmodules for newppu + + Revision 1.20 1998/06/15 15:38:14 pierre * small bug in systems.pas corrected + operators in different units better hanlded