paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 21:29:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Move enumration types uses in ppu files from systems.pas

Browse Source 
into systems.inc include file for direct inclusion by utils/ppudump.pp
  + new generic/cpuinfo.pas unit to allow compilation of ppudump without any
    CPU specific code.
  * Modified utils/ppudump rule in utils Makefile.fpc
    to use generic/cpuinfo unit by use of -dGENERIC_CPU
  * globals unit changed to support GENERIC_CPU.
  * utils/ppudump.pp changed to remove local enumeration types.

git-svn-id: trunk@17773 -
This commit is contained in:
pierre 2011-06-20 14:16:57 +00:00
parent cd6e00c99a
commit 83f100432c
6 changed files with 372 additions and 477 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -146,6 +146,7 @@ compiler/fpccrc.pas svneol=native#text/plain
compiler/fpcdefs.inc svneol=native#text/plain compiler/fpcdefs.inc svneol=native#text/plain
compiler/fppu.pas svneol=native#text/plain compiler/fppu.pas svneol=native#text/plain
compiler/gendef.pas svneol=native#text/plain compiler/gendef.pas svneol=native#text/plain
compiler/generic/cpuinfo.pas svneol=native#text/plain
compiler/globals.pas svneol=native#text/plain compiler/globals.pas svneol=native#text/plain
compiler/globtype.pas svneol=native#text/plain compiler/globtype.pas svneol=native#text/plain
compiler/html/i386/readme.txt svneol=native#text/plain compiler/html/i386/readme.txt svneol=native#text/plain

153
compiler/generic/cpuinfo.pas Normal file
View File

@ -0,0 +1,153 @@
{
Copyright (c) 1998-2002 by the Free Pascal development team
Basic Processor information for the Generic CPU
This file is used by PPUDump program from utils subdirectory.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
Unit CPUInfo;
Interface
uses
globtype;
Type
bestreal = double;
ts32real = single;
ts64real = double;
ts80real = type extended;
ts128real = type extended;
ts64comp = comp;
pbestreal=^bestreal;
{ possible supported processors for this target }
tcputype =
(cpu_none
);
Type
tfputype =
(fpu_none,
fpu_soft
);
Const
cputypestr : array[tcputype] of string[8] = ('none');
fputypestr : array[tfputype] of string[6] = ('none','soft');
Implementation
end.
{
Copyright (c) 1998-2002 by the Free Pascal development team
Basic Processor information for the Generic CPU
This file is used by PPUDump program from utils subdirectory.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
Unit CPUInfo;
Interface
uses
globtype;
Type
bestreal = double;
ts32real = single;
ts64real = double;
ts80real = type extended;
ts128real = type extended;
ts64comp = comp;
pbestreal=^bestreal;
{ possible supported processors for this target }
tcputype =
(cpu_none
);
Type
tfputype =
(fpu_none,
fpu_soft
);
Const
cputypestr : array[tcputype] of string[8] = ('none');
fputypestr : array[tfputype] of string[6] = ('none','soft');
Implementation
end.
{
Copyright (c) 1998-2002 by the Free Pascal development team
Basic Processor information for the Generic CPU
This file is used by PPUDump program from utils subdirectory.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
Unit CPUInfo;
Interface
uses
globtype;
Type
bestreal = double;
ts32real = single;
ts64real = double;
ts80real = type extended;
ts128real = type extended;
ts64comp = comp;
pbestreal=^bestreal;
{ possible supported processors for this target }
tcputype =
(cpu_none
);
Type
tfputype =
(fpu_none,
fpu_soft
);
Const
cputypestr : array[tcputype] of string[8] = ('none');
fputypestr : array[tfputype] of string[6] = ('none','soft');
Implementation
end.

11
compiler/globals.pas
View File

@ -236,6 +236,8 @@ interface
autoloadunits : string; autoloadunits : string;
{ linking } { linking }
usegnubinutils : boolean;
forceforwardslash : boolean;
usewindowapi : boolean; usewindowapi : boolean;
description : string; description : string;
SetPEFlagsSetExplicity, SetPEFlagsSetExplicity,
@ -363,6 +365,14 @@ interface
packrecords : 0; packrecords : 0;
maxfpuregisters : 0; maxfpuregisters : 0;
{ Note: GENERIC_CPU is sued together with generic subdirectory to
be able to compile some of the units without any real CPU.
This is used to generate a CPU independant PPUDUMP utility. PM }
{$ifdef GENERIC_CPU}
cputype : cpu_none;
optimizecputype : cpu_none;
fputype : fpu_none;
{$else not GENERIC_CPU}
{$ifdef i386} {$ifdef i386}
cputype : cpu_Pentium; cputype : cpu_Pentium;
optimizecputype : cpu_Pentium3; optimizecputype : cpu_Pentium3;
@ -408,6 +418,7 @@ interface
optimizecputype : cpu_mips32; optimizecputype : cpu_mips32;
fputype : fpu_mips2; fputype : fpu_mips2;
{$endif mips} {$endif mips}
{$endif not GENERIC_CPU}
asmmode : asmmode_standard; asmmode : asmmode_standard;
interfacetype : it_interfacecom; interfacetype : it_interfacecom;
defproccall : pocall_default; defproccall : pocall_default;

62
compiler/utils/Makefile
View File

@ -1,8 +1,8 @@
# #
# Don't edit, this file is generated by FPCMake Version 2.0.0 [2010/09/29] # Don't edit, this file is generated by FPCMake Version 2.0.0 [2011/06/15]
# #
default: all default: all
MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux
BSDs = freebsd netbsd openbsd darwin BSDs = freebsd netbsd openbsd darwin
UNIXs = linux $(BSDs) solaris qnx haiku UNIXs = linux $(BSDs) solaris qnx haiku
LIMIT83fs = go32v2 os2 emx watcom LIMIT83fs = go32v2 os2 emx watcom
@ -264,6 +264,29 @@ ifeq ($(UNITSDIR),)
UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET)) UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
endif endif
PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(FPCDIR)/packages/extra) PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
ifndef FPCFPMAKE
ifdef CROSSCOMPILE
ifeq ($(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR)))),)
FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
ifneq ($(FPCPROG),)
FPCPROG:=$(firstword $(FPCPROG))
FPCFPMAKE:=$(shell $(FPCPROG) -PB)
ifeq ($(strip $(wildcard $(FPCFPMAKE))),)
FPCFPMAKE:=$(firstword $(FPCPROG))
endif
else
override FPCFPMAKE=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
endif
else
FPCFPMAKE=$(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR))))
FPMAKE_SKIP_CONFIG=-n
export FPCFPMAKE
export FPMAKE_SKIP_CONFIG
endif
else
FPCFPMAKE=$(FPC)
endif
endif
ifeq ($(FULL_TARGET),i386-linux) ifeq ($(FULL_TARGET),i386-linux)
override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins
endif endif
@ -375,6 +398,9 @@ endif
ifeq ($(FULL_TARGET),powerpc-embedded) ifeq ($(FULL_TARGET),powerpc-embedded)
override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins
endif endif
ifeq ($(FULL_TARGET),powerpc-wii)
override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins
endif
ifeq ($(FULL_TARGET),sparc-linux) ifeq ($(FULL_TARGET),sparc-linux)
override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins
endif endif
@ -561,6 +587,9 @@ endif
ifeq ($(FULL_TARGET),powerpc-embedded) ifeq ($(FULL_TARGET),powerpc-embedded)
override CLEAN_UNITS+=ppu crc usubst override CLEAN_UNITS+=ppu crc usubst
endif endif
ifeq ($(FULL_TARGET),powerpc-wii)
override CLEAN_UNITS+=ppu crc usubst
endif
ifeq ($(FULL_TARGET),sparc-linux) ifeq ($(FULL_TARGET),sparc-linux)
override CLEAN_UNITS+=ppu crc usubst override CLEAN_UNITS+=ppu crc usubst
endif endif
@ -748,6 +777,9 @@ endif
ifeq ($(FULL_TARGET),powerpc-embedded) ifeq ($(FULL_TARGET),powerpc-embedded)
override COMPILER_UNITDIR+=.. override COMPILER_UNITDIR+=..
endif endif
ifeq ($(FULL_TARGET),powerpc-wii)
override COMPILER_UNITDIR+=..
endif
ifeq ($(FULL_TARGET),sparc-linux) ifeq ($(FULL_TARGET),sparc-linux)
override COMPILER_UNITDIR+=.. override COMPILER_UNITDIR+=..
endif endif
@ -934,6 +966,9 @@ endif
ifeq ($(FULL_TARGET),powerpc-embedded) ifeq ($(FULL_TARGET),powerpc-embedded)
override COMPILER_SOURCEDIR+=.. override COMPILER_SOURCEDIR+=..
endif endif
ifeq ($(FULL_TARGET),powerpc-wii)
override COMPILER_SOURCEDIR+=..
endif
ifeq ($(FULL_TARGET),sparc-linux) ifeq ($(FULL_TARGET),sparc-linux)
override COMPILER_SOURCEDIR+=.. override COMPILER_SOURCEDIR+=..
endif endif
@ -1357,6 +1392,11 @@ ifeq ($(OS_TARGET),NativeNT)
SHAREDLIBEXT=.dll SHAREDLIBEXT=.dll
SHORTSUFFIX=nativent SHORTSUFFIX=nativent
endif endif
ifeq ($(OS_TARGET),wii)
EXEEXT=.dol
SHAREDLIBEXT=.so
SHORTSUFFIX=wii
endif
else else
ifeq ($(OS_TARGET),go32v1) ifeq ($(OS_TARGET),go32v1)
PPUEXT=.pp1 PPUEXT=.pp1
@ -1893,6 +1933,9 @@ endif
ifeq ($(FULL_TARGET),powerpc-embedded) ifeq ($(FULL_TARGET),powerpc-embedded)
REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_RTL=1
endif endif
ifeq ($(FULL_TARGET),powerpc-wii)
REQUIRE_PACKAGES_RTL=1
endif
ifeq ($(FULL_TARGET),sparc-linux) ifeq ($(FULL_TARGET),sparc-linux)
REQUIRE_PACKAGES_RTL=1 REQUIRE_PACKAGES_RTL=1
endif endif
@ -1976,6 +2019,15 @@ UNITDIR_RTL=$(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)
else else
UNITDIR_RTL=$(PACKAGEDIR_RTL) UNITDIR_RTL=$(PACKAGEDIR_RTL)
endif endif
ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(SOURCESUFFIX)),)
UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)/units/$(SOURCESUFFIX)
else
ifneq ($(wildcard $(PACKAGEDIR_RTL)/units_bs/$(SOURCESUFFIX)),)
UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)/units_bs/$(SOURCESUFFIX)
else
UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)
endif
endif
ifdef CHECKDEPEND ifdef CHECKDEPEND
$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE): $(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE):
$(MAKE) -C $(PACKAGEDIR_RTL)/$(OS_TARGET) $(FPCMADE) $(MAKE) -C $(PACKAGEDIR_RTL)/$(OS_TARGET) $(FPCMADE)
@ -1993,6 +2045,9 @@ endif
ifdef UNITDIR_RTL ifdef UNITDIR_RTL
override COMPILER_UNITDIR+=$(UNITDIR_RTL) override COMPILER_UNITDIR+=$(UNITDIR_RTL)
endif endif
ifdef UNITDIR_FPMAKE_RTL
override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_RTL)
endif
endif endif
ifndef NOCPUDEF ifndef NOCPUDEF
override FPCOPTDEF=$(ARCH) override FPCOPTDEF=$(ARCH)
@ -2404,6 +2459,7 @@ fpc_baseinfo:
@$(ECHO) Full Target.. $(FULL_TARGET) @$(ECHO) Full Target.. $(FULL_TARGET)
@$(ECHO) SourceSuffix. $(SOURCESUFFIX) @$(ECHO) SourceSuffix. $(SOURCESUFFIX)
@$(ECHO) TargetSuffix. $(TARGETSUFFIX) @$(ECHO) TargetSuffix. $(TARGETSUFFIX)
@$(ECHO) FPC fpmake... $(FPCFPMAKE)
@$(ECHO) @$(ECHO)
@$(ECHO) == Directory info == @$(ECHO) == Directory info ==
@$(ECHO) @$(ECHO)
@ -2528,7 +2584,7 @@ endif
ppu$(PPUEXT): ppu.pas ppu$(PPUEXT): ppu.pas
ppufiles$(EXEEXT): ppufiles.pp ppu$(PPUEXT) ppufiles$(EXEEXT): ppufiles.pp ppu$(PPUEXT)
ppudump$(EXEEXT): ppudump.pp ppu$(PPUEXT) ppudump$(EXEEXT): ppudump.pp ppu$(PPUEXT)
$(COMPILER) ppudump.pp -Fu../$(CPU_TARGET) -Fi.. $(COMPILER) ppudump.pp -Fu../generic -dGENERIC_CPU -Fi..
ppumove$(EXEEXT): ppumove.pp ppu$(PPUEXT) ppumove$(EXEEXT): ppumove.pp ppu$(PPUEXT)
msg2inc$(EXEEXT): $(COMPILER_UNITTARGETDIR) msg2inc.pp msg2inc$(EXEEXT): $(COMPILER_UNITTARGETDIR) msg2inc.pp
fpcsubst$(EXEEXT): fpcsubst.pp usubst.pp fpcsubst$(EXEEXT): fpcsubst.pp usubst.pp

2
compiler/utils/Makefile.fpc
View File

@ -40,7 +40,7 @@ ppufiles$(EXEEXT): ppufiles.pp ppu$(PPUEXT)
ppudump$(EXEEXT): ppudump.pp ppu$(PPUEXT) ppudump$(EXEEXT): ppudump.pp ppu$(PPUEXT)
$(COMPILER) ppudump.pp -Fu../$(CPU_TARGET) -Fi.. $(COMPILER) ppudump.pp -Fu../generic -dGENERIC_CPU -Fi..
ppumove$(EXEEXT): ppumove.pp ppu$(PPUEXT) ppumove$(EXEEXT): ppumove.pp ppu$(PPUEXT)

584
compiler/utils/ppudump.pp
View File

@ -25,10 +25,13 @@ program ppudump;
uses uses
{ do NOT add symconst or globtype to make merging easier } { do NOT add symconst or globtype to make merging easier }
{ do include symconst and globtype now before splitting 2.5 PM 2011-06-15 }
SysUtils, SysUtils,
constexp, constexp,
symconst,
ppu, ppu,
globals, globals,
globtype,
tokens; tokens;
const const
@ -46,164 +49,31 @@ const
// v_browser = $20; // v_browser = $20;
v_all = $ff; v_all = $ff;
type {$i systems.inc }
tprocinfoflag=(
{ procedure has at least one assembler block }
pi_has_assembler_block,
{ procedure does a call }
pi_do_call,
{ procedure has a try statement = no register optimization }
pi_uses_exceptions,
{ procedure is declared as @var(assembler), don't optimize}
pi_is_assembler,
{ procedure contains data which needs to be finalized }
pi_needs_implicit_finally,
{ procedure has the implicit try..finally generated }
pi_has_implicit_finally,
{ procedure uses fpu}
pi_uses_fpu,
{ procedure uses GOT for PIC code }
pi_needs_got,
{ references var/proc/type/const in static symtable,
i.e. not allowed for inlining from other units }
pi_uses_static_symtable,
{ set if the procedure has to push parameters onto the stack }
pi_has_stackparameter,
{ set if the procedure has at least one got }
pi_has_label,
{ calls itself recursive }
pi_is_recursive,
{ stack frame optimization not possible (only on x86 probably) }
pi_needs_stackframe,
{ set if the procedure has at least one register saved on the stack }
pi_has_saved_regs,
{ dfa was generated for this proc }
pi_dfaavailable
);
tprocinfoflags=set of tprocinfoflag;
tspecialgenerictoken = (ST_LOADSETTINGS,ST_LINE,ST_COLUMN,ST_FILEINDEX); { List of all supported cpus }
{ Copied from systems.pas }
tsystemcpu=
(
cpu_no, { 0 }
cpu_i386, { 1 }
cpu_m68k, { 2 }
cpu_alpha, { 3 }
cpu_powerpc, { 4 }
cpu_sparc, { 5 }
cpu_vm, { 6 }
cpu_iA64, { 7 }
cpu_x86_64, { 8 }
cpu_mips, { 9 }
cpu_arm, { 10 }
cpu_powerpc64, { 11 }
cpu_avr { 12 }
);
var
ppufile : tppufile;
space : string;
verbose : longint;
derefdata : pbyte;
derefdatalen : longint;
{****************************************************************************
Helper Routines
****************************************************************************}
const has_errors : boolean = false;
Procedure Error(const S : string);
Begin
Writeln(S);
has_errors:=true;
End;
function ToStr(w:longint):String;
begin
Str(w,ToStr);
end;
Function Target2Str(w:longint):string;
type
{ taken from systems.pas }
ttarget =
(
target_none, { 0 }
obsolete_target_i386_GO32V1,{ 1 }
target_i386_GO32V2, { 2 }
target_i386_linux, { 3 }
target_i386_OS2, { 4 }
target_i386_Win32, { 5 }
target_i386_freebsd, { 6 }
target_m68k_Amiga, { 7 }
target_m68k_Atari, { 8 }
target_m68k_Mac, { 9 }
target_m68k_linux, { 10 }
target_m68k_PalmOS, { 11 }
target_alpha_linux, { 12 }
target_powerpc_linux, { 13 }
target_powerpc_macos, { 14 }
target_i386_solaris, { 15 }
target_i386_beos, { 16 }
target_i386_netbsd, { 17 }
target_m68k_netbsd, { 18 }
target_i386_Netware, { 19 }
target_i386_qnx, { 20 }
target_i386_wdosx, { 21 }
target_sparc_solaris, { 22 }
target_sparc_linux, { 23 }
target_i386_openbsd, { 24 }
target_m68k_openbsd, { 25 }
target_x86_64_linux, { 26 }
target_powerpc_darwin, { 27 }
target_i386_emx, { 28 }
target_powerpc_netbsd, { 29 }
target_powerpc_openbsd, { 30 }
target_arm_linux, { 31 }
target_i386_watcom, { 32 }
target_powerpc_MorphOS, { 33 }
target_x86_64_freebsd, { 34 }
target_i386_netwlibc, { 35 }
target_powerpc_Amiga, { 36 }
target_x86_64_win64, { 37 }
target_arm_wince, { 38 }
target_ia64_win64, { 39 }
target_i386_wince, { 40 }
target_x86_6432_linux, { 41 }
target_arm_gba, { 42 }
target_powerpc64_linux, { 43 }
target_i386_darwin, { 44 }
target_arm_palmos, { 45 }
target_powerpc64_darwin, { 46 }
target_arm_nds, { 47 }
target_i386_embedded, { 48 }
target_m68k_embedded, { 49 }
target_alpha_embedded, { 50 }
target_powerpc_embedded, { 51 }
target_sparc_embedded, { 52 }
target_vm_embedded, { 53 }
target_iA64_embedded, { 54 }
target_x86_64_embedded, { 55 }
target_mips_embedded, { 56 }
target_arm_embedded, { 57 }
target_powerpc64_embedded, { 58 }
target_i386_symbian, { 59 }
target_arm_symbian, { 60 }
target_x86_64_darwin, { 61 }
target_avr_embedded, { 62 }
target_i386_haiku, { 63 }
target_arm_darwin, { 64 }
target_x86_64_solaris, { 65 }
target_mips_linux, { 66 }
target_mipsel_linux, { 67 }
target_i386_nativent, { 68 }
target_i386_iphonesim { 69 }
);
const const
Targets : array[ttarget] of string[18]=( CpuTxt : array[tsystemcpu] of string[9]=
(
{ 0 } 'none',
{ 1 } 'i386',
{ 2 } 'm68k',
{ 3 } 'alpha',
{ 4 } 'powerpc',
{ 5 } 'sparc',
{ 6 } 'vis',
{ 7 } 'ia64',
{ 8 } 'x86_64',
{ 9 } 'mips',
{ 10 } 'arm',
{ 11 } 'powerpc64',
{ 12 } 'avr',
{ 13 } 'mipsel'
);
{ List of all supported system-cpu couples }
const
Targets : array[tsystem] of string[18]=(
{ 0 } 'none', { 0 } 'none',
{ 1 } 'GO32V1 (obsolete)', { 1 } 'GO32V1 (obsolete)',
{ 2 } 'GO32V2', { 2 } 'GO32V2',
@ -273,21 +143,49 @@ const
{ 66 } 'Linux-MIPS', { 66 } 'Linux-MIPS',
{ 67 } 'Linux-MIPSel', { 67 } 'Linux-MIPSel',
{ 68 } 'NativeNT-i386', { 68 } 'NativeNT-i386',
{ 69 } 'iPhoneSim-i386' { 69 } 'iPhoneSim-i386',
{ 70 } 'Wii-powerpc'
); );
type
tspecialgenerictoken = (ST_LOADSETTINGS,ST_LINE,ST_COLUMN,ST_FILEINDEX);
var
ppufile : tppufile;
space : string;
verbose : longint;
derefdata : pbyte;
derefdatalen : longint;
{****************************************************************************
Helper Routines
****************************************************************************}
const has_errors : boolean = false;
Procedure Error(const S : string);
Begin
Writeln(S);
has_errors:=true;
End;
function ToStr(w:longint):String;
begin begin
if w<=ord(high(ttarget)) then Str(w,ToStr);
Target2Str:=Targets[ttarget(w)] end;
Function Target2Str(w:longint):string;
begin
if w<=ord(high(tsystem)) then
Target2Str:=Targets[tsystem(w)]
else else
Target2Str:='<!! Unknown target value '+tostr(w)+'>'; Target2Str:='<!! Unknown target value '+tostr(w)+'>';
end; end;
Function Cpu2Str(w:longint):string; Function Cpu2Str(w:longint):string;
const
CpuTxt : array[tsystemcpu] of string[9]=
('none','i386','m68k','alpha','powerpc','sparc','vis','ia64',
'x86_64','mips','arm','powerpc64','avr');
begin begin
if w<=ord(high(tsystemcpu)) then if w<=ord(high(tsystemcpu)) then
Cpu2Str:=CpuTxt[tsystemcpu(w)] Cpu2Str:=CpuTxt[tsystemcpu(w)]
@ -298,20 +196,23 @@ end;
Function Varspez2Str(w:longint):string; Function Varspez2Str(w:longint):string;
const const
varspezstr : array[0..4] of string[6]=('Value','Const','Var','Out','Hidden'); { in symconst unit
tvarspez = (vs_value,vs_const,vs_var,vs_out,vs_constref); }
varspezstr : array[tvarspez] of string[6]=('Value','Const','Var','Out','Hidden');
begin begin
if w<=ord(high(varspezstr)) then if w<=ord(high(varspezstr)) then
Varspez2Str:=varspezstr[w] Varspez2Str:=varspezstr[tvarspez(w)]
else else
Varspez2Str:='<!! Unknown varspez value '+tostr(w)+'>'; Varspez2Str:='<!! Unknown varspez value '+tostr(w)+'>';
end; end;
Function VarRegable2Str(w:longint):string; Function VarRegable2Str(w:longint):string;
{ tvarregable type is defined in symconst unit }
const const
varregableStr : array[0..4] of string[6]=('None','IntReg','FPUReg','MMReg','Addr'); varregableStr : array[tvarregable] of string[6]=('None','IntReg','FPUReg','MMReg','Addr');
begin begin
if w<=ord(high(varregablestr)) then if w<=ord(high(varregablestr)) then
Varregable2Str:=varregablestr[w] Varregable2Str:=varregablestr[tvarregable(w)]
else else
Varregable2Str:='<!! Unknown regable value '+tostr(w)+'>'; Varregable2Str:='<!! Unknown regable value '+tostr(w)+'>';
end; end;
@ -319,13 +220,15 @@ end;
Function Visibility2Str(w:longint):string; Function Visibility2Str(w:longint):string;
const const
visibilityName : array[0..6] of string[16] = ( { tvisibility type is defined in symconst unit }
visibilityName : array[tvisibility] of string[16] = (
'hidden','strict private','private','strict protected','protected', 'hidden','strict private','private','strict protected','protected',
'public','published' 'public','published'
); );
begin begin
if w<=ord(high(visibilityName)) then if w<=ord(high(visibilityName)) then
result:=visibilityName[w] result:=visibilityName[tvisibility(w)]
else else
result:='<!! Unknown visibility value '+tostr(w)+'>'; result:='<!! Unknown visibility value '+tostr(w)+'>';
end; end;
@ -434,16 +337,12 @@ end;
procedure readsymtableoptions(const s: string); procedure readsymtableoptions(const s: string);
type type
tsymtableoption = (
sto_has_helper { contains at least one helper symbol }
);
tsymtableoptions = set of tsymtableoption;
tsymtblopt=record tsymtblopt=record
mask : tsymtableoption; mask : tsymtableoption;
str : string[30]; str : string[30];
end; end;
const const
symtblopts=1; symtblopts=ord(high(tsymtableoption)) + 1;
symtblopt : array[1..symtblopts] of tsymtblopt=( symtblopt : array[1..symtblopts] of tsymtblopt=(
(mask:sto_has_helper; str:'Has helper') (mask:sto_has_helper; str:'Has helper')
); );
@ -482,13 +381,13 @@ Procedure ReadLinkContainer(const prefix:string);
with prefix with prefix
} }
function maskstr(m:longint):string; function maskstr(m:longint):string;
{ link options are in globtype unit
const const
{ link options }
link_none = $0; link_none = $0;
link_always = $1; link_always = $1;
link_static = $2; link_static = $2;
link_smart = $4; link_smart = $4;
link_shared = $8; link_shared = $8; }
var var
s : string; s : string;
begin begin
@ -602,8 +501,20 @@ end;
Procedure ReadAsmSymbols; Procedure ReadAsmSymbols;
type type
{ Copied from aasmbase.pas } { Copied from aasmbase.pas }
TAsmsymbind=(AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL); TAsmsymbind=(
TAsmsymtype=(AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION,AT_LABEL); AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL,AB_WEAK_EXTERNAL,
{ global in the current program/library, but not visible outside it }
AB_PRIVATE_EXTERN,AB_LAZY,AB_IMPORT);
TAsmsymtype=(
AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION,AT_LABEL,
{
the address of this code label is taken somewhere in the code
so it must be taken care of it when creating pic
}
AT_ADDR
);
var var
s, s,
bindstr, bindstr,
@ -624,6 +535,14 @@ begin
bindstr:='Local'; bindstr:='Local';
AB_GLOBAL : AB_GLOBAL :
bindstr:='Global'; bindstr:='Global';
AB_WEAK_EXTERNAL :
bindstr:='Weak external';
AB_PRIVATE_EXTERN :
bindstr:='Private extern';
AB_LAZY :
bindstr:='Lazy';
AB_IMPORT :
bindstr:='Import';
else else
bindstr:='<Error !!>' bindstr:='<Error !!>'
end; end;
@ -636,6 +555,8 @@ begin
typestr:='Section'; typestr:='Section';
AT_LABEL : AT_LABEL :
typestr:='Label'; typestr:='Label';
AT_ADDR :
typestr:='Label (with address taken)';
else else
typestr:='<Error !!>' typestr:='<Error !!>'
end; end;
@ -763,17 +684,10 @@ end;
procedure readpropaccesslist(const s:string); procedure readpropaccesslist(const s:string);
type { type tsltype is in symconst unit }
tsltype = (sl_none,
sl_load,
sl_call,
sl_subscript,
sl_vec,
sl_typeconv,
sl_absolutetype
);
const const
slstr : array[tsltype] of string[12] = ('', slstr : array[tsltype] of string[12] = (
'',
'load', 'load',
'call', 'call',
'subscript', 'subscript',
@ -810,27 +724,13 @@ end;
procedure readsymoptions(space : string); procedure readsymoptions(space : string);
type type
{ symbol options }
tsymoption=(sp_none,
sp_static,
sp_hint_deprecated,
sp_hint_platform,
sp_hint_library,
sp_hint_unimplemented,
sp_hint_experimental,
sp_has_overloaded,
sp_internal, { internal symbol, not reported as unused }
sp_implicitrename,
sp_generic_para,
sp_has_deprecated_msg
);
tsymoptions=set of tsymoption;
tsymopt=record tsymopt=record
mask : tsymoption; mask : tsymoption;
str : string[30]; str : string[30];
end; end;
const const
symopts=11; symopts=ord(high(tsymoption)) - ord(low(tsymoption));
{ sp_none = 0 corresponds to nothing }
symopt : array[1..symopts] of tsymopt=( symopt : array[1..symopts] of tsymopt=(
(mask:sp_static; str:'Static'), (mask:sp_static; str:'Static'),
(mask:sp_hint_deprecated; str:'Hint Deprecated'), (mask:sp_hint_deprecated; str:'Hint Deprecated'),
@ -882,47 +782,6 @@ end;
type
{ flags for a definition }
tdefoption=(df_none,
{ type is unique, i.e. declared with type = type <tdef>; }
df_unique,
{ type is a generic }
df_generic,
{ type is a specialization of a generic type }
df_specialization,
{ def has been copied from another def so symtable is not owned }
df_copied_def
);
tdefoptions=set of tdefoption;
tobjectoption=(oo_none,
oo_is_forward, { the class is only a forward declared yet }
oo_is_abstract, { the class is abstract - only descendants can be used }
oo_is_sealed, { the class is sealed - can't have descendants }
oo_has_virtual, { the object/class has virtual methods }
oo_has_private,
oo_has_protected,
oo_has_strictprivate,
oo_has_strictprotected,
oo_has_constructor, { the object/class has a constructor }
oo_has_destructor, { the object/class has a destructor }
oo_has_vmt, { the object/class has a vmt }
oo_has_msgstr,
oo_has_msgint,
oo_can_have_published,{ the class has rtti, i.e. you can publish properties }
oo_has_default_property,
oo_has_valid_guid,
oo_has_enumerator_movenext,
oo_has_enumerator_current,
oo_is_external, { the class is externally implemented (objcclass, cppclass) }
oo_is_anonymous, { the class is only formally defined in this module (objcclass x = class; external;) }
oo_is_classhelper, { objcclasses that represent categories, and Delpi-style class helpers, are marked like this }
oo_has_class_constructor, { the object/class has a class constructor }
oo_has_class_destructor { the object/class has a class destructor }
);
tobjectoptions=set of tobjectoption;
var var
{ needed during tobjectdef parsing... } { needed during tobjectdef parsing... }
current_defoptions : tdefoptions; current_defoptions : tdefoptions;
@ -930,16 +789,6 @@ var
procedure readcommondef(const s:string; out defoptions: tdefoptions); procedure readcommondef(const s:string; out defoptions: tdefoptions);
type type
tdefstate=(ds_none,
ds_vmt_written,
ds_rtti_table_used,
ds_init_table_used,
ds_rtti_table_written,
ds_init_table_written,
ds_dwarf_dbg_info_used,
ds_dwarf_dbg_info_written
);
tdefstates=set of tdefstate;
tdefopt=record tdefopt=record
mask : tdefoption; mask : tdefoption;
str : string[30]; str : string[30];
@ -1150,122 +999,9 @@ end;
{ Read abstract procdef and return if inline procdef } { Read abstract procdef and return if inline procdef }
type { type tproccalloption is in globtype unit }
tproccalloption=(pocall_none, { type tproctypeoption is in globtype unit }
{ procedure uses C styled calling } { type tprocoption is in globtype unit }
pocall_cdecl,
{ C++ calling conventions }
pocall_cppdecl,
{ Far16 for OS/2 }
pocall_far16,
{ Old style FPC default calling }
pocall_oldfpccall,
{ Procedure has compiler magic}
pocall_internproc,
{ procedure is a system call, applies e.g. to MorphOS and PalmOS }
pocall_syscall,
{ pascal standard left to right }
pocall_pascal,
{ procedure uses register (fastcall) calling }
pocall_register,
{ safe call calling conventions }
pocall_safecall,
{ procedure uses stdcall call }
pocall_stdcall,
{ Special calling convention for cpus without a floating point
unit. Floating point numbers are passed in integer registers
instead of floating point registers. Depending on the other
available calling conventions available for the cpu
this replaces either pocall_fastcall or pocall_stdcall.
}
pocall_softfloat,
{ Metrowerks Pascal. Special case on Mac OS (X): passes all }
{ constant records by reference. }
pocall_mwpascal
);
tproccalloptions = set of tproccalloption;
tproctypeoption=(potype_none,
potype_proginit, { Program initialization }
potype_unitinit, { unit initialization }
potype_unitfinalize, { unit finalization }
potype_constructor, { Procedure is a constructor }
potype_destructor, { Procedure is a destructor }
potype_operator, { Procedure defines an operator }
potype_procedure,
potype_function,
potype_class_constructor, { class constructor }
potype_class_destructor { class destructor }
);
tproctypeoptions=set of tproctypeoption;
tprocoption=(po_none,
po_classmethod, { class method }
po_virtualmethod, { Procedure is a virtual method }
po_abstractmethod, { Procedure is an abstract method }
po_finalmethod, { Procedure is a final method }
po_staticmethod, { static method }
po_overridingmethod, { method with override directive }
po_methodpointer, { method pointer, only in procvardef, also used for 'with object do' }
po_interrupt, { Procedure is an interrupt handler }
po_iocheck, { IO checking should be done after a call to the procedure }
po_assembler, { Procedure is written in assembler }
po_msgstr, { method for string message handling }
po_msgint, { method for int message handling }
po_exports, { Procedure has export directive (needed for OS/2) }
po_external, { Procedure is external (in other object or lib)}
po_overload, { procedure is declared with overload directive }
po_varargs, { printf like arguments }
po_internconst, { procedure has constant evaluator intern }
{ flag that only the address of a method is returned and not a full methodpointer }
po_addressonly,
{ procedure is exported }
po_public,
{ calling convention is specified explicitly }
po_hascallingconvention,
{ reintroduce flag }
po_reintroduce,
{ location of parameters is given explicitly as it is necessary for some syscall
conventions like that one of MorphOS }
po_explicitparaloc,
{ no stackframe will be generated, used by lowlevel assembler like get_frame }
po_nostackframe,
po_has_mangledname,
po_has_public_name,
po_forward,
po_global,
po_has_inlininginfo,
{ The different kind of syscalls on MorphOS }
po_syscall_legacy,
po_syscall_sysv,
po_syscall_basesysv,
po_syscall_sysvbase,
po_syscall_r12base,
{ Procedure can be inlined }
po_inline,
{ Procedure is used for internal compiler calls }
po_compilerproc,
{ importing }
po_has_importdll,
po_has_importname,
po_kylixlocal,
po_dispid,
{ weakly linked (i.e., may or may not exist at run time) }
po_weakexternal,
{ Objective-C method }
po_objc,
{ enumerator support }
po_enumerator_movenext,
{ optional Objective-C protocol method }
po_optional,
{ nested procedure that uses Delphi-style calling convention for passing
the frame pointer (pushed on the stack, always the last parameter,
removed by the caller). Required for nested procvar compatibility,
because such procvars can hold both regular and nested procedures
(when calling a regular procedure using the above convention, it will
simply not see the frame pointer parameter, and since the caller cleans
up the stack will also remain balanced) }
po_delphi_nested_cc
);
tprocoptions=set of tprocoption;
procedure read_abstract_proc_def(var proccalloption:tproccalloption;var procoptions:tprocoptions); procedure read_abstract_proc_def(var proccalloption:tproccalloption;var procoptions:tprocoptions);
type type
@ -1282,20 +1018,7 @@ type
str : string[30]; str : string[30];
end; end;
const const
proccalloptionStr : array[tproccalloption] of string[14]=('', {proccalloptionStr is also in globtype unit }
'CDecl',
'CPPDecl',
'Far16',
'OldFPCCall',
'InternProc',
'SysCall',
'Pascal',
'Register',
'SafeCall',
'StdCall',
'SoftFloat',
'MWPascal'
);
proctypeopt : array[1..ord(high(tproctypeoption))] of tproctypeopt=( proctypeopt : array[1..ord(high(tproctypeoption))] of tproctypeopt=(
(mask:potype_proginit; str:'ProgInit'), (mask:potype_proginit; str:'ProgInit'),
(mask:potype_unitinit; str:'UnitInit'), (mask:potype_unitinit; str:'UnitInit'),
@ -1306,7 +1029,10 @@ const
(mask:potype_procedure; str:'Procedure'), (mask:potype_procedure; str:'Procedure'),
(mask:potype_function; str:'Function'), (mask:potype_function; str:'Function'),
(mask:potype_class_constructor; str:'Class Constructor'), (mask:potype_class_constructor; str:'Class Constructor'),
(mask:potype_class_destructor; str:'Class Destructor') (mask:potype_class_destructor; str:'Class Destructor'),
{ Dispinterface property accessors }
(mask:potype_propgetter; str:'Property Getter'),
(mask:potype_propsetter; str:'Property Setter')
); );
procopt : array[1..ord(high(tprocoption))] of tprocopt=( procopt : array[1..ord(high(tprocoption))] of tprocopt=(
(mask:po_classmethod; str:'ClassMethod'), (mask:po_classmethod; str:'ClassMethod'),
@ -1402,43 +1128,9 @@ begin
end; end;
type { type tvaroption is in unit symconst }
tvaroption=(vo_none,
vo_is_external,
vo_is_dll_var,
vo_is_thread_var,
vo_has_local_copy,
vo_is_const, { variable is declared as const (parameter) and can't be written to }
vo_is_public,
vo_is_high_para,
vo_is_funcret,
vo_is_self,
vo_is_vmt,
vo_is_result, { special result variable }
vo_is_parentfp,
vo_is_loop_counter, { used to detect assignments to loop counter }
vo_is_hidden_para,
vo_has_explicit_paraloc,
vo_is_syscall_lib,
vo_has_mangledname,
vo_is_typed_const,
vo_is_range_check,
vo_is_overflow_check,
vo_is_typinfo_para,
vo_is_weak_external,
vo_is_msgsel,
vo_is_first_field
);
tvaroptions=set of tvaroption;
{ register variable } { register variable }
tvarregable=(vr_none, { type tvarregable is in unit symconst }
vr_intreg,
vr_fpureg,
vr_mmreg,
{ does not mean "needs address register", but "if it's a parameter which is }
{ passed by reference, then its address can be put in a register }
vr_addr
);
procedure readabstractvarsym(const s:string;var varoptions:tvaroptions); procedure readabstractvarsym(const s:string;var varoptions:tvaroptions);
type type
tvaropt=record tvaropt=record
@ -1470,7 +1162,9 @@ const
(mask:vo_is_typinfo_para; str:'TypeInfo'), (mask:vo_is_typinfo_para; str:'TypeInfo'),
(mask:vo_is_msgsel;str:'MsgSel'), (mask:vo_is_msgsel;str:'MsgSel'),
(mask:vo_is_weak_external;str:'WeakExternal'), (mask:vo_is_weak_external;str:'WeakExternal'),
(mask:vo_is_first_field;str:'IsFirstField') (mask:vo_is_first_field;str:'IsFirstField'),
(mask:vo_volatile;str:'Volatile'),
(mask:vo_has_section;str:'HasSection')
); );
var var
i : longint; i : longint;
@ -1495,6 +1189,8 @@ begin
else else
write(', '); write(', ');
write(varopt[i].str); write(varopt[i].str);
if varopt[i].mask = vo_has_section then
writeln('Section name:',ppufile.getansistring);
end; end;
writeln; writeln;
end; end;
@ -1528,7 +1224,7 @@ const
(mask:oo_has_enumerator_movenext; str:'HasEnumeratorMoveNext'), (mask:oo_has_enumerator_movenext; str:'HasEnumeratorMoveNext'),
(mask:oo_has_enumerator_current; str:'HasEnumeratorCurrent'), (mask:oo_has_enumerator_current; str:'HasEnumeratorCurrent'),
(mask:oo_is_external; str:'External'), (mask:oo_is_external; str:'External'),
(mask:oo_is_anonymous; str:'Anonymous'), (mask:oo_is_formal; str:'Formal'),
(mask:oo_is_classhelper; str:'Class Helper/Category'), (mask:oo_is_classhelper; str:'Class Helper/Category'),
(mask:oo_has_class_constructor; str:'HasClassConstructor'), (mask:oo_has_class_constructor; str:'HasClassConstructor'),
(mask:oo_has_class_destructor; str:'HasClassDestructor') (mask:oo_has_class_destructor; str:'HasClassDestructor')
@ -1556,18 +1252,8 @@ end;
procedure readarraydefoptions; procedure readarraydefoptions;
{ type tarraydefoption is in unit symconst }
type type
tarraydefoption=(ado_none,
ado_IsConvertedPointer,
ado_IsDynamicArray,
ado_IsVariant,
ado_IsConstructor,
ado_IsArrayOfConst,
ado_IsConstString,
ado_IsBitPacked
);
tarraydefoptions=set of tarraydefoption;
tsymopt=record tsymopt=record
mask : tarraydefoption; mask : tarraydefoption;
str : string[30]; str : string[30];
@ -1958,30 +1644,17 @@ end;
****************************************************************************} ****************************************************************************}
procedure readdefinitions(const s:string); procedure readdefinitions(const s:string);
type { type tordtype is in symconst unit }
tordtype = ( {
uvoid, uvoid,
u8bit,u16bit,u32bit,u64bit, u8bit,u16bit,u32bit,u64bit,
s8bit,s16bit,s32bit,s64bit, s8bit,s16bit,s32bit,s64bit,
bool8bit,bool16bit,bool32bit,bool64bit, bool8bit,bool16bit,bool32bit,bool64bit,
uchar,uwidechar,scurrency uchar,uwidechar,scurrency
); ); }
tobjecttyp = (odt_none,
odt_class, { type tobjecttyp is in symconst unit }
odt_object, { type tvarianttype is in symconst unit }
odt_interfacecom,
odt_interfacecom_property,
odt_interfacecom_function,
odt_interfacecorba,
odt_cppclass,
odt_dispinterface,
odt_objcclass,
odt_objcprotocol,
odt_helper
);
tvarianttype = (
vt_normalvariant,vt_olevariant
);
var var
b : byte; b : byte;
l,j : longint; l,j : longint;
@ -2377,6 +2050,7 @@ end;
procedure readmoduleoptions(space : string); procedure readmoduleoptions(space : string);
type type
{ tmoduleoption type is in unit fmodule }
tmoduleoption = (mo_none, tmoduleoption = (mo_none,
mo_hint_deprecated, mo_hint_deprecated,
mo_hint_platform, mo_hint_platform,
@ -2391,7 +2065,7 @@ type
str : string[30]; str : string[30];
end; end;
const const
moduleopts=6; moduleopts=ord(high(tmoduleoption));
moduleopt : array[1..moduleopts] of tmoduleopt=( moduleopt : array[1..moduleopts] of tmoduleopt=(
(mask:mo_hint_deprecated; str:'Hint Deprecated'), (mask:mo_hint_deprecated; str:'Hint Deprecated'),
(mask:mo_hint_platform; str:'Hint Platform'), (mask:mo_hint_platform; str:'Hint Platform'),