diff options
| author | florian <florian@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2005-11-09 10:41:50 +0000 |
|---|---|---|
| committer | florian <florian@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2005-11-09 10:41:50 +0000 |
| commit | d55f21e776cf6b1656975e9a11edf3be9aacab40 (patch) | |
| tree | 20dd674b9d2e8f723f5c887ad9a0a745530ee7ef | |
| parent | 115da97dbdfd46b1255d308084deee3c7cd4bd13 (diff) | |
| parent | bc35d85d93058c2a63d9a5b2d12b02025d416191 (diff) | |
| download | fpc-d55f21e776cf6b1656975e9a11edf3be9aacab40.tar.gz | |
+ 2.0.2 release tag
git-svn-id: http://svn.freepascal.org/svn/fpc/tags/release_2_0_2@1702 3ad0048d-3df7-0310-abae-a5850022a9f2
613 files changed, 14266 insertions, 71279 deletions
@@ -231,7 +231,7 @@ UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET)) endif PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra) override PACKAGE_NAME=fpc -override PACKAGE_VERSION=2.1.1 +override PACKAGE_VERSION=2.0.1 ifndef inOS2 override FPCDIR:=$(BASEDIR) export FPCDIR @@ -255,9 +255,6 @@ endif ifeq ($(CPU_TARGET),powerpc) PPSUF=ppc endif -ifeq ($(CPU_TARGET),powerpc64) -PPSUF=ppc64 -endif ifeq ($(CPU_TARGET),alpha) PPSUF=axp endif diff --git a/Makefile.fpc b/Makefile.fpc index fa96b4da80..09b7d988f7 100644 --- a/Makefile.fpc +++ b/Makefile.fpc @@ -4,7 +4,7 @@ [package] name=fpc -version=2.1.1 +version=2.0.1 [target] dirs=compiler rtl utils fcl fv packages ide installer @@ -48,9 +48,6 @@ endif ifeq ($(CPU_TARGET),powerpc) PPSUF=ppc endif -ifeq ($(CPU_TARGET),powerpc64) -PPSUF=ppc64 -endif ifeq ($(CPU_TARGET),alpha) PPSUF=axp endif diff --git a/compiler/Makefile b/compiler/Makefile index b889d23a61..820b22f0ed 100644 --- a/compiler/Makefile +++ b/compiler/Makefile @@ -233,17 +233,13 @@ PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/ext override PACKAGE_NAME=compiler override PACKAGE_VERSION=2.0.0 unexport FPC_VERSION FPC_COMPILERINFO -CYCLETARGETS=i386 powerpc sparc arm x86_64 powerpc64 -ALLTARGETS=$(CYCLETARGETS) m68k +CYCLETARGETS=i386 powerpc sparc arm x86_64 ifdef ALPHA PPC_TARGET=alpha endif ifdef POWERPC PPC_TARGET=powerpc endif -ifdef POWERPC64 -PPC_TARGET=powerpc64 -endif ifdef SPARC PPC_TARGET=sparc endif @@ -292,9 +288,6 @@ endif ifeq ($(PPC_TARGET),powerpc) CPUSUF=ppc endif -ifeq ($(PPC_TARGET),powerpc64) -CPUSUF=ppc64 -endif ifeq ($(PPC_TARGET),sparc) CPUSUF=sparc endif @@ -2648,14 +2641,14 @@ tempclean: -$(DEL) $(PPCROSSNAME) $(TEMPNAME) $(TEMPNAME1) $(TEMPNAME2) $(TEMPNAME3) $(MSG2INC) execlean : -$(DEL) ppc386$(EXEEXT) ppcaxp$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) $(EXENAME) -$(addsuffix _clean,$(ALLTARGETS)): +$(addsuffix _clean,$(CYCLETARGETS)): -$(DELTREE) $(addprefix $(subst _clean,,$@),/units) -$(DEL) $(addprefix $(subst _clean,,$@)/,*$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)) -$(DEL) $(addprefix $(subst _clean,,$@)/,ppc386$(EXEEXT) ppcaxp$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcppc$(EXEEXT) $(EXENAME)) cycleclean: cleanall $(addsuffix _clean,$(PPC_TARGET)) -$(DEL) $(EXENAME) clean: tempclean execlean cleanall $(addsuffix _clean,$(PPC_TARGET)) $(addsuffix _clean,$(TARGET_DIRS)) -distclean: tempclean execlean cleanall $(addsuffix _clean,$(ALLTARGETS)) $(addsuffix _distclean,$(TARGET_DIRS)) +distclean: tempclean execlean cleanall $(addsuffix _clean,$(CYCLETARGETS)) $(addsuffix _distclean,$(TARGET_DIRS)) $(MSG2INC): $(COMPILER_TARGETDIR) $(COMPILER_UNITTARGETDIR) $(COMPILERUTILSDIR)/msg2inc.pp $(COMPILER) -FE. $(COMPILERUTILSDIR)/msg2inc.pp msgtxt.inc: $(MSGFILE) diff --git a/compiler/Makefile.fpc b/compiler/Makefile.fpc index b9fd07e240..edb5d2cddc 100644 --- a/compiler/Makefile.fpc +++ b/compiler/Makefile.fpc @@ -32,21 +32,15 @@ fpcdir=.. unexport FPC_VERSION FPC_COMPILERINFO # Which platforms are ready for inclusion in the cycle -CYCLETARGETS=i386 powerpc sparc arm x86_64 powerpc64 +CYCLETARGETS=i386 powerpc sparc arm x86_64 -# All supported targets used for clean -ALLTARGETS=$(CYCLETARGETS) m68k - -# Allow ALPHA, POWERPC, POWERPC64, M68K, I386 defines for target cpu +# Allow ALPHA, POWERPC, M68K, I386 defines for target cpu ifdef ALPHA PPC_TARGET=alpha endif ifdef POWERPC PPC_TARGET=powerpc endif -ifdef POWERPC64 -PPC_TARGET=powerpc64 -endif ifdef SPARC PPC_TARGET=sparc endif @@ -121,9 +115,6 @@ endif ifeq ($(PPC_TARGET),powerpc) CPUSUF=ppc endif -ifeq ($(PPC_TARGET),powerpc64) -CPUSUF=ppc64 -endif ifeq ($(PPC_TARGET),sparc) CPUSUF=sparc endif @@ -303,7 +294,7 @@ tempclean: execlean : -$(DEL) ppc386$(EXEEXT) ppcaxp$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) $(EXENAME) -$(addsuffix _clean,$(ALLTARGETS)): +$(addsuffix _clean,$(CYCLETARGETS)): -$(DELTREE) $(addprefix $(subst _clean,,$@),/units) -$(DEL) $(addprefix $(subst _clean,,$@)/,*$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)) -$(DEL) $(addprefix $(subst _clean,,$@)/,ppc386$(EXEEXT) ppcaxp$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcppc$(EXEEXT) $(EXENAME)) @@ -313,7 +304,7 @@ cycleclean: cleanall $(addsuffix _clean,$(PPC_TARGET)) clean: tempclean execlean cleanall $(addsuffix _clean,$(PPC_TARGET)) $(addsuffix _clean,$(TARGET_DIRS)) -distclean: tempclean execlean cleanall $(addsuffix _clean,$(ALLTARGETS)) $(addsuffix _distclean,$(TARGET_DIRS)) +distclean: tempclean execlean cleanall $(addsuffix _clean,$(CYCLETARGETS)) $(addsuffix _distclean,$(TARGET_DIRS)) ##################################################################### diff --git a/compiler/aasmbase.pas b/compiler/aasmbase.pas index 26fd21a6e8..d9c0f88442 100644 --- a/compiler/aasmbase.pas +++ b/compiler/aasmbase.pas @@ -42,15 +42,14 @@ interface TAsmsymbind=(AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL); - TAsmsymtype=(AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION,AT_LABEL); + TAsmsymtype=(AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION); TAsmRelocationType = (RELOC_ABSOLUTE,RELOC_RELATIVE,RELOC_RVA); TAsmSectionType=(sec_none, - sec_code,sec_data,sec_rodata,sec_bss,sec_threadvar, + sec_code,sec_data,sec_rodata,sec_bss, sec_common, { used for executable creation } sec_custom, { custom section, no prefix } - sec_stub, { used for darwin import stubs } { stabs } sec_stab,sec_stabstr, { win32 } @@ -98,17 +97,16 @@ interface procedure setaddress(_pass:byte;sec:TAsmSection;offset,len:aint); end; - { is the label only there for getting an address (e.g. for i/o - checks -> alt_addr) or is it a jump target (alt_jump), for debug - info alt_dbgline and alt_dbgfile } - TAsmLabelType = (alt_jump,alt_addr,alt_data,alt_dbgline,alt_dbgfile,alt_dbgtype); - TAsmLabel = class(TAsmSymbol) - labelnr : longint; - labeltype : TAsmLabelType; - is_set : boolean; - constructor createlocal(nr:longint;ltyp:TAsmLabelType); - constructor createglobal(const modulename:string;nr:longint;ltyp:TAsmLabelType); + { this is set by the tai_label.Init } + is_set, + { is the label only there for getting an address (e.g. for i/o } + { checks -> true) or is it a jump target (false) } + is_addr : boolean; + labelnr : longint; + constructor create(nr:longint); + constructor createdata(const modulename:string;nr:longint); + constructor createaddr(nr:longint); function getname:string;override; end; @@ -156,12 +154,9 @@ interface TAsmObjectData = class(TLinkedListItem) private - FName : string[80]; + FName : string{$ifndef VER1_9_4}[80]{$endif}; FCurrSec : TAsmSection; - { Sections will be stored in order in SectsIndex, this is at least - required for stabs debuginfo. The SectsDict is only used for lookups (PFV) } - FSectsDict : TDictionary; - FSectsIndex : TIndexArray; + FSects : TDictionary; FCAsmSection : TAsmSectionClass; { Symbols that will be defined in this object file } FSymbols : TIndexArray; @@ -184,22 +179,23 @@ interface procedure setsection(asec:tasmsection); procedure alloc(len:aint); procedure allocalign(len:longint); - procedure allocstab(p:pchar); + procedure allocstabs(p:pchar); procedure allocsymbol(currpass:byte;p:tasmsymbol;len:aint); procedure writebytes(var data;len:aint); procedure writereloc(data,len:aint;p:tasmsymbol;relative:TAsmRelocationType);virtual;abstract; procedure writesymbol(p:tasmsymbol);virtual;abstract; - procedure writestab(offset:aint;ps:tasmsymbol;nidx,nother,line:longint;p:pchar);virtual;abstract; + procedure writestabs(offset:aint;p:pchar;nidx,nother,line:longint;reloc:boolean);virtual;abstract; + procedure writesymstabs(offset:aint;p:pchar;ps:tasmsymbol;nidx,nother,line:longint;reloc:boolean);virtual;abstract; procedure beforealloc;virtual; procedure beforewrite;virtual; procedure afteralloc;virtual; procedure afterwrite;virtual; procedure resetsections; procedure fixuprelocs; - property Name:string[80] read FName; + property Name:string{$ifndef VER1_9_4}[80]{$endif} read FName; property CurrSec:TAsmSection read FCurrSec; property Symbols:TindexArray read FSymbols; - property Sects:TIndexArray read FSectsIndex; + property Sects:TDictionary read FSects; end; TAsmObjectDataClass = class of TAsmObjectData; @@ -209,7 +205,7 @@ interface TAsmLibraryData = class(TLinkedListItem) private nextaltnr : longint; - nextlabelnr : array[Tasmlabeltype] of longint; + nextlabelnr : longint; public name, realname : string[80]; @@ -226,16 +222,15 @@ interface function newasmsymbol(const s : string;_bind:TAsmSymBind;_typ:TAsmsymtype) : tasmsymbol; function getasmsymbol(const s : string) : tasmsymbol; function renameasmsymbol(const sold, snew : string):tasmsymbol; - function newasmlabel(nr:longint;alt:tasmlabeltype;is_global:boolean) : tasmlabel; + function newasmlabel(nr:longint;is_addr,is_data:boolean) : tasmlabel; {# create a new assembler label } - procedure getlabel(var l : tasmlabel;alt:tasmlabeltype); - {# create a new assembler label for jumps } - procedure getjumplabel(var l : tasmlabel); + procedure getlabel(var l : tasmlabel); { make l as a new label and flag is_addr } procedure getaddrlabel(var l : tasmlabel); { make l as a new label and flag is_data } procedure getdatalabel(var l : tasmlabel); {# return a label number } + procedure getlabelnr(var l : longint); procedure CreateUsedAsmSymbolList; procedure DestroyUsedAsmSymbolList; procedure UsedAsmSymbolListInsert(p:tasmsymbol); @@ -247,9 +242,6 @@ interface procedure UsedAsmSymbolListCheckUndefined; end; - const - { alt_jump,alt_addr,alt_data,alt_dbgline,alt_dbgfile } - asmlabeltypeprefix : array[tasmlabeltype] of char = ('j','a','d','l','f','t'); var objectlibrary : tasmlibrarydata; @@ -262,7 +254,6 @@ implementation verbose; const - sectsgrow = 100; symbolsgrow = 100; @@ -279,7 +270,7 @@ implementation inusedlist:=false; pass:=255; ppuidx:=-1; - { mainly used to remove unused labels from the al_procedures } + { mainly used to remove unused labels from the codesegment } refs:=0; end; @@ -346,26 +337,33 @@ implementation TAsmLabel *****************************************************************************} - constructor tasmlabel.createlocal(nr:longint;ltyp:TAsmLabelType); + constructor tasmlabel.create(nr:longint); begin; - inherited create(target_asm.labelprefix+asmlabeltypeprefix[ltyp]+tostr(nr),AB_LOCAL,AT_LABEL); labelnr:=nr; - labeltype:=ltyp; + inherited create(target_asm.labelprefix+tostr(labelnr),AB_LOCAL,AT_FUNCTION); is_set:=false; + is_addr := false; end; - constructor tasmlabel.createglobal(const modulename:string;nr:longint;ltyp:TAsmLabelType); + constructor tasmlabel.createdata(const modulename:string;nr:longint); begin; - inherited create('_$'+modulename+'$_L'+asmlabeltypeprefix[ltyp]+tostr(nr),AB_GLOBAL,AT_DATA); labelnr:=nr; - labeltype:=ltyp; + inherited create('_$'+modulename+'$_L'+tostr(labelnr),AB_GLOBAL,AT_DATA); is_set:=false; + is_addr := false; { write it always } increfs; end; + constructor tasmlabel.createaddr(nr:longint); + begin; + self.create(nr); + is_addr := true; + end; + + function tasmlabel.getname:string; begin getname:=inherited getname; @@ -553,11 +551,8 @@ implementation begin inherited create; FName:=n; - { sections, the SectsIndex owns the items, the FSectsDict - is only used for lookups } - FSectsDict:=tdictionary.create; - FSectsDict.noclear:=true; - FSectsIndex:=tindexarray.create(sectsgrow); + { sections } + FSects:=tdictionary.create; FStabsRecSize:=1; FStabsSec:=nil; FStabStrSec:=nil; @@ -571,8 +566,7 @@ implementation destructor TAsmObjectData.destroy; begin - FSectsDict.free; - FSectsIndex.free; + FSects.free; FSymbols.free; end; @@ -580,10 +574,9 @@ implementation function TAsmObjectData.sectionname(atype:tasmsectiontype;const aname:string):string; const secnames : array[tasmsectiontype] of string[12] = ('', - 'code','data','rodata','bss','threadvar', + 'code','data','rodata','bss', 'common', 'note', - 'text', 'stab','stabstr', 'idata2','idata4','idata5','idata6','idata7','edata', 'eh_frame', @@ -603,15 +596,14 @@ implementation secname : string; begin secname:=sectionname(atype,aname); - result:=TasmSection(FSectsDict.search(secname)); + result:=TasmSection(FSects.search(secname)); if not assigned(result) then begin {$warning TODO make alloconly configurable} if atype=sec_bss then include(aoptions,aso_alloconly); result:=CAsmSection.create(secname,atype,aalign,aoptions); - FSectsDict.Insert(result); - FSectsIndex.Insert(result); + FSects.Insert(result); result.owner:=self; end; FCurrSec:=result; @@ -660,7 +652,7 @@ implementation end; - procedure TAsmObjectData.allocstab(p:pchar); + procedure TAsmObjectData.allocstabs(p:pchar); begin if not(assigned(FStabsSec) and assigned(FStabStrSec)) then internalerror(200402254); @@ -708,13 +700,13 @@ implementation procedure TAsmObjectData.resetsections; begin - FSectsDict.foreach(@section_reset,nil); + FSects.foreach(@section_reset,nil); end; procedure TAsmObjectData.fixuprelocs; begin - FSectsDict.foreach(@section_fixuprelocs,nil); + FSects.foreach(@section_fixuprelocs,nil); end; @@ -723,8 +715,6 @@ implementation ****************************************************************************} constructor TAsmLibraryData.create(const n:string); - var - alt : TAsmLabelType; begin inherited create; realname:=n; @@ -734,8 +724,7 @@ implementation symbolsearch.usehash; { labels } nextaltnr:=1; - for alt:=low(TAsmLabelType) to high(TAsmLabelType) do - nextlabelnr[alt]:=1; + nextlabelnr:=1; { ppu } asmsymbolppuidx:=0; asmsymbolidx:=nil; @@ -905,47 +894,49 @@ implementation end; - function TAsmLibraryData.newasmlabel(nr:longint;alt:tasmlabeltype;is_global:boolean) : tasmlabel; + function TAsmLibraryData.newasmlabel(nr:longint;is_addr,is_data:boolean) : tasmlabel; var hp : tasmlabel; begin - if is_global then - hp:=tasmlabel.createglobal(name,nr,alt) - else - hp:=tasmlabel.createlocal(nr,alt); + if is_addr then + hp:=tasmlabel.createaddr(nr) + else if is_data then + hp:=tasmlabel.createdata(name,nr) + else + hp:=tasmlabel.create(nr); symbolsearch.insert(hp); newasmlabel:=hp; end; - procedure TAsmLibraryData.getlabel(var l : tasmlabel;alt:tasmlabeltype); + procedure TAsmLibraryData.getlabel(var l : tasmlabel); begin - l:=tasmlabel.createlocal(nextlabelnr[alt],alt); - inc(nextlabelnr[alt]); + l:=tasmlabel.create(nextlabelnr); + inc(nextlabelnr); symbolsearch.insert(l); end; - procedure TAsmLibraryData.getjumplabel(var l : tasmlabel); + + procedure TAsmLibraryData.getdatalabel(var l : tasmlabel); begin - l:=tasmlabel.createlocal(nextlabelnr[alt_jump],alt_jump); - inc(nextlabelnr[alt_jump]); + l:=tasmlabel.createdata(name,nextlabelnr); + inc(nextlabelnr); symbolsearch.insert(l); end; - procedure TAsmLibraryData.getdatalabel(var l : tasmlabel); + procedure TAsmLibraryData.getaddrlabel(var l : tasmlabel); begin - l:=tasmlabel.createglobal(name,nextlabelnr[alt_data],alt_data); - inc(nextlabelnr[alt_data]); + l:=tasmlabel.createaddr(nextlabelnr); + inc(nextlabelnr); symbolsearch.insert(l); end; - procedure TAsmLibraryData.getaddrlabel(var l : tasmlabel); + procedure TAsmLibraryData.getlabelnr(var l : longint); begin - l:=tasmlabel.createlocal(nextlabelnr[alt_addr],alt_addr); - inc(nextlabelnr[alt_addr]); - symbolsearch.insert(l); + l:=nextlabelnr; + inc(nextlabelnr); end; diff --git a/compiler/aasmtai.pas b/compiler/aasmtai.pas index c733364dd0..1dba82c1e0 100644 --- a/compiler/aasmtai.pas +++ b/compiler/aasmtai.pas @@ -45,12 +45,12 @@ interface ait_align, ait_section, ait_comment, + ait_direct, ait_string, ait_instruction, ait_datablock, ait_symbol, ait_symbol_end, { needed to calc the size of a symbol } - ait_directive, ait_label, { the const_xx must be below each other so it can be used as array index } @@ -68,9 +68,12 @@ interface ait_real_80bit, ait_comp_64bit, ait_real_128bit, - ait_stab, +{$ifdef GDB} + ait_stabn, + ait_stabs, ait_force_line, - ait_function_name, + ait_stab_function_name, +{$endif GDB} {$ifdef alpha} { the follow is for the DEC Alpha } ait_frame, @@ -88,7 +91,9 @@ interface ait_regalloc, ait_tempalloc, { used to mark assembler blocks and inlined functions } - ait_marker + ait_marker, + { special symbol for darwin pic code } + ait_non_lazy_symbol_pointer ); const @@ -105,12 +110,12 @@ interface 'align', 'section', 'comment', + 'direct', 'string', 'instruction', 'datablock', 'symbol', 'symbol_end', - 'symbol_directive', 'label', 'const_128bit', 'const_64bit', @@ -126,9 +131,12 @@ interface 'real_80bit', 'comp_64bit', 'real_128bit', - 'stab', +{$ifdef GDB} + 'stabn', + 'stabs', 'force_line', - 'function_name', + 'stab_funcname', +{$endif GDB} {$ifdef alpha} { the follow is for the DEC Alpha } 'frame', @@ -144,21 +152,18 @@ interface 'cut', 'regalloc', 'tempalloc', - 'marker' + 'marker', + 'non_lazy_symbol_pointer' ); type { Types of operand } - toptype=(top_none,top_reg,top_ref,top_const,top_bool,top_local -{$ifdef arm} + toptype=(top_none,top_reg,top_ref,top_const,top_bool,top_local, { ARM only } - ,top_regset - ,top_shifterop -{$endif arm} -{$ifdef m68k} + top_regset, + top_shifterop, { m68k only } - ,top_regset -{$endif m68k} + top_reglist { i386 only}); { kinds of operations that an instruction can perform on an operand } @@ -202,20 +207,25 @@ interface { a new ait type! } const SkipInstr = [ait_comment, ait_symbol,ait_section - ,ait_stab, ait_function_name, ait_force_line - ,ait_regalloc, ait_tempalloc, ait_symbol_end, ait_directive]; +{$ifdef GDB} + ,ait_stabs, ait_stabn, ait_stab_function_name, ait_force_line +{$endif GDB} + ,ait_regalloc, ait_tempalloc, ait_symbol_end]; { ait_* types which do not have line information (and hence which are of type tai, otherwise, they are of type tailineinfo } SkipLineInfo =[ait_label, ait_regalloc,ait_tempalloc, - ait_stab,ait_function_name, - ait_cutobject,ait_marker,ait_align,ait_section,ait_comment, - ait_const_8bit,ait_const_16bit,ait_const_32bit,ait_const_64bit,ait_const_128bit, - ait_const_sleb128bit,ait_const_uleb128bit, - ait_const_rva_symbol,ait_const_indirect_symbol, - ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_real_128bit - ]; +{$ifdef GDB} + ait_stabn,ait_stabs,ait_stab_function_name, +{$endif GDB} + ait_cutobject,ait_marker,ait_align,ait_section,ait_comment, + ait_const_8bit,ait_const_16bit,ait_const_32bit,ait_const_64bit,ait_const_128bit, + ait_const_sleb128bit,ait_const_uleb128bit, + ait_const_rva_symbol,ait_const_indirect_symbol, + ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_real_128bit, + ait_non_lazy_symbol_pointer + ]; type @@ -270,7 +280,8 @@ interface { extra len so the string can contain an \0 } len : longint; constructor Create(const _str : string); - constructor Create_pchar(_str : pchar;length : longint); + constructor Create_pchar(_str : pchar); + constructor Create_length_pchar(_str : pchar;length : longint); destructor Destroy;override; constructor ppuload(t:taitype;ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override; @@ -300,18 +311,6 @@ interface procedure derefimpl;override; end; - tasmdirective=(asd_non_lazy_symbol_pointer,asd_indirect_symbol,asd_lazy_symbol_pointer, - asd_extern,asd_nasm_import); - - tai_directive = class(tailineinfo) - name : pstring; - directive : tasmdirective; - constructor Create(_directive:tasmdirective;const _name:string); - destructor Destroy;override; - constructor ppuload(t:taitype;ppufile:tcompilerppufile);override; - procedure ppuwrite(ppufile:tcompilerppufile);override; - end; - { Generates an assembler label } tai_label = class(tai) is_global : boolean; @@ -322,6 +321,16 @@ interface procedure derefimpl;override; end; + { Directly output data to final assembler file } + tai_direct = class(tailineinfo) + str : pchar; + constructor Create(_str : pchar); + destructor Destroy; override; + constructor ppuload(t:taitype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + function getcopy:tlinkedlistitem;override; + end; + { Generates an assembler comment } tai_comment = class(tai) str : pchar; @@ -441,26 +450,6 @@ interface procedure ppuwrite(ppufile:tcompilerppufile);override; end; - tstabtype = (stab_stabs,stab_stabn,stab_stabd); - - tai_stab = class(tai) - str : pchar; - stabtype : tstabtype; - constructor Create(_stabtype:tstabtype;_str : pchar); - constructor Create_str(_stabtype:tstabtype;const s:string); - destructor Destroy;override; - end; - - tai_force_line = class(tailineinfo) - constructor Create; - end; - - tai_function_name = class(tai) - funcname : pstring; - constructor create(const s:string); - destructor destroy;override; - end; - { Insert a cut to split assembler into several smaller files } tai_cutobject = class(tai) place : tcutplace; @@ -561,9 +550,6 @@ interface function is_same_reg_move(regtype: Tregistertype):boolean;virtual; function spilling_get_operation_type(opnr: longint): topertype;virtual; function spilling_get_operation_type_ref(opnr: longint; reg: tregister): topertype;virtual; - - function Pass1(offset:longint):longint;virtual;abstract; - procedure Pass2(objdata:TAsmObjectdata);virtual;abstract; end; tai_cpu_class = class of tai_cpu_abstract; @@ -589,52 +575,6 @@ interface procedure InsertAfter(Item,Loc : TLinkedListItem);override; end; - { Type of asmlists. The order is important for the layout of the - information in the .o file. The stabs for the types must be defined - before they can be referenced and therefor they need to be written - first (PFV) } - Tasmlist=(al_stabsstart, - al_stabs, - al_procedures, - al_globals, - al_const, - al_typedconsts, - al_rotypedconsts, - al_threadvars, - al_imports, - al_exports, - al_resources, - al_rtti, - al_dwarf, - al_picdata, - al_resourcestrings, - al_stabsend); - const - TasmlistStr : array[tasmlist] of string[24] =( - 'al_stabsstart', - 'al_stabs', - 'al_procedures', - 'al_globals', - 'al_const', - 'al_typedconsts', - 'al_rotypedconsts', - 'al_threadvars', - 'al_imports', - 'al_exports', - 'al_resources', - 'al_rtti', - 'al_dwarf', - 'al_picdata', - 'al_resourcestrings', - 'al_stabsend'); - - regallocstr : array[tregalloctype] of string[10]=('allocated','released','sync','resized'); - tempallocstr : array[boolean] of string[10]=('released','allocated'); - stabtypestr : array[tstabtype] of string[5]=('stabs','stabn','stabd'); - directivestr : array[tasmdirective] of string[24]=( - 'non_lazy_symbol_pointer','indirect_symbol','lazy_symbol_pointer', - 'extern','nasm_import' - ); var { array with all class types for tais } @@ -652,19 +592,23 @@ interface { hook to notify uses of registers } add_reg_instruction_hook : tadd_reg_instruction_proc; - asmlist:array[Tasmlist] of Taasmoutput; + { default lists } + datasegment,codesegment,bsssegment, + debuglist,withdebuglist,consts, + importssection,exportssection, + resourcesection,rttilist, + dwarflist, + { data used by pic code } + picdata, + resourcestringlist : taasmoutput; cai_align : tai_align_class; cai_cpu : tai_cpu_class; function use_smartlink_section:boolean; function maybe_smartlink_symbol:boolean; - procedure maybe_new_object_file(list:taasmoutput); procedure new_section(list:taasmoutput;Asectype:TAsmSectionType;Aname:string;Aalign:byte); - procedure section_symbol_start(list:taasmoutput;const Aname:string;Asymtyp:Tasmsymtype; - Aglobal:boolean;Asectype:TAsmSectionType;Aalign:byte); - procedure section_symbol_end(list:taasmoutput;const Aname:string); function ppuloadai(ppufile:tcompilerppufile):tai; procedure ppuwriteai(ppufile:tcompilerppufile;n:tai); @@ -729,7 +673,8 @@ implementation function use_smartlink_section:boolean; begin result:=(af_smartlink_sections in target_asm.flags) and - (tf_smartlink_sections in target_info.flags); + (tf_smartlink_sections in target_info.flags) and + not(cs_debuginfo in aktmoduleswitches); end; @@ -755,26 +700,6 @@ implementation end; - procedure section_symbol_start(list:taasmoutput;const Aname:string;Asymtyp:Tasmsymtype; - Aglobal:boolean;Asectype:TAsmSectionType;Aalign:byte); - begin - maybe_new_object_file(list); - list.concat(tai_section.create(Asectype,Aname,Aalign)); - list.concat(cai_align.create(Aalign)); - if Aglobal or - maybe_smartlink_symbol then - list.concat(tai_symbol.createname_global(Aname,Asymtyp,0)) - else - list.concat(tai_symbol.createname(Aname,Asymtyp,0)); - end; - - - procedure section_symbol_end(list:taasmoutput;const Aname:string); - begin - list.concat(tai_symbol_end.createname(Aname)); - end; - - {**************************************************************************** TAI ****************************************************************************} @@ -1049,41 +974,6 @@ implementation {**************************************************************************** - TAI_SYMBOL_END - ****************************************************************************} - - constructor tai_directive.Create(_directive:tasmdirective;const _name:string); - begin - inherited Create; - typ:=ait_directive; - name:=stringdup(_name); - directive:=_directive; - end; - - - destructor tai_directive.Destroy; - begin - stringdispose(name); - end; - - - constructor tai_directive.ppuload(t:taitype;ppufile:tcompilerppufile); - begin - inherited ppuload(t,ppufile); - name:=stringdup(ppufile.getstring); - directive:=tasmdirective(ppufile.getbyte); - end; - - - procedure tai_directive.ppuwrite(ppufile:tcompilerppufile); - begin - inherited ppuwrite(ppufile); - ppufile.putstring(name^); - ppufile.putbyte(byte(directive)); - end; - - -{**************************************************************************** TAI_CONST ****************************************************************************} @@ -1475,6 +1365,7 @@ implementation ****************************************************************************} constructor tai_string.Create(const _str : string); + begin inherited Create; typ:=ait_string; @@ -1483,20 +1374,30 @@ implementation strpcopy(str,_str); end; + constructor tai_string.Create_pchar(_str : pchar); - constructor tai_string.Create_pchar(_str : pchar;length : longint); begin inherited Create; typ:=ait_string; str:=_str; - len:=length; + len:=strlen(_str); end; + constructor tai_string.Create_length_pchar(_str : pchar;length : longint); + + begin + inherited Create; + typ:=ait_string; + str:=_str; + len:=length; + end; destructor tai_string.destroy; + begin + { you can have #0 inside the strings so } if str<>nil then - freemem(str); + freemem(str,len+1); inherited Destroy; end; @@ -1505,8 +1406,9 @@ implementation begin inherited ppuload(t,ppufile); len:=ppufile.getlongint; - getmem(str,len); + getmem(str,len+1); ppufile.getdata(str^,len); + str[len]:=#0; end; @@ -1523,8 +1425,8 @@ implementation p : tlinkedlistitem; begin p:=inherited getcopy; - getmem(tai_string(p).str,len); - move(str^,tai_string(p).str^,len); + getmem(tai_string(p).str,len+1); + move(str^,tai_string(p).str^,len+1); getcopy:=p; end; @@ -1567,25 +1469,25 @@ implementation {**************************************************************************** - tai_comment comment to be inserted in the assembler file + TAI_DIRECT ****************************************************************************} - constructor tai_comment.Create(_str : pchar); + constructor tai_direct.Create(_str : pchar); begin inherited Create; - typ:=ait_comment; + typ:=ait_direct; str:=_str; end; - destructor tai_comment.destroy; + destructor tai_direct.destroy; begin strdispose(str); inherited Destroy; end; - constructor tai_comment.ppuload(t:taitype;ppufile:tcompilerppufile); + constructor tai_direct.ppuload(t:taitype;ppufile:tcompilerppufile); var len : longint; begin @@ -1597,7 +1499,7 @@ implementation end; - procedure tai_comment.ppuwrite(ppufile:tcompilerppufile); + procedure tai_direct.ppuwrite(ppufile:tcompilerppufile); var len : longint; begin @@ -1608,67 +1510,67 @@ implementation end; - function tai_comment.getcopy : tlinkedlistitem; + function tai_direct.getcopy : tlinkedlistitem; var p : tlinkedlistitem; begin p:=inherited getcopy; - getmem(tai_comment(p).str,strlen(str)+1); - move(str^,tai_comment(p).str^,strlen(str)+1); + getmem(tai_direct(p).str,strlen(str)+1); + move(str^,tai_direct(p).str^,strlen(str)+1); getcopy:=p; end; {**************************************************************************** - TAI_STABS + tai_comment comment to be inserted in the assembler file ****************************************************************************} - constructor tai_stab.create(_stabtype:tstabtype;_str : pchar); - begin - inherited create; - typ:=ait_stab; - str:=_str; - stabtype:=_stabtype; - end; + constructor tai_comment.Create(_str : pchar); - constructor tai_stab.create_str(_stabtype:tstabtype;const s:string); - begin - self.create(_stabtype,strpnew(s)); - end; + begin + inherited Create; + typ:=ait_comment; + str:=_str; + end; + + destructor tai_comment.destroy; - destructor tai_stab.destroy; begin strdispose(str); - inherited destroy; + inherited Destroy; end; - -{**************************************************************************** - TAI_FORCE_LINE - ****************************************************************************} - - constructor tai_force_line.create; + constructor tai_comment.ppuload(t:taitype;ppufile:tcompilerppufile); + var + len : longint; begin - inherited create; - typ:=ait_force_line; + inherited ppuload(t,ppufile); + len:=ppufile.getlongint; + getmem(str,len+1); + ppufile.getdata(str^,len); + str[len]:=#0; end; -{**************************************************************************** - TAI_FUNCTION_NAME - ****************************************************************************} - - constructor tai_function_name.create(const s:string); + procedure tai_comment.ppuwrite(ppufile:tcompilerppufile); + var + len : longint; begin - inherited create; - typ:=ait_function_name; - funcname:=stringdup(s); + inherited ppuwrite(ppufile); + len:=strlen(str); + ppufile.putlongint(len); + ppufile.putdata(str^,len); end; - destructor tai_function_name.destroy; + + function tai_comment.getcopy : tlinkedlistitem; + var + p : tlinkedlistitem; begin - stringdispose(funcname); - inherited destroy; + p:=inherited getcopy; + getmem(tai_comment(p).str,strlen(str)+1); + move(str^,tai_comment(p).str^,strlen(str)+1); + getcopy:=p; end; @@ -2144,14 +2046,12 @@ implementation virtual;abstract; to prevent a lot of warnings of unimplemented abstract methods when tai_cpu is created (PFV) } internalerror(200404091); - result:=false; end; function tai_cpu_abstract.spilling_get_operation_type(opnr: longint): topertype; begin internalerror(200404091); - result:=operand_readwrite; end; diff --git a/compiler/aggas.pas b/compiler/aggas.pas index 2dbd719841..24a84fc1fb 100644 --- a/compiler/aggas.pas +++ b/compiler/aggas.pas @@ -52,12 +52,20 @@ interface function sectionname(atype:tasmsectiontype;const aname:string):string;virtual; procedure WriteSection(atype:tasmsectiontype;const aname:string); procedure WriteExtraHeader;virtual; +{$ifdef GDB} + procedure WriteFileLineInfo(var fileinfo : tfileposinfo); + procedure WriteFileEndInfo; +{$endif} procedure WriteInstruction(hp: tai); virtual; abstract; public procedure WriteTree(p:TAAsmoutput);override; procedure WriteAsmList;override; end; + const + regname_count=45; + regname_count_bsstart=32; { Largest power of 2 out of regname_count. } + implementation @@ -65,13 +73,27 @@ implementation cutils,globtype,systems, fmodule,finput,verbose, itcpugas +{$ifdef GDB} +{$IFDEF USE_SYSUTILS} +{$ELSE USE_SYSUTILS} + ,strings +{$ENDIF USE_SYSUTILS} + ,gdb +{$endif GDB} ; const line_length = 70; - var - CurrSecType : TAsmSectionType; { last section type written } +var +{$ifdef GDB} + n_line : byte; { different types of source lines } + linecount, + includecount : longint; + funcname : pchar; + stabslastfileinfo : tfileposinfo; +{$endif} + lasTSecType : TAsmSectionType; { last section type written } lastfileinfo : tfileposinfo; infile, lastinfile : tinputfile; @@ -190,14 +212,78 @@ implementation { GNU Assembler writer } {****************************************************************************} +{$ifdef GDB} + procedure TGNUAssembler.WriteFileLineInfo(var fileinfo : tfileposinfo); + var + curr_n : byte; + begin + if not ((cs_debuginfo in aktmoduleswitches) or + (cs_gdb_lineinfo in aktglobalswitches)) then + exit; + { file changed ? (must be before line info) } + if (fileinfo.fileindex<>0) and + (stabslastfileinfo.fileindex<>fileinfo.fileindex) then + begin + infile:=current_module.sourcefiles.get_file(fileinfo.fileindex); + if assigned(infile) then + begin + if includecount=0 then + curr_n:=n_sourcefile + else + curr_n:=n_includefile; + if (infile.path^<>'') then + begin + AsmWriteLn(#9'.stabs "'+BsToSlash(FixPath(infile.path^,false))+'",'+ + tostr(curr_n)+',0,0,'+target_asm.labelprefix+'text'+ToStr(IncludeCount)); + end; + AsmWriteLn(#9'.stabs "'+FixFileName(infile.name^)+'",'+ + tostr(curr_n)+',0,0,'+target_asm.labelprefix+'text'+ToStr(IncludeCount)); + AsmWriteLn(target_asm.labelprefix+'text'+ToStr(IncludeCount)+':'); + inc(includecount); + { force new line info } + stabslastfileinfo.line:=-1; + end; + end; + { line changed ? } + if (stabslastfileinfo.line<>fileinfo.line) and (fileinfo.line<>0) then + begin + if (n_line=n_textline) and assigned(funcname) and + (target_info.use_function_relative_addresses) then + begin + AsmWriteLn(target_asm.labelprefix+'l'+tostr(linecount)+':'); + AsmWrite(#9'.stabn '+tostr(n_line)+',0,'+tostr(fileinfo.line)+','+ + target_asm.labelprefix+'l'+tostr(linecount)+' - '); + AsmWritePChar(FuncName); + AsmLn; + inc(linecount); + end + else + AsmWriteLn(#9'.stabd'#9+tostr(n_line)+',0,'+tostr(fileinfo.line)); + end; + stabslastfileinfo:=fileinfo; + end; + + procedure TGNUAssembler.WriteFileEndInfo; + + begin + if not ((cs_debuginfo in aktmoduleswitches) or + (cs_gdb_lineinfo in aktglobalswitches)) then + exit; + WriteSection(sec_code,''); + AsmWriteLn(#9'.stabs "",'+tostr(n_sourcefile)+',0,0,'+target_asm.labelprefix+'etext'); + AsmWriteLn(target_asm.labelprefix+'etext:'); + end; + +{$endif GDB} + + function TGNUAssembler.sectionname(atype:tasmsectiontype;const aname:string):string; const secnames : array[tasmsectiontype] of string[12] = ('', {$warning TODO .rodata not yet working} - '.text','.data','.data','.bss','.threadvar', + '.text','.data','.data','.bss', 'common', '.note', - '__TEXT', { stubs } '.stab','.stabstr', '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata', '.eh_frame', @@ -206,8 +292,9 @@ implementation ); begin if use_smartlink_section and + (atype<>sec_bss) and (aname<>'') then - result:=secnames[atype]+'.'+aname + result:='.gnu.linkonce'+copy(secnames[atype],1,2)+'.'+aname else result:=secnames[atype]; end; @@ -219,43 +306,48 @@ implementation begin AsmLn; case target_info.system of - system_i386_OS2, - system_i386_EMX : ; - system_powerpc_darwin : - begin - if atype=sec_stub then - AsmWrite('.section '); - end; + system_powerpc_darwin, system_i386_OS2, system_i386_EMX: ; else AsmWrite('.section '); end; s:=sectionname(atype,aname); AsmWrite(s); - case atype of - sec_fpc : - AsmWrite(', "a", @progbits'); - sec_stub : - begin - if target_info.system=system_powerpc_darwin then - AsmWrite(',__symbol_stub1,symbol_stubs,pure_instructions,16'); + if copy(s,1,4)='.gnu' then + begin + case atype of + sec_rodata, + sec_data : + AsmWrite(',""'); + sec_code : + AsmWrite(',"x"'); end; - end; + end + else if atype=sec_fpc then + AsmWrite(', "a", @progbits'); AsmLn; - CurrSecType:=atype; +{$ifdef GDB} + { this is needed for line info in data } + funcname:=nil; + case atype of + sec_code : + n_line:=n_textline; + sec_rodata, + sec_data : + n_line:=n_dataline; + sec_bss : + n_line:=n_bssline; + else + n_line:=n_dataline; + end; +{$endif GDB} + LasTSecType:=atype; end; procedure TGNUAssembler.WriteTree(p:TAAsmoutput); - - function needsObject(hp : tai_symbol) : boolean; - begin - needsObject := - assigned(hp.next) and - (tai_symbol(hp.next).typ in [ait_const_rva_symbol, - ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_datablock, - ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit]); - end; - + const + regallocstr : array[tregalloctype] of string[10]=(' allocated',' released',' sync',' resized'); + tempallocstr : array[boolean] of string[10]=(' released',' allocated'); var ch : char; hp : tai; @@ -272,18 +364,15 @@ implementation e : extended; {$endif cpuextended} do_line : boolean; - - sepChar : char; begin if not assigned(p) then exit; - last_align := 2; InlineLevel:=0; - { lineinfo is only needed for al_procedures (PFV) } + { lineinfo is only needed for codesegment (PFV) } do_line:=(cs_asm_source in aktglobalswitches) or ((cs_lineinfo in aktmoduleswitches) - and (p=asmlist[al_procedures])); + and (p=codesegment)); hp:=tai(p.first); while assigned(hp) do begin @@ -291,6 +380,12 @@ implementation begin hp1 := hp as tailineinfo; aktfilepos:=hp1.fileinfo; +{$ifdef GDB} + { write stabs } + if (cs_debuginfo in aktmoduleswitches) or + (cs_gdb_lineinfo in aktglobalswitches) then + WriteFileLineInfo(hp1.fileinfo); +{$endif GDB} { no line info for inlined code } if do_line and (inlinelevel=0) then begin @@ -360,7 +455,6 @@ implementation hp:=tai(hp.next); AsmWrite(','); until false; - AsmWrite(' '); AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]); end; end; @@ -376,7 +470,7 @@ implementation else {$endif EXTDEBUG} AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+ - tostr(tai_tempalloc(hp).tempsize)+' '+tempallocstr[tai_tempalloc(hp).allocation]); + tostr(tai_tempalloc(hp).tempsize)+tempallocstr[tai_tempalloc(hp).allocation]); end; end; @@ -405,56 +499,47 @@ implementation ait_section : begin if tai_section(hp).sectype<>sec_none then - WriteSection(tai_section(hp).sectype,tai_section(hp).name^) + begin + WriteSection(tai_section(hp).sectype,tai_section(hp).name^); +{$ifdef GDB} + lastfileinfo.line:=-1; +{$endif GDB} + end else - begin + begin {$ifdef EXTDEBUG} - AsmWrite(target_asm.comment); - AsmWriteln(' sec_none'); + AsmWrite(target_asm.comment); + AsmWriteln(' sec_none'); {$endif EXTDEBUG} end; end; ait_datablock : begin - if target_info.system=system_powerpc_darwin then + if (target_info.system <> system_powerpc_darwin) or + not tai_datablock(hp).is_global then begin - {On Mac OS X you can't have common symbols in a shared - library, since those are in the TEXT section and the text section is - read-only in shared libraries (so it can be shared among different - processes). The alternate code creates some kind of common symbols in - the data segment. The generic code no longer uses common symbols, but - this doesn't work on Mac OS X as well.} if tai_datablock(hp).is_global then - begin - asmwrite('.globl '); - asmwriteln(tai_datablock(hp).sym.name); - asmwriteln('.data'); - asmwrite('.zerofill __DATA, __common, '); - asmwrite(tai_datablock(hp).sym.name); - asmwriteln(', '+tostr(tai_datablock(hp).size)+','+tostr(last_align)); - if not(CurrSecType in [sec_data,sec_none]) then - writesection(CurrSecType,''); - end + AsmWrite(#9'.comm'#9) else - begin - asmwrite(#9'.lcomm'#9); - asmwrite(tai_datablock(hp).sym.name); - asmwrite(','+tostr(tai_datablock(hp).size)); - asmwrite(','+tostr(last_align)); - asmwriteln(''); - end + AsmWrite(#9'.lcomm'#9); + AsmWrite(tai_datablock(hp).sym.name); + AsmWrite(','+tostr(tai_datablock(hp).size)); + if (target_info.system = system_powerpc_darwin) { and + not(tai_datablock(hp).is_global)} then + AsmWrite(','+tostr(last_align)); + AsmWriteln(''); end else begin - if Tai_datablock(hp).is_global then - begin - asmwrite(#9'.globl '); - asmwriteln(Tai_datablock(hp).sym.name); - end; - asmwrite(Tai_datablock(hp).sym.name); - asmwriteln(':'); - asmwriteln(#9'.space '+tostr(Tai_datablock(hp).size)); + AsmWrite('.globl '); + AsmWriteln(tai_datablock(hp).sym.name); + AsmWriteln('.data'); + AsmWrite('.zerofill __DATA, __common, '); + AsmWrite(tai_datablock(hp).sym.name); + AsmWriteln(', '+tostr(tai_datablock(hp).size)+','+tostr(last_align)); + if not(lasTSectype in [sec_data,sec_none]) then + WriteSection(lasTSectype,''); end; end; @@ -517,7 +602,7 @@ implementation { Values with symbols are written on a single line to improve reading of the .s file (PFV) } if assigned(tai_const(hp).sym) or - not(CurrSecType in [sec_data,sec_rodata]) or + not(LasTSecType in [sec_data,sec_rodata]) or (l>line_length) or (hp.next=nil) or (tai(hp.next).typ<>consttyp) or @@ -628,6 +713,20 @@ implementation AsmLn; end; + ait_direct : + begin + AsmWritePChar(tai_direct(hp).str); + AsmLn; +{$IfDef GDB} + if strpos(tai_direct(hp).str,'.data')<>nil then + n_line:=n_dataline + else if strpos(tai_direct(hp).str,'.text')<>nil then + n_line:=n_textline + else if strpos(tai_direct(hp).str,'.bss')<>nil then + n_line:=n_bssline; +{$endif GDB} + end; + ait_string : begin pos:=0; @@ -671,6 +770,7 @@ implementation AsmWriteLn(':'); end; end; + ait_symbol : begin if tai_symbol(hp).is_global then @@ -678,48 +778,40 @@ implementation AsmWrite('.globl'#9); AsmWriteLn(tai_symbol(hp).sym.name); end; - if (target_info.system = system_powerpc64_linux) and - (tai_symbol(hp).sym.typ = AT_FUNCTION) then - begin - AsmWriteLn('.section "opd", "aw"'); - AsmWriteLn('.align 3'); - AsmWriteLn(tai_symbol(hp).sym.name + ':'); - AsmWriteLn('.quad .' + tai_symbol(hp).sym.name + ', .TOC.@tocbase, 0'); - AsmWriteLn('.previous'); - AsmWriteLn('.size ' + tai_symbol(hp).sym.name + ', 24'); - AsmWriteLn('.globl .' + tai_symbol(hp).sym.name); - AsmWriteLn('.type .' + tai_symbol(hp).sym.name + ', @function'); - { the dotted name is the name of the actual function } - AsmWrite('.'); - end - else - begin - if (target_info.system <> system_arm_linux) then + if target_info.system in [system_i386_linux,system_i386_beos, + system_powerpc_linux,system_m68k_linux, + system_sparc_linux,system_alpha_linux, + system_x86_64_linux,system_arm_linux] then + begin + AsmWrite(#9'.type'#9); + AsmWrite(tai_symbol(hp).sym.name); + if assigned(tai(hp.next)) and + (tai(hp.next).typ in [ait_const_rva_symbol, + ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_datablock, + ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit]) then begin - sepChar := '@'; + if target_info.system = system_arm_linux then + AsmWriteLn(',#object') + else + AsmWriteLn(',@object') end else begin - sepChar := '#'; - end; - - if (tf_needs_symbol_type in target_info.flags) then - begin - AsmWrite(#9'.type'#9 + tai_symbol(hp).sym.name); - if (needsObject(tai_symbol(hp))) then - begin - AsmWriteLn(',' + sepChar + 'object'); - end + if target_info.system = system_arm_linux then + AsmWriteLn(',#function') else - begin - AsmWriteLn(',' + sepChar + 'function'); - end; + AsmWriteLn(',@function'); end; - if (tf_needs_symbol_size in target_info.flags) and (tai_symbol(hp).sym.size > 0) then begin - AsmWriteLn(#9'.size'#9 + tai_symbol(hp).sym.name + ', ' + tostr(tai_symbol(hp).sym.size)); - end; - end; - AsmWriteLn(tai_symbol(hp).sym.name + ':'); + if tai_symbol(hp).sym.size>0 then + begin + AsmWrite(#9'.size'#9); + AsmWrite(tai_symbol(hp).sym.name); + AsmWrite(', '); + AsmWriteLn(tostr(tai_symbol(hp).sym.size)); + end; + end; + AsmWrite(tai_symbol(hp).sym.name); + AsmWriteLn(':'); end; ait_symbol_end : @@ -730,16 +822,8 @@ implementation inc(symendcount); AsmWriteLn(s+':'); AsmWrite(#9'.size'#9); - if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then - begin - AsmWrite('.'); - end; AsmWrite(tai_symbol_end(hp).sym.name); AsmWrite(', '+s+' - '); - if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then - begin - AsmWrite('.'); - end; AsmWriteLn(tai_symbol_end(hp).sym.name); end; end; @@ -749,18 +833,33 @@ implementation WriteInstruction(hp); end; - ait_stab : +{$ifdef GDB} + ait_stabs : begin - if assigned(tai_stab(hp).str) then + if assigned(tai_stabs(hp).str) then begin - AsmWrite(#9'.'+stabtypestr[tai_stab(hp).stabtype]+' '); - AsmWritePChar(tai_stab(hp).str); + AsmWrite(#9'.stabs '); + AsmWritePChar(tai_stabs(hp).str); AsmLn; end; end; - ait_force_line, - ait_function_name : ; + ait_stabn : + begin + if assigned(tai_stabn(hp).str) then + begin + AsmWrite(#9'.stabn '); + AsmWritePChar(tai_stabn(hp).str); + AsmLn; + end; + end; + + ait_force_line : + stabslastfileinfo.line:=0; + + ait_stab_function_name: + funcname:=tai_stab_function_name(hp).str; +{$endif GDB} ait_cutobject : begin @@ -779,11 +878,18 @@ implementation while assigned(hp.next) and (tai(hp.next).typ in [ait_cutobject,ait_section,ait_comment]) do begin if tai(hp.next).typ=ait_section then - CurrSecType:=tai_section(hp.next).sectype; + lasTSectype:=tai_section(hp.next).sectype; hp:=tai(hp.next); end; - if CurrSecType<>sec_none then - WriteSection(CurrSecType,''); +{$ifdef GDB} + { force write of filename } + FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0); + includecount:=0; + funcname:=nil; + WriteFileLineInfo(aktfilepos); +{$endif GDB} + if lasTSectype<>sec_none then + WriteSection(lasTSectype,''); AsmStartSize:=AsmSize; end; end; @@ -794,13 +900,8 @@ implementation else if tai_marker(hp).kind=InlineEnd then dec(InlineLevel); - ait_directive : - begin - AsmWrite('.'+directivestr[tai_directive(hp).directive]+' '); - if assigned(tai_directive(hp).name) then - AsmWrite(tai_directive(hp).name^); - AsmLn; - end; + ait_non_lazy_symbol_pointer: + AsmWriteLn('.non_lazy_symbol_pointer'); else internalerror(10000); @@ -820,14 +921,20 @@ implementation p:dirstr; n:namestr; e:extstr; - hal : tasmlist; +{$ifdef GDB} + fileinfo : tfileposinfo; +{$endif GDB} + begin {$ifdef EXTDEBUG} if assigned(current_module.mainsource) then Comment(V_Debug,'Start writing gas-styled assembler output for '+current_module.mainsource^); {$endif} - CurrSecType:=sec_none; + LasTSectype:=sec_none; +{$ifdef GDB} + FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0); +{$endif GDB} FillChar(lastfileinfo,sizeof(lastfileinfo),0); LastInfile:=nil; @@ -850,15 +957,38 @@ implementation { to get symify to work } AsmWriteLn(#9'.file "'+FixFileName(n+e)+'"'); WriteExtraHeader; +{$ifdef GDB} + n_line:=n_bssline; + funcname:=nil; + linecount:=1; + includecount:=0; + fileinfo.fileindex:=1; + fileinfo.line:=1; + { Write main file } + WriteFileLineInfo(fileinfo); +{$endif GDB} AsmStartSize:=AsmSize; symendcount:=0; - for hal:=low(Tasmlist) to high(Tasmlist) do - begin - AsmWriteLn(target_asm.comment+'Begin asmlist '+TasmlistStr[hal]); - writetree(asmlist[hal]); - AsmWriteLn(target_asm.comment+'End asmlist '+TasmlistStr[hal]); - end; + If (cs_debuginfo in aktmoduleswitches) then + WriteTree(debuglist); + WriteTree(codesegment); + WriteTree(datasegment); + WriteTree(consts); + WriteTree(rttilist); + WriteTree(picdata); + Writetree(resourcestringlist); + WriteTree(bsssegment); + Writetree(importssection); + { exports are written by DLLTOOL + if we use it so don't insert it twice (PM) } + if not UseDeffileForExports and assigned(exportssection) then + Writetree(exportssection); + Writetree(resourcesection); + Writetree(dwarflist); + {$ifdef GDB} + WriteFileEndInfo; + {$ENDIF} AsmLn; {$ifdef EXTDEBUG} diff --git a/compiler/aopt.pas b/compiler/aopt.pas index c3d9e6ec0a..9d60bf0367 100644 --- a/compiler/aopt.pas +++ b/compiler/aopt.pas @@ -35,7 +35,7 @@ Unit aopt; TAsmOptimizer = class(TAoptObj) { _AsmL is the PAasmOutpout list that has to be optimized } - Constructor create(_AsmL: taasmoutput); virtual; + Constructor create(_AsmL: taasmoutput); { call the necessary optimizer procedures } Procedure Optimize; @@ -219,9 +219,7 @@ Unit aopt; End; { more peephole optimizations } { PeepHoleOptPass2;} - { if pass = last_pass then } - PostPeepHoleOpts; - { free memory } + { free memory } clear; { continue where we left off, BlockEnd is either the start of an } { assembler block or nil} @@ -264,4 +262,6 @@ Unit aopt; end; +begin + casmoptimizer:=TAsmOptimizer; end. diff --git a/compiler/aoptbase.pas b/compiler/aoptbase.pas index 83ad7b34ed..0b898b57f3 100644 --- a/compiler/aoptbase.pas +++ b/compiler/aoptbase.pas @@ -44,7 +44,7 @@ unit aoptbase; TAoptBase = class { processor independent methods } - constructor create; virtual; + constructor create; destructor destroy;override; { returns true if register Reg is used by instruction p1 } Function RegInInstruction(Reg: TRegister; p1: tai): Boolean; diff --git a/compiler/aoptda.pas b/compiler/aoptda.pas index 25bc035898..4897270c70 100644 --- a/compiler/aoptda.pas +++ b/compiler/aoptda.pas @@ -97,7 +97,9 @@ Unit aoptda; ait_label: If (Pai_label(p)^.l^.is_used) Then CurProp^.DestroyAllRegs(InstrSinceLastMod); - ait_stab, ait_force_line, ait_function_name:; + {$ifdef GDB} + ait_stabs, ait_stabn, ait_stab_function_name:; + {$endif GDB} ait_instruction: if not(PInstr(p)^.is_jmp) then begin diff --git a/compiler/aoptobj.pas b/compiler/aoptobj.pas index 49a1698a0e..39f9d0f13c 100644 --- a/compiler/aoptobj.pas +++ b/compiler/aoptobj.pas @@ -249,7 +249,7 @@ Unit AoptObj; { that has to be optimized and _LabelInfo a pointer to a } { TLabelInfo record } Constructor create(_AsmL: TAasmOutput; _BlockStart, _BlockEnd: Tai; - _LabelInfo: PLabelInfo); virtual; + _LabelInfo: PLabelInfo); { processor independent methods } @@ -290,15 +290,12 @@ Unit AoptObj; function getlabelwithsym(sym: tasmlabel): tai; { peephole optimizer } - procedure PrePeepHoleOpts; - procedure PeepHoleOptPass1; - procedure PeepHoleOptPass2; - procedure PostPeepHoleOpts; + procedure PrePeepHoleOpts;virtual; + procedure PeepHoleOptPass1;virtual; + procedure PeepHoleOptPass2;virtual; + procedure PostPeepHoleOpts;virtual; { processor dependent methods } - // if it returns true, perform a "continue" - function PeepHoleOptPass1Cpu(var p: tai): boolean; virtual; - function PostPeepHoleOptsCpu(var p: tai): boolean; virtual; End; Function ArrayRefsEq(const r1, r2: TReference): Boolean; @@ -960,7 +957,7 @@ Unit AoptObj; insertllitem(asml,p1,p1.next,tai_comment.Create( strpnew('previous label inserted')))); {$endif finaldestdebug} - objectlibrary.getjumplabel(l); + objectlibrary.getlabel(l); insertllitem(p1,p1.next,tai_label.Create(l)); tasmlabel(taicpu(hp).oper[0]^.ref^.symbol).decrefs; hp.oper[0]^.ref^.symbol := l; @@ -1000,8 +997,6 @@ Unit AoptObj; while (p <> BlockEnd) Do begin //!!!! UpDateUsedRegs(UsedRegs, tai(p.next)); - if PeepHoleOptPass1Cpu(p) then - continue; case p.Typ Of ait_instruction: begin @@ -1095,31 +1090,8 @@ Unit AoptObj; procedure TAOptObj.PostPeepHoleOpts; - var - p: tai; - begin - p := BlockStart; - //!!!! UsedRegs := []; - while (p <> BlockEnd) Do - begin - //!!!! UpDateUsedRegs(UsedRegs, tai(p.next)); - if PostPeepHoleOptsCpu(p) then - continue; - //!!!!!!!! updateUsedRegs(UsedRegs,p); - p:=tai(p.next); - end; - end; - - - function TAOptObj.PeepHoleOptPass1Cpu(var p: tai): boolean; begin - result := false; end; - function TAOptObj.PostPeepHoleOptsCpu(var p: tai): boolean; - begin - result := false; - end; - End. diff --git a/compiler/arm/aasmcpu.pas b/compiler/arm/aasmcpu.pas index 534ca0099f..114251979c 100644 --- a/compiler/arm/aasmcpu.pas +++ b/compiler/arm/aasmcpu.pas @@ -26,9 +26,8 @@ unit aasmcpu; interface uses - cclasses,globtype,globals,verbose, - aasmbase,aasmtai, - symtype, + cclasses,aasmtai, + aasmbase,globtype,globals,verbose, cpubase,cpuinfo,cgbase,cgutils; const @@ -37,120 +36,6 @@ uses { "mov reg,reg" source operand number } O_MOV_DEST = 0; - { Operand types } - OT_NONE = $00000000; - - OT_BITS8 = $00000001; { size, and other attributes, of the operand } - OT_BITS16 = $00000002; - OT_BITS32 = $00000004; - OT_BITS64 = $00000008; { FPU only } - OT_BITS80 = $00000010; - OT_FAR = $00000020; { this means 16:16 or 16:32, like in CALL/JMP } - OT_NEAR = $00000040; - OT_SHORT = $00000080; - OT_BITSTINY = $00000100; { fpu constant } - OT_BITSSHIFTER = - $00000200; - - OT_SIZE_MASK = $000003FF; { all the size attributes } - OT_NON_SIZE = longint(not OT_SIZE_MASK); - - OT_SIGNED = $00000100; { the operand need to be signed -128-127 } - - OT_TO = $00000200; { operand is followed by a colon } - { reverse effect in FADD, FSUB &c } - OT_COLON = $00000400; - - OT_SHIFTEROP = $00000800; - OT_REGISTER = $00001000; - OT_IMMEDIATE = $00002000; - OT_REGLIST = $00008000; - OT_IMM8 = $00002001; - OT_IMM24 = $00002002; - OT_IMM32 = $00002004; - OT_IMM64 = $00002008; - OT_IMM80 = $00002010; - OT_IMMTINY = $00002100; - OT_IMMSHIFTER= $00002200; - OT_IMMEDIATE24 = OT_IMM24; - OT_SHIFTIMM = OT_SHIFTEROP or OT_IMMSHIFTER; - OT_SHIFTIMMEDIATE = OT_SHIFTIMM; - OT_IMMEDIATESHIFTER = OT_IMMSHIFTER; - - OT_IMMEDIATEFPU = OT_IMMTINY; - - OT_REGMEM = $00200000; { for r/m, ie EA, operands } - OT_REGNORM = $00201000; { 'normal' reg, qualifies as EA } - OT_REG8 = $00201001; - OT_REG16 = $00201002; - OT_REG32 = $00201004; - OT_REG64 = $00201008; - OT_VREG = $00201010; { vector register } - OT_MEMORY = $00204000; { register number in 'basereg' } - OT_MEM8 = $00204001; - OT_MEM16 = $00204002; - OT_MEM32 = $00204004; - OT_MEM64 = $00204008; - OT_MEM80 = $00204010; - { word/byte load/store } - OT_AM2 = $00010000; - { misc ld/st operations } - OT_AM3 = $00020000; - { multiple ld/st operations } - OT_AM4 = $00040000; - { co proc. ld/st operations } - OT_AM5 = $00080000; - OT_AMMASK = $000f0000; - - OT_MEMORYAM2 = OT_MEMORY or OT_AM2; - OT_MEMORYAM3 = OT_MEMORY or OT_AM3; - OT_MEMORYAM4 = OT_MEMORY or OT_AM4; - OT_MEMORYAM5 = OT_MEMORY or OT_AM5; - - OT_FPUREG = $01000000; { floating point stack registers } - OT_REG_SMASK = $00070000; { special register operands: these may be treated differently } - { a mask for the following } - - OT_MEM_OFFS = $00604000; { special type of EA } - { simple [address] offset } - OT_ONENESS = $00800000; { special type of immediate operand } - { so UNITY == IMMEDIATE | ONENESS } - OT_UNITY = $00802000; { for shift/rotate instructions } - - instabentries = {$i armnop.inc} - - maxinfolen = 5; - - IF_NONE = $00000000; - - IF_ARMMASK = $000F0000; - IF_ARM7 = $00070000; - IF_FPMASK = $00F00000; - IF_FPA = $00100000; - - { if the instruction can change in a second pass } - IF_PASS2 = longint($80000000); - - type - TInsTabCache=array[TasmOp] of longint; - PInsTabCache=^TInsTabCache; - - tinsentry = record - opcode : tasmop; - ops : byte; - optypes : array[0..3] of longint; - code : array[0..maxinfolen] of char; - flags : longint; - end; - - pinsentry=^tinsentry; - - const - InsTab : array[0..instabentries-1] of TInsEntry={$i armtab.inc} - - var - InsTabCache : PInsTabCache; - type taicpu = class(tai_cpu_abstract) oppostfix : TOpPostfix; @@ -190,37 +75,7 @@ uses function is_same_reg_move(regtype: Tregistertype):boolean; override; function spilling_get_operation_type(opnr: longint): topertype;override; - - { assembler } - public - { the next will reset all instructions that can change in pass 2 } - procedure ResetPass1; - procedure ResetPass2; - function CheckIfValid:boolean; - function GetString:string; - function Pass1(offset:longint):longint;override; - procedure Pass2(objdata:TAsmObjectdata);override; - protected - procedure ppuloadoper(ppufile:tcompilerppufile;var o:toper);override; - procedure ppuwriteoper(ppufile:tcompilerppufile;const o:toper);override; - procedure ppubuildderefimploper(var o:toper);override; - procedure ppuderefoper(var o:toper);override; - private - { next fields are filled in pass1, so pass2 is faster } - inssize : shortint; - insoffset : longint; - LastInsOffset : longint; { need to be public to be reset } - insentry : PInsEntry; - function InsEnd:longint; - procedure create_ot; - function Matches(p:PInsEntry):longint; - function calcsize(p:PInsEntry):shortint; - procedure gencode(objdata:TAsmObjectData); - function NeedAddrPrefix(opidx:byte):boolean; - procedure Swapoperands; - function FindInsentry:boolean; end; - tai_align = class(tai_align_abstract) { nothing to add } end; @@ -460,6 +315,8 @@ implementation end; +{ ****************************** newra stuff *************************** } + function taicpu.is_same_reg_move(regtype: Tregistertype):boolean; begin { allow the register allocator to remove unnecessary moves } @@ -511,7 +368,7 @@ implementation case opcode of A_ADC,A_ADD,A_AND, A_EOR,A_CLZ, - A_LDR,A_LDRB,A_LDRBT,A_LDRH,A_LDRSB, + A_LDR,A_LDRB,A_LDRD,A_LDRBT,A_LDRH,A_LDRSB, A_LDRSH,A_LDRT, A_MOV,A_MVN,A_MLA,A_MUL, A_ORR,A_RSB,A_RSC,A_SBC,A_SUB, @@ -540,7 +397,7 @@ implementation result:=operand_write else result:=operand_read; - A_STR,A_STRB,A_STRBT, + A_STR,A_STRB,A_STRBT,A_STRD, A_STRH,A_STRT,A_STF,A_SFM: { important is what happens with the involved registers } if opnr=0 then @@ -554,36 +411,13 @@ implementation end; - procedure BuildInsTabCache; - var - i : longint; - begin - new(instabcache); - FillChar(instabcache^,sizeof(tinstabcache),$ff); - i:=0; - while (i<InsTabEntries) do - begin - if InsTabCache^[InsTab[i].Opcode]=-1 then - InsTabCache^[InsTab[i].Opcode]:=i; - inc(i); - end; - end; - - procedure InitAsm; begin - if not assigned(instabcache) then - BuildInsTabCache; end; procedure DoneAsm; begin - if assigned(instabcache) then - begin - dispose(instabcache); - instabcache:=nil; - end; end; @@ -667,7 +501,7 @@ implementation begin lastpos:=curpos; hp:=tai(curtai.next); - objectlibrary.getjumplabel(l); + objectlibrary.getlabel(l); curdata.insert(taicpu.op_sym(A_B,l)); curdata.concat(tai_label.create(l)); list.insertlistafter(curtai,curdata); @@ -680,1720 +514,4 @@ implementation curdata.free; end; - -(* - Floating point instruction format information, taken from the linux kernel - ARM Floating Point Instruction Classes - | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | - |c o n d|1 1 0 P|U|u|W|L| Rn |v| Fd |0|0|0|1| o f f s e t | CPDT - |c o n d|1 1 0 P|U|w|W|L| Rn |x| Fd |0|0|1|0| o f f s e t | CPDT (copro 2) - | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | - |c o n d|1 1 1 0|a|b|c|d|e| Fn |j| Fd |0|0|0|1|f|g|h|0|i| Fm | CPDO - |c o n d|1 1 1 0|a|b|c|L|e| Fn | Rd |0|0|0|1|f|g|h|1|i| Fm | CPRT - |c o n d|1 1 1 0|a|b|c|1|e| Fn |1|1|1|1|0|0|0|1|f|g|h|1|i| Fm | comparisons - | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | - - CPDT data transfer instructions - LDF, STF, LFM (copro 2), SFM (copro 2) - - CPDO dyadic arithmetic instructions - ADF, MUF, SUF, RSF, DVF, RDF, - POW, RPW, RMF, FML, FDV, FRD, POL - - CPDO monadic arithmetic instructions - MVF, MNF, ABS, RND, SQT, LOG, LGN, EXP, - SIN, COS, TAN, ASN, ACS, ATN, URD, NRM - - CPRT joint arithmetic/data transfer instructions - FIX (arithmetic followed by load/store) - FLT (load/store followed by arithmetic) - CMF, CNF CMFE, CNFE (comparisons) - WFS, RFS (write/read floating point status register) - WFC, RFC (write/read floating point control register) - - cond condition codes - P pre/post index bit: 0 = postindex, 1 = preindex - U up/down bit: 0 = stack grows down, 1 = stack grows up - W write back bit: 1 = update base register (Rn) - L load/store bit: 0 = store, 1 = load - Rn base register - Rd destination/source register - Fd floating point destination register - Fn floating point source register - Fm floating point source register or floating point constant - - uv transfer length (TABLE 1) - wx register count (TABLE 2) - abcd arithmetic opcode (TABLES 3 & 4) - ef destination size (rounding precision) (TABLE 5) - gh rounding mode (TABLE 6) - j dyadic/monadic bit: 0 = dyadic, 1 = monadic - i constant bit: 1 = constant (TABLE 6) - */ - - /* - TABLE 1 - +-------------------------+---+---+---------+---------+ - | Precision | u | v | FPSR.EP | length | - +-------------------------+---+---+---------+---------+ - | Single | 0 | 0 | x | 1 words | - | Double | 1 | 1 | x | 2 words | - | Extended | 1 | 1 | x | 3 words | - | Packed decimal | 1 | 1 | 0 | 3 words | - | Expanded packed decimal | 1 | 1 | 1 | 4 words | - +-------------------------+---+---+---------+---------+ - Note: x = don't care - */ - - /* - TABLE 2 - +---+---+---------------------------------+ - | w | x | Number of registers to transfer | - +---+---+---------------------------------+ - | 0 | 1 | 1 | - | 1 | 0 | 2 | - | 1 | 1 | 3 | - | 0 | 0 | 4 | - +---+---+---------------------------------+ - */ - - /* - TABLE 3: Dyadic Floating Point Opcodes - +---+---+---+---+----------+-----------------------+-----------------------+ - | a | b | c | d | Mnemonic | Description | Operation | - +---+---+---+---+----------+-----------------------+-----------------------+ - | 0 | 0 | 0 | 0 | ADF | Add | Fd := Fn + Fm | - | 0 | 0 | 0 | 1 | MUF | Multiply | Fd := Fn * Fm | - | 0 | 0 | 1 | 0 | SUF | Subtract | Fd := Fn - Fm | - | 0 | 0 | 1 | 1 | RSF | Reverse subtract | Fd := Fm - Fn | - | 0 | 1 | 0 | 0 | DVF | Divide | Fd := Fn / Fm | - | 0 | 1 | 0 | 1 | RDF | Reverse divide | Fd := Fm / Fn | - | 0 | 1 | 1 | 0 | POW | Power | Fd := Fn ^ Fm | - | 0 | 1 | 1 | 1 | RPW | Reverse power | Fd := Fm ^ Fn | - | 1 | 0 | 0 | 0 | RMF | Remainder | Fd := IEEE rem(Fn/Fm) | - | 1 | 0 | 0 | 1 | FML | Fast Multiply | Fd := Fn * Fm | - | 1 | 0 | 1 | 0 | FDV | Fast Divide | Fd := Fn / Fm | - | 1 | 0 | 1 | 1 | FRD | Fast reverse divide | Fd := Fm / Fn | - | 1 | 1 | 0 | 0 | POL | Polar angle (ArcTan2) | Fd := arctan2(Fn,Fm) | - | 1 | 1 | 0 | 1 | | undefined instruction | trap | - | 1 | 1 | 1 | 0 | | undefined instruction | trap | - | 1 | 1 | 1 | 1 | | undefined instruction | trap | - +---+---+---+---+----------+-----------------------+-----------------------+ - Note: POW, RPW, POL are deprecated, and are available for backwards - compatibility only. - */ - - /* - TABLE 4: Monadic Floating Point Opcodes - +---+---+---+---+----------+-----------------------+-----------------------+ - | a | b | c | d | Mnemonic | Description | Operation | - +---+---+---+---+----------+-----------------------+-----------------------+ - | 0 | 0 | 0 | 0 | MVF | Move | Fd := Fm | - | 0 | 0 | 0 | 1 | MNF | Move negated | Fd := - Fm | - | 0 | 0 | 1 | 0 | ABS | Absolute value | Fd := abs(Fm) | - | 0 | 0 | 1 | 1 | RND | Round to integer | Fd := int(Fm) | - | 0 | 1 | 0 | 0 | SQT | Square root | Fd := sqrt(Fm) | - | 0 | 1 | 0 | 1 | LOG | Log base 10 | Fd := log10(Fm) | - | 0 | 1 | 1 | 0 | LGN | Log base e | Fd := ln(Fm) | - | 0 | 1 | 1 | 1 | EXP | Exponent | Fd := e ^ Fm | - | 1 | 0 | 0 | 0 | SIN | Sine | Fd := sin(Fm) | - | 1 | 0 | 0 | 1 | COS | Cosine | Fd := cos(Fm) | - | 1 | 0 | 1 | 0 | TAN | Tangent | Fd := tan(Fm) | - | 1 | 0 | 1 | 1 | ASN | Arc Sine | Fd := arcsin(Fm) | - | 1 | 1 | 0 | 0 | ACS | Arc Cosine | Fd := arccos(Fm) | - | 1 | 1 | 0 | 1 | ATN | Arc Tangent | Fd := arctan(Fm) | - | 1 | 1 | 1 | 0 | URD | Unnormalized round | Fd := int(Fm) | - | 1 | 1 | 1 | 1 | NRM | Normalize | Fd := norm(Fm) | - +---+---+---+---+----------+-----------------------+-----------------------+ - Note: LOG, LGN, EXP, SIN, COS, TAN, ASN, ACS, ATN are deprecated, and are - available for backwards compatibility only. - */ - - /* - TABLE 5 - +-------------------------+---+---+ - | Rounding Precision | e | f | - +-------------------------+---+---+ - | IEEE Single precision | 0 | 0 | - | IEEE Double precision | 0 | 1 | - | IEEE Extended precision | 1 | 0 | - | undefined (trap) | 1 | 1 | - +-------------------------+---+---+ - */ - - /* - TABLE 5 - +---------------------------------+---+---+ - | Rounding Mode | g | h | - +---------------------------------+---+---+ - | Round to nearest (default) | 0 | 0 | - | Round toward plus infinity | 0 | 1 | - | Round toward negative infinity | 1 | 0 | - | Round toward zero | 1 | 1 | - +---------------------------------+---+---+ -*) - function taicpu.GetString:string; - var - i : longint; - s : string; - addsize : boolean; - begin - s:='['+gas_op2str[opcode]; - for i:=0 to ops-1 do - begin - with oper[i]^ do - begin - if i=0 then - s:=s+' ' - else - s:=s+','; - { type } - addsize:=false; - if (ot and OT_VREG)=OT_VREG then - s:=s+'vreg' - else - if (ot and OT_FPUREG)=OT_FPUREG then - s:=s+'fpureg' - else - if (ot and OT_REGISTER)=OT_REGISTER then - begin - s:=s+'reg'; - addsize:=true; - end - else - if (ot and OT_REGLIST)=OT_REGLIST then - begin - s:=s+'reglist'; - addsize:=false; - end - else - if (ot and OT_IMMEDIATE)=OT_IMMEDIATE then - begin - s:=s+'imm'; - addsize:=true; - end - else - if (ot and OT_MEMORY)=OT_MEMORY then - begin - s:=s+'mem'; - addsize:=true; - if (ot and OT_AM2)<>0 then - s:=s+' am2 '; - end - else - s:=s+'???'; - { size } - if addsize then - begin - if (ot and OT_BITS8)<>0 then - s:=s+'8' - else - if (ot and OT_BITS16)<>0 then - s:=s+'24' - else - if (ot and OT_BITS32)<>0 then - s:=s+'32' - else - if (ot and OT_BITSSHIFTER)<>0 then - s:=s+'shifter' - else - s:=s+'??'; - { signed } - if (ot and OT_SIGNED)<>0 then - s:=s+'s'; - end; - end; - end; - GetString:=s+']'; - end; - - - procedure taicpu.ResetPass1; - begin - { we need to reset everything here, because the choosen insentry - can be invalid for a new situation where the previously optimized - insentry is not correct } - InsEntry:=nil; - InsSize:=0; - LastInsOffset:=-1; - end; - - - procedure taicpu.ResetPass2; - begin - { we are here in a second pass, check if the instruction can be optimized } - if assigned(InsEntry) and - ((InsEntry^.flags and IF_PASS2)<>0) then - begin - InsEntry:=nil; - InsSize:=0; - end; - LastInsOffset:=-1; - end; - - - function taicpu.CheckIfValid:boolean; - begin - end; - - - function taicpu.Pass1(offset:longint):longint; - var - ldr2op : array[PF_B..PF_T] of tasmop = ( - A_LDRB,A_LDRSB,A_LDRBT,A_LDRH,A_LDRSH,A_LDRT); - str2op : array[PF_B..PF_T] of tasmop = ( - A_STRB,A_None,A_STRBT,A_STRH,A_None,A_STRT); - begin - Pass1:=0; - { Save the old offset and set the new offset } - InsOffset:=Offset; - { Error? } - if (Insentry=nil) and (InsSize=-1) then - exit; - { set the file postion } - aktfilepos:=fileinfo; - - { tranlate LDR+postfix to complete opcode } - if (opcode=A_LDR) and (oppostfix<>PF_None) then - begin - if (oppostfix in [low(ldr2op)..high(ldr2op)]) then - opcode:=ldr2op[oppostfix] - else - internalerror(2005091001); - if opcode=A_None then - internalerror(2005091004); - { postfix has been added to opcode } - oppostfix:=PF_None; - end - else if (opcode=A_STR) and (oppostfix<>PF_None) then - begin - if (oppostfix in [low(str2op)..high(str2op)]) then - opcode:=str2op[oppostfix] - else - internalerror(2005091002); - if opcode=A_None then - internalerror(2005091003); - { postfix has been added to opcode } - oppostfix:=PF_None; - end; - - { Get InsEntry } - if FindInsEntry then - begin - InsSize:=4; - LastInsOffset:=InsOffset; - Pass1:=InsSize; - exit; - end; - LastInsOffset:=-1; - end; - - - procedure taicpu.Pass2(objdata:TAsmObjectdata); - begin - { error in pass1 ? } - if insentry=nil then - exit; - aktfilepos:=fileinfo; - { Generate the instruction } - GenCode(objdata); - end; - - - procedure taicpu.ppuloadoper(ppufile:tcompilerppufile;var o:toper); - begin - end; - - - procedure taicpu.ppuwriteoper(ppufile:tcompilerppufile;const o:toper); - begin - end; - - - procedure taicpu.ppubuildderefimploper(var o:toper); - begin - end; - - - procedure taicpu.ppuderefoper(var o:toper); - begin - end; - - - function taicpu.InsEnd:longint; - begin - end; - - - procedure taicpu.create_ot; - var - i,l,relsize : longint; - dummy : byte; - begin - if ops=0 then - exit; - { update oper[].ot field } - for i:=0 to ops-1 do - with oper[i]^ do - begin - case typ of - top_regset: - begin - ot:=OT_REGLIST; - end; - top_reg : - begin - case getregtype(reg) of - R_INTREGISTER: - ot:=OT_REG32 or OT_SHIFTEROP; - R_FPUREGISTER: - ot:=OT_FPUREG; - else - internalerror(2005090901); - end; - end; - top_ref : - begin - if ref^.refaddr=addr_no then - begin - { create ot field } - { we should get the size here dependend on the - instruction } - if (ot and OT_SIZE_MASK)=0 then - ot:=OT_MEMORY or OT_BITS32 - else - ot:=OT_MEMORY or (ot and OT_SIZE_MASK); - if (ref^.base=NR_NO) and (ref^.index=NR_NO) then - ot:=ot or OT_MEM_OFFS; - { if we need to fix a reference, we do it here } - - { pc relative addressing } - if (ref^.base=NR_NO) and - (ref^.index=NR_NO) and - (ref^.shiftmode=SM_None) - { at least we should check if the destination symbol - is in a text section } - { and - (ref^.symbol^.owner="text") } then - ref^.base:=NR_PC; - - { determine possible address modes } - if (ref^.base<>NR_NO) and - ( - ( - (ref^.index=NR_NO) and - (ref^.shiftmode=SM_None) and - (ref^.offset>=-4097) and - (ref^.offset<=4097) - ) or - ( - (ref^.shiftmode=SM_None) and - (ref^.offset=0) - ) or - ( - (ref^.index<>NR_NO) and - (ref^.shiftmode<>SM_None) and - (ref^.shiftimm<=31) and - (ref^.offset=0) - ) - ) then - ot:=ot or OT_AM2; - - if (ref^.index<>NR_NO) and - (oppostfix in [PF_IA,PF_IB,PF_DA,PF_DB,PF_FD,PF_FA,PF_ED,PF_EA]) and - ( - (ref^.base=NR_NO) and - (ref^.shiftmode=SM_None) and - (ref^.offset=0) - ) then - ot:=ot or OT_AM4; - - end - else - begin - l:=ref^.offset; - if assigned(ref^.symbol) then - inc(l,ref^.symbol.address); - relsize:=(InsOffset+2)-l; - if (relsize<-33554428) or (relsize>33554428) then - ot:=OT_IMM32 - else - ot:=OT_IMM24; - end; - end; - top_local : - begin - { we should get the size here dependend on the - instruction } - if (ot and OT_SIZE_MASK)=0 then - ot:=OT_MEMORY or OT_BITS32 - else - ot:=OT_MEMORY or (ot and OT_SIZE_MASK); - end; - top_const : - begin - ot:=OT_IMMEDIATE; - if is_shifter_const(val,dummy) then - ot:=OT_IMMSHIFTER - else - ot:=OT_IMM32 - end; - top_none : - begin - { generated when there was an error in the - assembler reader. It never happends when generating - assembler } - end; - top_shifterop: - begin - ot:=OT_SHIFTEROP; - end; - else - internalerror(200402261); - end; - end; - end; - - - function taicpu.Matches(p:PInsEntry):longint; - { * IF_SM stands for Size Match: any operand whose size is not - * explicitly specified by the template is `really' intended to be - * the same size as the first size-specified operand. - * Non-specification is tolerated in the input instruction, but - * _wrong_ specification is not. - * - * IF_SM2 invokes Size Match on only the first _two_ operands, for - * three-operand instructions such as SHLD: it implies that the - * first two operands must match in size, but that the third is - * required to be _unspecified_. - * - * IF_SB invokes Size Byte: operands with unspecified size in the - * template are really bytes, and so no non-byte specification in - * the input instruction will be tolerated. IF_SW similarly invokes - * Size Word, and IF_SD invokes Size Doubleword. - * - * (The default state if neither IF_SM nor IF_SM2 is specified is - * that any operand with unspecified size in the template is - * required to have unspecified size in the instruction too...) - } - var - i,j,asize,oprs : longint; - siz : array[0..3] of longint; - begin - Matches:=100; - writeln(getstring,'---'); - - { Check the opcode and operands } - if (p^.opcode<>opcode) or (p^.ops<>ops) then - begin - Matches:=0; - exit; - end; - - { Check that no spurious colons or TOs are present } - for i:=0 to p^.ops-1 do - if (oper[i]^.ot and (not p^.optypes[i]) and (OT_COLON or OT_TO))<>0 then - begin - Matches:=0; - exit; - end; - - { Check that the operand flags all match up } - for i:=0 to p^.ops-1 do - begin - if ((p^.optypes[i] and (not oper[i]^.ot)) or - ((p^.optypes[i] and OT_SIZE_MASK) and - ((p^.optypes[i] xor oper[i]^.ot) and OT_SIZE_MASK)))<>0 then - begin - if ((p^.optypes[i] and (not oper[i]^.ot) and OT_NON_SIZE) or - (oper[i]^.ot and OT_SIZE_MASK))<>0 then - begin - Matches:=0; - exit; - end - else - Matches:=1; - end; - end; - - { check postfixes: - the existance of a certain postfix requires a - particular code } - - { update condition flags - or floating point single } - if (oppostfix=PF_S) and - not(p^.code[0] in [#$04]) then - begin - Matches:=0; - exit; - end; - - { floating point size } - if (oppostfix in [PF_D,PF_E,PF_P,PF_EP]) and - not(p^.code[0] in []) then - begin - Matches:=0; - exit; - end; - - { multiple load/store address modes } - if (oppostfix in [PF_IA,PF_IB,PF_DA,PF_DB,PF_FD,PF_FA,PF_ED,PF_EA]) and - not(p^.code[0] in [ - // ldr,str,ldrb,strb - #$17, - // stm,ldm - #$26 - ]) then - begin - Matches:=0; - exit; - end; - - { we shouldn't see any opsize prefixes here } - if (oppostfix in [PF_B,PF_SB,PF_BT,PF_H,PF_SH,PF_T]) then - begin - Matches:=0; - exit; - end; - - if (roundingmode<>RM_None) and not(p^.code[0] in []) then - begin - Matches:=0; - exit; - end; - - { Check operand sizes } - { as default an untyped size can get all the sizes, this is different - from nasm, but else we need to do a lot checking which opcodes want - size or not with the automatic size generation } - asize:=longint($ffffffff); - (* - if (p^.flags and IF_SB)<>0 then - asize:=OT_BITS8 - else if (p^.flags and IF_SW)<>0 then - asize:=OT_BITS16 - else if (p^.flags and IF_SD)<>0 then - asize:=OT_BITS32; - if (p^.flags and IF_ARMASK)<>0 then - begin - siz[0]:=0; - siz[1]:=0; - siz[2]:=0; - if (p^.flags and IF_AR0)<>0 then - siz[0]:=asize - else if (p^.flags and IF_AR1)<>0 then - siz[1]:=asize - else if (p^.flags and IF_AR2)<>0 then - siz[2]:=asize; - end - else - begin - { we can leave because the size for all operands is forced to be - the same - but not if IF_SB IF_SW or IF_SD is set PM } - if asize=-1 then - exit; - siz[0]:=asize; - siz[1]:=asize; - siz[2]:=asize; - end; - - if (p^.flags and (IF_SM or IF_SM2))<>0 then - begin - if (p^.flags and IF_SM2)<>0 then - oprs:=2 - else - oprs:=p^.ops; - for i:=0 to oprs-1 do - if ((p^.optypes[i] and OT_SIZE_MASK) <> 0) then - begin - for j:=0 to oprs-1 do - siz[j]:=p^.optypes[i] and OT_SIZE_MASK; - break; - end; - end - else - oprs:=2; - - { Check operand sizes } - for i:=0 to p^.ops-1 do - begin - if ((p^.optypes[i] and OT_SIZE_MASK)=0) and - ((oper[i]^.ot and OT_SIZE_MASK and (not siz[i]))<>0) and - { Immediates can always include smaller size } - ((oper[i]^.ot and OT_IMMEDIATE)=0) and - (((p^.optypes[i] and OT_SIZE_MASK) or siz[i])<(oper[i]^.ot and OT_SIZE_MASK)) then - Matches:=2; - end; - *) - end; - - - function taicpu.calcsize(p:PInsEntry):shortint; - begin - result:=4; - end; - - - function taicpu.NeedAddrPrefix(opidx:byte):boolean; - begin - end; - - - procedure taicpu.Swapoperands; - begin - end; - - - function taicpu.FindInsentry:boolean; - var - i : longint; - begin - result:=false; - { Things which may only be done once, not when a second pass is done to - optimize } - if (Insentry=nil) or ((InsEntry^.flags and IF_PASS2)<>0) then - begin - { create the .ot fields } - create_ot; - { set the file postion } - aktfilepos:=fileinfo; - end - else - begin - { we've already an insentry so it's valid } - result:=true; - exit; - end; - { Lookup opcode in the table } - InsSize:=-1; - i:=instabcache^[opcode]; - if i=-1 then - begin - Message1(asmw_e_opcode_not_in_table,gas_op2str[opcode]); - exit; - end; - insentry:=@instab[i]; - while (insentry^.opcode=opcode) do - begin - if matches(insentry)=100 then - begin - result:=true; - exit; - end; - inc(i); - insentry:=@instab[i]; - end; - Message1(asmw_e_invalid_opcode_and_operands,GetString); - { No instruction found, set insentry to nil and inssize to -1 } - insentry:=nil; - inssize:=-1; - end; - - - procedure taicpu.gencode(objdata:TAsmObjectData); - var - bytes : dword; - i_field : byte; - - procedure setshifterop(op : byte); - begin - case oper[op]^.typ of - top_const: - begin - i_field:=1; - bytes:=bytes or (oper[op]^.val and $fff); - end; - top_reg: - begin - i_field:=0; - bytes:=bytes or (getsupreg(oper[op]^.reg) shl 16); - - { does a real shifter op follow? } - if (op+1<=op) and (oper[op+1]^.typ=top_shifterop) then - begin - end; - end; - else - internalerror(2005091103); - end; - end; - - begin - bytes:=$0; - { evaluate and set condition code } - - { condition code allowed? } - - { setup rest of the instruction } - case insentry^.code[0] of - #$08: - begin - { set instruction code } - bytes:=bytes or (ord(insentry^.code[1]) shl 26); - bytes:=bytes or (ord(insentry^.code[2]) shl 21); - - { set destination } - bytes:=bytes or (getsupreg(oper[0]^.reg) shl 12); - - { create shifter op } - setshifterop(1); - - { set i field } - bytes:=bytes or (i_field shl 25); - - { set s if necessary } - if oppostfix=PF_S then - bytes:=bytes or (1 shl 20); - end; - #$ff: - internalerror(2005091101); - else - internalerror(2005091102); - end; - { we're finished, write code } - objdata.writebytes(bytes,sizeof(bytes)); - end; - - end. - -{$ifdef dummy} - (* -static void gencode (long segment, long offset, int bits, - insn *ins, char *codes, long insn_end) -{ - int has_S_code; /* S - setflag */ - int has_B_code; /* B - setflag */ - int has_T_code; /* T - setflag */ - int has_W_code; /* ! => W flag */ - int has_F_code; /* ^ => S flag */ - int keep; - unsigned char c; - unsigned char bytes[4]; - long data, size; - static int cc_code[] = /* bit pattern of cc */ - { /* order as enum in */ - 0x0E, 0x03, 0x02, 0x00, /* nasm.h */ - 0x0A, 0x0C, 0x08, 0x0D, - 0x09, 0x0B, 0x04, 0x01, - 0x05, 0x07, 0x06, - }; - -(* -#ifdef DEBUG -static char *CC[] = - { /* condition code names */ - "AL", "CC", "CS", "EQ", - "GE", "GT", "HI", "LE", - "LS", "LT", "MI", "NE", - "PL", "VC", "VS", "", - "S" -}; -*) - - has_S_code = (ins->condition & C_SSETFLAG); - has_B_code = (ins->condition & C_BSETFLAG); - has_T_code = (ins->condition & C_TSETFLAG); - has_W_code = (ins->condition & C_EXSETFLAG); - has_F_code = (ins->condition & C_FSETFLAG); - ins->condition = (ins->condition & 0x0F); - -(* - if (rt_debug) - { - printf ("gencode: instruction: %s%s", insn_names[ins->opcode], - CC[ins->condition & 0x0F]); - if (has_S_code) - printf ("S"); - if (has_B_code) - printf ("B"); - if (has_T_code) - printf ("T"); - if (has_W_code) - printf ("!"); - if (has_F_code) - printf ("^"); - - printf ("\n"); - - c = *codes; - - printf (" (%d) decode - '0x%02X'\n", ins->operands, c); - - - bytes[0] = 0xB; - bytes[1] = 0xE; - bytes[2] = 0xE; - bytes[3] = 0xF; - } -*) - // First condition code in upper nibble - if (ins->condition < C_NONE) - { - c = cc_code[ins->condition] << 4; - } - else - { - c = cc_code[C_AL] << 4; // is often ALWAYS but not always - } - - - switch (keep = *codes) - { - case 1: - // B, BL - ++codes; - c |= *codes++; - bytes[0] = c; - - if (ins->oprs[0].segment != segment) - { - // fais une relocation - c = 1; - data = 0; // Let the linker locate ?? - } - else - { - c = 0; - data = ins->oprs[0].offset - (offset + 8); - - if (data % 4) - { - errfunc (ERR_NONFATAL, "offset not aligned on 4 bytes"); - } - } - - if (data >= 0x1000) - { - errfunc (ERR_NONFATAL, "too long offset"); - } - - data = data >> 2; - bytes[1] = (data >> 16) & 0xFF; - bytes[2] = (data >> 8) & 0xFF; - bytes[3] = (data ) & 0xFF; - - if (c == 1) - { -// out (offset, segment, &bytes[0], OUT_RAWDATA+1, NO_SEG, NO_SEG); - out (offset, segment, &bytes[0], OUT_REL3ADR+4, ins->oprs[0].segment, NO_SEG); - } - else - { - out (offset, segment, &bytes[0], OUT_RAWDATA+4, NO_SEG, NO_SEG); - } - return; - - case 2: - // SWI - ++codes; - c |= *codes++; - bytes[0] = c; - data = ins->oprs[0].offset; - bytes[1] = (data >> 16) & 0xFF; - bytes[2] = (data >> 8) & 0xFF; - bytes[3] = (data) & 0xFF; - out (offset, segment, &bytes, OUT_RAWDATA+4, NO_SEG, NO_SEG); - return; - case 3: - // BX - ++codes; - c |= *codes++; - bytes[0] = c; - bytes[1] = *codes++; - bytes[2] = *codes++; - bytes[3] = *codes++; - c = regval (&ins->oprs[0],1); - if (c == 15) // PC - { - errfunc (ERR_WARNING, "'BX' with R15 has undefined behaviour"); - } - else if (c > 15) - { - errfunc (ERR_NONFATAL, "Illegal register specified for 'BX'"); - } - - bytes[3] |= (c & 0x0F); - out (offset, segment, bytes, OUT_RAWDATA+4, NO_SEG, NO_SEG); - return; - - case 4: // AND Rd,Rn,Rm - case 5: // AND Rd,Rn,Rm,<shift>Rs - case 6: // AND Rd,Rn,Rm,<shift>imm - case 7: // AND Rd,Rn,<shift>imm - ++codes; -#ifdef DEBUG - if (rt_debug) - { - printf (" decode - '0x%02X'\n", keep); - printf (" code - '0x%02X'\n", (unsigned char) ( *codes)); - } -#endif - bytes[0] = c | *codes; - ++codes; - - bytes[1] = *codes; - if (has_S_code) - bytes[1] |= 0x10; - c = regval (&ins->oprs[1],1); - // Rn in low nibble - bytes[1] |= c; - - // Rd in high nibble - bytes[2] = regval (&ins->oprs[0],1) << 4; - - if (keep != 7) - { - // Rm in low nibble - bytes[3] = regval (&ins->oprs[2],1); - } - - // Shifts if any - if (keep == 5 || keep == 6) - { - // Shift in bytes 2 and 3 - if (keep == 5) - { - // Rs - c = regval (&ins->oprs[3],1); - bytes[2] |= c; - - c = 0x10; // Set bit 4 in byte[3] - } - if (keep == 6) - { - c = (ins->oprs[3].offset) & 0x1F; - - // #imm - bytes[2] |= c >> 1; - if (c & 0x01) - { - bytes[3] |= 0x80; - } - c = 0; // Clr bit 4 in byte[3] - } - // <shift> - c |= shiftval (&ins->oprs[3]) << 5; - - bytes[3] |= c; - } - - // reg,reg,imm - if (keep == 7) - { - int shimm; - - shimm = imm_shift (ins->oprs[2].offset); - - if (shimm == -1) - { - errfunc (ERR_NONFATAL, "cannot create that constant"); - } - bytes[3] = shimm & 0xFF; - bytes[2] |= (shimm & 0xF00) >> 8; - } - - out (offset, segment, bytes, OUT_RAWDATA+4, NO_SEG, NO_SEG); - return; - - case 8: // MOV Rd,Rm - case 9: // MOV Rd,Rm,<shift>Rs - case 0xA: // MOV Rd,Rm,<shift>imm - case 0xB: // MOV Rd,<shift>imm - ++codes; -#ifdef DEBUG - if (rt_debug) - { - printf (" decode - '0x%02X'\n", keep); - printf (" code - '0x%02X'\n", (unsigned char) ( *codes)); - } -#endif - bytes[0] = c | *codes; - ++codes; - - bytes[1] = *codes; - if (has_S_code) - bytes[1] |= 0x10; - - // Rd in high nibble - bytes[2] = regval (&ins->oprs[0],1) << 4; - - if (keep != 0x0B) - { - // Rm in low nibble - bytes[3] = regval (&ins->oprs[1],1); - } - - // Shifts if any - if (keep == 0x09 || keep == 0x0A) - { - // Shift in bytes 2 and 3 - if (keep == 0x09) - { - // Rs - c = regval (&ins->oprs[2],1); - bytes[2] |= c; - - c = 0x10; // Set bit 4 in byte[3] - } - if (keep == 0x0A) - { - c = (ins->oprs[2].offset) & 0x1F; - - // #imm - bytes[2] |= c >> 1; - if (c & 0x01) - { - bytes[3] |= 0x80; - } - c = 0; // Clr bit 4 in byte[3] - } - // <shift> - c |= shiftval (&ins->oprs[2]) << 5; - - bytes[3] |= c; - } - - // reg,imm - if (keep == 0x0B) - { - int shimm; - - shimm = imm_shift (ins->oprs[1].offset); - - if (shimm == -1) - { - errfunc (ERR_NONFATAL, "cannot create that constant"); - } - bytes[3] = shimm & 0xFF; - bytes[2] |= (shimm & 0xF00) >> 8; - } - - out (offset, segment, bytes, OUT_RAWDATA+4, NO_SEG, NO_SEG); - return; - - - case 0xC: // CMP Rn,Rm - case 0xD: // CMP Rn,Rm,<shift>Rs - case 0xE: // CMP Rn,Rm,<shift>imm - case 0xF: // CMP Rn,<shift>imm - ++codes; - - bytes[0] = c | *codes++; - - bytes[1] = *codes; - - // Implicit S code - bytes[1] |= 0x10; - - c = regval (&ins->oprs[0],1); - // Rn in low nibble - bytes[1] |= c; - - // No destination - bytes[2] = 0; - - if (keep != 0x0B) - { - // Rm in low nibble - bytes[3] = regval (&ins->oprs[1],1); - } - - // Shifts if any - if (keep == 0x0D || keep == 0x0E) - { - // Shift in bytes 2 and 3 - if (keep == 0x0D) - { - // Rs - c = regval (&ins->oprs[2],1); - bytes[2] |= c; - - c = 0x10; // Set bit 4 in byte[3] - } - if (keep == 0x0E) - { - c = (ins->oprs[2].offset) & 0x1F; - - // #imm - bytes[2] |= c >> 1; - if (c & 0x01) - { - bytes[3] |= 0x80; - } - c = 0; // Clr bit 4 in byte[3] - } - // <shift> - c |= shiftval (&ins->oprs[2]) << 5; - - bytes[3] |= c; - } - - // reg,imm - if (keep == 0x0F) - { - int shimm; - - shimm = imm_shift (ins->oprs[1].offset); - - if (shimm == -1) - { - errfunc (ERR_NONFATAL, "cannot create that constant"); - } - bytes[3] = shimm & 0xFF; - bytes[2] |= (shimm & 0xF00) >> 8; - } - - out (offset, segment, bytes, OUT_RAWDATA+4, NO_SEG, NO_SEG); - return; - - case 0x10: // MRS Rd,<psr> - ++codes; - - bytes[0] = c | *codes++; - - bytes[1] = *codes++; - - // Rd - c = regval (&ins->oprs[0],1); - - bytes[2] = c << 4; - - bytes[3] = 0; - - c = ins->oprs[1].basereg; - - if (c == R_CPSR || c == R_SPSR) - { - if (c == R_SPSR) - { - bytes[1] |= 0x40; - } - } - else - { - errfunc (ERR_NONFATAL, "CPSR or SPSR expected"); - } - - out (offset, segment, bytes, OUT_RAWDATA+4, NO_SEG, NO_SEG); - - return; - - case 0x11: // MSR <psr>,Rm - case 0x12: // MSR <psrf>,Rm - case 0x13: // MSR <psrf>,#expression - ++codes; - - bytes[0] = c | *codes++; - - bytes[1] = *codes++; - - bytes[2] = *codes; - - - if (keep == 0x11 || keep == 0x12) - { - // Rm - c = regval (&ins->oprs[1],1); - - bytes[3] = c; - } - else - { - int shimm; - - shimm = imm_shift (ins->oprs[1].offset); - - if (shimm == -1) - { - errfunc (ERR_NONFATAL, "cannot create that constant"); - } - bytes[3] = shimm & 0xFF; - bytes[2] |= (shimm & 0xF00) >> 8; - } - - c = ins->oprs[0].basereg; - - if ( keep == 0x11) - { - if ( c == R_CPSR || c == R_SPSR) - { - if ( c== R_SPSR) - { - bytes[1] |= 0x40; - } - } - else - { - errfunc (ERR_NONFATAL, "CPSR or SPSR expected"); - } - } - else - { - if ( c == R_CPSR_FLG || c == R_SPSR_FLG) - { - if ( c== R_SPSR_FLG) - { - bytes[1] |= 0x40; - } - } - else - { - errfunc (ERR_NONFATAL, "CPSR_flg or SPSR_flg expected"); - } - } - break; - - case 0x14: // MUL Rd,Rm,Rs - case 0x15: // MULA Rd,Rm,Rs,Rn - ++codes; - - bytes[0] = c | *codes++; - - bytes[1] = *codes++; - - bytes[3] = *codes; - - // Rd - bytes[1] |= regval (&ins->oprs[0],1); - if (has_S_code) - bytes[1] |= 0x10; - - // Rm - bytes[3] |= regval (&ins->oprs[1],1); - - // Rs - bytes[2] = regval (&ins->oprs[2],1); - - if (keep == 0x15) - { - bytes[2] |= regval (&ins->oprs[3],1) << 4; - } - break; - - case 0x16: // SMLAL RdHi,RdLo,Rm,Rs - ++codes; - - bytes[0] = c | *codes++; - - bytes[1] = *codes++; - - bytes[3] = *codes; - - // RdHi - bytes[1] |= regval (&ins->oprs[1],1); - if (has_S_code) - bytes[1] |= 0x10; - - // RdLo - bytes[2] = regval (&ins->oprs[0],1) << 4; - // Rm - bytes[3] |= regval (&ins->oprs[2],1); - - // Rs - bytes[2] |= regval (&ins->oprs[3],1); - - break; - - case 0x17: // LDR Rd, expression - ++codes; - - bytes[0] = c | *codes++; - - bytes[1] = *codes++; - - // Rd - bytes[2] = regval (&ins->oprs[0],1) << 4; - if (has_B_code) - bytes[1] |= 0x40; - if (has_T_code) - { - errfunc (ERR_NONFATAL, "'T' not allowed in pre-index mode"); - } - if (has_W_code) - { - errfunc (ERR_NONFATAL, "'!' not allowed"); - } - - // Rn - implicit R15 - bytes[1] |= 0xF; - - if (ins->oprs[1].segment != segment) - { - errfunc (ERR_NONFATAL, "label not in same segment"); - } - - data = ins->oprs[1].offset - (offset + 8); - - if (data < 0) - { - data = -data; - } - else - { - bytes[1] |= 0x80; - } - - if (data >= 0x1000) - { - errfunc (ERR_NONFATAL, "too long offset"); - } - - bytes[2] |= ((data & 0xF00) >> 8); - bytes[3] = data & 0xFF; - break; - - case 0x18: // LDR Rd, [Rn] - ++codes; - - bytes[0] = c | *codes++; - - bytes[1] = *codes++; - - // Rd - bytes[2] = regval (&ins->oprs[0],1) << 4; - if (has_B_code) - bytes[1] |= 0x40; - if (has_T_code) - { - bytes[1] |= 0x20; // write-back - } - else - { - bytes[0] |= 0x01; // implicit pre-index mode - } - - if (has_W_code) - { - bytes[1] |= 0x20; // write-back - } - - // Rn - c = regval (&ins->oprs[1],1); - bytes[1] |= c; - - if (c == 0x15) // R15 - data = -8; - else - data = 0; - - if (data < 0) - { - data = -data; - } - else - { - bytes[1] |= 0x80; - } - - bytes[2] |= ((data & 0xF00) >> 8); - bytes[3] = data & 0xFF; - break; - - case 0x19: // LDR Rd, [Rn,#expression] - case 0x20: // LDR Rd, [Rn,Rm] - case 0x21: // LDR Rd, [Rn,Rm,shift] - ++codes; - - bytes[0] = c | *codes++; - - bytes[1] = *codes++; - - // Rd - bytes[2] = regval (&ins->oprs[0],1) << 4; - if (has_B_code) - bytes[1] |= 0x40; - - // Rn - c = regval (&ins->oprs[1],1); - bytes[1] |= c; - - if (ins->oprs[ins->operands-1].bracket) // FIXME: Bracket on last operand -> pre-index <-- - { - bytes[0] |= 0x01; // pre-index mode - if (has_W_code) - { - bytes[1] |= 0x20; - } - if (has_T_code) - { - errfunc (ERR_NONFATAL, "'T' not allowed in pre-index mode"); - } - } - else - { - if (has_T_code) // Forced write-back in post-index mode - { - bytes[1] |= 0x20; - } - if (has_W_code) - { - errfunc (ERR_NONFATAL, "'!' not allowed in post-index mode"); - } - } - - if (keep == 0x19) - { - data = ins->oprs[2].offset; - - if (data < 0) - { - data = -data; - } - else - { - bytes[1] |= 0x80; - } - - if (data >= 0x1000) - { - errfunc (ERR_NONFATAL, "too long offset"); - } - - bytes[2] |= ((data & 0xF00) >> 8); - bytes[3] = data & 0xFF; - } - else - { - if (ins->oprs[2].minus == 0) - { - bytes[1] |= 0x80; - } - c = regval (&ins->oprs[2],1); - bytes[3] = c; - - if (keep == 0x21) - { - c = ins->oprs[3].offset; - if (c > 0x1F) - { - errfunc (ERR_NONFATAL, "too large shiftvalue"); - c = c & 0x1F; - } - - bytes[2] |= c >> 1; - if (c & 0x01) - { - bytes[3] |= 0x80; - } - bytes[3] |= shiftval (&ins->oprs[3]) << 5; - } - } - - break; - - case 0x22: // LDRH Rd, expression - ++codes; - - bytes[0] = c | 0x01; // Implicit pre-index - - bytes[1] = *codes++; - - // Rd - bytes[2] = regval (&ins->oprs[0],1) << 4; - - // Rn - implicit R15 - bytes[1] |= 0xF; - - if (ins->oprs[1].segment != segment) - { - errfunc (ERR_NONFATAL, "label not in same segment"); - } - - data = ins->oprs[1].offset - (offset + 8); - - if (data < 0) - { - data = -data; - } - else - { - bytes[1] |= 0x80; - } - - if (data >= 0x100) - { - errfunc (ERR_NONFATAL, "too long offset"); - } - bytes[3] = *codes++; - - bytes[2] |= ((data & 0xF0) >> 4); - bytes[3] |= data & 0xF; - break; - - case 0x23: // LDRH Rd, Rn - ++codes; - - bytes[0] = c | 0x01; // Implicit pre-index - - bytes[1] = *codes++; - - // Rd - bytes[2] = regval (&ins->oprs[0],1) << 4; - - // Rn - c = regval (&ins->oprs[1],1); - bytes[1] |= c; - - if (c == 0x15) // R15 - data = -8; - else - data = 0; - - if (data < 0) - { - data = -data; - } - else - { - bytes[1] |= 0x80; - } - - if (data >= 0x100) - { - errfunc (ERR_NONFATAL, "too long offset"); - } - bytes[3] = *codes++; - - bytes[2] |= ((data & 0xF0) >> 4); - bytes[3] |= data & 0xF; - break; - - case 0x24: // LDRH Rd, Rn, expression - case 0x25: // LDRH Rd, Rn, Rm - ++codes; - - bytes[0] = c; - - bytes[1] = *codes++; - - // Rd - bytes[2] = regval (&ins->oprs[0],1) << 4; - - // Rn - c = regval (&ins->oprs[1],1); - bytes[1] |= c; - - if (ins->oprs[ins->operands-1].bracket) // FIXME: Bracket on last operand -> pre-index <-- - { - bytes[0] |= 0x01; // pre-index mode - if (has_W_code) - { - bytes[1] |= 0x20; - } - } - else - { - if (has_W_code) - { - errfunc (ERR_NONFATAL, "'!' not allowed in post-index mode"); - } - } - - bytes[3] = *codes++; - - if (keep == 0x24) - { - data = ins->oprs[2].offset; - - if (data < 0) - { - data = -data; - } - else - { - bytes[1] |= 0x80; - } - - if (data >= 0x100) - { - errfunc (ERR_NONFATAL, "too long offset"); - } - - bytes[2] |= ((data & 0xF0) >> 4); - bytes[3] |= data & 0xF; - } - else - { - if (ins->oprs[2].minus == 0) - { - bytes[1] |= 0x80; - } - c = regval (&ins->oprs[2],1); - bytes[3] |= c; - - } - break; - - case 0x26: // LDM/STM Rn, {reg-list} - ++codes; - - bytes[0] = c; - - bytes[0] |= ( *codes >> 4) & 0xF; - bytes[1] = ( *codes << 4) & 0xF0; - ++codes; - - if (has_W_code) - { - bytes[1] |= 0x20; - } - if (has_F_code) - { - bytes[1] |= 0x40; - } - - // Rn - bytes[1] |= regval (&ins->oprs[0],1); - - data = ins->oprs[1].basereg; - - bytes[2] = ((data >> 8) & 0xFF); - bytes[3] = (data & 0xFF); - - break; - - case 0x27: // SWP Rd, Rm, [Rn] - ++codes; - - bytes[0] = c; - - bytes[0] |= *codes++; - - bytes[1] = regval (&ins->oprs[2],1); - if (has_B_code) - { - bytes[1] |= 0x40; - } - bytes[2] = regval (&ins->oprs[0],1) << 4; - bytes[3] = *codes++; - bytes[3] |= regval (&ins->oprs[1],1); - break; - - default: - errfunc (ERR_FATAL, "unknown decoding of instruction"); - - bytes[0] = c; - // And a fix nibble - ++codes; - bytes[0] |= *codes++; - - if ( *codes == 0x01) // An I bit - { - - } - if ( *codes == 0x02) // An I bit - { - - } - ++codes; - } - out (offset, segment, bytes, OUT_RAWDATA+4, NO_SEG, NO_SEG); -} - - -*) -{$endif dummy -} diff --git a/compiler/arm/aoptcpu.pas b/compiler/arm/aoptcpu.pas index e15acceb04..6b691f5c2a 100644 --- a/compiler/arm/aoptcpu.pas +++ b/compiler/arm/aoptcpu.pas @@ -28,15 +28,13 @@ Unit aoptcpu; Interface -uses cpubase, aopt, aoptcpub; +uses cpubase, aoptobj, aoptcpub; Type - TCpuAsmOptimizer = class(TAsmOptimizer) + TAOptCpu = class(TAoptObj) { uses the same constructor as TAopObj } End; Implementation -begin - casmoptimizer:=TCpuAsmOptimizer; End. diff --git a/compiler/arm/armatt.inc b/compiler/arm/armatt.inc deleted file mode 100644 index e29160bef4..0000000000 --- a/compiler/arm/armatt.inc +++ /dev/null @@ -1,90 +0,0 @@ -{ don't edit, this file is generated from armins.dat } -( -'none', -'abs', -'acs', -'asn', -'atn', -'adc', -'add', -'adf', -'and', -'b', -'bic', -'bl', -'blx', -'bkpt', -'bx', -'cdp', -'cmf', -'cmfe', -'cmn', -'cmp', -'clz', -'cnf', -'cos', -'dvf', -'eor', -'exp', -'fdv', -'flt', -'fix', -'fml', -'frd', -'ldc', -'ldm', -'ldrbt', -'ldrb', -'ldr', -'ldrh', -'ldrsb', -'ldrsh', -'ldrt', -'ldf', -'lfm', -'lgn', -'log', -'mcr', -'mla', -'mov', -'mnf', -'muf', -'mul', -'mvf', -'mvn', -'orr', -'rdf', -'rfs', -'rfc', -'rmf', -'rpw', -'rsb', -'rsc', -'rsf', -'rnd', -'pol', -'sbc', -'sfm', -'sin', -'smlal', -'smull', -'sqt', -'suf', -'stf', -'stm', -'str', -'strb', -'strbt', -'strh', -'strt', -'sub', -'swi', -'swp', -'swpb', -'tan', -'teq', -'tst', -'umlal', -'umull', -'wfs' -); diff --git a/compiler/arm/armatts.inc b/compiler/arm/armatts.inc deleted file mode 100644 index eb08065e2f..0000000000 --- a/compiler/arm/armatts.inc +++ /dev/null @@ -1,90 +0,0 @@ -{ don't edit, this file is generated from armins.dat } -( -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE, -attsufNONE -); diff --git a/compiler/arm/armins.dat b/compiler/arm/armins.dat deleted file mode 100644 index 1f4958b86d..0000000000 --- a/compiler/arm/armins.dat +++ /dev/null @@ -1,394 +0,0 @@ -;
-; Table of assembler instructions for Free Pascal
-; adapted from Netwide Assembler by Florian Klaempfl
-;
-;
-; The Netwide Assembler is copyright (C) 1996 Simon Tatham and
-; Julian Hall. All rights reserved. The software is
-; redistributable under the licence given in the file "Licence"
-; distributed in the NASM archive.
-;
-; Format of file: all four fields must be present on every functional
-; line. Hence `void' for no-operand instructions, and `\0' for such
-; as EQU. If the last three fields are all `ignore', no action is
-; taken except to register the opcode as being present.
-;
-;
-; 'ignore' means no instruc
-; 'void' means instruc with zero operands
-;
-; Third field has a first byte indicating how to
-; put together the bits, and then some codes
-; that may be used at will (see assemble.c)
-;
-; \1 - 24 bit pc-rel offset [B, BL]
-; \2 - 24 bit imm value [SWI]
-; \3 - 3 byte code [BX]
-;
-; \4 - reg,reg,reg [AND,EOR,SUB,RSB,ADD,ADC,SBC,RSC,ORR,BIC]
-; \5 - reg,reg,reg,<shift>reg [-"-]
-; \6 - reg,reg,reg,<shift>#imm [-"-]
-; \7 - reg,reg,#imm [-"-]
-;
-; \x8 - reg,reg [MOV,MVN]
-; \x9 - reg,reg,<shift>reg [-"-]
-; \xA - reg,reg,<shift>#imm [-"-]
-; \xB - reg,#imm [-"-]
-;
-; \xC - reg,reg [CMP,CMN,TEQ,TST]
-; \xD - reg,reg,<shift>reg [-"-]
-; \xE - reg,reg,<shift>#imm [-"-]
-; \xF - reg,#imm [-"-]
-;
-; \xFx - floating point instructions
-; Floating point instruction format information, taken from the linux kernel,
-; for detailed tables, see aasmcpu.pas
-;
-; ARM Floating Point Instruction Classes
-; | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
-; |c o n d|1 1 0 P|U|u|W|L| Rn |v| Fd |0|0|0|1| o f f s e t | CPDT
-; |c o n d|1 1 0 P|U|w|W|L| Rn |x| Fd |0|0|1|0| o f f s e t | CPDT (copro 2)
-; | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
-; |c o n d|1 1 1 0|a|b|c|d|e| Fn |j| Fd |0|0|0|1|f|g|h|0|i| Fm | CPDO
-; |c o n d|1 1 1 0|a|b|c|L|e| Fn | Rd |0|0|0|1|f|g|h|1|i| Fm | CPRT
-; |c o n d|1 1 1 0|a|b|c|1|e| Fn |1|1|1|1|0|0|0|1|f|g|h|1|i| Fm | comparisons
-; | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
-;
-; CPDT data transfer instructions
-; LDF, STF, LFM (copro 2), SFM (copro 2)
-;
-; CPDO dyadic arithmetic instructions
-; ADF, MUF, SUF, RSF, DVF, RDF,
-; POW, RPW, RMF, FML, FDV, FRD, POL
-;
-; CPDO monadic arithmetic instructions
-; MVF, MNF, ABS, RND, SQT, LOG, LGN, EXP,
-; SIN, COS, TAN, ASN, ACS, ATN, URD, NRM
-;
-; CPRT joint arithmetic/data transfer instructions
-; FIX (arithmetic followed by load/store)
-; FLT (load/store followed by arithmetic)
-; CMF, CNF CMFE, CNFE (comparisons)
-; WFS, RFS (write/read floating point status register)
-; WFC, RFC (write/read floating point control register)
-; \xF0 - CPDT
-; code 1: copro (1/2)
-; code 2: load/store bit
-; \xF1 - CPDO
-; \xF2 - CPDO monadic
-; \xF3 - CPRT
-; \xF4 - CPRT comparison
-;
-; \xFF - fix me
-;
-
-[NONE]
-void void none
-
-[ABScc]
-
-[ACScc]
-
-[ASNcc]
-
-[ATNcc]
-
-[ADCcc]
-reg32,reg32,reg32 \4\x0\xA0 ARM7
-reg32,reg32,reg32,reg32 \5\x0\xA0 ARM7
-reg32,reg32,reg32,imm \6\x0\xA0 ARM7
-reg32,reg32,imm \7\x2\xA0 ARM7
-
-[ADDcc]
-reg32,reg32,reg32 \4\x0\x80 ARM7
-reg32,reg32,reg32,reg32 \5\x0\x80 ARM7
-reg32,reg32,reg32,imm \6\x0\x80 ARM7
-reg32,reg32,imm \7\x2\x80 ARM7
-
-[ADFcc]
-
-[ANDcc]
-reg32,reg32,reg32 \4\x0\x00 ARM7
-reg32,reg32,reg32,reg32 \5\x0\x00 ARM7
-reg32,reg32,reg32,imm \6\x0\x00 ARM7
-reg32,reg32,imm \7\x2\x00 ARM7
-
-[Bcc]
-mem32 \1\x0A ARM7
-imm24 \1\x0A ARM7
-
-[BICcc]
-reg32,reg32,reg32 \4\x1\xC0 ARM7
-reg32,reg32,reg32,reg32 \5\x1\xC0 ARM7
-reg32,reg32,reg32,imm \6\x1\xC0 ARM7
-reg32,reg32,imm \7\x3\xC0 ARM7
-
-[BLcc]
-mem32 \1\x0B ARM7
-imm24 \1\x0B ARM7
-
-[BLX]
-mem32 \xff ARM7
-imm24 \xff ARM7
-
-[BKPTcc]
-
-[BXcc]
-reg32 \3\x01\x2F\xFF\x10 ARM7
-
-[CDP]
-reg8,reg8 \300\1\x10\101 ARM7
-
-[CMFcc]
-
-[CMFEcc]
-
-[CMNcc]
-reg32,reg32 \xC\x1\x60 ARM7
-reg32,reg32,reg32 \xD\x1\x60 ARM7
-reg32,reg32,imm \xE\x1\x60 ARM7
-reg32,imm \xF\x3\x60 ARM7
-
-[CMPcc]
-reg32,reg32 \xC\x1\x40 ARM7
-reg32,reg32,reg32 \xD\x1\x40 ARM7
-reg32,reg32,imm \xE\x1\x40 ARM7
-reg32,imm \xF\x3\x40 ARM7
-
-[CLZcc]
-reg32,reg32 \x27\x01\x01 ARM7
-
-[CNFcc]
-
-[COScc]
-
-[DVFcc]
-
-[EORcc]
-reg32,reg32,reg32 \4\x0\x20 ARM7
-reg32,reg32,reg32,reg32 \5\x0\x20 ARM7
-reg32,reg32,reg32,imm \6\x0\x20 ARM7
-reg32,reg32,imm \7\x2\x20 ARM7
-
-[EXPcc]
-
-[FDVcc]
-
-[FLTcc]
-
-[FIXcc]
-
-[FMLcc]
-
-[FRDcc]
-
-[LDC]
-reg32,reg32 \321\300\1\x11\101 ARM7
-
-[LDMcc]
-memam4,reglist \x26\x81 ARM7
-
-[LDRBTcc]
-
-[LDRBcc]
-reg32,memam2 \x17\x07\x10 ARM7
-
-[LDRcc]
-reg32,memam2 \x17\x05\x10 ARM7
-; reg32,imm32 \x17\x05\x10 ARM7
-; reg32,reg32 \x18\x04\x10 ARM7
-; reg32,reg32,imm32 \x19\x04\x10 ARM7
-; reg32,reg32,reg32 \x20\x06\x10 ARM7
-; reg32,reg32,reg32,imm32 \x21\x06\x10 ARM7
-
-[LDRHcc]
-reg32,imm32 \x22\x50\xB0 ARM7
-reg32,reg32 \x23\x50\xB0 ARM7
-reg32,reg32,imm32 \x24\x50\xB0 ARM7
-reg32,reg32,reg32 \x25\x10\xB0 ARM7
-
-[LDRSBcc]
-reg32,imm32 \x22\x50\xD0 ARM7
-reg32,reg32 \x23\x50\xD0 ARM7
-reg32,reg32,imm32 \x24\x50\xD0 ARM7
-reg32,reg32,reg32 \x25\x10\xD0 ARM7
-
-[LDRSHcc]
-reg32,imm32 \x22\x50\xF0 ARM7
-reg32,reg32 \x23\x50\xF0 ARM7
-reg32,reg32,imm32 \x24\x50\xF0 ARM7
-reg32,reg32,reg32 \x25\x10\xF0 ARM7
-
-[LDRTcc]
-
-[LDFcc]
-
-[LFMcc]
-reg32,imm8,fpureg \xF0\x02\x01 FPA
-
-[LGNcc]
-
-[LOGcc]
-
-[MCR]
-reg32,mem32 \320\301\1\x13\110 ARM7
-
-[MLAcc]
-reg32,reg32,reg32,reg32 \x15\x00\x20\x90 ARM7
-
-[MOVcc]
-reg32,shifterop \x8\x0\0xd ARM7
-reg32,immshifter \x8\x0\0xd ARM7
-; reg32,reg32,reg32 \x9\x1\xA0 ARM7
-; reg32,reg32,imm \xA\x1\xA0 ARM7
-; reg32,imm \xB\x3\xA0 ARM7
-
-; [MRC]
-; reg32,reg32 \321\301\1\x13\110 ARM7
-
-; [MRScc]
-; reg32,reg32 \x10\x01\x0F ARM7
-
-; [MSRcc]
-; reg32,reg32 \x11\x01\x29\xF0 ARM7
-; regf,reg32 \x12\x01\x28\xF0 ARM7
-; regf,imm \x13\x03\x28\xF0 ARM7
-
-[MNFcc]
-
-[MUFcc]
-
-[MULcc]
-reg32,reg32,reg32 \x14\x00\x00\x90 ARM7
-
-[MVFcc]
-fpureg,fpureg \xF2 FPA
-fpureg,immfpu \xF2 FPA
-
-[MVNcc]
-reg32,reg32 \x8\x0\0xf ARM7
-reg32,reg32,reg32 \x9\x1\xE0 ARM7
-reg32,reg32,imm \xA\x1\xE0 ARM7
-reg32,imm \xB\x3\xE0 ARM7
-
-[ORRcc]
-reg32,reg32,reg32 \4\x1\x80 ARM7
-reg32,reg32,reg32,reg32 \5\x1\x80 ARM7
-reg32,reg32,reg32,imm \6\x1\x80 ARM7
-reg32,reg32,imm \7\x3\x80 ARM7
-
-[RDFcc]
-
-[RFScc]
-
-[RFCcc]
-
-[RMFcc]
-
-[RPWcc]
-
-[RSBcc]
-reg32,reg32,reg32 \4\x0\x60 ARM7
-reg32,reg32,reg32,reg32 \5\x0\x60 ARM7
-reg32,reg32,reg32,imm \6\x0\x60 ARM7
-reg32,reg32,imm \7\x2\x60 ARM7
-
-[RSCcc]
-reg32,reg32,reg32 \4\x0\xE0 ARM7
-reg32,reg32,reg32,reg32 \5\x0\xE0 ARM7
-reg32,reg32,reg32,imm \6\x0\xE0 ARM7
-reg32,reg32,imm \7\x2\xE0 ARM7
-
-[RSFcc]
-
-[RNDcc]
-
-[POLcc]
-
-[SBCcc]
-reg32,reg32,reg32 \4\x0\xC0 ARM7
-reg32,reg32,reg32,reg32 \5\x0\xC0 ARM7
-reg32,reg32,reg32,imm \6\x0\xC0 ARM7
-reg32,reg32,imm \7\x2\xC0 ARM7
-
-[SFMcc]
-reg32,imm8,fpureg \xF0\x02\x00 FPA
-
-[SINcc]
-
-[SMLALcc]
-reg32,reg32,reg32,reg32 \x16\x00\xE0\x90 ARM7
-
-[SMULLcc]
-reg32,reg32,reg32,reg32 \x16\x00\xC0\x90 ARM7
-
-[SQTcc]
-
-[SUFcc]
-
-[STFcc]
-
-[STMcc]
-memam4,reglist \x26\x80 ARM7
-
-[STRcc]
-reg32,memam2 \x17\x04\x00 ARM7
-; reg32,imm32 \x17\x05\x00 ARM7
-; reg32,reg32 \x18\x04\x00 ARM7
-; reg32,reg32,imm32 \x19\x04\x00 ARM7
-; reg32,reg32,reg32 \x20\x06\x00 ARM7
-; reg32,reg32,reg32,imm32 \x21\x06\x00 ARM7
-
-[STRBcc]
-reg32,memam2 \x17\x06\x00 ARM7
-
-[STRBTcc]
-
-; A dummy since it is parsed as STR{cond}H
-[STRHcc]
-reg32,imm32 \x22\x40\xB0 ARM7
-reg32,reg32 \x23\x40\xB0 ARM7
-reg32,reg32,imm32 \x24\x40\xB0 ARM7
-reg32,reg32,reg32 \x25\x00\xB0 ARM7
-
-[STRTcc]
-
-[SUBcc]
-reg32,reg32,shifterop \4\x0\x40 ARM7
-reg32,reg32,immshifter \4\x0\x40 ARM7
-reg32,reg32,reg32 \4\x0\x40 ARM7
-; reg32,reg32,reg32,reg32 \5\x0\x40 ARM7
-; reg32,reg32,reg32,imm \6\x0\x40 ARM7
-; reg32,reg32,imm \7\x2\x40 ARM7
-
-[SWIcc]
-imm \2\x0F ARM7
-
-[SWPcc]
-reg32,reg32,reg32 \x27\x01\x90 ARM7
-
-[SWPBcc]
-reg32,reg32,reg32 \x27\x01\x90 ARM7
-
-[TANcc]
-
-[TEQcc]
-reg32,reg32 \xC\x1\x20 ARM7
-reg32,reg32,reg32 \xD\x1\x20 ARM7
-reg32,reg32,imm \xE\x1\x20 ARM7
-reg32,imm \xF\x3\x20 ARM7
-
-[TSTcc]
-reg32,reg32 \xC\x1\x00 ARM7
-reg32,reg32,reg32 \xD\x1\x00 ARM7
-reg32,reg32,imm \xE\x1\x00 ARM7
-reg32,imm \xF\x3\x00 ARM7
-
-[UMLALcc]
-reg32,reg32,reg32,reg32 \x16\x00\xA0\x90 ARM7
-
-[UMULLcc]
-reg32,reg32,reg32,reg32 \x16\x00\x80\x90 ARM7
-
-[WFScc]
-
diff --git a/compiler/arm/armnop.inc b/compiler/arm/armnop.inc deleted file mode 100644 index 5566510957..0000000000 --- a/compiler/arm/armnop.inc +++ /dev/null @@ -1,2 +0,0 @@ -{ don't edit, this file is generated from armins.dat } -108; diff --git a/compiler/arm/armop.inc b/compiler/arm/armop.inc deleted file mode 100644 index 134a8c8069..0000000000 --- a/compiler/arm/armop.inc +++ /dev/null @@ -1,90 +0,0 @@ -{ don't edit, this file is generated from armins.dat } -( -A_NONE, -A_ABS, -A_ACS, -A_ASN, -A_ATN, -A_ADC, -A_ADD, -A_ADF, -A_AND, -A_B, -A_BIC, -A_BL, -A_BLX, -A_BKPT, -A_BX, -A_CDP, -A_CMF, -A_CMFE, -A_CMN, -A_CMP, -A_CLZ, -A_CNF, -A_COS, -A_DVF, -A_EOR, -A_EXP, -A_FDV, -A_FLT, -A_FIX, -A_FML, -A_FRD, -A_LDC, -A_LDM, -A_LDRBT, -A_LDRB, -A_LDR, -A_LDRH, -A_LDRSB, -A_LDRSH, -A_LDRT, -A_LDF, -A_LFM, -A_LGN, -A_LOG, -A_MCR, -A_MLA, -A_MOV, -A_MNF, -A_MUF, -A_MUL, -A_MVF, -A_MVN, -A_ORR, -A_RDF, -A_RFS, -A_RFC, -A_RMF, -A_RPW, -A_RSB, -A_RSC, -A_RSF, -A_RND, -A_POL, -A_SBC, -A_SFM, -A_SIN, -A_SMLAL, -A_SMULL, -A_SQT, -A_SUF, -A_STF, -A_STM, -A_STR, -A_STRB, -A_STRBT, -A_STRH, -A_STRT, -A_SUB, -A_SWI, -A_SWP, -A_SWPB, -A_TAN, -A_TEQ, -A_TST, -A_UMLAL, -A_UMULL, -A_WFS -); diff --git a/compiler/arm/armtab.inc b/compiler/arm/armtab.inc deleted file mode 100644 index 1a81a1eed2..0000000000 --- a/compiler/arm/armtab.inc +++ /dev/null @@ -1,759 +0,0 @@ -{ don't edit, this file is generated from armins.dat } -( - ( - opcode : A_NONE; - ops : 0; - optypes : (ot_none,ot_none,ot_none,ot_none); - code : #0; - flags : if_none - ), - ( - opcode : A_ADC; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #4#0#160; - flags : if_arm7 - ), - ( - opcode : A_ADC; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); - code : #5#0#160; - flags : if_arm7 - ), - ( - opcode : A_ADC; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate); - code : #6#0#160; - flags : if_arm7 - ), - ( - opcode : A_ADC; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); - code : #7#2#160; - flags : if_arm7 - ), - ( - opcode : A_ADD; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #4#0#128; - flags : if_arm7 - ), - ( - opcode : A_ADD; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); - code : #5#0#128; - flags : if_arm7 - ), - ( - opcode : A_ADD; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate); - code : #6#0#128; - flags : if_arm7 - ), - ( - opcode : A_ADD; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); - code : #7#2#128; - flags : if_arm7 - ), - ( - opcode : A_AND; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #4#0#0; - flags : if_arm7 - ), - ( - opcode : A_AND; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); - code : #5#0#0; - flags : if_arm7 - ), - ( - opcode : A_AND; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate); - code : #6#0#0; - flags : if_arm7 - ), - ( - opcode : A_AND; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); - code : #7#2#0; - flags : if_arm7 - ), - ( - opcode : A_B; - ops : 1; - optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); - code : #1#10; - flags : if_arm7 - ), - ( - opcode : A_B; - ops : 1; - optypes : (ot_immediate24,ot_none,ot_none,ot_none); - code : #1#10; - flags : if_arm7 - ), - ( - opcode : A_BIC; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #4#1#192; - flags : if_arm7 - ), - ( - opcode : A_BIC; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); - code : #5#1#192; - flags : if_arm7 - ), - ( - opcode : A_BIC; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate); - code : #6#1#192; - flags : if_arm7 - ), - ( - opcode : A_BIC; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); - code : #7#3#192; - flags : if_arm7 - ), - ( - opcode : A_BL; - ops : 1; - optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); - code : #1#11; - flags : if_arm7 - ), - ( - opcode : A_BL; - ops : 1; - optypes : (ot_immediate24,ot_none,ot_none,ot_none); - code : #1#11; - flags : if_arm7 - ), - ( - opcode : A_BLX; - ops : 1; - optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); - code : #15#15; - flags : if_arm7 - ), - ( - opcode : A_BLX; - ops : 1; - optypes : (ot_immediate24,ot_none,ot_none,ot_none); - code : #15#15; - flags : if_arm7 - ), - ( - opcode : A_BX; - ops : 1; - optypes : (ot_reg32,ot_none,ot_none,ot_none); - code : #3#1#47#255#16; - flags : if_arm7 - ), - ( - opcode : A_CDP; - ops : 2; - optypes : (ot_reg8,ot_reg8,ot_none,ot_none); - code : #192#1#16#65; - flags : if_arm7 - ), - ( - opcode : A_CMN; - ops : 2; - optypes : (ot_reg32,ot_reg32,ot_none,ot_none); - code : #12#1#96; - flags : if_arm7 - ), - ( - opcode : A_CMN; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #13#1#96; - flags : if_arm7 - ), - ( - opcode : A_CMN; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); - code : #14#1#96; - flags : if_arm7 - ), - ( - opcode : A_CMN; - ops : 2; - optypes : (ot_reg32,ot_immediate,ot_none,ot_none); - code : #15#3#96; - flags : if_arm7 - ), - ( - opcode : A_CMP; - ops : 2; - optypes : (ot_reg32,ot_reg32,ot_none,ot_none); - code : #12#1#64; - flags : if_arm7 - ), - ( - opcode : A_CMP; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #13#1#64; - flags : if_arm7 - ), - ( - opcode : A_CMP; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); - code : #14#1#64; - flags : if_arm7 - ), - ( - opcode : A_CMP; - ops : 2; - optypes : (ot_reg32,ot_immediate,ot_none,ot_none); - code : #15#3#64; - flags : if_arm7 - ), - ( - opcode : A_CLZ; - ops : 2; - optypes : (ot_reg32,ot_reg32,ot_none,ot_none); - code : #39#1#1; - flags : if_arm7 - ), - ( - opcode : A_EOR; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #4#0#32; - flags : if_arm7 - ), - ( - opcode : A_EOR; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); - code : #5#0#32; - flags : if_arm7 - ), - ( - opcode : A_EOR; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate); - code : #6#0#32; - flags : if_arm7 - ), - ( - opcode : A_EOR; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); - code : #7#2#32; - flags : if_arm7 - ), - ( - opcode : A_LDC; - ops : 2; - optypes : (ot_reg32,ot_reg32,ot_none,ot_none); - code : #209#192#1#17#65; - flags : if_arm7 - ), - ( - opcode : A_LDM; - ops : 2; - optypes : (ot_memoryam4,ot_reglist,ot_none,ot_none); - code : #38#129; - flags : if_arm7 - ), - ( - opcode : A_LDRB; - ops : 2; - optypes : (ot_reg32,ot_memoryam2,ot_none,ot_none); - code : #23#7#16; - flags : if_arm7 - ), - ( - opcode : A_LDR; - ops : 2; - optypes : (ot_reg32,ot_memoryam2,ot_none,ot_none); - code : #23#5#16; - flags : if_arm7 - ), - ( - opcode : A_LDRH; - ops : 2; - optypes : (ot_reg32,ot_immediate or ot_bits32,ot_none,ot_none); - code : #34#80#176; - flags : if_arm7 - ), - ( - opcode : A_LDRH; - ops : 2; - optypes : (ot_reg32,ot_reg32,ot_none,ot_none); - code : #35#80#176; - flags : if_arm7 - ), - ( - opcode : A_LDRH; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_immediate or ot_bits32,ot_none); - code : #36#80#176; - flags : if_arm7 - ), - ( - opcode : A_LDRH; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #37#16#176; - flags : if_arm7 - ), - ( - opcode : A_LDRSB; - ops : 2; - optypes : (ot_reg32,ot_immediate or ot_bits32,ot_none,ot_none); - code : #34#80#208; - flags : if_arm7 - ), - ( - opcode : A_LDRSB; - ops : 2; - optypes : (ot_reg32,ot_reg32,ot_none,ot_none); - code : #35#80#208; - flags : if_arm7 - ), - ( - opcode : A_LDRSB; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_immediate or ot_bits32,ot_none); - code : #36#80#208; - flags : if_arm7 - ), - ( - opcode : A_LDRSB; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #37#16#208; - flags : if_arm7 - ), - ( - opcode : A_LDRSH; - ops : 2; - optypes : (ot_reg32,ot_immediate or ot_bits32,ot_none,ot_none); - code : #34#80#240; - flags : if_arm7 - ), - ( - opcode : A_LDRSH; - ops : 2; - optypes : (ot_reg32,ot_reg32,ot_none,ot_none); - code : #35#80#240; - flags : if_arm7 - ), - ( - opcode : A_LDRSH; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_immediate or ot_bits32,ot_none); - code : #36#80#240; - flags : if_arm7 - ), - ( - opcode : A_LDRSH; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #37#16#240; - flags : if_arm7 - ), - ( - opcode : A_LFM; - ops : 3; - optypes : (ot_reg32,ot_immediate or ot_bits8,ot_fpureg,ot_none); - code : #240#2#1; - flags : if_fpa - ), - ( - opcode : A_MCR; - ops : 2; - optypes : (ot_reg32,ot_memory or ot_bits32,ot_none,ot_none); - code : #208#193#1#19#72; - flags : if_arm7 - ), - ( - opcode : A_MLA; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); - code : #21#0#32#144; - flags : if_arm7 - ), - ( - opcode : A_MOV; - ops : 2; - optypes : (ot_reg32,ot_shifterop,ot_none,ot_none); - code : #8#1#160; - flags : if_arm7 - ), - ( - opcode : A_MOV; - ops : 2; - optypes : (ot_reg32,ot_immediateshifter,ot_none,ot_none); - code : #8#1#160; - flags : if_arm7 - ), - ( - opcode : A_MUL; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #20#0#0#144; - flags : if_arm7 - ), - ( - opcode : A_MVF; - ops : 2; - optypes : (ot_fpureg,ot_fpureg,ot_none,ot_none); - code : #242; - flags : if_fpa - ), - ( - opcode : A_MVF; - ops : 2; - optypes : (ot_fpureg,ot_immediatefpu,ot_none,ot_none); - code : #242; - flags : if_fpa - ), - ( - opcode : A_MVN; - ops : 2; - optypes : (ot_reg32,ot_reg32,ot_none,ot_none); - code : #8#1#224; - flags : if_arm7 - ), - ( - opcode : A_MVN; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #9#1#224; - flags : if_arm7 - ), - ( - opcode : A_MVN; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); - code : #10#1#224; - flags : if_arm7 - ), - ( - opcode : A_MVN; - ops : 2; - optypes : (ot_reg32,ot_immediate,ot_none,ot_none); - code : #11#3#224; - flags : if_arm7 - ), - ( - opcode : A_ORR; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #4#1#128; - flags : if_arm7 - ), - ( - opcode : A_ORR; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); - code : #5#1#128; - flags : if_arm7 - ), - ( - opcode : A_ORR; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate); - code : #6#1#128; - flags : if_arm7 - ), - ( - opcode : A_ORR; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); - code : #7#3#128; - flags : if_arm7 - ), - ( - opcode : A_RSB; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #4#0#96; - flags : if_arm7 - ), - ( - opcode : A_RSB; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); - code : #5#0#96; - flags : if_arm7 - ), - ( - opcode : A_RSB; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate); - code : #6#0#96; - flags : if_arm7 - ), - ( - opcode : A_RSB; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); - code : #7#2#96; - flags : if_arm7 - ), - ( - opcode : A_RSC; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #4#0#224; - flags : if_arm7 - ), - ( - opcode : A_RSC; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); - code : #5#0#224; - flags : if_arm7 - ), - ( - opcode : A_RSC; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate); - code : #6#0#224; - flags : if_arm7 - ), - ( - opcode : A_RSC; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); - code : #7#2#224; - flags : if_arm7 - ), - ( - opcode : A_SBC; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #4#0#192; - flags : if_arm7 - ), - ( - opcode : A_SBC; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); - code : #5#0#192; - flags : if_arm7 - ), - ( - opcode : A_SBC; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate); - code : #6#0#192; - flags : if_arm7 - ), - ( - opcode : A_SBC; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); - code : #7#2#192; - flags : if_arm7 - ), - ( - opcode : A_SFM; - ops : 3; - optypes : (ot_reg32,ot_immediate or ot_bits8,ot_fpureg,ot_none); - code : #240#2#0; - flags : if_fpa - ), - ( - opcode : A_SMLAL; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); - code : #22#0#224#144; - flags : if_arm7 - ), - ( - opcode : A_SMULL; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); - code : #22#0#192#144; - flags : if_arm7 - ), - ( - opcode : A_STM; - ops : 2; - optypes : (ot_memoryam4,ot_reglist,ot_none,ot_none); - code : #38#128; - flags : if_arm7 - ), - ( - opcode : A_STR; - ops : 2; - optypes : (ot_reg32,ot_memoryam2,ot_none,ot_none); - code : #23#4#0; - flags : if_arm7 - ), - ( - opcode : A_STRB; - ops : 2; - optypes : (ot_reg32,ot_memoryam2,ot_none,ot_none); - code : #23#6#0; - flags : if_arm7 - ), - ( - opcode : A_STRH; - ops : 2; - optypes : (ot_reg32,ot_immediate or ot_bits32,ot_none,ot_none); - code : #34#64#176; - flags : if_arm7 - ), - ( - opcode : A_STRH; - ops : 2; - optypes : (ot_reg32,ot_reg32,ot_none,ot_none); - code : #35#64#176; - flags : if_arm7 - ), - ( - opcode : A_STRH; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_immediate or ot_bits32,ot_none); - code : #36#64#176; - flags : if_arm7 - ), - ( - opcode : A_STRH; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #37#0#176; - flags : if_arm7 - ), - ( - opcode : A_SUB; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_shifterop,ot_none); - code : #4#0#64; - flags : if_arm7 - ), - ( - opcode : A_SUB; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_immediateshifter,ot_none); - code : #4#0#64; - flags : if_arm7 - ), - ( - opcode : A_SUB; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #4#0#64; - flags : if_arm7 - ), - ( - opcode : A_SWI; - ops : 1; - optypes : (ot_immediate,ot_none,ot_none,ot_none); - code : #2#15; - flags : if_arm7 - ), - ( - opcode : A_SWP; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #39#1#144; - flags : if_arm7 - ), - ( - opcode : A_SWPB; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #39#1#144; - flags : if_arm7 - ), - ( - opcode : A_TEQ; - ops : 2; - optypes : (ot_reg32,ot_reg32,ot_none,ot_none); - code : #12#1#32; - flags : if_arm7 - ), - ( - opcode : A_TEQ; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #13#1#32; - flags : if_arm7 - ), - ( - opcode : A_TEQ; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); - code : #14#1#32; - flags : if_arm7 - ), - ( - opcode : A_TEQ; - ops : 2; - optypes : (ot_reg32,ot_immediate,ot_none,ot_none); - code : #15#3#32; - flags : if_arm7 - ), - ( - opcode : A_TST; - ops : 2; - optypes : (ot_reg32,ot_reg32,ot_none,ot_none); - code : #12#1#0; - flags : if_arm7 - ), - ( - opcode : A_TST; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none); - code : #13#1#0; - flags : if_arm7 - ), - ( - opcode : A_TST; - ops : 3; - optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none); - code : #14#1#0; - flags : if_arm7 - ), - ( - opcode : A_TST; - ops : 2; - optypes : (ot_reg32,ot_immediate,ot_none,ot_none); - code : #15#3#0; - flags : if_arm7 - ), - ( - opcode : A_UMLAL; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); - code : #22#0#160#144; - flags : if_arm7 - ), - ( - opcode : A_UMULL; - ops : 4; - optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32); - code : #22#0#128#144; - flags : if_arm7 - ) -); diff --git a/compiler/arm/cgcpu.pas b/compiler/arm/cgcpu.pas index c1b497c252..865180837e 100644 --- a/compiler/arm/cgcpu.pas +++ b/compiler/arm/cgcpu.pas @@ -118,6 +118,8 @@ unit cgcpu; OpCmp2AsmCond : Array[topcmp] of TAsmCond = (C_NONE,C_EQ,C_GT, C_LT,C_GE,C_LE,C_NE,C_LS,C_CC,C_CS,C_HI); + function is_shifter_const(d : aint;var imm_shift : byte) : boolean; + function get_fpu_postfix(def : tdef) : toppostfix; implementation @@ -198,70 +200,59 @@ unit cgcpu; procedure tcgarm.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const paraloc : TCGPara); var - tmpref, ref: treference; - location: pcgparalocation; - sizeleft: aint; - begin - location := paraloc.location; - tmpref := r; - sizeleft := paraloc.intsize; - while assigned(location) do - begin - case location^.loc of - LOC_REGISTER,LOC_CREGISTER: - a_load_ref_reg(list,location^.size,location^.size,tmpref,location^.register); - LOC_REFERENCE: - begin - reference_reset_base(ref,location^.reference.index,location^.reference.offset); - g_concatcopy(list,tmpref,ref,sizeleft); - if assigned(location^.next) then - internalerror(2005010710); - end; - LOC_FPUREGISTER,LOC_CFPUREGISTER: - case location^.size of - OS_F32, OS_F64: - a_loadfpu_ref_reg(list,location^.size,tmpref,location^.register); - else - internalerror(2002072801); - end; - LOC_VOID: - begin - // nothing to do - end; - else - internalerror(2002081103); - end; - inc(tmpref.offset,tcgsize2size[location^.size]); - dec(sizeleft,tcgsize2size[location^.size]); - location := location^.next; - end; - end; - - - procedure tcgarm.a_paramaddr_ref(list : taasmoutput;const r : treference;const paraloc : TCGPara); - var ref: treference; tmpreg: tregister; begin paraloc.check_simple_location; case paraloc.location^.loc of LOC_REGISTER,LOC_CREGISTER: - a_loadaddr_ref_reg(list,r,paraloc.location^.register); + a_load_ref_reg(list,size,size,r,paraloc.location^.register); LOC_REFERENCE: begin - reference_reset(ref); - ref.base := paraloc.location^.reference.index; - ref.offset := paraloc.location^.reference.offset; - tmpreg := getintregister(list,OS_ADDR); - a_loadaddr_ref_reg(list,r,tmpreg); - a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref); + reference_reset(ref); + ref.base:=paraloc.location^.reference.index; + ref.offset:=paraloc.location^.reference.offset; + tmpreg := getintregister(list,size); + a_load_ref_reg(list,size,size,r,tmpreg); + a_load_reg_ref(list,size,size,tmpreg,ref); + end; + LOC_FPUREGISTER,LOC_CFPUREGISTER: + case size of + OS_F32, OS_F64: + a_loadfpu_ref_reg(list,size,r,paraloc.location^.register); + else + internalerror(2002072801); end; else - internalerror(2002080701); + internalerror(2002081103); end; end; + procedure tcgarm.a_paramaddr_ref(list : taasmoutput;const r : treference;const paraloc : TCGPara); + var + ref: treference; + tmpreg: tregister; + begin + paraloc.check_simple_location; + case paraloc.location^.loc of + LOC_REGISTER,LOC_CREGISTER: + a_loadaddr_ref_reg(list,r,paraloc.location^.register); + LOC_REFERENCE: + begin + reference_reset(ref); + ref.base := paraloc.location^.reference.index; + ref.offset := paraloc.location^.reference.offset; + tmpreg := getintregister(list,OS_ADDR); + a_loadaddr_ref_reg(list,r,tmpreg); + a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref); + end; + else + internalerror(2002080701); + end; + end; + + procedure tcgarm.a_call_name(list : taasmoutput;const s : string); begin list.concat(taicpu.op_sym(A_BL,objectlibrary.newasmsymbol(s,AB_EXTERNAL,AT_FUNCTION))); @@ -544,6 +535,29 @@ unit cgcpu; end; + function rotl(d : dword;b : byte) : dword; + begin + result:=(d shr (32-b)) or (d shl b); + end; + + + function is_shifter_const(d : aint;var imm_shift : byte) : boolean; + var + i : longint; + begin + for i:=0 to 15 do + begin + if (dword(d) and not(rotl($ff,i*2)))=0 then + begin + imm_shift:=i*2; + result:=true; + exit; + end; + end; + result:=false; + end; + + procedure tcgarm.a_load_const_reg(list : taasmoutput; size: tcgsize; a : aint;reg : tregister); var imm_shift : byte; @@ -560,7 +574,7 @@ unit cgcpu; begin reference_reset(hr); - objectlibrary.getjumplabel(l); + objectlibrary.getlabel(l); cg.a_label(current_procinfo.aktlocaldata,l); hr.symboldata:=current_procinfo.aktlocaldata.last; current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(longint(a))); @@ -626,7 +640,7 @@ unit cgcpu; tmpreg:=getintregister(list,OS_INT); if assigned(ref.symbol) then begin - objectlibrary.getjumplabel(l); + objectlibrary.getlabel(l); cg.a_label(current_procinfo.aktlocaldata,l); tmpref.symboldata:=current_procinfo.aktlocaldata.last; @@ -892,7 +906,7 @@ unit cgcpu; OS_F80: oppostfix:=PF_E; else - InternalError(200309022); + InternalError(200309021); end; handle_load_store(list,A_STF,oppostfix,reg,ref); end; @@ -936,7 +950,7 @@ unit cgcpu; procedure tcgarm.a_jmp_always(list : taasmoutput;l: tasmlabel); begin - list.concat(taicpu.op_sym(A_B,l)); + list.concat(taicpu.op_sym(A_B,objectlibrary.newasmsymbol(l.name,AB_EXTERNAL,AT_FUNCTION))); end; @@ -1159,7 +1173,7 @@ unit cgcpu; } { create consts entry } reference_reset(tmpref); - objectlibrary.getjumplabel(l); + objectlibrary.getlabel(l); cg.a_label(current_procinfo.aktlocaldata,l); tmpref.symboldata:=current_procinfo.aktlocaldata.last; @@ -1241,7 +1255,7 @@ unit cgcpu; var l : tasmlabel; begin - objectlibrary.getjumplabel(l); + objectlibrary.getlabel(l); a_load_const_reg(list,OS_INT,count,countreg); cg.a_label(list,l); srcref.addressmode:=AM_POSTINDEXED; @@ -1359,7 +1373,7 @@ unit cgcpu; begin if not(cs_check_overflow in aktlocalswitches) then exit; - objectlibrary.getjumplabel(hl); + objectlibrary.getlabel(hl); case ovloc.loc of LOC_VOID: begin diff --git a/compiler/arm/cpubase.pas b/compiler/arm/cpubase.pas index 097854076b..18afda33b6 100644 --- a/compiler/arm/cpubase.pas +++ b/compiler/arm/cpubase.pas @@ -43,7 +43,24 @@ unit cpubase; *****************************************************************************} type - TAsmOp= {$i armop.inc} + TAsmOp=(A_None,A_ADC,A_ADD,A_AND,A_N,A_BIC,A_BKPT,A_B,A_BL,A_BLX,A_BX, + A_CDP,A_CDP2,A_CLZ,A_CMN,A_CMP,A_EOR,A_LDC,_A_LDC2, + A_LDM,A_LDR,A_LDRB,A_LDRD,A_LDRBT,A_LDRH,A_LDRSB, + A_LDRSH,A_LDRT,A_MCR,A_MCR2,A_MCRR,A_MLA,A_MOV, + A_MRC,A_MRC2,A_MRRC,A_RS,A_MSR,A_MUL,A_MVN, + A_ORR,A_PLD,A_QADD,A_QDADD,A_QDSUB,A_QSUB,A_RSB,A_RSC, + A_SBC,A_SMLAL,A_SMULL,A_SMUL, + A_SMULW,A_STC,A_STC2,A_STM,A_STR,A_STRB,A_STRBT,A_STRD, + A_STRH,A_STRT,A_SUB,A_SWI,A_SWP,A_SWPB,A_TEQ,A_TST, + A_UMLAL,A_UMULL, + { FPA coprocessor instructions } + A_LDF,A_STF,A_LFM,A_SFM,A_FLT,A_FIX,A_WFS,A_RFS,A_RFC, + A_ADF,A_DVF,A_FDV,A_FML,A_FRD,A_MUF,A_POL,A_PW,A_RDF, + A_RMF,A_RPW,A_RSF,A_SUF,A_ABS,A_ACS,A_ASN,A_ATN,A_COS, + A_EXP,A_LOG,A_LGN,A_MVF,A_MNF,A_NRM,A_RND,A_SIN,A_SQT,A_TAN,A_URD, + A_CMF,A_CMFE,A_CNF + { VPA coprocessor codes } + ); { This should define the array of instructions as string } op2strtable=array[tasmop] of string[11]; @@ -369,8 +386,6 @@ unit cpubase; procedure shifterop_reset(var so : tshifterop); function is_pc(const r : tregister) : boolean; - function is_shifter_const(d : aint;var imm_shift : byte) : boolean; - implementation uses @@ -399,7 +414,7 @@ unit cpubase; function reg_cgsize(const reg: tregister): tcgsize; const subreg2cgsize:array[Tsubregister] of Tcgsize = - (OS_NO,OS_8,OS_8,OS_16,OS_32,OS_64,OS_NO,OS_NO,OS_NO,OS_NO,OS_NO); + (OS_NO,OS_8,OS_8,OS_16,OS_32,OS_64,OS_NO,OS_NO,OS_NO); begin case getregtype(reg) of R_INTREGISTER : @@ -487,7 +502,7 @@ unit cpubase; begin result := inverse[c]; end; - + function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE} begin @@ -495,26 +510,4 @@ unit cpubase; end; - function rotl(d : dword;b : byte) : dword; - begin - result:=(d shr (32-b)) or (d shl b); - end; - - - function is_shifter_const(d : aint;var imm_shift : byte) : boolean; - var - i : longint; - begin - for i:=0 to 15 do - begin - if (dword(d) and not(rotl($ff,i*2)))=0 then - begin - imm_shift:=i*2; - result:=true; - exit; - end; - end; - result:=false; - end; - end. diff --git a/compiler/arm/cpunode.pas b/compiler/arm/cpunode.pas index 89993d5d1f..ccb32b10f8 100644 --- a/compiler/arm/cpunode.pas +++ b/compiler/arm/cpunode.pas @@ -38,9 +38,7 @@ unit cpunode; narmcal, narmmat, narminl, - narmcnv, - narmcon + narmcnv ; - end. diff --git a/compiler/arm/cpupara.pas b/compiler/arm/cpupara.pas index f22ba181bd..9fcf076b16 100644 --- a/compiler/arm/cpupara.pas +++ b/compiler/arm/cpupara.pas @@ -27,7 +27,7 @@ unit cpupara; interface uses - globtype,globals, + globtype, aasmtai, cpuinfo,cpubase,cgbase, symconst,symbase,symtype,symdef,parabase,paramgr; @@ -107,7 +107,7 @@ unit cpupara; orddef: getparaloc:=LOC_REGISTER; floatdef: - if (calloption in [pocall_cdecl,pocall_cppdecl,pocall_softfloat]) or (cs_fp_emulation in aktmoduleswitches) then + if calloption in [pocall_cdecl,pocall_cppdecl,pocall_softfloat] then getparaloc:=LOC_REGISTER else getparaloc:=LOC_FPUREGISTER; @@ -275,7 +275,7 @@ unit cpupara; end; paralen:=tcgsize2size[paracgsize]; - hp.paraloc[side].intsize:=paralen; + hp.paraloc[side].intsize:=paralen; {$ifdef EXTDEBUG} if paralen=0 then internalerror(200410311); @@ -289,14 +289,7 @@ unit cpupara; else if paracgsize in [OS_64,OS_S64] then paraloc^.size:=OS_32 else if (loc=LOC_REGISTER) and (paracgsize in [OS_F32,OS_F64,OS_F80]) then - case paracgsize of - OS_F32: - paraloc^.size:=OS_32; - OS_F64: - paraloc^.size:=OS_64; - else - internalerror(2005082901); - end + paraloc^.size:=OS_32 else paraloc^.size:=paracgsize; case loc of @@ -311,14 +304,10 @@ unit cpupara; end else begin - { LOC_REFERENCE covers always the overleft } paraloc^.loc:=LOC_REFERENCE; - paraloc^.size:=int_cgsize(paralen); - if (side=callerside) then - paraloc^.reference.index:=NR_STACK_POINTER_REG; + paraloc^.reference.index:=NR_STACK_POINTER_REG; paraloc^.reference.offset:=stack_offset; - inc(stack_offset,align(paralen,4)); - paralen:=0; + inc(stack_offset,4); end; end; LOC_FPUREGISTER: @@ -376,15 +365,6 @@ unit cpupara; end; dec(paralen,tcgsize2size[paraloc^.size]); end; - { hack to swap doubles in int registers } - if is_double(hp.vartype.def) and (paracgsize=OS_64) and - (hp.paraloc[side].location^.loc=LOC_REGISTER) then - begin - paraloc:=hp.paraloc[side].location; - hp.paraloc[side].location:=hp.paraloc[side].location^.next; - hp.paraloc[side].location^.next:=paraloc; - paraloc^.next:=nil; - end; end; curintreg:=nextintreg; curfloatreg:=nextfloatreg; @@ -423,34 +403,8 @@ unit cpupara; { Return in FPU register? } if p.rettype.def.deftype=floatdef then begin - if (p.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_softfloat]) or (cs_fp_emulation in aktmoduleswitches) then - begin - case retcgsize of - OS_64, - OS_F64: - begin - { low } - p.funcretloc[side].loc:=LOC_REGISTER; - p.funcretloc[side].register64.reglo:=NR_FUNCTION_RESULT64_HIGH_REG; - p.funcretloc[side].register64.reghi:=NR_FUNCTION_RESULT64_LOW_REG; - p.funcretloc[side].size:=OS_64; - end; - OS_32, - OS_F32: - begin - p.funcretloc[side].loc:=LOC_REGISTER; - p.funcretloc[side].register:=NR_FUNCTION_RETURN_REG; - p.funcretloc[side].size:=OS_32; - end; - else - internalerror(2005082603); - end; - end - else - begin - p.funcretloc[side].loc:=LOC_FPUREGISTER; - p.funcretloc[side].register:=NR_FPU_RESULT_REG; - end; + p.funcretloc[side].loc:=LOC_FPUREGISTER; + p.funcretloc[side].register:=NR_FPU_RESULT_REG; end { Return in register? } else if not ret_in_param(p.rettype.def,p.proccalloption) then diff --git a/compiler/arm/cputarg.pas b/compiler/arm/cputarg.pas index 61429d9de6..02bd2530c4 100644 --- a/compiler/arm/cputarg.pas +++ b/compiler/arm/cputarg.pas @@ -38,12 +38,6 @@ implementation {$ifndef NOTARGETLINUX} ,t_linux {$endif} - {$ifndef NOTARGETWINCE} - ,t_win - {$endif} - {$ifndef NOTARGETGBA} - ,t_gba - {$endif} {************************************** Assemblers @@ -52,27 +46,6 @@ implementation {$ifndef NOAGARMGAS} ,agarmgas {$endif} - - ,ogcoff - -{************************************** - Assembler Readers -**************************************} - - {$ifndef NoRaarmgas} - ,raarmgas - {$endif NoRaarmgas} - -{************************************** - Debuginfo -**************************************} - - {$ifndef NoDbgStabs} - ,dbgstabs - {$endif NoDbgStabs} - {$ifndef NoDbgDwarf} - ,dbgdwarf - {$endif NoDbgDwarf} ; end. diff --git a/compiler/arm/itcpugas.pas b/compiler/arm/itcpugas.pas index 74a186a20e..65ca3580c0 100644 --- a/compiler/arm/itcpugas.pas +++ b/compiler/arm/itcpugas.pas @@ -34,7 +34,26 @@ interface opcode strings should conform to the names as defined by the processor manufacturer. } - gas_op2str : op2strtable = {$i armatt.inc} + gas_op2str : op2strtable = ( + '','adc','add','and','n','bic','bkpt','b','bl','blx','bx', + 'cdp','cdp2','clz','cmn','cmp','eor','ldc','ldc2', + 'ldm','ldr','ldrb','ldrd','ldrbt','ldrh','ldrsb', + 'ldrsh','ldrt','mcr','mcr2','mcrr','mla','mov', + 'mrc','mrc2','mrrc','rs','msr','mul','mvn', + 'orr','pld','qadd','qdadd','qdsub','qsub','rsb','rsc', + 'sbc','smlal','smull','smul', + 'smulw','stc','stc2','stm','str','strb','strbt','strd', + 'strh','strt','sub','swi','swp','swpb','teq','tst', + 'umlal','umull', + { FPA coprocessor codes } + 'ldf','stf','lfm','sfm','flt','fix','wfs','rfs','rfc', + 'adf','dvf','fdv','fml','frd','muf','pol','pw','rdf', + 'rmf','rpw','rsf','suf','abs','acs','asn','atn','cos', + 'exp','log','lgn','mvf','mnf','nrm','rnd','sin','sqt','tan','urd', + 'cmf','cmfe','cnf' + { VPA coprocessor codes } + ); + function gas_regnum_search(const s:string):Tregister; function gas_regname(r:Tregister):string; diff --git a/compiler/arm/narmcnv.pas b/compiler/arm/narmcnv.pas index 6fb0fdc62e..45f82eefe1 100644 --- a/compiler/arm/narmcnv.pas +++ b/compiler/arm/narmcnv.pas @@ -57,7 +57,7 @@ interface implementation uses - verbose,globtype,globals,systems, + verbose,globals,systems, symconst,symdef,aasmbase,aasmtai, defutil, cgbase,cgutils, @@ -76,77 +76,37 @@ implementation var fname: string[19]; begin - if cs_fp_emulation in aktmoduleswitches then + { converting a 64bit integer to a float requires a helper } + if is_64bitint(left.resulttype.def) or + is_currency(left.resulttype.def) then begin - if target_info.system in system_wince then - begin - { converting a 64bit integer to a float requires a helper } - if is_64bitint(left.resulttype.def) or - is_currency(left.resulttype.def) then - begin - { hack to avoid double division by 10000, as it's - already done by resulttypepass.resulttype_int_to_real } - if is_currency(left.resulttype.def) then - left.resulttype := s64inttype; - if is_signed(left.resulttype.def) then - fname:='I64TOD' - else - fname:='UI64TOD'; - end - else - { other integers are supposed to be 32 bit } - begin - if is_signed(left.resulttype.def) then - fname:='ITOD' - else - fname:='UTOD'; - firstpass(left); - end; - result:=ccallnode.createintern(fname,ccallparanode.create( - left,nil)); - left:=nil; - firstpass(result); - exit; - end + { hack to avoid double division by 10000, as it's + already done by resulttypepass.resulttype_int_to_real } + if is_currency(left.resulttype.def) then + left.resulttype := s64inttype; + if is_signed(left.resulttype.def) then + fname := 'fpc_int64_to_double' else - begin - internalerror(2005082803); - end; + fname := 'fpc_qword_to_double'; + result := ccallnode.createintern(fname,ccallparanode.create( + left,nil)); + left:=nil; + firstpass(result); + exit; end else + { other integers are supposed to be 32 bit } begin - { converting a 64bit integer to a float requires a helper } - if is_64bitint(left.resulttype.def) or - is_currency(left.resulttype.def) then - begin - { hack to avoid double division by 10000, as it's - already done by resulttypepass.resulttype_int_to_real } - if is_currency(left.resulttype.def) then - left.resulttype := s64inttype; - if is_signed(left.resulttype.def) then - fname := 'fpc_int64_to_double' - else - fname := 'fpc_qword_to_double'; - result := ccallnode.createintern(fname,ccallparanode.create( - left,nil)); - left:=nil; - firstpass(result); - exit; - end + if is_signed(left.resulttype.def) then + inserttypeconv(left,s32inttype) else - { other integers are supposed to be 32 bit } - begin - if is_signed(left.resulttype.def) then - inserttypeconv(left,s32inttype) - else - inserttypeconv(left,u32inttype); - firstpass(left); - end; - result := nil; - if registersfpu<1 then - registersfpu:=1; - expectloc:=LOC_FPUREGISTER; + inserttypeconv(left,u32inttype); + firstpass(left); end; + result := nil; + if registersfpu<1 then + registersfpu:=1; + expectloc:=LOC_FPUREGISTER; end; @@ -172,8 +132,8 @@ implementation begin oldtruelabel:=truelabel; oldfalselabel:=falselabel; - objectlibrary.getjumplabel(truelabel); - objectlibrary.getjumplabel(falselabel); + objectlibrary.getlabel(truelabel); + objectlibrary.getlabel(falselabel); secondpass(left); if codegenerror then exit; @@ -237,7 +197,7 @@ implementation LOC_JUMP : begin hregister:=cg.getintregister(exprasmlist,OS_INT); - objectlibrary.getjumplabel(hlabel); + objectlibrary.getlabel(hlabel); cg.a_label(exprasmlist,truelabel); cg.a_load_const_reg(exprasmlist,OS_INT,1,hregister); cg.a_jmp_always(exprasmlist,hlabel); diff --git a/compiler/arm/narmcon.pas b/compiler/arm/narmcon.pas deleted file mode 100644 index b37b240b4b..0000000000 --- a/compiler/arm/narmcon.pas +++ /dev/null @@ -1,141 +0,0 @@ -{ - Copyright (c) 2005 by Florian Klaempfl - - Code generation for const nodes on the ARM - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit narmcon; - -{$i fpcdefs.inc} - -interface - - uses - node,ncgcon,cpubase; - - type - tarmrealconstnode = class(tcgrealconstnode) - procedure pass_2;override; - end; - - implementation - - uses - verbose, - globtype,globals, - cpuinfo, - aasmbase,aasmtai, - symconst,symdef, - defutil, - cgbase,cgutils, - procinfo, - ncon; - -{***************************************************************************** - TARMREALCONSTNODE -*****************************************************************************} - - procedure tarmrealconstnode.pass_2; - { I suppose the parser/pass_1 must make sure the generated real } - { constants are actually supported by the target processor? (JM) } - const - floattype2ait:array[tfloattype] of taitype= - (ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_comp_64bit,ait_real_128bit); - var - hp1 : tai; - lastlabel : tasmlabel; - realait : taitype; - hiloswapped : boolean; - - begin - location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def)); - lastlabel:=nil; - realait:=floattype2ait[tfloatdef(resulttype.def).typ]; - hiloswapped:=aktfputype in [fpu_fpa,fpu_fpa10,fpu_fpa11]; - { const already used ? } - if not assigned(lab_real) then - begin - objectlibrary.getjumplabel(lastlabel); - lab_real:=lastlabel; - current_procinfo.aktlocaldata.concat(Tai_label.Create(lastlabel)); - location.reference.symboldata:=current_procinfo.aktlocaldata.last; - case realait of - ait_real_32bit : - begin - current_procinfo.aktlocaldata.concat(Tai_real_32bit.Create(ts32real(value_real))); - { range checking? } - if ((cs_check_range in aktlocalswitches) or - (cs_check_overflow in aktlocalswitches)) and - (tai_real_32bit(asmlist[al_typedconsts].last).value=double(MathInf)) then - Message(parser_e_range_check_error); - end; - - ait_real_64bit : - begin - if hiloswapped then - current_procinfo.aktlocaldata.concat(Tai_real_64bit.Create_hiloswapped(ts64real(value_real))) - else - current_procinfo.aktlocaldata.concat(Tai_real_64bit.Create(ts64real(value_real))); - - { range checking? } - if ((cs_check_range in aktlocalswitches) or - (cs_check_overflow in aktlocalswitches)) and - (tai_real_64bit(asmlist[al_typedconsts].last).value=double(MathInf)) then - Message(parser_e_range_check_error); - end; - - ait_real_80bit : - begin - current_procinfo.aktlocaldata.concat(Tai_real_80bit.Create(value_real)); - - { range checking? } - if ((cs_check_range in aktlocalswitches) or - (cs_check_overflow in aktlocalswitches)) and - (tai_real_80bit(asmlist[al_typedconsts].last).value=double(MathInf)) then - Message(parser_e_range_check_error); - end; -{$ifdef cpufloat128} - ait_real_128bit : - begin - current_procinfo.aktlocaldata.concat(Tai_real_128bit.Create(value_real)); - - { range checking? } - if ((cs_check_range in aktlocalswitches) or - (cs_check_overflow in aktlocalswitches)) and - (tai_real_128bit(asmlist[al_typedconsts].last).value=double(MathInf)) then - Message(parser_e_range_check_error); - end; -{$endif cpufloat128} - - { the round is necessary for native compilers where comp isn't a float } - ait_comp_64bit : - if (value_real>9223372036854775807.0) or (value_real<-9223372036854775808.0) then - message(parser_e_range_check_error) - else - current_procinfo.aktlocaldata.concat(Tai_comp_64bit.Create(round(value_real))); - else - internalerror(2005092401); - end; - end; - location.reference.symbol:=lab_real; - location.reference.base:=NR_R15; - end; - -begin - crealconstnode:=tarmrealconstnode; -end. diff --git a/compiler/arm/narminl.pas b/compiler/arm/narminl.pas index ab9453c24c..fcfd160623 100644 --- a/compiler/arm/narminl.pas +++ b/compiler/arm/narminl.pas @@ -85,43 +85,28 @@ implementation function tarminlinenode.first_abs_real : tnode; begin - if cs_fp_emulation in aktmoduleswitches then - result:=inherited first_abs_real - else - begin - expectloc:=LOC_FPUREGISTER; - registersint:=left.registersint; - registersfpu:=max(left.registersfpu,1); - first_abs_real:=nil; - end; + expectloc:=LOC_FPUREGISTER; + registersint:=left.registersint; + registersfpu:=max(left.registersfpu,1); + first_abs_real := nil; end; function tarminlinenode.first_sqr_real : tnode; begin - if cs_fp_emulation in aktmoduleswitches then - result:=inherited first_sqr_real - else - begin - expectloc:=LOC_FPUREGISTER; - registersint:=left.registersint; - registersfpu:=max(left.registersfpu,1); - first_sqr_real:=nil; - end; + expectloc:=LOC_FPUREGISTER; + registersint:=left.registersint; + registersfpu:=max(left.registersfpu,1); + first_sqr_real:=nil; end; function tarminlinenode.first_sqrt_real : tnode; begin - if cs_fp_emulation in aktmoduleswitches then - result:=inherited first_sqrt_real - else - begin - expectloc:=LOC_FPUREGISTER; - registersint:=left.registersint; - registersfpu:=max(left.registersfpu,1); - first_sqrt_real := nil; - end; + expectloc:=LOC_FPUREGISTER; + registersint:=left.registersint; + registersfpu:=max(left.registersfpu,1); + first_sqrt_real := nil; end; diff --git a/compiler/arm/rgcpu.pas b/compiler/arm/rgcpu.pas index a522a4f38c..1a0378269c 100644 --- a/compiler/arm/rgcpu.pas +++ b/compiler/arm/rgcpu.pas @@ -64,7 +64,7 @@ unit rgcpu; helplist:=taasmoutput.create; reference_reset(tmpref); { create consts entry } - objectlibrary.getjumplabel(l); + objectlibrary.getlabel(l); cg.a_label(current_procinfo.aktlocaldata,l); tmpref.symboldata:=current_procinfo.aktlocaldata.last; @@ -112,7 +112,7 @@ unit rgcpu; helplist:=taasmoutput.create; reference_reset(tmpref); { create consts entry } - objectlibrary.getjumplabel(l); + objectlibrary.getlabel(l); cg.a_label(current_procinfo.aktlocaldata,l); tmpref.symboldata:=current_procinfo.aktlocaldata.last; diff --git a/compiler/assemble.pas b/compiler/assemble.pas index 92f47eca39..29ac0771cc 100644 --- a/compiler/assemble.pas +++ b/compiler/assemble.pas @@ -42,7 +42,7 @@ interface const { maximum of aasmoutput lists there will be } - maxoutputlists = 20; + maxoutputlists = 10; { buffer size for writing the .s file } AsmOutSize=32768; @@ -143,7 +143,19 @@ interface currlistidx : byte; currlist : TAAsmoutput; currpass : byte; - procedure convertstab(p:pchar); +{$ifdef GDB} + n_line : byte; { different types of source lines } + linecount, + includecount : longint; + funcname : tasmsymbol; + stabslastfileinfo : tfileposinfo; + procedure convertstabs(p:pchar); + procedure emitlineinfostabs(nidx,line : longint); + procedure emitstabs(s:string); + procedure WriteFileLineInfo(var fileinfo : tfileposinfo); + procedure StartFileLineInfo; + procedure EndFileLineInfo; +{$endif} function MaybeNextList(var hp:Tai):boolean; function TreePass0(hp:Tai):Tai; function TreePass1(hp:Tai):Tai; @@ -176,6 +188,10 @@ Implementation {$ifdef memdebug} cclasses, {$endif memdebug} +{$ifdef GDB} + finput, + gdb, +{$endif GDB} {$ifdef m68k} cpuinfo, {$endif m68k} @@ -247,7 +263,7 @@ Implementation begin DoPipe:=(cs_asm_pipe in aktglobalswitches) and not(cs_asm_leave in aktglobalswitches) - and ((target_asm.id in [as_gas,as_darwin])); + and ((aktoutputformat in [as_gas,as_darwin])); end; @@ -678,200 +694,271 @@ Implementation end; - procedure TInternalAssembler.convertstab(p:pchar); +{$ifdef GDB} + procedure TInternalAssembler.convertstabs(p:pchar); + var + ofs, + nidx,nother,ii,i,line,j : longint; + code : integer; + hp : pchar; + reloc : boolean; + ps : tasmsymbol; + s : string; + begin + ofs:=0; + reloc:=true; + ps:=nil; + if p[0]='"' then + begin + i:=1; + { we can have \" inside the string !! PM } + while not ((p[i]='"') and (p[i-1]<>'\')) do + inc(i); + p[i]:=#0; + ii:=i; + hp:=@p[1]; + s:=StrPas(@P[i+2]); + end + else + begin + hp:=nil; + s:=StrPas(P); + i:=-2; {needed below (PM) } + end; + { When in pass 1 then only alloc and leave } + if currpass=1 then + begin + objectdata.allocstabs(hp); + if assigned(hp) then + p[i]:='"'; + exit; + end; + { Parse the rest of the stabs } + if s='' then + internalerror(33000); + j:=pos(',',s); + if j=0 then + internalerror(33001); + Val(Copy(s,1,j-1),nidx,code); + if code<>0 then + internalerror(33002); + i:=i+2+j; + Delete(s,1,j); + j:=pos(',',s); + if (j=0) then + internalerror(33003); + Val(Copy(s,1,j-1),nother,code); + if code<>0 then + internalerror(33004); + i:=i+j; + Delete(s,1,j); + j:=pos(',',s); + if j=0 then + begin + j:=256; + ofs:=-1; + end; + Val(Copy(s,1,j-1),line,code); + if code<>0 then + internalerror(33005); + if ofs=0 then + begin + Delete(s,1,j); + i:=i+j; + Val(s,ofs,code); + if code=0 then + reloc:=false + else + begin + ofs:=0; + s:=strpas(@p[i]); + { handle asmsymbol or + asmsymbol - asmsymbol } + j:=pos(' ',s); + if j=0 then + j:=pos('-',s); + { also try to handle + asmsymbol + constant + or + asmsymbol - constant } + if j=0 then + j:=pos('+',s); + + if j<>0 then + begin + Val(Copy(s,j+1,255),ofs,code); + if code<>0 then + ofs:=0 + else + { constant reading successful, + avoid further treatment by + setting s[j] to '+' } + s[j]:='+'; + end + else + { single asmsymbol } + j:=256; + { the symbol can be external + so we must use newasmsymbol and + not getasmsymbol !! PM } + ps:=objectlibrary.newasmsymbol(copy(s,1,j-1),AB_EXTERNAL,AT_NONE); + if not assigned(ps) then + internalerror(33006) + else + begin + ofs:=ofs+ps.address; + reloc:=true; + objectlibrary.UsedAsmSymbolListInsert(ps); + end; + if (j<256) and (s[j]<>'+') then + begin + i:=i+j; + s:=strpas(@p[i]); + if (s<>'') and (s[1]=' ') then + begin + j:=0; + while (s[j+1]=' ') do + inc(j); + i:=i+j; + s:=strpas(@p[i]); + end; + ps:=objectlibrary.getasmsymbol(s); + if not assigned(ps) then + internalerror(33007) + else + begin + if ps.section<>objectdata.currsec then + internalerror(33008); + ofs:=ofs-ps.address; + reloc:=false; + objectlibrary.UsedAsmSymbolListInsert(ps); + end; + end; + end; + end; + { External references (AB_EXTERNAL and AB_COMMON) need a symbol relocation } + if assigned(ps) and (ps.currbind in [AB_EXTERNAL,AB_COMMON]) then + begin + if currpass=2 then + begin + objectdata.writesymbol(ps); + objectoutput.exportsymbol(ps); + end; + objectdata.writeSymStabs(ofs,hp,ps,nidx,nother,line,reloc) + end + else + objectdata.writeStabs(ofs,hp,nidx,nother,line,reloc); + if assigned(hp) then + p[ii]:='"'; + end; + + + procedure TInternalAssembler.emitlineinfostabs(nidx,line : longint); + begin + if currpass=1 then + begin + objectdata.allocstabs(nil); + exit; + end; - function consumecomma(var p:pchar):boolean; - begin - while (p^=' ') do - inc(p); - result:=(p^=','); - inc(p); - end; + if (nidx=n_textline) and assigned(funcname) and + (target_info.use_function_relative_addresses) then + objectdata.writeStabs(objectdata.currsec.datasize-funcname.address,nil,nidx,0,line,false) + else + objectdata.writeStabs(objectdata.currsec.datasize,nil,nidx,0,line,true); + end; - function consumenumber(var p:pchar;out value:longint):boolean; - var - hs : string; - len, - code : integer; - begin - value:=0; - while (p^=' ') do - inc(p); - len:=0; - while (p^ in ['0'..'9']) do - begin - inc(len); - hs[len]:=p^; - inc(p); - end; - if len>0 then - begin - hs[0]:=chr(len); - val(hs,value,code); - end - else - code:=-1; - result:=(code=0); - end; - function consumeoffset(var p:pchar;out relocsym:tasmsymbol;out value:longint):boolean; - var - hs : string; - len, - code : integer; - pstart : pchar; - sym : tasmsymbol; - exprvalue : longint; - gotmin, - dosub : boolean; - begin - result:=false; - value:=0; - relocsym:=nil; - gotmin:=false; - repeat - dosub:=false; - exprvalue:=0; - if gotmin then - begin - dosub:=true; - gotmin:=false; - end; - while (p^=' ') do - inc(p); - case p^ of - #0 : - break; - ' ' : - inc(p); - '0'..'9' : - begin - len:=0; - while (p^ in ['0'..'9']) do - begin - inc(len); - hs[len]:=p^; - inc(p); - end; - hs[0]:=chr(len); - val(hs,exprvalue,code); - end; - '.','_', - 'A'..'Z', - 'a'..'z' : - begin - pstart:=p; - while not(p^ in [#0,' ','-','+']) do - inc(p); - len:=p-pstart; - if len>255 then - internalerror(200509187); - move(pstart^,hs[1],len); - hs[0]:=chr(len); - sym:=objectlibrary.newasmsymbol(hs,AB_EXTERNAL,AT_NONE); - if not assigned(sym) then - internalerror(200509188); - objectlibrary.UsedAsmSymbolListInsert(sym); - { Second symbol? } - if assigned(relocsym) then - begin - if (relocsym.section<>sym.section) then - internalerror(2005091810); - relocsym:=nil; - end - else - begin - relocsym:=sym; - end; - exprvalue:=sym.address; - end; - '+' : - begin - { nothing, by default addition is done } - inc(p); - end; - '-' : + procedure TInternalAssembler.emitstabs(s:string); + begin + s:=s+#0; + ConvertStabs(@s[1]); + end; + + + procedure TInternalAssembler.WriteFileLineInfo(var fileinfo : tfileposinfo); + var + curr_n : byte; + hp : tasmsymbol; + infile : tinputfile; + begin + if not ((cs_debuginfo in aktmoduleswitches) or + (cs_gdb_lineinfo in aktglobalswitches)) then + exit; + + { file changed ? (must be before line info) } + if (fileinfo.fileindex<>0) and + (stabslastfileinfo.fileindex<>fileinfo.fileindex) then + begin + infile:=current_module.sourcefiles.get_file(fileinfo.fileindex); + if assigned(infile) then + begin + if includecount=0 then + curr_n:=n_sourcefile + else + curr_n:=n_includefile; + { get symbol for this includefile } + hp:=objectlibrary.newasmsymbol('Ltext'+ToStr(IncludeCount),AB_LOCAL,AT_FUNCTION); + if currpass=1 then begin - gotmin:=true; - inc(p); - end; + objectdata.allocsymbol(currpass,hp,0); + objectlibrary.UsedAsmSymbolListInsert(hp); + end else - internalerror(200509189); + objectdata.writesymbol(hp); + { emit stabs } + if (infile.path^<>'') then + EmitStabs('"'+BsToSlash(FixPath(infile.path^,false))+'",'+tostr(curr_n)+ + ',0,0,Ltext'+ToStr(IncludeCount)); + EmitStabs('"'+FixFileName(infile.name^)+'",'+tostr(curr_n)+ + ',0,0,Ltext'+ToStr(IncludeCount)); + inc(includecount); + { force new line info } + stabslastfileinfo.line:=-1; end; - if dosub then - dec(value,exprvalue) - else - inc(value,exprvalue); - until false; - result:=true; - end; + end; + + { line changed ? } + if (stabslastfileinfo.line<>fileinfo.line) and (fileinfo.line<>0) then + emitlineinfostabs(n_line,fileinfo.line); + stabslastfileinfo:=fileinfo; + end; - const - N_Function = $24; { function or const } + + procedure TInternalAssembler.StartFileLineInfo; var - ofs, - nline, - nidx, - nother, - i : longint; - relocsym : tasmsymbol; - pstr, - pcurr, - pendquote : pchar; + fileinfo : tfileposinfo; begin - pcurr:=nil; - pstr:=nil; - pendquote:=nil; + FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0); + n_line:=n_bssline; + funcname:=nil; + linecount:=1; + includecount:=0; + fileinfo.fileindex:=1; + fileinfo.line:=1; + WriteFileLineInfo(fileinfo); + end; - { Parse string part } - if p[0]='"' then - begin - pstr:=@p[1]; - { Ignore \" inside the string } - i:=1; - while not((p[i]='"') and (p[i-1]<>'\')) and - (p[i]<>#0) do - inc(i); - pendquote:=@p[i]; - pendquote^:=#0; - pcurr:=@p[i+1]; - if not consumecomma(pcurr) then - internalerror(200509181); - end - else - pcurr:=p; - { When in pass 1 then only alloc and leave } + procedure TInternalAssembler.EndFileLineInfo; + var + hp : tasmsymbol; + begin + if not ((cs_debuginfo in aktmoduleswitches) or + (cs_gdb_lineinfo in aktglobalswitches)) then + exit; + objectdata.createsection(sec_code,'',0,[]); + hp:=objectlibrary.newasmsymbol('Letext',AB_LOCAL,AT_FUNCTION); if currpass=1 then - objectdata.allocstab(pstr) - else begin - { Stabs format: nidx,nother,nline[,offset] } - if not consumenumber(pcurr,nidx) then - internalerror(200509182); - if not consumecomma(pcurr) then - internalerror(200509183); - if not consumenumber(pcurr,nother) then - internalerror(200509184); - if not consumecomma(pcurr) then - internalerror(200509185); - if not consumenumber(pcurr,nline) then - internalerror(200509186); - if consumecomma(pcurr) then - consumeoffset(pcurr,relocsym,ofs) - else - begin - ofs:=0; - relocsym:=nil; - end; - if (nidx=N_Function) and - target_info.use_function_relative_addresses then - ofs:=0; - objectdata.writestab(ofs,relocsym,nidx,nother,nline,pstr); - end; - if assigned(pendquote) then - pendquote^:='"'; + objectdata.allocsymbol(currpass,hp,0); + objectlibrary.UsedAsmSymbolListInsert(hp); + end + else + objectdata.writesymbol(hp); + EmitStabs('"",'+tostr(n_sourcefile)+',0,0,Letext'); end; +{$endif GDB} function TInternalAssembler.MaybeNextList(var hp:Tai):boolean; @@ -953,11 +1040,6 @@ Implementation objectdata.alloc(Taicpu(hp).Pass1(objectdata.currsec.datasize)); {$endif NOAG386BIN} {$endif i386} -{$ifdef arm} - { reset instructions which could change in pass 2 } - Taicpu(hp).resetpass2; - objectdata.alloc(Taicpu(hp).Pass1(objectdata.currsec.datasize)); -{$endif arm} end; ait_cutobject : if SmartAsm then @@ -972,12 +1054,27 @@ Implementation function TInternalAssembler.TreePass1(hp:Tai):Tai; var InlineLevel, - l, + l : longint; +{$ifdef i386} +{$ifndef NOAG386BIN} i : longint; +{$endif NOAG386BIN} +{$endif i386} begin inlinelevel:=0; while assigned(hp) do begin +{$ifdef GDB} + { write stabs, no line info for inlined code } + if (inlinelevel=0) and + ((cs_debuginfo in aktmoduleswitches) or + (cs_gdb_lineinfo in aktglobalswitches)) then + begin + if (objectdata.currsec<>nil) and + not(hp.typ in SkipLineInfo) then + WriteFileLineInfo(tailineinfo(hp).fileinfo); + end; +{$endif GDB} case hp.typ of ait_align : begin @@ -988,23 +1085,23 @@ Implementation end; ait_datablock : begin - if not (objectdata.currsec.sectype in [sec_bss,sec_threadvar]) then + if objectdata.currsec.sectype<>sec_bss then Message(asmw_e_alloc_data_only_in_bss); l:=used_align(size_2_align(Tai_datablock(hp).size),0,objectdata.currsec.addralign); -{ if Tai_datablock(hp).is_global and + if Tai_datablock(hp).is_global and not SmartAsm then - begin} -{ objectdata.allocsymbol(currpass,Tai_datablock(hp).sym,Tai_datablock(hp).size);} + begin + objectdata.allocsymbol(currpass,Tai_datablock(hp).sym,Tai_datablock(hp).size); { force to be common/external, must be after setaddress as that would set it to AB_GLOBAL } -{ Tai_datablock(hp).sym.currbind:=AB_COMMON; + Tai_datablock(hp).sym.currbind:=AB_COMMON; end else - begin} + begin objectdata.allocalign(l); objectdata.allocsymbol(currpass,Tai_datablock(hp).sym,Tai_datablock(hp).size); objectdata.alloc(Tai_datablock(hp).size); -{ end;} + end; objectlibrary.UsedAsmSymbolListInsert(Tai_datablock(hp).sym); end; ait_real_80bit : @@ -1032,14 +1129,44 @@ Implementation begin { use cached value } objectdata.setsection(Tai_section(hp).sec); +{$ifdef GDB} + case Tai_section(hp).sectype of + sec_code : + n_line:=n_textline; + sec_data : + n_line:=n_dataline; + sec_bss : + n_line:=n_bssline; + else + n_line:=n_dataline; + end; + stabslastfileinfo.line:=-1; +{$endif GDB} + end; +{$ifdef GDB} + ait_stabn : + begin + if assigned(Tai_stabn(hp).str) then + convertstabs(Tai_stabn(hp).str); end; - ait_stab : + ait_stabs : begin - if assigned(Tai_stab(hp).str) then - convertstab(Tai_stab(hp).str); + if assigned(Tai_stabs(hp).str) then + convertstabs(Tai_stabs(hp).str); end; - ait_function_name, - ait_force_line : ; + ait_stab_function_name : + begin + if assigned(Tai_stab_function_name(hp).str) then + begin + funcname:=objectlibrary.getasmsymbol(strpas(Tai_stab_function_name(hp).str)); + objectlibrary.UsedAsmSymbolListInsert(funcname); + end + else + funcname:=nil; + end; + ait_force_line : + stabslastfileinfo.line:=0; +{$endif} ait_symbol : begin objectdata.allocsymbol(currpass,Tai_symbol(hp).sym,0); @@ -1062,6 +1189,8 @@ Implementation objectdata.alloc(Tai_string(hp).len); ait_instruction : begin +{$ifdef i386} +{$ifndef NOAG386BIN} objectdata.alloc(Taicpu(hp).Pass1(objectdata.currsec.datasize)); { fixup the references } for i:=1 to Taicpu(hp).ops do @@ -1079,7 +1208,11 @@ Implementation end; end; end; +{$endif NOAG386BIN} +{$endif i386} end; + ait_direct : + Message(asmw_f_direct_not_supported); ait_cutobject : if SmartAsm then break; @@ -1109,10 +1242,21 @@ Implementation { main loop } while assigned(hp) do begin +{$ifdef GDB} + { write stabs, no line info for inlined code } + if (inlinelevel=0) and + ((cs_debuginfo in aktmoduleswitches) or + (cs_gdb_lineinfo in aktglobalswitches)) then + begin + if (objectdata.currsec<>nil) and + not(hp.typ in SkipLineInfo) then + WriteFileLineInfo(tailineinfo(hp).fileinfo); + end; +{$endif GDB} case hp.typ of ait_align : begin - if objectdata.currsec.sectype in [sec_bss,sec_threadvar] then + if objectdata.currsec.sectype=sec_bss then objectdata.alloc(Tai_align(hp).fillsize) else objectdata.writebytes(Tai_align(hp).calculatefillbuf(fillbuffer)^,Tai_align(hp).fillsize); @@ -1121,6 +1265,16 @@ Implementation begin { use cached value } objectdata.setsection(Tai_section(hp).sec); +{$ifdef GDB} + case Tai_section(hp).sectype of + sec_code : n_line:=n_textline; + sec_data : n_line:=n_dataline; + sec_bss : n_line:=n_bssline; + else + n_line:=n_dataline; + end; + stabslastfileinfo.line:=-1; +{$endif GDB} end; ait_symbol : begin @@ -1132,11 +1286,11 @@ Implementation l:=used_align(size_2_align(Tai_datablock(hp).size),0,objectdata.currsec.addralign); objectdata.writesymbol(Tai_datablock(hp).sym); objectoutput.exportsymbol(Tai_datablock(hp).sym); -{ if SmartAsm or (not Tai_datablock(hp).is_global) then - begin} + if SmartAsm or (not Tai_datablock(hp).is_global) then + begin objectdata.allocalign(l); objectdata.alloc(Tai_datablock(hp).size); -{ end;} + end; end; ait_real_80bit : objectdata.writebytes(Tai_real_80bit(hp).value,10); @@ -1147,7 +1301,11 @@ Implementation ait_comp_64bit : begin {$ifdef x86} +{$ifdef FPC} co:=comp(Tai_comp_64bit(hp).value); +{$else} + co:=Tai_comp_64bit(hp).value; +{$endif} objectdata.writebytes(co,8); {$endif x86} end; @@ -1168,8 +1326,7 @@ Implementation objectdata.writebytes(v,tai_const(hp).size); end else - objectdata.writereloc(Tai_const(hp).value,Tai_const(hp).size, - Tai_const(hp).sym,RELOC_ABSOLUTE); + objectdata.writereloc(Tai_const(hp).value,Tai_const(hp).size,Tai_const(hp).sym,RELOC_ABSOLUTE); end else objectdata.writebytes(Tai_const(hp).value,tai_const(hp).size); @@ -1183,12 +1340,25 @@ Implementation but it's better to be on the safe side (PFV) } objectoutput.exportsymbol(Tai_label(hp).l); end; +{$ifdef i386} +{$ifndef NOAG386BIN} ait_instruction : Taicpu(hp).Pass2(objectdata); - ait_stab : - convertstab(Tai_stab(hp).str); - ait_function_name, - ait_force_line : ; +{$endif NOAG386BIN} +{$endif i386} +{$ifdef GDB} + ait_stabn : + convertstabs(Tai_stabn(hp).str); + ait_stabs : + convertstabs(Tai_stabs(hp).str); + ait_stab_function_name : + if assigned(Tai_stab_function_name(hp).str) then + funcname:=objectlibrary.getasmsymbol(strpas(Tai_stab_function_name(hp).str)) + else + funcname:=nil; + ait_force_line : + stabslastfileinfo.line:=0; +{$endif} ait_cutobject : if SmartAsm then break; @@ -1237,6 +1407,9 @@ Implementation objectdata.resetsections; objectdata.beforealloc; objectdata.createsection(sec_code,'',0,[]); +{$ifdef GDB} + StartFileLineInfo; +{$endif GDB} { start with list 1 } currlistidx:=1; currlist:=list[currlistidx]; @@ -1246,7 +1419,9 @@ Implementation hp:=TreePass1(hp); MaybeNextList(hp); end; - objectdata.createsection(sec_code,'',0,[]); +{$ifdef GDB} + EndFileLineInfo; +{$endif GDB} objectdata.afteralloc; { check for undefined labels and reset } objectlibrary.UsedAsmSymbolListCheckUndefined; @@ -1260,6 +1435,9 @@ Implementation objectdata.resetsections; objectdata.beforewrite; objectdata.createsection(sec_code,'',0,[]); +{$ifdef GDB} + StartFileLineInfo; +{$endif GDB} { start with list 1 } currlistidx:=1; currlist:=list[currlistidx]; @@ -1269,7 +1447,9 @@ Implementation hp:=TreePass2(hp); MaybeNextList(hp); end; - objectdata.createsection(sec_code,'',0,[]); +{$ifdef GDB} + EndFileLineInfo; +{$endif GDB} objectdata.afterwrite; { don't write the .o file if errors have occured } @@ -1325,7 +1505,13 @@ Implementation objectdata.resetsections; objectdata.beforealloc; objectdata.createsection(startsectype,'',0,[]); +{$ifdef GDB} + StartFileLineInfo; +{$endif GDB} TreePass1(hp); +{$ifdef GDB} + EndFileLineInfo; +{$endif GDB} objectdata.afteralloc; { check for undefined labels } objectlibrary.UsedAsmSymbolListCheckUndefined; @@ -1340,10 +1526,16 @@ Implementation objectdata.resetsections; objectdata.beforewrite; objectdata.createsection(startsectype,'',0,[]); +{$ifdef GDB} + StartFileLineInfo; +{$endif GDB} hp:=TreePass2(hp); { save section type for next loop, must be done before EndFileLineInfo because that changes the section to sec_code } startsectype:=objectdata.currsec.sectype; +{$ifdef GDB} + EndFileLineInfo; +{$endif GDB} objectdata.afterwrite; { leave if errors have occured } if errorcount>0 then @@ -1397,9 +1589,6 @@ Implementation procedure TInternalAssembler.MakeObject; - var to_do:set of Tasmlist; - i:Tasmlist; - procedure addlist(p:TAAsmoutput); begin inc(lists); @@ -1407,17 +1596,25 @@ Implementation end; begin - to_do:=[low(Tasmlist)..high(Tasmlist)]; - if usedeffileforexports then - exclude(to_do,al_exports); - {$warning TODO internal writer support for dwarf} - exclude(to_do,al_dwarf); -{$ifndef segment_threadvars} - exclude(to_do,al_threadvars); -{$endif} - for i:=low(Tasmlist) to high(Tasmlist) do - if (i in to_do) and (asmlist[i]<>nil) then - addlist(asmlist[i]); + if cs_debuginfo in aktmoduleswitches then + addlist(debuglist); + addlist(codesegment); + addlist(datasegment); + addlist(consts); + addlist(rttilist); + addlist(picdata); + if assigned(resourcestringlist) then + addlist(resourcestringlist); + addlist(bsssegment); + if assigned(importssection) then + addlist(importssection); + if assigned(exportssection) and not UseDeffileForExports then + addlist(exportssection); + if assigned(resourcesection) then + addlist(resourcesection); +{$warning TODO internal writer support for dwarf} + {if assigned(dwarflist) then + addlist(dwarflist);} if SmartAsm then writetreesmart @@ -1472,6 +1669,9 @@ Implementation procedure InitAssembler; begin + { target_asm is already set by readarguments } + initoutputformat:=target_asm.id; + aktoutputformat:=target_asm.id; end; diff --git a/compiler/cg64f32.pas b/compiler/cg64f32.pas index e80e4cad7f..2ea35a11ef 100644 --- a/compiler/cg64f32.pas +++ b/compiler/cg64f32.pas @@ -589,7 +589,7 @@ unit cg64f32; hreg:=cg.getintregister(list,OS_32); a_load64high_ref_reg(list,l.reference,hreg); end; - objectlibrary.getjumplabel(poslabel); + objectlibrary.getlabel(poslabel); { check high dword, must be 0 (for positive numbers) } cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,0,hreg,poslabel); @@ -597,7 +597,7 @@ unit cg64f32; { It can also be $ffffffff, but only for negative numbers } if from_signed and to_signed then begin - objectlibrary.getjumplabel(neglabel); + objectlibrary.getlabel(neglabel); cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,-1,hreg,neglabel); end; { For all other values we have a range check error } @@ -620,7 +620,7 @@ unit cg64f32; if from_signed and to_signed then begin - objectlibrary.getjumplabel(endlabel); + objectlibrary.getlabel(endlabel); cg.a_jmp_always(list,endlabel); { if the high dword = $ffffffff, then the low dword (when } { considered as a longint) must be < 0 } @@ -635,7 +635,7 @@ unit cg64f32; a_load64low_ref_reg(list,l.reference,hreg); end; { get a new neglabel (JM) } - objectlibrary.getjumplabel(neglabel); + objectlibrary.getlabel(neglabel); cg.a_cmp_const_reg_label(list,OS_32,OC_LT,0,hreg,neglabel); cg.a_call_name(list,'FPC_RANGEERROR'); @@ -687,7 +687,7 @@ unit cg64f32; else cg.a_load_ref_reg(list,opsize,OS_32,l.reference,hreg); end; - objectlibrary.getjumplabel(poslabel); + objectlibrary.getlabel(poslabel); cg.a_cmp_const_reg_label(list,opsize,OC_GTE,0,hreg,poslabel); cg.a_call_name(list,'FPC_RANGEERROR'); diff --git a/compiler/cgbase.pas b/compiler/cgbase.pas index 6f1a241028..97625f9adc 100644 --- a/compiler/cgbase.pas +++ b/compiler/cgbase.pas @@ -53,28 +53,9 @@ interface LOC_CMMREGISTER ); - { since we have only 16bit offsets, we need to be able to specify the high - and lower 16 bits of the address of a symbol of up to 64 bit } - trefaddr = ( - addr_no, - addr_full, - {$IFNDEF POWERPC64} - addr_hi, - addr_lo, - {$ENDIF} - addr_pic - {$IFDEF POWERPC64} - , - addr_low, // bits 48-63 - addr_high, // bits 32-47 - addr_higher, // bits 16-31 - addr_highest, // bits 00-15 - addr_higha, // bits 16-31, adjusted - addr_highera, // bits 32-47, adjusted - addr_highesta // bits 48-63, adjusted - {$ENDIF} - ); - + { since we have only 16 offsets, we need to be able to specify the high + and low 16 bits of the address of a symbol } + trefaddr = (addr_no,addr_full,addr_hi,addr_lo,addr_pic); {# Generic opcodes, which must be supported by all processors } @@ -148,9 +129,7 @@ interface { For Sparc floats that use F0:F1 to store doubles } R_SUBFS, { = 6; Float that allocates 1 FPU register } R_SUBFD, { = 7; Float that allocates 2 FPU registers } - R_SUBFQ, { = 8; Float that allocates 4 FPU registers } - R_SUBMMS, { = 9; single scalar in multi media register } - R_SUBMMD { = 10; double scalar in multi media register } + R_SUBFQ { = 8; Float that allocates 4 FPU registers } ); TSuperRegister = type word; @@ -518,10 +497,6 @@ implementation result:=result+'fs'; R_SUBFD: result:=result+'fd'; - R_SUBMMD: - result:=result+'md'; - R_SUBMMS: - result:=result+'ms'; else internalerror(200308252); end; diff --git a/compiler/cgobj.pas b/compiler/cgobj.pas index c51bcc1b56..61514a0544 100644 --- a/compiler/cgobj.pas +++ b/compiler/cgobj.pas @@ -95,8 +95,6 @@ unit cgobj; {# Free multiple registers specified.} procedure dealloccpuregisters(list:Taasmoutput;rt:Tregistertype;r:Tcpuregisterset);virtual; - procedure allocallcpuregisters(list:Taasmoutput);virtual; - procedure deallocallcpuregisters(list:Taasmoutput);virtual; procedure do_register_allocation(list:Taasmoutput;headertai:tai);virtual; function makeregsize(list:Taasmoutput;reg:Tregister;size:Tcgsize):Tregister; @@ -563,7 +561,7 @@ implementation function tcg.getmmregister(list:Taasmoutput;size:Tcgsize):Tregister; begin if not assigned(rg[R_MMREGISTER]) then - internalerror(2003121214); + internalerror(200312124); result:=rg[R_MMREGISTER].getregister(list,cgsize2subreg(size)); end; @@ -619,18 +617,6 @@ implementation end; - procedure tcg.allocallcpuregisters(list:Taasmoutput); - begin - alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); -{$ifndef i386} - alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); -{$ifdef cpumm} - alloccpuregisters(list,R_MMREGISTER,paramanager.get_volatile_registers_mm(pocall_default)); -{$endif cpumm} -{$endif i386} - end; - - procedure tcg.dealloccpuregisters(list:Taasmoutput;rt:Tregistertype;r:Tcpuregisterset); begin if assigned(rg[rt]) then @@ -640,18 +626,6 @@ implementation end; - procedure tcg.deallocallcpuregisters(list:Taasmoutput); - begin - dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); -{$ifndef i386} - dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); -{$ifdef cpumm} - dealloccpuregisters(list,R_MMREGISTER,paramanager.get_volatile_registers_mm(pocall_default)); -{$endif cpumm} -{$endif i386} - end; - - function tcg.uses_registers(rt:Tregistertype):boolean; begin if assigned(rg[rt]) then @@ -1411,9 +1385,11 @@ implementation paramanager.freeparaloc(list,cgpara3); paramanager.freeparaloc(list,cgpara2); paramanager.freeparaloc(list,cgpara1); - allocallcpuregisters(list); + alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); + alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); a_call_name(list,'FPC_SHORTSTR_ASSIGN'); - deallocallcpuregisters(list); + dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); + dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cgpara3.done; cgpara2.done; cgpara1.done; @@ -1460,9 +1436,9 @@ implementation { these functions get the pointer by value } a_param_ref(list,OS_ADDR,ref,cgpara1); paramanager.freeparaloc(list,cgpara1); - allocallcpuregisters(list); + alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); a_call_name(list,incrfunc); - deallocallcpuregisters(list); + dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end else begin @@ -1473,9 +1449,9 @@ implementation a_paramaddr_ref(list,ref,cgpara1); paramanager.freeparaloc(list,cgpara1); paramanager.freeparaloc(list,cgpara2); - allocallcpuregisters(list); + alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); a_call_name(list,'FPC_ADDREF'); - deallocallcpuregisters(list); + dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end; cgpara2.done; cgpara1.done; @@ -1534,9 +1510,9 @@ implementation paramanager.freeparaloc(list,cgpara1); if needrtti then paramanager.freeparaloc(list,cgpara2); - allocallcpuregisters(list); + alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); a_call_name(list,decrfunc); - deallocallcpuregisters(list); + dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end else begin @@ -1547,9 +1523,9 @@ implementation a_paramaddr_ref(list,ref,cgpara1); paramanager.freeparaloc(list,cgpara1); paramanager.freeparaloc(list,cgpara2); - allocallcpuregisters(list); + alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); a_call_name(list,'FPC_DECREF'); - deallocallcpuregisters(list); + dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end; cgpara2.done; cgpara1.done; @@ -1579,9 +1555,11 @@ implementation a_paramaddr_ref(list,ref,cgpara1); paramanager.freeparaloc(list,cgpara1); paramanager.freeparaloc(list,cgpara2); - allocallcpuregisters(list); + alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); + alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); a_call_name(list,'FPC_INITIALIZE'); - deallocallcpuregisters(list); + dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); + dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end; cgpara1.done; cgpara2.done; @@ -1613,9 +1591,11 @@ implementation a_paramaddr_ref(list,ref,cgpara1); paramanager.freeparaloc(list,cgpara1); paramanager.freeparaloc(list,cgpara2); - allocallcpuregisters(list); + alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); + alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); a_call_name(list,'FPC_FINALIZE'); - deallocallcpuregisters(list); + dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); + dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end; cgpara1.done; cgpara2.done; @@ -1736,7 +1716,7 @@ implementation hreg:=getintregister(list,OS_INT); a_load_loc_reg(list,OS_INT,l,hreg); a_op_const_reg(list,OP_SUB,OS_INT,aint(lto),hreg); - objectlibrary.getjumplabel(neglabel); + objectlibrary.getlabel(neglabel); { if from_signed then a_cmp_const_reg_label(list,OS_INT,OC_GTE,aint(hto-lto),hreg,neglabel) @@ -1778,7 +1758,7 @@ implementation if (cs_check_object in aktlocalswitches) or (cs_check_range in aktlocalswitches) then begin - objectlibrary.getjumplabel(oklabel); + objectlibrary.getlabel(oklabel); a_cmp_const_reg_label(list,OS_ADDR,OC_NE,0,reg,oklabel); cgpara1.init; paramanager.getintparaloc(pocall_default,1,cgpara1); @@ -1810,9 +1790,9 @@ implementation a_param_reg(list,OS_ADDR,reg,cgpara1); paramanager.freeparaloc(list,cgpara1); paramanager.freeparaloc(list,cgpara2); - allocallcpuregisters(list); + alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); a_call_name(list,'FPC_CHECK_OBJECT_EXT'); - deallocallcpuregisters(list); + dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end else if (cs_check_range in aktlocalswitches) then @@ -1820,9 +1800,9 @@ implementation paramanager.allocparaloc(list,cgpara1); a_param_reg(list,OS_ADDR,reg,cgpara1); paramanager.freeparaloc(list,cgpara1); - allocallcpuregisters(list); + alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); a_call_name(list,'FPC_CHECK_OBJECT'); - deallocallcpuregisters(list); + dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end; cgpara1.done; cgpara2.done; @@ -1866,9 +1846,11 @@ implementation paramanager.allocparaloc(list,cgpara1); a_param_reg(list,OS_INT,sizereg,cgpara1); paramanager.freeparaloc(list,cgpara1); - allocallcpuregisters(list); + alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); + alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); a_call_name(list,'FPC_GETMEM'); - deallocallcpuregisters(list); + dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); + dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cgpara1.done; { return the new address } a_load_reg_reg(list,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,destreg); @@ -1892,9 +1874,11 @@ implementation paramanager.freeparaloc(list,cgpara3); paramanager.freeparaloc(list,cgpara2); paramanager.freeparaloc(list,cgpara1); - allocallcpuregisters(list); + alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); + alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); a_call_name(list,'FPC_MOVE'); - deallocallcpuregisters(list); + dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); + dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cgpara3.done; cgpara2.done; cgpara1.done; @@ -1912,9 +1896,11 @@ implementation paramanager.allocparaloc(list,cgpara1); a_param_loc(list,l,cgpara1); paramanager.freeparaloc(list,cgpara1); - allocallcpuregisters(list); + alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); + alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); a_call_name(list,'FPC_FREEMEM'); - deallocallcpuregisters(list); + dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); + dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cgpara1.done; end; diff --git a/compiler/cgutils.pas b/compiler/cgutils.pas index 0e8c94f316..e4a78b54c5 100644 --- a/compiler/cgutils.pas +++ b/compiler/cgutils.pas @@ -113,6 +113,8 @@ unit cgutils; procedure location_copy(var destloc:tlocation; const sourceloc : tlocation); procedure location_swap(var destloc,sourceloc : tlocation); + + implementation {**************************************************************************** diff --git a/compiler/compiler.pas b/compiler/compiler.pas index ed6d64ac0d..ef43dd3fd1 100644 --- a/compiler/compiler.pas +++ b/compiler/compiler.pas @@ -1,8 +1,8 @@ { - This unit is the interface of the compiler which can be used by - external programs to link in the compiler + Copyright (c) 1998-2002 by Florian Klaempfl - Copyright (c) 1998-2005 by Florian Klaempfl + This unit is the interface of the compiler which can be used by + external programs to link in the compiler This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -64,14 +64,6 @@ unit compiler; {$fatal cannot define two CPU switches} {$endif} {$endif} - - {$ifdef POWERPC64} - {$ifndef CPUOK} - {$DEFINE CPUOK} - {$else} - {$fatal cannot define two CPU switches} - {$endif} - {$endif} {$ifdef ia64} {$ifndef CPUOK} @@ -149,13 +141,9 @@ uses {$ENDIF MACOS_USE_FAKE_SYSUTILS} verbose,comphook,systems, cutils,cclasses,globals,options,fmodule,parser,symtable, - assemble,link,dbgbase,import,export,tokens,pass_1 - { cpu specific commandline options } + assemble,link,import,export,tokens,pass_1 + { cpu overrides } ,cpuswtch - { cpu parameter handling } - ,cpupara - { procinfo stuff } - ,cpupi { cpu codegenerator } ,cgcpu {$ifndef NOPASS2} @@ -163,6 +151,10 @@ uses {$endif} { cpu targets } ,cputarg + { cpu parameter handling } + ,cpupara + { procinfo stuff } + ,cpupi { system information for source system } { the information about the target os } { are pulled in by the t_* units } @@ -175,12 +167,9 @@ uses {$ifdef beos} ,i_beos {$endif beos} -{$ifdef fbsd} +{$ifdef fbds} ,i_fbsd -{$endif fbsd} -{$ifdef gba} - ,i_gba -{$endif gba} +{$endif fbds} {$ifdef go32v2} ,i_go32v2 {$endif go32v2} @@ -213,8 +202,31 @@ uses ,i_wdosx {$endif wdosx} {$ifdef win32} - ,i_win + ,i_win32 {$endif win32} + { assembler readers } +{$ifdef i386} + {$ifndef NoRa386Int} + ,ra386int + {$endif NoRa386Int} + {$ifndef NoRa386Att} + ,ra386att + {$endif NoRa386Att} +{$else} + ,rasm +{$endif i386} +{$ifdef powerpc} + ,rappcgas +{$endif powerpc} +{$ifdef x86_64} + ,rax64att +{$endif x86_64} +{$ifdef arm} + ,raarmgas +{$endif arm} +{$ifdef SPARC} + ,racpugas +{$endif SPARC} ; function Compile(const cmd:string):longint; @@ -258,7 +270,6 @@ begin DoneParser; DoneImport; DoneExport; - DoneDebuginfo; DoneLinker; DoneAssembler; DoneAsm; @@ -302,7 +313,6 @@ begin InitExport; InitLinker; InitAssembler; - InitDebugInfo; InitAsm; CompilerInitedAfterArgs:=true; end; diff --git a/compiler/comprsrc.pas b/compiler/comprsrc.pas index 35910d176e..0acf3bda15 100644 --- a/compiler/comprsrc.pas +++ b/compiler/comprsrc.pas @@ -83,9 +83,9 @@ begin resbin:=''; resfound:=false; if utilsdirectory<>'' then - resfound:=FindFile(utilsprefix+target_res.resbin+source_info.exeext,utilsdirectory,resbin); + resfound:=FindFile(target_res.resbin+source_info.exeext,utilsdirectory,resbin); if not resfound then - resfound:=FindExe(utilsprefix+target_res.resbin,resbin); + resfound:=FindExe(target_res.resbin,resbin); { get also the path to be searched for the windres.h } {$IFDEF USE_SYSUTILS} respath := SplitPath(resbin); @@ -169,16 +169,19 @@ begin if not (target_info.system in [system_i386_os2, system_i386_emx,system_powerpc_macos]) then While not current_module.ResourceFiles.Empty do - begin - if target_info.res<>res_none then - begin - hr:=new(presourcefile,init(current_module.ResourceFiles.getfirst)); - hr^.compile; - dispose(hr,done); - end - else - Message(scan_e_resourcefiles_not_supported); - end; + begin + case target_info.system of + system_m68k_palmos, + system_i386_win32, + system_i386_linux, + system_i386_wdosx : + hr:=new(presourcefile,init(current_module.ResourceFiles.getfirst)); + else + Message(scan_e_resourcefiles_not_supported); + end; + hr^.compile; + dispose(hr,done); + end; end; diff --git a/compiler/cresstr.pas b/compiler/cresstr.pas index 7cae976a23..84aa4af388 100644 --- a/compiler/cresstr.pas +++ b/compiler/cresstr.pas @@ -40,7 +40,7 @@ Type procedure CalcHash; end; - Tresourcestrings=class + TResourceStrings=class private List : TLinkedList; public @@ -53,7 +53,7 @@ Type end; var - resourcestrings : Tresourcestrings; + ResourceStrings : TResourceStrings; implementation @@ -113,17 +113,17 @@ end; { --------------------------------------------------------------------- - Tresourcestrings + TRESOURCESTRINGS ---------------------------------------------------------------------} -Constructor Tresourcestrings.Create; +Constructor TResourceStrings.Create; begin List:=TStringList.Create; ResStrCount:=0; end; -Destructor Tresourcestrings.Destroy; +Destructor TResourceStrings.Destroy; begin List.Free; end; @@ -133,7 +133,7 @@ end; Create the full asmlist for resourcestrings. ---------------------------------------------------------------------} -procedure Tresourcestrings.CreateResourceStringList; +procedure TResourceStrings.CreateResourceStringList; Procedure AppendToAsmResList (P : TResourceStringItem); Var @@ -141,64 +141,58 @@ procedure Tresourcestrings.CreateResourceStringList; s : pchar; l : longint; begin - with p Do + With P Do begin if (Value=nil) or (len=0) then - asmlist[al_resourcestrings].concat(tai_const.create_sym(nil)) + resourcestringlist.concat(tai_const.create_sym(nil)) else begin objectlibrary.getdatalabel(l1); - asmlist[al_resourcestrings].concat(tai_const.create_sym(l1)); - maybe_new_object_file(asmlist[al_const]); - asmlist[al_const].concat(tai_align.Create(const_align(sizeof(aint)))); - asmlist[al_const].concat(tai_const.create_aint(-1)); - asmlist[al_const].concat(tai_const.create_aint(len)); - asmlist[al_const].concat(tai_label.create(l1)); + resourcestringlist.concat(tai_const.create_sym(l1)); + consts.concat(tai_align.Create(const_align(sizeof(aint)))); + consts.concat(tai_const.create_aint(-1)); + consts.concat(tai_const.create_aint(len)); + consts.concat(tai_label.create(l1)); getmem(s,len+1); - move(value^,s^,len); + move(Value^,s^,len); s[len]:=#0; - asmlist[al_const].concat(tai_string.create_pchar(s,len)); - asmlist[al_const].concat(tai_const.create_8bit(0)); + consts.concat(tai_string.create_length_pchar(s,len)); + consts.concat(tai_const.create_8bit(0)); end; { append Current value (nil) and hash...} - asmlist[al_resourcestrings].concat(tai_const.create_sym(nil)); - asmlist[al_resourcestrings].concat(tai_const.create_32bit(longint(hash))); + resourcestringlist.concat(tai_const.create_sym(nil)); + resourcestringlist.concat(tai_const.create_32bit(longint(hash))); { Append the name as a ansistring. } objectlibrary.getdatalabel(l1); - l:=length(name); - asmlist[al_resourcestrings].concat(tai_const.create_sym(l1)); - maybe_new_object_file(asmlist[al_const]); - asmlist[al_const].concat(tai_align.create(const_align(sizeof(aint)))); - asmlist[al_const].concat(tai_const.create_aint(-1)); - asmlist[al_const].concat(tai_const.create_aint(l)); - asmlist[al_const].concat(tai_label.create(l1)); + L:=Length(Name); + resourcestringlist.concat(tai_const.create_sym(l1)); + consts.concat(tai_align.Create(const_align(sizeof(aint)))); + consts.concat(tai_const.create_aint(-1)); + consts.concat(tai_const.create_aint(l)); + consts.concat(tai_label.create(l1)); getmem(s,l+1); move(Name[1],s^,l); s[l]:=#0; - asmlist[al_const].concat(tai_string.create_pchar(s,l)); - asmlist[al_const].concat(tai_const.create_8bit(0)); + consts.concat(tai_string.create_length_pchar(s,l)); + consts.concat(tai_const.create_8bit(0)); end; end; Var R : tresourceStringItem; begin - if asmlist[al_resourcestrings]=nil then - asmlist[al_resourcestrings]:=taasmoutput.create; - maybe_new_object_file(asmlist[al_resourcestrings]); - new_section(asmlist[al_resourcestrings],sec_data,'',4); - asmlist[al_resourcestrings].concat(tai_align.create(const_align(sizeof(aint)))); - asmlist[al_resourcestrings].concat(tai_symbol.createname_global( - make_mangledname('RESOURCESTRINGLIST',current_module.localsymtable,''),AT_DATA,0)); - asmlist[al_resourcestrings].concat(tai_const.create_32bit(resstrcount)); + if not(assigned(resourcestringlist)) then + resourcestringlist:=taasmoutput.create; + resourcestringlist.insert(tai_const.create_32bit(resstrcount)); + resourcestringlist.insert(tai_symbol.createname_global(make_mangledname('RESOURCESTRINGLIST',current_module.localsymtable,''),AT_DATA,0)); + resourcestringlist.insert(tai_align.Create(const_align(sizeof(aint)))); R:=TResourceStringItem(List.First); - while assigned(R) do + While assigned(R) do begin AppendToAsmResList(R); R:=TResourceStringItem(R.Next); end; - asmlist[al_resourcestrings].concat(tai_symbol_end.createname( - current_module.modulename^+'_'+'RESOURCESTRINGLIST')); + resourcestringlist.concat(tai_symbol_end.createname(current_module.modulename^+'_'+'RESOURCESTRINGLIST')); end; @@ -206,7 +200,7 @@ end; Insert 1 resource string in all tables. ---------------------------------------------------------------------} -function Tresourcestrings.Register(const name : string;p : pchar;len : longint) : longint; +function TResourceStrings.Register(const name : string;p : pchar;len : longint) : longint; begin List.Concat(tResourceStringItem.Create(lower(current_module.modulename^+'.'+Name),p,len)); Register:=ResStrCount; @@ -214,7 +208,7 @@ begin end; -Procedure Tresourcestrings.WriteResourceFile(const FileName : String); +Procedure TResourceStrings.WriteResourceFile(const FileName : String); Type TMode = (quoted,unquoted); Var diff --git a/compiler/cutils.pas b/compiler/cutils.pas index 0f8392abed..4d97a1c128 100644 --- a/compiler/cutils.pas +++ b/compiler/cutils.pas @@ -32,6 +32,7 @@ interface type pstring = ^string; + get_var_value_proc=function(const s:string):string of object; Tcharset=set of char; var @@ -107,6 +108,8 @@ interface function strpnew(const s : string) : pchar; procedure strdispose(var p : pchar); + function string_evaluate(s:string;get_var_value:get_var_value_proc; + const vars:array of string):Pchar; {# makes the character @var(c) lowercase, with spanish, french and german character set } @@ -841,6 +844,124 @@ uses CompareText:=0; end; + function string_evaluate(s:string;get_var_value:get_var_value_proc; + const vars:array of string):Pchar; + + {S contains a prototype of a stabstring. Stabstr_evaluate will expand + variables and parameters. + + Output is s in ASCIIZ format, with the following expanded: + + ${varname} - The variable name is expanded. + $n - The parameter n is expanded. + $$ - Is expanded to $ + } + + const maxvalue=9; + maxdata=1023; + + var i,j:byte; + varname:string[63]; + varno,varcounter:byte; + varvalues:array[0..9] of Pstring; + {1 kb of parameters is the limit. 256 extra bytes are allocated to + ensure buffer integrity.} + varvaluedata:array[0..maxdata+256] of char; + varptr:Pchar; + len:cardinal; + r:Pchar; + + begin + {Two pass approach, first, calculate the length and receive variables.} + i:=1; + len:=0; + varcounter:=0; + varptr:=@varvaluedata; + while i<=length(s) do + begin + if (s[i]='$') and (i<length(s)) then + begin + if s[i+1]='$' then + begin + inc(len); + inc(i); + end + else if (s[i+1]='{') and (length(s)>2) and (i<length(s)-2) then + begin + varname:=''; + inc(i,2); + repeat + inc(varname[0]); + varname[length(varname)]:=s[i]; + s[i]:=char(varcounter); + inc(i); + until s[i]='}'; + varvalues[varcounter]:=Pstring(varptr); + if varptr>@varvaluedata+maxdata then + internalerrorproc(200411152); + Pstring(varptr)^:=get_var_value(varname); + inc(len,length(Pstring(varptr)^)); + inc(varptr,length(Pstring(varptr)^)+1); + inc(varcounter); + end + else if s[i+1] in ['0'..'9'] then + begin + inc(len,length(vars[byte(s[i+1])-byte('1')])); + inc(i); + end; + end + else + inc(len); + inc(i); + end; + + {Second pass, writeout stabstring.} + getmem(r,len+1); + string_evaluate:=r; + i:=1; + while i<=length(s) do + begin + if (s[i]='$') and (i<length(s)) then + begin + if s[i+1]='$' then + begin + r^:='$'; + inc(r); + inc(i); + end + else if (s[i+1]='{') and (length(s)>2) and (i<length(s)-2) then + begin + varname:=''; + inc(i,2); + varno:=byte(s[i]); + repeat + inc(i); + until s[i]='}'; + for j:=1 to length(varvalues[varno]^) do + begin + r^:=varvalues[varno]^[j]; + inc(r); + end; + end + else if s[i+1] in ['0'..'9'] then + begin + for j:=1 to length(vars[byte(s[i+1])-byte('1')]) do + begin + r^:=vars[byte(s[i+1])-byte('1')][j]; + inc(r); + end; + inc(i); + end + end + else + begin + r^:=s[i]; + inc(r); + end; + inc(i); + end; + r^:=#0; + end; {***************************************************************************** GetSpeedValue diff --git a/compiler/dbgbase.pas b/compiler/dbgbase.pas deleted file mode 100644 index 681230743d..0000000000 --- a/compiler/dbgbase.pas +++ /dev/null @@ -1,128 +0,0 @@ -{ - Copyright (c) 2003-2004 by Peter Vreman and Florian Klaempfl - - This units contains support for debug info generation - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit dbgbase; - -{$i fpcdefs.inc} - -interface - - uses - systems, - symdef,symtype, - symsym, - aasmtai; - - type - TDebugInfo=class - constructor Create;virtual; - procedure inserttypeinfo;virtual; - procedure insertmoduleinfo;virtual; - procedure insertlineinfo(list:taasmoutput);virtual; - procedure referencesections(list:taasmoutput);virtual; - end; - TDebugInfoClass=class of TDebugInfo; - - var - CDebugInfo : array[tdbg] of TDebugInfoClass; - DebugInfo : TDebugInfo; - - procedure InitDebugInfo; - procedure DoneDebugInfo; - procedure RegisterDebugInfo(const r:tdbginfo;c:TDebugInfoClass); - - -implementation - - uses - verbose; - - - constructor tdebuginfo.Create; - begin - end; - - - procedure tdebuginfo.insertmoduleinfo; - begin - end; - - - procedure tdebuginfo.inserttypeinfo; - begin - end; - - - procedure tdebuginfo.insertlineinfo(list:taasmoutput); - begin - end; - - - procedure tdebuginfo.referencesections(list:taasmoutput); - begin - end; - - - procedure InitDebugInfo; - begin - if not assigned(CDebugInfo[target_dbg.id]) then - begin - Comment(V_Fatal,'cg_f_debuginfo_output_not_supported'); - exit; - end; - DebugInfo:=CDebugInfo[target_dbg.id].Create; - end; - - - procedure DoneDebugInfo; - begin - if assigned(DebugInfo) then - begin - DebugInfo.Free; - DebugInfo:=nil; - end; - end; - - - procedure RegisterDebugInfo(const r:tdbginfo;c:TDebugInfoClass); - var - t : tdbg; - begin - t:=r.id; - if assigned(dbginfos[t]) then - writeln('Warning: DebugInfo is already registered!') - else - Getmem(dbginfos[t],sizeof(tdbginfo)); - dbginfos[t]^:=r; - CDebugInfo[t]:=c; - end; - - - const - dbg_none_info : tdbginfo = - ( - id : dbg_none; - idtxt : 'NONE'; - ); - -initialization - RegisterDebugInfo(dbg_none_info,tdebuginfo); -end. diff --git a/compiler/dbgdwarf.pas b/compiler/dbgdwarf.pas deleted file mode 100644 index bab6d43069..0000000000 --- a/compiler/dbgdwarf.pas +++ /dev/null @@ -1,49 +0,0 @@ -{ - Copyright (c) 2003-2004 by Peter Vreman and Florian Klaempfl - - This units contains support for DWARF debug info generation - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit dbgdwarf; - -{$i fpcdefs.inc} - -interface - - uses - DbgBase; - - type - TDebugInfoDwarf=class(TDebugInfo) - end; - -implementation - - uses - Systems; - - const - dbg_dwarf_info : tdbginfo = - ( - id : dbg_dwarf; - idtxt : 'DWARF'; - ); - -initialization - RegisterDebugInfo(dbg_dwarf_info,TDebugInfoDwarf); -end. diff --git a/compiler/dbgstabs.pas b/compiler/dbgstabs.pas deleted file mode 100644 index 447c016665..0000000000 --- a/compiler/dbgstabs.pas +++ /dev/null @@ -1,1587 +0,0 @@ -{ - Copyright (c) 2003-2004 by Peter Vreman and Florian Klaempfl - - This units contains support for STABS debug info generation - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit dbgstabs; - -{$i fpcdefs.inc} - -interface - - uses - cclasses, - dbgbase, - symtype,symdef,symsym,symtable,symbase, - aasmtai; - - type - TDebugInfoStabs=class(TDebugInfo) - private - writing_def_stabs : boolean; - global_stab_number : word; - defnumberlist : tlist; - { tsym writing } - function sym_var_value(const s:string;arg:pointer):string; - function sym_stabstr_evaluate(sym:tsym;const s:string;const vars:array of string):Pchar; - procedure write_symtable_syms(list:taasmoutput;st:tsymtable); - { tdef writing } - function def_stab_number(def:tdef):string; - function def_stab_classnumber(def:tobjectdef):string; - function def_var_value(const s:string;arg:pointer):string; - function def_stabstr_evaluate(def:tdef;const s:string;const vars:array of string):Pchar; - procedure field_add_stabstr(p:Tnamedindexitem;arg:pointer); - procedure method_add_stabstr(p:Tnamedindexitem;arg:pointer); - function def_stabstr(def:tdef):pchar; - procedure write_def_stabstr(list:taasmoutput;def:tdef); - procedure field_write_defs(p:Tnamedindexitem;arg:pointer); - procedure method_write_defs(p :tnamedindexitem;arg:pointer); - procedure write_symtable_defs(list:taasmoutput;st:tsymtable); - procedure write_procdef(list:taasmoutput;pd:tprocdef); - procedure insertsym(list:taasmoutput;sym:tsym); - procedure insertdef(list:taasmoutput;def:tdef); - public - procedure inserttypeinfo;override; - procedure insertmoduleinfo;override; - procedure insertlineinfo(list:taasmoutput);override; - procedure referencesections(list:taasmoutput);override; - end; - - -implementation - - uses - strings,cutils, - systems,globals,globtype,verbose, - symconst,defutil, - cpuinfo,cpubase,cgbase,paramgr, - aasmbase,procinfo, - finput,fmodule,ppu; - - const - memsizeinc = 512; - - N_GSYM = $20; - N_STSYM = 38; { initialized const } - N_LCSYM = 40; { non initialized variable} - N_Function = $24; { function or const } - N_TextLine = $44; - N_DataLine = $46; - N_BssLine = $48; - N_RSYM = $40; { register variable } - N_LSYM = $80; - N_tsym = 160; - N_SourceFile = $64; - N_IncludeFile = $84; - N_BINCL = $82; - N_EINCL = $A2; - N_EXCL = $C2; - - tagtypes = [ - recorddef, - enumdef, - stringdef, - filedef, - objectdef - ]; - - type - get_var_value_proc=function(const s:string;arg:pointer):string of object; - - Trecord_stabgen_state=record - stabstring:Pchar; - stabsize,staballoc,recoffset:integer; - end; - Precord_stabgen_state=^Trecord_stabgen_state; - - - function string_evaluate(s:string;get_var_value:get_var_value_proc; - get_var_value_arg:pointer; - const vars:array of string):Pchar; - - (* - S contains a prototype of a result. Stabstr_evaluate will expand - variables and parameters. - - Output is s in ASCIIZ format, with the following expanded: - - ${varname} - The variable name is expanded. - $n - The parameter n is expanded. - $$ - Is expanded to $ - *) - - const maxvalue=9; - maxdata=1023; - - var i,j:byte; - varname:string[63]; - varno,varcounter:byte; - varvalues:array[0..9] of Pstring; - {1 kb of parameters is the limit. 256 extra bytes are allocated to - ensure buffer integrity.} - varvaluedata:array[0..maxdata+256] of char; - varptr:Pchar; - varidx : byte; - len:cardinal; - r:Pchar; - - begin - {Two pass approach, first, calculate the length and receive variables.} - i:=1; - len:=0; - varcounter:=0; - varptr:=@varvaluedata; - while i<=length(s) do - begin - if (s[i]='$') and (i<length(s)) then - begin - if s[i+1]='$' then - begin - inc(len); - inc(i); - end - else if (s[i+1]='{') and (length(s)>2) and (i<length(s)-2) then - begin - varname:=''; - inc(i,2); - repeat - inc(varname[0]); - varname[length(varname)]:=s[i]; - s[i]:=char(varcounter); - inc(i); - until s[i]='}'; - varvalues[varcounter]:=Pstring(varptr); - if varptr>@varvaluedata+maxdata then - internalerrorproc(200411152); - Pstring(varptr)^:=get_var_value(varname,get_var_value_arg); - inc(len,length(Pstring(varptr)^)); - inc(varptr,length(Pstring(varptr)^)+1); - inc(varcounter); - end - else if s[i+1] in ['1'..'9'] then - begin - varidx:=byte(s[i+1])-byte('1'); - if varidx>high(vars) then - internalerror(200509263); - inc(len,length(vars[varidx])); - inc(i); - end; - end - else - inc(len); - inc(i); - end; - - {Second pass, writeout result.} - getmem(r,len+1); - string_evaluate:=r; - i:=1; - while i<=length(s) do - begin - if (s[i]='$') and (i<length(s)) then - begin - if s[i+1]='$' then - begin - r^:='$'; - inc(r); - inc(i); - end - else if (s[i+1]='{') and (length(s)>2) and (i<length(s)-2) then - begin - varname:=''; - inc(i,2); - varno:=byte(s[i]); - repeat - inc(i); - until s[i]='}'; - for j:=1 to length(varvalues[varno]^) do - begin - r^:=varvalues[varno]^[j]; - inc(r); - end; - end - else if s[i+1] in ['0'..'9'] then - begin - for j:=1 to length(vars[byte(s[i+1])-byte('1')]) do - begin - r^:=vars[byte(s[i+1])-byte('1')][j]; - inc(r); - end; - inc(i); - end - end - else - begin - r^:=s[i]; - inc(r); - end; - inc(i); - end; - r^:=#0; - end; - - -{**************************************************************************** - TDef support -****************************************************************************} - - function TDebugInfoStabs.def_stab_number(def:tdef):string; - begin - { procdefs only need a number, mark them as already written - so they won't be written implicitly } - if (def.deftype=procdef) then - def.stab_state:=stab_state_written; - { Stab must already be written, or we must be busy writing it } - if writing_def_stabs and - not(def.stab_state in [stab_state_writing,stab_state_written]) then - internalerror(200403091); - { Keep track of used stabs, this info is only usefull for stabs - referenced by the symbols. Definitions will always include all - required stabs } - if def.stab_state=stab_state_unused then - def.stab_state:=stab_state_used; - { Need a new number? } - if def.stab_number=0 then - begin - inc(global_stab_number); - { classes require 2 numbers } - if is_class(def) then - inc(global_stab_number); - def.stab_number:=global_stab_number; - if global_stab_number>=defnumberlist.count then - defnumberlist.count:=global_stab_number+250; - defnumberlist[global_stab_number]:=def; - end; - result:=tostr(def.stab_number); - end; - - - function TDebugInfoStabs.def_stab_classnumber(def:tobjectdef):string; - begin - if def.stab_number=0 then - def_stab_number(def); - if (def.objecttype=odt_class) then - result:=tostr(def.stab_number-1) - else - result:=tostr(def.stab_number); - end; - - - function TDebugInfoStabs.def_var_value(const s:string;arg:pointer):string; - var - def : tdef; - begin - def:=tdef(arg); - result:=''; - if s='numberstring' then - result:=def_stab_number(def) - else if s='sym_name' then - begin - if assigned(def.typesym) then - result:=Ttypesym(def.typesym).name; - end - else if s='N_LSYM' then - result:=tostr(N_LSYM) - else if s='savesize' then - result:=tostr(def.size); - end; - - - function TDebugInfoStabs.def_stabstr_evaluate(def:tdef;const s:string;const vars:array of string):Pchar; - begin - result:=string_evaluate(s,@def_var_value,def,vars); - end; - - - procedure TDebugInfoStabs.field_add_stabstr(p:Tnamedindexitem;arg:pointer); - var - newrec : Pchar; - spec : string[3]; - varsize : aint; - state : Precord_stabgen_state; - begin - state:=arg; - { static variables from objects are like global objects } - if (Tsym(p).typ=fieldvarsym) and - not(sp_static in Tsym(p).symoptions) then - begin - if ([sp_protected,sp_strictprotected]*tsym(p).symoptions)<>[] then - spec:='/1' - else if ([sp_private,sp_strictprivate]*tsym(p).symoptions)<>[] then - spec:='/0' - else - spec:=''; - varsize:=tfieldvarsym(p).vartype.def.size; - { open arrays made overflows !! } - if varsize>$fffffff then - varsize:=$fffffff; - newrec:=def_stabstr_evaluate(nil,'$1:$2,$3,$4;',[p.name, - spec+def_stab_number(tfieldvarsym(p).vartype.def), - tostr(tfieldvarsym(p).fieldoffset*8),tostr(varsize*8)]); - if state^.stabsize+strlen(newrec)>=state^.staballoc-256 then - begin - inc(state^.staballoc,strlen(newrec)+64); - reallocmem(state^.stabstring,state^.staballoc); - end; - strcopy(state^.stabstring+state^.stabsize,newrec); - inc(state^.stabsize,strlen(newrec)); - strdispose(newrec); - {This should be used for case !!} - inc(state^.recoffset,Tfieldvarsym(p).vartype.def.size); - end; - end; - - - procedure TDebugInfoStabs.method_add_stabstr(p:Tnamedindexitem;arg:pointer); - var virtualind,argnames : string; - newrec : pchar; - pd : tprocdef; - lindex : longint; - arglength : byte; - sp : char; - state:^Trecord_stabgen_state; - olds:integer; - i : integer; - parasym : tparavarsym; - begin - state:=arg; - if tsym(p).typ = procsym then - begin - pd := tprocsym(p).first_procdef; - if (po_virtualmethod in pd.procoptions) then - begin - lindex := pd.extnumber; - {doesnt seem to be necessary - lindex := lindex or $80000000;} - virtualind := '*'+tostr(lindex)+';'+def_stab_classnumber(pd._class)+';' - end - else - virtualind := '.'; - - { used by gdbpas to recognize constructor and destructors } - if (pd.proctypeoption=potype_constructor) then - argnames:='__ct__' - else if (pd.proctypeoption=potype_destructor) then - argnames:='__dt__' - else - argnames := ''; - - { arguments are not listed here } - {we don't need another definition} - for i:=0 to pd.paras.count-1 do - begin - parasym:=tparavarsym(pd.paras[i]); - if Parasym.vartype.def.deftype = formaldef then - begin - case Parasym.varspez of - vs_var : - argnames := argnames+'3var'; - vs_const : - argnames:=argnames+'5const'; - vs_out : - argnames:=argnames+'3out'; - end; - end - else - begin - { if the arg definition is like (v: ^byte;.. - there is no sym attached to data !!! } - if assigned(Parasym.vartype.def.typesym) then - begin - arglength := length(Parasym.vartype.def.typesym.name); - argnames := argnames + tostr(arglength)+Parasym.vartype.def.typesym.name; - end - else - argnames:=argnames+'11unnamedtype'; - end; - end; - { here 2A must be changed for private and protected } - { 0 is private 1 protected and 2 public } - if ([sp_private,sp_strictprivate]*tsym(p).symoptions)<>[] then - sp:='0' - else if ([sp_protected,sp_strictprotected]*tsym(p).symoptions)<>[] then - sp:='1' - else - sp:='2'; - newrec:=def_stabstr_evaluate(nil,'$1::$2=##$3;:$4;$5A$6;',[p.name,def_stab_number(pd), - def_stab_number(pd.rettype.def),argnames,sp, - virtualind]); - { get spare place for a string at the end } - olds:=state^.stabsize; - inc(state^.stabsize,strlen(newrec)); - if state^.stabsize>=state^.staballoc-256 then - begin - inc(state^.staballoc,strlen(newrec)+64); - reallocmem(state^.stabstring,state^.staballoc); - end; - strcopy(state^.stabstring+olds,newrec); - strdispose(newrec); - {This should be used for case !! - RecOffset := RecOffset + pd.size;} - end; - end; - - - function TDebugInfoStabs.def_stabstr(def:tdef):pchar; - - function stringdef_stabstr(def:tstringdef):pchar; - var - slen : aint; - bytest,charst,longst : string; - begin - case def.string_typ of - st_shortstring: - begin - { fix length of openshortstring } - slen:=def.len; - if slen=0 then - slen:=255; - charst:=def_stab_number(cchartype.def); - bytest:=def_stab_number(u8inttype.def); - result:=def_stabstr_evaluate(def,'s$1length:$2,0,8;st:ar$2;1;$3;$4,8,$5;;', - [tostr(slen+1),bytest,tostr(slen),charst,tostr(slen*8)]); - end; - st_longstring: - begin - charst:=def_stab_number(cchartype.def); - bytest:=def_stab_number(u8inttype.def); - longst:=def_stab_number(u32inttype.def); - result:=def_stabstr_evaluate(def,'s$1length:$2,0,32;dummy:$6,32,8;st:ar$2;1;$3;$4,40,$5;;', - [tostr(def.len+5),longst,tostr(def.len),charst,tostr(def.len*8),bytest]); - end; - st_ansistring: - begin - { looks like a pchar } - charst:=def_stab_number(cchartype.def); - result:=strpnew('*'+charst); - end; - st_widestring: - begin - { looks like a pwidechar } - charst:=def_stab_number(cwidechartype.def); - result:=strpnew('*'+charst); - end; - end; - end; - - function enumdef_stabstr(def:tenumdef):pchar; - var - st : Pchar; - p : Tenumsym; - s : string; - memsize, - stl : aint; - begin - memsize:=memsizeinc; - getmem(st,memsize); - { we can specify the size with @s<size>; prefix PM } - if def.size <> std_param_align then - strpcopy(st,'@s'+tostr(def.size*8)+';e') - else - strpcopy(st,'e'); - p := tenumsym(def.firstenum); - stl:=strlen(st); - while assigned(p) do - begin - s :=p.name+':'+tostr(p.value)+','; - { place for the ending ';' also } - if (stl+length(s)+1>=memsize) then - begin - inc(memsize,memsizeinc); - reallocmem(st,memsize); - end; - strpcopy(st+stl,s); - inc(stl,length(s)); - p:=p.nextenum; - end; - st[stl]:=';'; - st[stl+1]:=#0; - reallocmem(st,stl+2); - result:=st; - end; - - function orddef_stabstr(def:torddef):pchar; - begin - if cs_gdb_valgrind in aktglobalswitches then - begin - case def.typ of - uvoid : - result:=strpnew(def_stab_number(def)); - bool8bit, - bool16bit, - bool32bit : - result:=def_stabstr_evaluate(def,'r${numberstring};0;255;',[]); - u32bit, - s64bit, - u64bit : - result:=def_stabstr_evaluate(def,'r${numberstring};0;-1;',[]); - else - result:=def_stabstr_evaluate(def,'r${numberstring};$1;$2;',[tostr(longint(def.low)),tostr(longint(def.high))]); - end; - end - else - begin - case def.typ of - uvoid : - result:=strpnew(def_stab_number(def)); - uchar : - result:=strpnew('-20;'); - uwidechar : - result:=strpnew('-30;'); - bool8bit : - result:=strpnew('-21;'); - bool16bit : - result:=strpnew('-22;'); - bool32bit : - result:=strpnew('-23;'); - u64bit : - result:=strpnew('-32;'); - s64bit : - result:=strpnew('-31;'); - {u32bit : result:=def_stab_number(s32inttype.def)+';0;-1;'); } - else - result:=def_stabstr_evaluate(def,'r${numberstring};$1;$2;',[tostr(longint(def.low)),tostr(longint(def.high))]); - end; - end; - end; - - function floatdef_stabstr(def:tfloatdef):Pchar; - begin - case def.typ of - s32real, - s64real, - s80real: - result:=def_stabstr_evaluate(def,'r$1;${savesize};0;',[def_stab_number(s32inttype.def)]); - s64currency, - s64comp: - result:=def_stabstr_evaluate(def,'r$1;-${savesize};0;',[def_stab_number(s32inttype.def)]); - else - internalerror(200509261); - end; - end; - - function filedef_stabstr(def:tfiledef):pchar; - begin -{$ifdef cpu64bit} - result:=def_stabstr_evaluate(def,'s${savesize}HANDLE:$1,0,32;MODE:$1,32,32;RECSIZE:$2,64,64;'+ - '_PRIVATE:ar$1;1;64;$3,128,256;USERDATA:ar$1;1;16;$3,384,128;'+ - 'NAME:ar$1;0;255;$4,512,2048;;',[def_stab_number(s32inttype.def), - def_stab_number(s64inttype.def), - def_stab_number(u8inttype.def), - def_stab_number(cchartype.def)]); -{$else cpu64bit} - result:=def_stabstr_evaluate(def,'s${savesize}HANDLE:$1,0,32;MODE:$1,32,32;RECSIZE:$1,64,32;'+ - '_PRIVATE:ar$1;1;32;$3,96,256;USERDATA:ar$1;1;16;$2,352,128;'+ - 'NAME:ar$1;0;255;$3,480,2048;;',[def_stab_number(s32inttype.def), - def_stab_number(u8inttype.def), - def_stab_number(cchartype.def)]); -{$endif cpu64bit} - end; - - function procdef_stabstr(def:tprocdef):pchar; - Var - RType : Char; - Obj,Info : String; - stabsstr : string; - p : pchar; - begin - obj := def.procsym.name; - info := ''; - if (po_global in def.procoptions) then - RType := 'F' - else - RType := 'f'; - if assigned(def.owner) then - begin - if (def.owner.symtabletype = objectsymtable) then - obj := def.owner.name^+'__'+def.procsym.name; - if not(cs_gdb_valgrind in aktglobalswitches) and - (def.owner.symtabletype=localsymtable) and - assigned(def.owner.defowner) and - assigned(tprocdef(def.owner.defowner).procsym) then - info := ','+def.procsym.name+','+tprocdef(def.owner.defowner).procsym.name; - end; - stabsstr:=def.mangledname; - getmem(p,length(stabsstr)+255); - strpcopy(p,'"'+obj+':'+RType - +def_stab_number(def.rettype.def)+info+'",'+tostr(n_function) - +',0,'+ - tostr(def.fileinfo.line) - +','); - strpcopy(strend(p),stabsstr); - result:=strnew(p); - freemem(p,length(stabsstr)+255); - end; - - function recorddef_stabstr(def:trecorddef):pchar; - var - state : Trecord_stabgen_state; - begin - getmem(state.stabstring,memsizeinc); - state.staballoc:=memsizeinc; - strpcopy(state.stabstring,'s'+tostr(def.size)); - state.recoffset:=0; - state.stabsize:=strlen(state.stabstring); - def.symtable.foreach(@field_add_stabstr,@state); - state.stabstring[state.stabsize]:=';'; - state.stabstring[state.stabsize+1]:=#0; - reallocmem(state.stabstring,state.stabsize+2); - result:=state.stabstring; - end; - - function objectdef_stabstr(def:tobjectdef):pchar; - var - anc : tobjectdef; - state :Trecord_stabgen_state; - ts : string; - begin - { Write the invisible pointer for the class? } - if (def.objecttype=odt_class) and - (not def.writing_class_record_stab) then - begin - result:=strpnew('*'+def_stab_classnumber(def)); - exit; - end; - - state.staballoc:=memsizeinc; - getmem(state.stabstring,state.staballoc); - strpcopy(state.stabstring,'s'+tostr(tobjectsymtable(def.symtable).datasize)); - if assigned(def.childof) then - begin - {only one ancestor not virtual, public, at base offset 0 } - { !1 , 0 2 0 , } - strpcopy(strend(state.stabstring),'!1,020,'+def_stab_classnumber(def.childof)+';'); - end; - {virtual table to implement yet} - state.recoffset:=0; - state.stabsize:=strlen(state.stabstring); - def.symtable.foreach(@field_add_stabstr,@state); - if (oo_has_vmt in def.objectoptions) then - if not assigned(def.childof) or not(oo_has_vmt in def.childof.objectoptions) then - begin - ts:='$vf'+def_stab_classnumber(def)+':'+def_stab_number(vmtarraytype.def)+','+tostr(def.vmt_offset*8)+';'; - strpcopy(state.stabstring+state.stabsize,ts); - inc(state.stabsize,length(ts)); - end; - def.symtable.foreach(@method_add_stabstr,@state); - if (oo_has_vmt in def.objectoptions) then - begin - anc := def; - while assigned(anc.childof) and (oo_has_vmt in anc.childof.objectoptions) do - anc := anc.childof; - { just in case anc = self } - ts:=';~%'+def_stab_classnumber(anc)+';'; - end - else - ts:=';'; - strpcopy(state.stabstring+state.stabsize,ts); - inc(state.stabsize,length(ts)); - reallocmem(state.stabstring,state.stabsize+1); - result:=state.stabstring; - end; - - begin - result:=nil; - case def.deftype of - stringdef : - result:=stringdef_stabstr(tstringdef(def)); - enumdef : - result:=enumdef_stabstr(tenumdef(def)); - orddef : - result:=orddef_stabstr(torddef(def)); - floatdef : - result:=floatdef_stabstr(tfloatdef(def)); - filedef : - result:=filedef_stabstr(tfiledef(def)); - recorddef : - result:=recorddef_stabstr(trecorddef(def)); - variantdef : - result:=def_stabstr_evaluate(def,'formal${numberstring};',[]); - pointerdef : - result:=strpnew('*'+def_stab_number(tpointerdef(def).pointertype.def)); - classrefdef : - result:=strpnew(def_stab_number(pvmttype.def)); - setdef : - result:=def_stabstr_evaluate(def,'@s$1;S$2',[tostr(def.size*8),def_stab_number(tsetdef(def).elementtype.def)]); - formaldef : - result:=def_stabstr_evaluate(def,'formal${numberstring};',[]); - arraydef : - result:=def_stabstr_evaluate(def,'ar$1;$2;$3;$4',[def_stab_number(tarraydef(def).rangetype.def), - tostr(tarraydef(def).lowrange),tostr(tarraydef(def).highrange),def_stab_number(tarraydef(def).elementtype.def)]); - procdef : - result:=procdef_stabstr(tprocdef(def)); - procvardef : - result:=strpnew('*f'+def_stab_number(tprocvardef(def).rettype.def)); - objectdef : - result:=objectdef_stabstr(tobjectdef(def)); - end; - end; - - - procedure TDebugInfoStabs.write_def_stabstr(list:taasmoutput;def:tdef); - var - stabchar : string[2]; - ss,st,su : pchar; - begin - { procdefs require a different stabs style without type prefix } - if def.deftype=procdef then - begin - st:=def_stabstr(def); - { add to list } - list.concat(Tai_stab.create(stab_stabs,st)); - end - else - begin - { type prefix } - if def.deftype in tagtypes then - stabchar := 'Tt' - else - stabchar := 't'; - { Here we maybe generate a type, so we have to use numberstring } - if is_class(def) and - tobjectdef(def).writing_class_record_stab then - st:=def_stabstr_evaluate(def,'"${sym_name}:$1$2=',[stabchar,def_stab_classnumber(tobjectdef(def))]) - else - st:=def_stabstr_evaluate(def,'"${sym_name}:$1$2=',[stabchar,def_stab_number(def)]); - ss:=def_stabstr(def); - reallocmem(st,strlen(ss)+512); - { line info is set to 0 for all defs, because the def can be in an other - unit and then the linenumber is invalid in the current sourcefile } - su:=def_stabstr_evaluate(def,'",${N_LSYM},0,0,0',[]); - strcopy(strecopy(strend(st),ss),su); - reallocmem(st,strlen(st)+1); - strdispose(ss); - strdispose(su); - { add to list } - list.concat(Tai_stab.create(stab_stabs,st)); - end; - end; - - - procedure TDebugInfoStabs.field_write_defs(p:Tnamedindexitem;arg:pointer); - begin - if (Tsym(p).typ=fieldvarsym) and - not(sp_static in Tsym(p).symoptions) then - insertdef(taasmoutput(arg),tfieldvarsym(p).vartype.def); - end; - - - procedure TDebugInfoStabs.method_write_defs(p :tnamedindexitem;arg:pointer); - var - pd : tprocdef; - begin - if tsym(p).typ = procsym then - begin - pd:=tprocsym(p).first_procdef; - insertdef(taasmoutput(arg),pd.rettype.def); - end; - end; - - - procedure TDebugInfoStabs.insertdef(list:taasmoutput;def:tdef); - var - anc : tobjectdef; - oldtypesym : tsym; -// nb : string[12]; - begin - if (def.stab_state in [stab_state_writing,stab_state_written]) then - exit; - { to avoid infinite loops } - def.stab_state := stab_state_writing; - { write dependencies first } - case def.deftype of - stringdef : - begin - if tstringdef(def).string_typ=st_widestring then - insertdef(list,cwidechartype.def) - else - begin - insertdef(list,cchartype.def); - insertdef(list,u8inttype.def); - end; - end; - floatdef : - insertdef(list,s32inttype.def); - filedef : - begin - insertdef(list,s32inttype.def); -{$ifdef cpu64bit} - insertdef(list,s64inttype.def); -{$endif cpu64bit} - insertdef(list,u8inttype.def); - insertdef(list,cchartype.def); - end; - classrefdef : - insertdef(list,pvmttype.def); - pointerdef : - insertdef(list,tpointerdef(def).pointertype.def); - setdef : - insertdef(list,tsetdef(def).elementtype.def); - procvardef, - procdef : - insertdef(list,tprocdef(def).rettype.def); - arraydef : - begin - insertdef(list,tarraydef(def).rangetype.def); - insertdef(list,tarraydef(def).elementtype.def); - end; - recorddef : - trecorddef(def).symtable.foreach(@field_write_defs,list); - objectdef : - begin - insertdef(list,vmtarraytype.def); - { first the parents } - anc:=tobjectdef(def); - while assigned(anc.childof) do - begin - anc:=anc.childof; - insertdef(list,anc); - end; - tobjectdef(def).symtable.foreach(@field_write_defs,list); - tobjectdef(def).symtable.foreach(@method_write_defs,list); - end; - end; -(* - { Handle pointerdefs to records and objects to avoid recursion } - if (def.deftype=pointerdef) and - (tpointerdef(def).pointertype.def.deftype in [recorddef,objectdef]) then - begin - def.stab_state:=stab_state_used; - write_def_stabstr(list,def); - {to avoid infinite recursion in record with next-like fields } - if tdef(tpointerdef(def).pointertype.def).stab_state=stab_state_writing then - begin - if assigned(tpointerdef(def).pointertype.def.typesym) then - begin - if is_class(tpointerdef(def).pointertype.def) then - nb:=def_stab_classnumber(tobjectdef(tpointerdef(def).pointertype.def)) - else - nb:=def_stab_number(tpointerdef(def).pointertype.def); - list.concat(Tai_stab.create(stab_stabs,def_stabstr_evaluate( - def,'"${sym_name}:t${numberstring}=*$1=xs$2:",${N_LSYM},0,0,0', - [nb,tpointerdef(def).pointertype.def.typesym.name]))); - end; - def.stab_state:=stab_state_written; - end - end - else -*) - case def.deftype of - objectdef : - begin - { classes require special code to write the record and the invisible pointer } - if is_class(def) then - begin - { Write the record class itself } - tobjectdef(def).writing_class_record_stab:=true; - write_def_stabstr(list,def); - tobjectdef(def).writing_class_record_stab:=false; - { Write the invisible pointer class } - oldtypesym:=def.typesym; - def.typesym:=nil; - write_def_stabstr(list,def); - def.typesym:=oldtypesym; - end - else - write_def_stabstr(list,def); - { VMT symbol } - if (oo_has_vmt in tobjectdef(def).objectoptions) and - assigned(def.owner) and - assigned(def.owner.name) then - list.concat(Tai_stab.create(stab_stabs,strpnew('"vmt_'+def.owner.name^+tobjectdef(def).name+':S'+ - def_stab_number(vmttype.def)+'",'+tostr(N_STSYM)+',0,0,'+tobjectdef(def).vmt_mangledname))); - end; - procdef : - begin - { procdefs are handled separatly } - end; - else - write_def_stabstr(list,def); - end; - - def.stab_state := stab_state_written; - end; - - - procedure TDebugInfoStabs.write_symtable_defs(list:taasmoutput;st:tsymtable); - - procedure dowritestabs(list:taasmoutput;st:tsymtable); - var - p : tdef; - begin - p:=tdef(st.defindex.first); - while assigned(p) do - begin - if (p.stab_state=stab_state_used) then - insertdef(list,p); - p:=tdef(p.indexnext); - end; - end; - - var - old_writing_def_stabs : boolean; - begin - case st.symtabletype of - staticsymtable : - list.concat(tai_comment.Create(strpnew('Defs - Begin Staticsymtable'))); - globalsymtable : - list.concat(tai_comment.Create(strpnew('Defs - Begin unit '+st.name^+' has index '+tostr(st.moduleid)))); - end; - old_writing_def_stabs:=writing_def_stabs; - writing_def_stabs:=true; - dowritestabs(list,st); - writing_def_stabs:=old_writing_def_stabs; - case st.symtabletype of - staticsymtable : - list.concat(tai_comment.Create(strpnew('Defs - End Staticsymtable'))); - globalsymtable : - list.concat(tai_comment.Create(strpnew('Defs - End unit '+st.name^+' has index '+tostr(st.moduleid)))); - end; - end; - - - procedure TDebugInfoStabs.write_procdef(list:taasmoutput;pd:tprocdef); - var - templist : taasmoutput; - stabsendlabel : tasmlabel; - mangled_length : longint; - p : pchar; - hs : string; - begin - if assigned(pd.procstarttai) then - begin - templist:=taasmoutput.create; - { para types } - write_def_stabstr(templist,pd); - if assigned(pd.parast) then - write_symtable_syms(templist,pd.parast); - { local type defs and vars should not be written - inside the main proc stab } - if assigned(pd.localst) and - (pd.localst.symtabletype=localsymtable) then - write_symtable_syms(templist,pd.localst); - asmlist[al_procedures].insertlistbefore(pd.procstarttai,templist); - { end of procedure } - objectlibrary.getlabel(stabsendlabel,alt_dbgtype); - templist.concat(tai_label.create(stabsendlabel)); - if assigned(pd.funcretsym) and - (tabstractnormalvarsym(pd.funcretsym).refs>0) then - begin - if tabstractnormalvarsym(pd.funcretsym).localloc.loc=LOC_REFERENCE then - begin - {$warning Need to add gdb support for ret in param register calling} - if paramanager.ret_in_param(pd.rettype.def,pd.proccalloption) then - hs:='X*' - else - hs:='X'; - templist.concat(Tai_stab.create(stab_stabs,strpnew( - '"'+pd.procsym.name+':'+hs+def_stab_number(pd.rettype.def)+'",'+ - tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(pd.funcretsym).localloc.reference.offset)))); - if (m_result in aktmodeswitches) then - templist.concat(Tai_stab.create(stab_stabs,strpnew( - '"RESULT:'+hs+def_stab_number(pd.rettype.def)+'",'+ - tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(pd.funcretsym).localloc.reference.offset)))); - end; - end; - mangled_length:=length(pd.mangledname); - getmem(p,2*mangled_length+50); - strpcopy(p,'192,0,0,'); - {$IFDEF POWERPC64}strpcopy(strend(p), '.');{$ENDIF POWERPC64} - strpcopy(strend(p),pd.mangledname); - if (target_info.use_function_relative_addresses) then - begin - strpcopy(strend(p),'-'); - {$IFDEF POWERPC64}strpcopy(strend(p), '.');{$ENDIF POWERPC64} - strpcopy(strend(p),pd.mangledname); - end; - templist.concat(Tai_stab.Create(stab_stabn,strnew(p))); - strpcopy(p,'224,0,0,'+stabsendlabel.name); - if (target_info.use_function_relative_addresses) then - begin - strpcopy(strend(p),'-'); - {$IFDEF POWERPC64}strpcopy(strend(p), '.');{$ENDIF POWERPC64} - strpcopy(strend(p),pd.mangledname); - end; - templist.concat(Tai_stab.Create(stab_stabn,strnew(p))); - freemem(p,2*mangled_length+50); - asmlist[al_procedures].insertlistbefore(pd.procendtai,templist); - templist.free; - end; - end; - - -{**************************************************************************** - TSym support -****************************************************************************} - - function TDebugInfoStabs.sym_var_value(const s:string;arg:pointer):string; - var - sym : tsym; - begin - sym:=tsym(arg); - result:=''; - if s='name' then - result:=sym.name - else if s='mangledname' then - result:=sym.mangledname - else if s='ownername' then - result:=sym.owner.name^ - else if s='line' then - result:=tostr(sym.fileinfo.line) - else if s='N_LSYM' then - result:=tostr(N_LSYM) - else if s='N_LCSYM' then - result:=tostr(N_LCSYM) - else if s='N_RSYM' then - result:=tostr(N_RSYM) - else if s='N_TSYM' then - result:=tostr(N_TSYM) - else if s='N_STSYM' then - result:=tostr(N_STSYM) - else if s='N_FUNCTION' then - result:=tostr(N_FUNCTION) - else - internalerror(200401152); - end; - - - function TDebugInfoStabs.sym_stabstr_evaluate(sym:tsym;const s:string;const vars:array of string):Pchar; - begin - result:=string_evaluate(s,@sym_var_value,sym,vars); - end; - - - procedure TDebugInfoStabs.insertsym(list:taasmoutput;sym:tsym); - - function fieldvarsym_stabstr(sym:tfieldvarsym):Pchar; - begin - result:=nil; - if (sym.owner.symtabletype=objectsymtable) and - (sp_static in sym.symoptions) then - result:=sym_stabstr_evaluate(sym,'"${ownername}__${name}:S$1",${N_LCSYM},0,${line},${mangledname}', - [def_stab_number(sym.vartype.def)]); - end; - - function globalvarsym_stabstr(sym:tglobalvarsym):Pchar; - var - st : string; - threadvaroffset : string; - regidx : Tregisterindex; - begin - result:=nil; - { external symbols can't be resolved at link time, so we - can't generate stabs for them } - if vo_is_external in sym.varoptions then - exit; - st:=def_stab_number(sym.vartype.def); - case sym.localloc.loc of - LOC_REGISTER, - LOC_CREGISTER, - LOC_MMREGISTER, - LOC_CMMREGISTER, - LOC_FPUREGISTER, - LOC_CFPUREGISTER : - begin - regidx:=findreg_by_number(sym.localloc.register); - { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", } - { this is the register order for GDB} - if regidx<>0 then - result:=sym_stabstr_evaluate(sym,'"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]); - end; - else - begin - if (vo_is_thread_var in sym.varoptions) then - threadvaroffset:='+'+tostr(sizeof(aint)) - else - threadvaroffset:=''; - { Here we used S instead of - because with G GDB doesn't look at the address field - but searches the same name or with a leading underscore - but these names don't exist in pascal !} - st:='S'+st; - result:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]); - end; - end; - end; - - function localvarsym_stabstr(sym:tlocalvarsym):Pchar; - var - st : string; - regidx : Tregisterindex; - begin - result:=nil; - { There is no space allocated for not referenced locals } - if (sym.owner.symtabletype=localsymtable) and (sym.refs=0) then - exit; - - st:=def_stab_number(sym.vartype.def); - case sym.localloc.loc of - LOC_REGISTER, - LOC_CREGISTER, - LOC_MMREGISTER, - LOC_CMMREGISTER, - LOC_FPUREGISTER, - LOC_CFPUREGISTER : - begin - regidx:=findreg_by_number(sym.localloc.register); - { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", } - { this is the register order for GDB} - if regidx<>0 then - result:=sym_stabstr_evaluate(sym,'"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]); - end; - LOC_REFERENCE : - { offset to ebp => will not work if the framepointer is esp - so some optimizing will make things harder to debug } - result:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(sym.localloc.reference.offset)]) - else - internalerror(2003091814); - end; - end; - - function paravarsym_stabstr(sym:tparavarsym):Pchar; - var - st : string; - regidx : Tregisterindex; - c : char; - begin - result:=nil; - { set loc to LOC_REFERENCE to get somewhat usable debugging info for -Or } - { while stabs aren't adapted for regvars yet } - if (vo_is_self in sym.varoptions) then - begin - case sym.localloc.loc of - LOC_REGISTER, - LOC_CREGISTER: - regidx:=findreg_by_number(sym.localloc.register); - LOC_REFERENCE: ; - else - internalerror(2003091815); - end; - if (po_classmethod in tabstractprocdef(sym.owner.defowner).procoptions) or - (po_staticmethod in tabstractprocdef(sym.owner.defowner).procoptions) then - begin - if (sym.localloc.loc=LOC_REFERENCE) then - result:=sym_stabstr_evaluate(sym,'"pvmt:p$1",${N_TSYM},0,0,$2', - [def_stab_number(pvmttype.def),tostr(sym.localloc.reference.offset)]); - (* else - result:=sym_stabstr_evaluate(sym,'"pvmt:r$1",${N_RSYM},0,0,$2', - [def_stab_number(pvmttype.def),tostr(regstabs_table[regidx])]) *) - end - else - begin - if not(is_class(tprocdef(sym.owner.defowner)._class)) then - c:='v' - else - c:='p'; - if (sym.localloc.loc=LOC_REFERENCE) then - result:=sym_stabstr_evaluate(sym,'"$$t:$1",${N_TSYM},0,0,$2', - [c+def_stab_number(tprocdef(sym.owner.defowner)._class),tostr(sym.localloc.reference.offset)]); - (* else - result:=sym_stabstr_evaluate(sym,'"$$t:r$1",${N_RSYM},0,0,$2', - [c+def_stab_number(tprocdef(sym.owner.defowner)._class),tostr(regstabs_table[regidx])]); *) - end; - end - else - begin - st:=def_stab_number(sym.vartype.def); - - if paramanager.push_addr_param(sym.varspez,sym.vartype.def,tprocdef(sym.owner.defowner).proccalloption) and - not(vo_has_local_copy in sym.varoptions) and - not is_open_string(sym.vartype.def) then - st := 'v'+st { should be 'i' but 'i' doesn't work } - else - st := 'p'+st; - case sym.localloc.loc of - LOC_REGISTER, - LOC_CREGISTER, - LOC_MMREGISTER, - LOC_CMMREGISTER, - LOC_FPUREGISTER, - LOC_CFPUREGISTER : - begin - regidx:=findreg_by_number(sym.localloc.register); - { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", } - { this is the register order for GDB} - if regidx<>0 then - result:=sym_stabstr_evaluate(sym,'"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(longint(regstabs_table[regidx]))]); - end; - LOC_REFERENCE : - { offset to ebp => will not work if the framepointer is esp - so some optimizing will make things harder to debug } - result:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(sym.localloc.reference.offset)]) - else - internalerror(2003091814); - end; - end; - end; - - function constsym_stabstr(sym:tconstsym):Pchar; - var - st : string; - begin - case sym.consttyp of - conststring: - begin - if sym.value.len<200 then - st:='s'''+backspace_quote(octal_quote(strpas(pchar(sym.value.valueptr)),[#0..#9,#11,#12,#14..#31,'''']),['"','\',#10,#13])+'''' - else - st:='<constant string too long>'; - end; - constord: - st:='i'+tostr(sym.value.valueord); - constpointer: - st:='i'+tostr(sym.value.valueordptr); - constreal: - begin - system.str(pbestreal(sym.value.valueptr)^,st); - st := 'r'+st; - end; - else - begin - { if we don't know just put zero !! } - st:='i0'; - end; - end; - { valgrind does not support constants } - if cs_gdb_valgrind in aktglobalswitches then - result:=nil - else - result:=sym_stabstr_evaluate(sym,'"${name}:c=$1;",${N_FUNCTION},0,${line},0',[st]); - end; - - function typesym_stabstr(sym:ttypesym) : pchar; - var - stabchar : string[2]; - begin - result:=nil; - if not assigned(sym.restype.def) then - internalerror(200509262); - if sym.restype.def.deftype in tagtypes then - stabchar:='Tt' - else - stabchar:='t'; - result:=sym_stabstr_evaluate(sym,'"${name}:$1$2",${N_LSYM},0,${line},0',[stabchar,def_stab_number(sym.restype.def)]); - end; - - function procsym_stabstr(sym:tprocsym) : pchar; - var - i : longint; - begin - result:=nil; - for i:=1 to sym.procdef_count do - write_procdef(list,sym.procdef[i]); - end; - - var - stabstr : Pchar; - begin - stabstr:=nil; - case sym.typ of - labelsym : - stabstr:=sym_stabstr_evaluate(sym,'"${name}",${N_LSYM},0,${line},0',[]); - fieldvarsym : - stabstr:=fieldvarsym_stabstr(tfieldvarsym(sym)); - globalvarsym : - stabstr:=globalvarsym_stabstr(tglobalvarsym(sym)); - localvarsym : - stabstr:=localvarsym_stabstr(tlocalvarsym(sym)); - paravarsym : - stabstr:=paravarsym_stabstr(tparavarsym(sym)); - typedconstsym : - stabstr:=sym_stabstr_evaluate(sym,'"${name}:S$1",${N_STSYM},0,${line},${mangledname}', - [def_stab_number(ttypedconstsym(sym).typedconsttype.def)]); - constsym : - stabstr:=constsym_stabstr(tconstsym(sym)); - typesym : - stabstr:=typesym_stabstr(ttypesym(sym)); - procsym : - stabstr:=procsym_stabstr(tprocsym(sym)); - end; - if stabstr<>nil then - list.concat(Tai_stab.create(stab_stabs,stabstr)); - { For object types write also the symtable entries } - if (sym.typ=typesym) and (ttypesym(sym).restype.def.deftype=objectdef) then - write_symtable_syms(list,tobjectdef(ttypesym(sym).restype.def).symtable); - sym.isstabwritten:=true; - end; - - - procedure TDebugInfoStabs.write_symtable_syms(list:taasmoutput;st:tsymtable); - var - p : tsym; - begin - case st.symtabletype of - staticsymtable : - list.concat(tai_comment.Create(strpnew('Syms - Begin Staticsymtable'))); - globalsymtable : - list.concat(tai_comment.Create(strpnew('Syms - Begin unit '+st.name^+' has index '+tostr(st.moduleid)))); - end; - p:=tsym(st.symindex.first); - while assigned(p) do - begin - if (not p.isstabwritten) then - insertsym(list,p); - p:=tsym(p.indexnext); - end; - case st.symtabletype of - staticsymtable : - list.concat(tai_comment.Create(strpnew('Syms - End Staticsymtable'))); - globalsymtable : - list.concat(tai_comment.Create(strpnew('Syms - End unit '+st.name^+' has index '+tostr(st.moduleid)))); - end; - end; - -{**************************************************************************** - Proc/Module support -****************************************************************************} - - procedure tdebuginfostabs.inserttypeinfo; - - procedure reset_unit_type_info; - var - hp : tmodule; - begin - hp:=tmodule(loaded_units.first); - while assigned(hp) do - begin - hp.is_stab_written:=false; - hp:=tmodule(hp.next); - end; - end; - - procedure write_used_unit_type_info(list:taasmoutput;hp:tmodule); - var - pu : tused_unit; - begin - pu:=tused_unit(hp.used_units.first); - while assigned(pu) do - begin - if not pu.u.is_stab_written then - begin - { prevent infinte loop for circular dependencies } - pu.u.is_stab_written:=true; - { write type info from used units, use a depth first - strategy to reduce the recursion in writing all - dependent stabs } - write_used_unit_type_info(list,pu.u); - if assigned(pu.u.globalsymtable) then - write_symtable_defs(list,pu.u.globalsymtable); - end; - pu:=tused_unit(pu.next); - end; - end; - - var - stabsvarlist, - stabstypelist : taasmoutput; - storefilepos : tfileposinfo; - st : tsymtable; - i : longint; - begin - storefilepos:=aktfilepos; - aktfilepos:=current_module.mainfilepos; - - global_stab_number:=0; - defnumberlist:=tlist.create; - stabsvarlist:=taasmoutput.create; - stabstypelist:=taasmoutput.create; - - { include symbol that will be referenced from the main to be sure to - include this debuginfo .o file } - if current_module.is_unit then - begin - current_module.flags:=current_module.flags or uf_has_debuginfo; - st:=current_module.globalsymtable; - end - else - st:=current_module.localsymtable; - new_section(asmlist[al_stabs],sec_data,st.name^,0); - asmlist[al_stabs].concat(tai_symbol.Createname_global(make_mangledname('DEBUGINFO',st,''),AT_DATA,0)); - - { first write all global/local symbols. This will flag all required tdefs } - if assigned(current_module.globalsymtable) then - write_symtable_syms(stabsvarlist,current_module.globalsymtable); - if assigned(current_module.localsymtable) then - write_symtable_syms(stabsvarlist,current_module.localsymtable); - - { reset unit type info flag } - reset_unit_type_info; - - { write used types from the used units } - write_used_unit_type_info(stabstypelist,current_module); - { last write the types from this unit } - if assigned(current_module.globalsymtable) then - write_symtable_defs(stabstypelist,current_module.globalsymtable); - if assigned(current_module.localsymtable) then - write_symtable_defs(stabstypelist,current_module.localsymtable); - - asmlist[al_stabs].concatlist(stabstypelist); - asmlist[al_stabs].concatlist(stabsvarlist); - - { reset stab numbers } - for i:=0 to defnumberlist.count-1 do - begin - if assigned(defnumberlist[i]) then - begin - tdef(defnumberlist[i]).stab_number:=0; - tdef(defnumberlist[i]).stab_state:=stab_state_unused; - end; - end; - - defnumberlist.free; - defnumberlist:=nil; - - stabsvarlist.free; - stabstypelist.free; - aktfilepos:=storefilepos; - end; - - - procedure tdebuginfostabs.insertlineinfo(list:taasmoutput); - var - currfileinfo, - lastfileinfo : tfileposinfo; - currfuncname : pstring; - currsectype : tasmsectiontype; - hlabel : tasmlabel; - hp : tai; - infile : tinputfile; - begin - FillChar(lastfileinfo,sizeof(lastfileinfo),0); - currfuncname:=nil; - currsectype:=sec_code; - hp:=Tai(list.first); - while assigned(hp) do - begin - case hp.typ of - ait_section : - currsectype:=tai_section(hp).sectype; - ait_function_name : - currfuncname:=tai_function_name(hp).funcname; - ait_force_line : - lastfileinfo.line:=-1; - end; - - if (currsectype=sec_code) and - (hp.typ=ait_instruction) then - begin - currfileinfo:=tailineinfo(hp).fileinfo; - { file changed ? (must be before line info) } - if (currfileinfo.fileindex<>0) and - (lastfileinfo.fileindex<>currfileinfo.fileindex) then - begin - infile:=current_module.sourcefiles.get_file(currfileinfo.fileindex); - if assigned(infile) then - begin - objectlibrary.getlabel(hlabel,alt_dbgfile); - { emit stabs } - if (infile.path^<>'') then - list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(infile.path^,false))+'",'+tostr(n_includefile)+ - ',0,0,'+hlabel.name),hp); - list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+FixFileName(infile.name^)+'",'+tostr(n_includefile)+ - ',0,0,'+hlabel.name),hp); - list.insertbefore(tai_label.create(hlabel),hp); - { force new line info } - lastfileinfo.line:=-1; - end; - end; - - { line changed ? } - if (lastfileinfo.line<>currfileinfo.line) and (currfileinfo.line<>0) then - begin - if assigned(currfuncname) and - (target_info.use_function_relative_addresses) then - begin - objectlibrary.getlabel(hlabel,alt_dbgline); - list.insertbefore(Tai_stab.Create_str(stab_stabn,tostr(n_textline)+',0,'+tostr(currfileinfo.line)+','+ - hlabel.name+' - '+{$IFDEF POWERPC64}'.'+{$ENDIF POWERPC64}currfuncname^),hp); - list.insertbefore(tai_label.create(hlabel),hp); - end - else - list.insertbefore(Tai_stab.Create_str(stab_stabd,tostr(n_textline)+',0,'+tostr(currfileinfo.line)),hp); - end; - lastfileinfo:=currfileinfo; - end; - - hp:=tai(hp.next); - end; - end; - - - procedure tdebuginfostabs.insertmoduleinfo; - var - hlabel : tasmlabel; - infile : tinputfile; - templist : taasmoutput; - begin - { emit main source n_sourcefile for start of module } - objectlibrary.getlabel(hlabel,alt_dbgfile); - infile:=current_module.sourcefiles.get_file(1); - templist:=taasmoutput.create; - new_section(templist,sec_code,'',0); - if (infile.path^<>'') then - templist.concat(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(infile.path^,false))+'",'+tostr(n_sourcefile)+ - ',0,0,'+hlabel.name)); - templist.concat(Tai_stab.Create_str(stab_stabs,'"'+FixFileName(infile.name^)+'",'+tostr(n_sourcefile)+ - ',0,0,'+hlabel.name)); - templist.concat(tai_label.create(hlabel)); - asmlist[al_stabsstart].insertlist(templist); - templist.free; - { emit empty n_sourcefile for end of module } - objectlibrary.getlabel(hlabel,alt_dbgfile); - templist:=taasmoutput.create; - new_section(templist,sec_code,'',0); - templist.concat(Tai_stab.Create_str(stab_stabs,'"",'+tostr(n_sourcefile)+',0,0,'+hlabel.name)); - templist.concat(tai_label.create(hlabel)); - asmlist[al_stabsend].insertlist(templist); - templist.free; - end; - - - procedure tdebuginfostabs.referencesections(list:taasmoutput); - var - hp : tused_unit; - begin - { Reference all DEBUGINFO sections from the main .text section } - if (target_info.system <> system_powerpc_macos) then - begin - { include reference to all debuginfo sections of used units } - hp:=tused_unit(usedunits.first); - while assigned(hp) do - begin - If (hp.u.flags and uf_has_debuginfo)=uf_has_debuginfo then - list.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',hp.u.globalsymtable,''),AT_DATA,0)); - hp:=tused_unit(hp.next); - end; - { include reference to debuginfo for this program } - list.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',current_module.localsymtable,''),AT_DATA,0)); - end; - end; - - - const - dbg_stabs_info : tdbginfo = - ( - id : dbg_stabs; - idtxt : 'STABS'; - ); - -initialization - RegisterDebugInfo(dbg_stabs_info,TDebugInfoStabs); -end. diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas index 8117ef0ea4..50567ac68e 100644 --- a/compiler/defcmp.pas +++ b/compiler/defcmp.pas @@ -267,7 +267,7 @@ implementation doconv:=tc_int_2_int; end; end; - arraydef : + stringdef : begin if (m_mac in aktmodeswitches) and (fromtreetype=stringconstn) then @@ -287,9 +287,7 @@ implementation { Constant string } if (fromtreetype=stringconstn) then begin - { we can change the stringconst node } - if (tstringdef(def_from).string_typ=st_conststring) or - (tstringdef(def_from).string_typ=tstringdef(def_to).string_typ) then + if (tstringdef(def_from).string_typ=tstringdef(def_to).string_typ) then eq:=te_equal else begin @@ -660,8 +658,7 @@ implementation else { to array of char, from "Untyped" stringconstn (array of char) } if (fromtreetype=stringconstn) and - (is_chararray(def_to) or - is_widechararray(def_to)) then + is_chararray(def_to) then begin eq:=te_convert_l1; doconv:=tc_string_2_chararray; diff --git a/compiler/defutil.pas b/compiler/defutil.pas index a22c9f967b..fa11ed3793 100644 --- a/compiler/defutil.pas +++ b/compiler/defutil.pas @@ -891,10 +891,7 @@ implementation result:=int_cgsize(def.size); end; floatdef: - if cs_fp_emulation in aktmoduleswitches then - result:=int_cgsize(def.size) - else - result:=tfloat2tcgsize[tfloatdef(def).typ]; + result := tfloat2tcgsize[tfloatdef(def).typ]; recorddef : result:=int_cgsize(def.size); arraydef : diff --git a/compiler/dwarf.pas b/compiler/dwarf.pas index 0e0c2188c6..d5a1e819c2 100644 --- a/compiler/dwarf.pas +++ b/compiler/dwarf.pas @@ -61,11 +61,11 @@ interface tdwarf=class private - Fal_dwarf : TLinkedList; + FDwarfList : TLinkedList; public constructor create; destructor destroy;override; - property al_dwarf:TlinkedList read Fal_dwarf; + property DwarfList:TlinkedList read FDwarfList; end; tdwarfcfi=class(tdwarf) @@ -133,13 +133,13 @@ implementation constructor tdwarf.create; begin - Fal_dwarf:=TLinkedList.Create; + FDwarfList:=TLinkedList.Create; end; destructor tdwarf.destroy; begin - Fal_dwarf.Free; + FDwarfList.Free; end; @@ -270,10 +270,10 @@ implementation BYTE return address register <...> start sequence } - objectlibrary.getjumplabel(cielabel); + objectlibrary.getlabel(cielabel); list.concat(tai_label.create(cielabel)); - objectlibrary.getjumplabel(lenstartlabel); - objectlibrary.getjumplabel(lenendlabel); + objectlibrary.getlabel(lenstartlabel); + objectlibrary.getlabel(lenendlabel); list.concat(tai_const.create_rel_sym(ait_const_32bit,lenstartlabel,lenendlabel)); list.concat(tai_label.create(lenstartlabel)); list.concat(tai_const.create_32bit(longint($ffffffff))); @@ -298,7 +298,7 @@ implementation lenstartlabel:=nil; lenendlabel:=nil; - hp:=TDwarfItem(al_dwarf.first); + hp:=TDwarfItem(Dwarflist.first); while assigned(hp) do begin case hp.op of @@ -309,8 +309,8 @@ implementation if (hp.ops<>1) or (hp.oper[0].typ<>dop_reloffset) then internalerror(200404126); - objectlibrary.getjumplabel(lenstartlabel); - objectlibrary.getjumplabel(lenendlabel); + objectlibrary.getlabel(lenstartlabel); + objectlibrary.getlabel(lenendlabel); { FDE DWORD length DWORD CIE-pointer = cielabel @@ -341,8 +341,8 @@ implementation { Check for open frames } if assigned(lenstartlabel) then internalerror(2004041210); - { al_dwarf is processed, remove items } - al_dwarf.Clear; + { Dwarflist is processed, remove items } + DwarfList.Clear; end; @@ -350,11 +350,11 @@ implementation begin if assigned(FFrameStartLabel) then internalerror(200404129); - objectlibrary.getjumplabel(FFrameStartLabel); - objectlibrary.getjumplabel(FFrameEndLabel); + objectlibrary.getlabel(FFrameStartLabel); + objectlibrary.getlabel(FFrameEndLabel); FLastloclabel:=FFrameStartLabel; list.concat(tai_label.create(FFrameStartLabel)); - al_dwarf.concat(tdwarfitem.create_reloffset(DW_CFA_start_frame,doe_32bit,FFrameStartLabel,FFrameEndLabel)); + dwarflist.concat(tdwarfitem.create_reloffset(DW_CFA_start_frame,doe_32bit,FFrameStartLabel,FFrameEndLabel)); end; @@ -362,7 +362,7 @@ implementation begin if not assigned(FFrameStartLabel) then internalerror(2004041213); - al_dwarf.concat(tdwarfitem.create(DW_CFA_end_frame)); + dwarflist.concat(tdwarfitem.create(DW_CFA_end_frame)); list.concat(tai_label.create(FFrameEndLabel)); FFrameStartLabel:=nil; FFrameEndLabel:=nil; @@ -376,9 +376,9 @@ implementation begin if FLastloclabel=nil then internalerror(200404082); - objectlibrary.getjumplabel(currloclabel); + objectlibrary.getlabel(currloclabel); list.concat(tai_label.create(currloclabel)); - al_dwarf.concat(tdwarfitem.create_reloffset(DW_CFA_advance_loc4,doe_32bit,FLastloclabel,currloclabel)); + dwarflist.concat(tdwarfitem.create_reloffset(DW_CFA_advance_loc4,doe_32bit,FLastloclabel,currloclabel)); FLastloclabel:=currloclabel; end; @@ -388,28 +388,28 @@ implementation cfa_advance_loc(list); {$warning TODO check if ref is a temp} { offset must be positive } - al_dwarf.concat(tdwarfitem.create_reg_const(DW_CFA_offset_extended,doe_uleb,reg,doe_uleb,ofs div data_alignment_factor)); + dwarflist.concat(tdwarfitem.create_reg_const(DW_CFA_offset_extended,doe_uleb,reg,doe_uleb,ofs div data_alignment_factor)); end; procedure tdwarfcfi.cfa_restore(list:taasmoutput;reg:tregister); begin cfa_advance_loc(list); - al_dwarf.concat(tdwarfitem.create_reg(DW_CFA_restore_extended,doe_uleb,reg)); + dwarflist.concat(tdwarfitem.create_reg(DW_CFA_restore_extended,doe_uleb,reg)); end; procedure tdwarfcfi.cfa_def_cfa_register(list:taasmoutput;reg:tregister); begin cfa_advance_loc(list); - al_dwarf.concat(tdwarfitem.create_reg(DW_CFA_def_cfa_register,doe_uleb,reg)); + dwarflist.concat(tdwarfitem.create_reg(DW_CFA_def_cfa_register,doe_uleb,reg)); end; procedure tdwarfcfi.cfa_def_cfa_offset(list:taasmoutput;ofs:longint); begin cfa_advance_loc(list); - al_dwarf.concat(tdwarfitem.create_const(DW_CFA_def_cfa_offset,doe_uleb,ofs)); + dwarflist.concat(tdwarfitem.create_const(DW_CFA_def_cfa_offset,doe_uleb,ofs)); end; diff --git a/compiler/fpcdefs.inc b/compiler/fpcdefs.inc index 8b3b54fe68..0faa5e1ebc 100644 --- a/compiler/fpcdefs.inc +++ b/compiler/fpcdefs.inc @@ -37,7 +37,6 @@ {$define cpuextended} {$define USECMOV} {$define SUPPORT_MMX} - {$define cpumm} {$endif i386} {$ifdef x86_64} @@ -48,7 +47,6 @@ {$define cpufloat128} {$define cputargethasfixedstack} {$define USECMOV} - {$define cpumm} {$endif x86_64} {$ifdef alpha} @@ -64,20 +62,10 @@ {$ifdef powerpc} {$define cpuflags} {$define cputargethasfixedstack} - {$define cpumm} {$endif powerpc} -{$ifdef powerpc64} - {$define cpu64bit} - {$define cpuflags} - {$define cputargethasfixedstack} - {$define cpumm} - {$define cpurequiresproperalignment} -{$endif powerpc64} - {$ifdef arm} {$define cpuflags} - {$define cpufpemu} {$define cpuneedsdiv32helper} {$define cputargethasfixedstack} {$define cpurequiresproperalignment} @@ -91,3 +79,4 @@ {$IFDEF MACOS} {$DEFINE MACOS_USE_FAKE_SYSUTILS} {$ENDIF MACOS} + diff --git a/compiler/fppu.pas b/compiler/fppu.pas index 2dad576c66..956c196f10 100644 --- a/compiler/fppu.pas +++ b/compiler/fppu.pas @@ -202,7 +202,6 @@ uses end; {$ifdef cpufpemu} { check if floating point emulation is on?} - { fpu emulation isn't unit levelwise if ((ppufile.header.flags and uf_fpu_emulation)<>0) and (cs_fp_emulation in aktmoduleswitches) then begin @@ -211,7 +210,6 @@ uses Message(unit_u_ppu_invalid_fpumode); exit; end; - } {$endif cpufpemu} { Load values to be access easier } @@ -597,19 +595,22 @@ uses s:=librarydata.asmsymbolidx^[i-1]; if not assigned(s) then internalerror(200208071); + asmsymtype:=1; if s.Classtype=tasmlabel then - asmsymtype:=2 - else - asmsymtype:=1; + begin + if tasmlabel(s).is_addr then + asmsymtype:=4 + else if tasmlabel(s).typ=AT_DATA then + asmsymtype:=3 + else + asmsymtype:=2; + end; ppufile.putbyte(asmsymtype); case asmsymtype of 1 : ppufile.putstring(s.name); - 2 : - begin - ppufile.putbyte(byte(tasmlabel(s).labeltype)); - ppufile.putlongint(tasmlabel(s).labelnr); - end; + 2..4 : + ppufile.putlongint(tasmlabel(s).labelnr); end; ppufile.putbyte(byte(s.defbind)); ppufile.putbyte(byte(s.typ)); @@ -853,7 +854,6 @@ uses labelnr, i : longint; name : string; - labeltype : tasmlabeltype; bind : TAsmSymBind; typ : TAsmSymType; asmsymtype : byte; @@ -869,11 +869,8 @@ uses case asmsymtype of 1 : name:=ppufile.getstring; - 2 : - begin - labeltype:=tasmlabeltype(ppufile.getbyte); - labelnr:=ppufile.getlongint; - end; + 2..4 : + labelnr:=ppufile.getlongint; else internalerror(200208192); end; @@ -883,7 +880,11 @@ uses 1 : librarydata.asmsymbolidx^[i-1]:=librarydata.newasmsymbol(name,bind,typ); 2 : - librarydata.asmsymbolidx^[i-1]:=librarydata.newasmlabel(labelnr,labeltype,(typ=AT_DATA)); + librarydata.asmsymbolidx^[i-1]:=librarydata.newasmlabel(labelnr,false,false); + 3 : + librarydata.asmsymbolidx^[i-1]:=librarydata.newasmlabel(labelnr,false,true); + 4 : + librarydata.asmsymbolidx^[i-1]:=librarydata.newasmlabel(labelnr,true,false); end; end; end; @@ -993,6 +994,10 @@ uses Message1(unit_u_ppu_write,realmodulename^); { create unit flags } +{$ifdef GDB} + if cs_gdb_dbx in aktglobalswitches then + flags:=flags or uf_has_dbx; +{$endif GDB} if cs_browser in aktmoduleswitches then flags:=flags or uf_has_browser; if cs_local_browser in aktmoduleswitches then diff --git a/compiler/gdb.pas b/compiler/gdb.pas new file mode 100644 index 0000000000..2649517480 --- /dev/null +++ b/compiler/gdb.pas @@ -0,0 +1,233 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This units contains special support for the GDB + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit gdb; + +{$i fpcdefs.inc} + +interface + +uses + strings, + globtype, + aasmtai; + +{stab constants } +Const + N_GSYM = $20; + N_STSYM = 38; {initialized const } + N_LCSYM = 40; {non initialized variable} + N_Function = $24; {function or const } + N_TextLine = $44; + N_DataLine = $46; + N_BssLine = $48; + N_RSYM = $40; { register variable } + N_LSYM = $80; + N_tsym = 160; + N_SourceFile = $64; + N_IncludeFile = $84; + N_BINCL = $82; + N_EINCL = $A2; + N_EXCL = $C2; + + type + tai_stabs = class(tai) + str : pchar; + constructor Create(_str : pchar); + destructor Destroy;override; + end; + + tai_stabn = class(tai) + str : pchar; + constructor Create(_str : pchar); + destructor Destroy;override; + end; + + { insert a cut to split into several smaller files } + tai_force_line = class(tailineinfo) + constructor Create; + end; + + tai_stab_function_name = class(tai) + str : pchar; + constructor create(_str : pchar); + destructor destroy;override; + end; + + const + DBX_counter : plongint = nil; + do_count_dbx : boolean = false; + + + implementation + +uses fmodule; + +{ to use N_EXCL we have to count the character in the stabs for +N_BINCL to N_EINCL + Code comes from stabs.c for ld + if (type == N_BINCL) + ( + bfd_vma val; + int nest; + bfd_byte *incl_sym; + struct stab_link_includes_entry *incl_entry; + struct stab_link_includes_totals *t; + struct stab_excl_list *ne; + + val = 0; + nest = 0; + for (incl_sym = sym + STABSIZE; + incl_sym < symend; + incl_sym += STABSIZE) + ( + int incl_type; + + incl_type = incl_sym[TYPEOFF]; + if (incl_type == 0) + break; + else if (incl_type == N_EINCL) + ( + if (nest == 0) + break; + --nest; + ) + else if (incl_type == N_BINCL) + ++nest; + else if (nest == 0) + ( + const char *str; + + str = ((char *) stabstrbuf + + stroff + + bfd_get_32 (abfd, incl_sym + STRDXOFF)); + for (; *str != '\0'; str++) + ( + val += *str; + if *str == '(' + ( + Skip the file number. + ++str; + while (isdigit ((unsigned char) *str)) + ++str; + --str; + ) + ) + ) + ) } + + + procedure count_dbx(st : pchar); + var i : longint; + do_count : boolean; + begin + do_count := false; + if assigned(dbx_counter) then + begin +{$IfDef ExtDebugDbx } + Comment(V_Info,'Counting '+st); + Comment(V_Info,'count = '+tostr(dbx_counter^)); + Comment(V_Info,'addr = '+tostr(longint(dbx_counter))); +{$EndIf ExtDebugDbx } + i:=0; + while i<=strlen(st) do + begin + if st[i] = '"' then + if do_count then exit + else do_count := true + else + if do_count then + begin + dbx_counter^ := dbx_counter^+byte(st[i]); + { skip file number } + if st[i] = '(' then + begin + inc(i); + while st[i] in ['0'..'9'] do inc(i); + dec(i); + end; + end; + inc(i); + end; + end; + end; + + + constructor tai_stabs.create(_str : pchar); + + begin + inherited create; + typ:=ait_stabs; + +if current_module.modulename^='NCNV' then + current_module:=current_module; + + str:=_str; + if do_count_dbx then + begin + count_dbx(str); + end; + end; + + destructor tai_stabs.destroy; + + begin + strdispose(str); + inherited destroy; + end; + + constructor tai_stabn.create(_str : pchar); + + begin + inherited create; + typ:=ait_stabn; + str:=_str; + end; + + destructor tai_stabn.destroy; + + begin + strdispose(str); + inherited destroy; + end; + + constructor tai_force_line.create; + + begin + inherited create; + typ:=ait_force_line; + end; + + constructor tai_stab_function_name.create(_str : pchar); + + begin + inherited create; + typ:=ait_stab_function_name; + str:=_str; + end; + + destructor tai_stab_function_name.destroy; + + begin + strdispose(str); + inherited destroy; + end; +end. diff --git a/compiler/globals.pas b/compiler/globals.pas index 21721ac164..3b250a2fcd 100644 --- a/compiler/globals.pas +++ b/compiler/globals.pas @@ -136,9 +136,6 @@ interface outputunitdir : dirstr; { things specified with parameters } - paratarget : tsystem; - paratargetdbg : tdbg; - paratargetasm : tasm; paralinkoptions, paradynamiclinker : string; paraprintnodetree : byte; @@ -219,6 +216,7 @@ interface initfputype : tfputype; initasmmode : tasmmode; initinterfacetype : tinterfacetypes; + initoutputformat : tasm; initdefproccall : tproccalloption; initsourcecodepage : tcodepagestring; @@ -244,6 +242,7 @@ interface aktfputype : tfputype; aktasmmode : tasmmode; aktinterfacetype : tinterfacetypes; + aktoutputformat : tasm; aktdefproccall : tproccalloption; aktsourcecodepage : tcodepagestring; @@ -2118,9 +2117,6 @@ end; resolving_forward:=false; make_ref:=false; LinkTypeSetExplicitly:=false; - paratarget:=system_none; - paratargetasm:=as_none; - paratargetdbg:=dbg_none; { Output } OutputFile:=''; @@ -2166,6 +2162,7 @@ end; initmoduleswitches:=[cs_extsyntax,cs_implicit_exceptions]; initsourcecodepage:='8859-1'; initglobalswitches:=[cs_check_unit_name,cs_link_static{$ifdef INTERNALLINKER},cs_link_internal,cs_link_map{$endif}]; + initoutputformat:=target_asm.id; fillchar(initalignment,sizeof(talignmentinfo),0); { might be overridden later } initasmmode:=asmmode_standard; @@ -2196,14 +2193,6 @@ end; {$ENDIF} initfputype:=fpu_standard; {$endif powerpc} -{$ifdef POWERPC64} - initoptprocessor:=PPC970; - initpackenum:=4; - {$IFDEF testvarsets} - initsetalloc:=0; - {$ENDIF} - initfputype:=fpu_standard; -{$endif POWERPC64} {$ifdef sparc} initoptprocessor:=SPARC_V8; initpackenum:=4; diff --git a/compiler/globtype.pas b/compiler/globtype.pas index 4eae2cbedf..8415100aaf 100644 --- a/compiler/globtype.pas +++ b/compiler/globtype.pas @@ -116,12 +116,12 @@ than 255 characters. That's why using Ansi Strings} cs_load_fpcylix_unit, { optimizer } cs_regvars,cs_no_regalloc,cs_uncertainopts,cs_littlesize, - cs_optimize,cs_fastoptimize,cs_slowoptimize,cs_align,cs_loopunroll, + cs_optimize,cs_fastoptimize,cs_slowoptimize,cs_align, { browser } cs_browser_log, - { debuginfo } - cs_use_heaptrc,cs_use_lineinfo, - cs_gdb_valgrind, + { debugger } + cs_gdb_dbx,cs_gdb_gsym,cs_gdb_heaptrc,cs_gdb_lineinfo, + cs_gdb_valgrind,cs_gdb_dwarf, { assembling } cs_asm_leave,cs_asm_extern,cs_asm_pipe,cs_asm_source, cs_asm_regalloc,cs_asm_tempalloc,cs_asm_nodes, diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 7db14c51e9..e18227875a 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -147,7 +147,6 @@ interface function valid_for_assignment(p:tnode):boolean; function valid_for_addr(p : tnode) : boolean; - function allowenumop(nt:tnodetype):boolean; implementation @@ -1378,13 +1377,6 @@ implementation end; - function allowenumop(nt:tnodetype):boolean; - begin - result:=(nt in [equaln,unequaln,ltn,lten,gtn,gten]) or - ((cs_allow_enum_calc in aktlocalswitches) and - (nt in [addn,subn])); - end; - {**************************************************************************** TCallCandidates diff --git a/compiler/x86/agx86int.pas b/compiler/i386/ag386int.pas index d46211c8a6..04fb1ec26d 100644 --- a/compiler/x86/agx86int.pas +++ b/compiler/i386/ag386int.pas @@ -22,7 +22,7 @@ { This unit implements an asmoutput class for Intel syntax with Intel i386+ } -unit agx86int; +unit ag386int; {$i fpcdefs.inc} @@ -33,7 +33,7 @@ interface aasmbase,aasmtai,aasmcpu,assemble,cgutils; type - Tx86IntelAssembler = class(TExternalAssembler) + T386IntelAssembler = class(TExternalAssembler) private procedure WriteReference(var ref : treference); procedure WriteOper(const o:toper;s : topsize; opcode: tasmop;dest : boolean); @@ -59,18 +59,11 @@ implementation line_length = 70; secnames : array[TAsmSectionType] of string[4] = ('', - 'CODE','DATA','DATA','BSS','', - '','','','','','','', + 'CODE','DATA','DATA','BSS', + '','','','','','', '','','','','','','' ); - secnamesml64 : array[TAsmSectionType] of string[7] = ('', - '_TEXT','_DATE','_DATA','_BSS','', - '','','','','', - 'idata$2','idata$4','idata$5','idata$6','idata$7','edata', - '','','' - ); - function single2str(d : single) : string; var hs : string; @@ -158,10 +151,10 @@ implementation {**************************************************************************** - tx86IntelAssembler + T386IntelAssembler ****************************************************************************} - procedure tx86IntelAssembler.WriteReference(var ref : treference); + procedure T386IntelAssembler.WriteReference(var ref : treference); var first : boolean; begin @@ -174,7 +167,7 @@ implementation AsmWrite('['); if assigned(symbol) then begin - if (target_asm.id = as_i386_tasm) then + if (aktoutputformat = as_i386_tasm) then AsmWrite('dword ptr '); AsmWrite(symbol.name); first:=false; @@ -214,7 +207,7 @@ implementation end; - procedure tx86IntelAssembler.WriteOper(const o:toper;s : topsize; opcode: tasmop;dest : boolean); + procedure T386IntelAssembler.WriteOper(const o:toper;s : topsize; opcode: tasmop;dest : boolean); begin case o.typ of top_reg : @@ -233,7 +226,6 @@ implementation S_B : AsmWrite('byte ptr '); S_W : AsmWrite('word ptr '); S_L : AsmWrite('dword ptr '); - S_Q : AsmWrite('qword ptr '); S_IS : AsmWrite('word ptr '); S_IL : AsmWrite('dword ptr '); S_IQ : AsmWrite('qword ptr '); @@ -253,22 +245,6 @@ implementation AsmWrite('dword ptr ') else AsmWrite('word ptr '); -{$ifdef x86_64} - S_BQ : if dest then - AsmWrite('qword ptr ') - else - AsmWrite('byte ptr '); - S_WQ : if dest then - AsmWrite('qword ptr ') - else - AsmWrite('word ptr '); - S_LQ : if dest then - AsmWrite('qword ptr ') - else - AsmWrite('dword ptr '); - S_XMM: AsmWrite('xmmword ptr '); - -{$endif x86_64} end; end; WriteReference(o.ref^); @@ -289,12 +265,12 @@ implementation end; end; else - internalerror(2005060510); + internalerror(10001); end; end; - procedure tx86IntelAssembler.WriteOper_jmp(const o:toper;s : topsize); + procedure T386IntelAssembler.WriteOper_jmp(const o:toper;s : topsize); begin case o.typ of top_reg : @@ -306,16 +282,12 @@ implementation begin if o.ref^.refaddr=addr_no then begin - if (target_asm.id <> as_i386_tasm) then + if (aktoutputformat <> as_i386_tasm) then begin if s=S_FAR then AsmWrite('far ptr ') else -{$ifdef x86_64} - AsmWrite('qword ptr '); -{$else x86_64} AsmWrite('dword ptr '); -{$endif x86_64} end; WriteReference(o.ref^); end @@ -330,7 +302,7 @@ implementation end; end; else - internalerror(2005060511); + internalerror(10001); end; end; @@ -343,9 +315,9 @@ implementation const ait_const2str : array[ait_const_128bit..ait_const_indirect_symbol] of string[20]=( - #9''#9,#9'DQ'#9,#9'DD'#9,#9'DW'#9,#9'DB'#9, + #9'FIXME128',#9'FIXME64',#9'DD'#9,#9'DW'#9,#9'DB'#9, #9'FIXMESLEB',#9'FIXEMEULEB', - #9'DD RVA'#9,#9'FIXMEINDIRECT'#9 + #9'RVA'#9,#9'FIXMEINDIRECT'#9 ); Function PadTabs(const p:string;addch:char):string; @@ -367,7 +339,7 @@ implementation PadTabs:=s+#9; end; - procedure tx86IntelAssembler.WriteTree(p:TAAsmoutput); + procedure T386IntelAssembler.WriteTree(p:TAAsmoutput); const regallocstr : array[tregalloctype] of string[10]=(' allocated',' released',' sync',' resized'); tempallocstr : array[boolean] of string[10]=(' released',' allocated'); @@ -387,10 +359,10 @@ implementation begin if not assigned(p) then exit; - { lineinfo is only needed for al_procedures (PFV) } + { lineinfo is only needed for codesegment (PFV) } do_line:=((cs_asm_source in aktglobalswitches) or (cs_lineinfo in aktmoduleswitches)) - and (p=asmlist[al_procedures]); + and (p=codesegment); InlineLevel:=0; DoNotSplitLine:=false; hp:=tai(p.first); @@ -443,12 +415,11 @@ implementation end; DoNotSplitLine:=false; case hp.typ of - ait_comment : - Begin - AsmWrite(target_asm.comment); - AsmWritePChar(tai_comment(hp).str); - AsmLn; - End; + ait_comment : Begin + AsmWrite(target_asm.comment); + AsmWritePChar(tai_comment(hp).str); + AsmLn; + End; ait_regalloc : begin @@ -472,43 +443,30 @@ implementation end; end; - ait_section : - begin - if tai_section(hp).sectype<>sec_none then - begin - if target_asm.id=as_x86_64_masm then - begin - if LasTSecType<>sec_none then - AsmWriteLn(secnamesml64[LasTSecType]+#9#9'ENDS'); - AsmLn; - AsmWriteLn(secnamesml64[tai_section(hp).sectype]+#9+'SEGMENT') - end - else - begin - if LasTSecType<>sec_none then + ait_section : begin + if LasTSecType<>sec_none then AsmWriteLn('_'+secnames[LasTSecType]+#9#9'ENDS'); - AsmLn; - AsmWriteLn('_'+secnames[tai_section(hp).sectype]+#9#9+ - 'SEGMENT'#9'PARA PUBLIC USE32 '''+ - secnames[tai_section(hp).sectype]+''''); - end; - end; - LasTSecType:=tai_section(hp).sectype; - end; - ait_align : - begin - { CAUSES PROBLEMS WITH THE SEGMENT DEFINITION } - { SEGMENT DEFINITION SHOULD MATCH TYPE OF ALIGN } - { HERE UNDER TASM! } - if tai_align(hp).aligntype>1 then - AsmWriteLn(#9'ALIGN '+tostr(tai_align(hp).aligntype)); - end; - ait_datablock : - begin - if tai_datablock(hp).is_global then - AsmWriteLn(#9'PUBLIC'#9+tai_datablock(hp).sym.name); - AsmWriteLn(PadTabs(tai_datablock(hp).sym.name,#0)+'DB'#9+tostr(tai_datablock(hp).size)+' DUP(?)'); - end; + if tai_section(hp).sectype<>sec_none then + begin + AsmLn; + AsmWriteLn('_'+secnames[tai_section(hp).sectype]+#9#9+ + 'SEGMENT'#9'PARA PUBLIC USE32 '''+ + secnames[tai_section(hp).sectype]+''''); + end; + LasTSecType:=tai_section(hp).sectype; + end; + ait_align : begin + { CAUSES PROBLEMS WITH THE SEGMENT DEFINITION } + { SEGMENT DEFINITION SHOULD MATCH TYPE OF ALIGN } + { HERE UNDER TASM! } + if tai_align(hp).aligntype>1 then + AsmWriteLn(#9'ALIGN '+tostr(tai_align(hp).aligntype)); + end; + ait_datablock : begin + if tai_datablock(hp).is_global then + AsmWriteLn(#9'PUBLIC'#9+tai_datablock(hp).sym.name); + AsmWriteLn(PadTabs(tai_datablock(hp).sym.name,#0)+'DB'#9+tostr(tai_datablock(hp).size)+' DUP(?)'); + end; ait_const_uleb128bit, ait_const_sleb128bit, ait_const_128bit, @@ -545,241 +503,233 @@ implementation AsmLn; end; - ait_real_32bit : - AsmWriteLn(#9#9'DD'#9+single2str(tai_real_32bit(hp).value)); - ait_real_64bit : - AsmWriteLn(#9#9'DQ'#9+double2str(tai_real_64bit(hp).value)); - ait_real_80bit : - AsmWriteLn(#9#9'DT'#9+extended2str(tai_real_80bit(hp).value)); - ait_comp_64bit : - AsmWriteLn(#9#9'DQ'#9+comp2str(tai_real_80bit(hp).value)); - ait_string : - begin - counter := 0; - lines := tai_string(hp).len div line_length; - { separate lines in different parts } - if tai_string(hp).len > 0 then - Begin - for j := 0 to lines-1 do - begin - AsmWrite(#9#9'DB'#9); - quoted:=false; - for i:=counter to counter+line_length-1 do - begin - { it is an ascii character. } - if (ord(tai_string(hp).str[i])>31) and - (ord(tai_string(hp).str[i])<128) and - (tai_string(hp).str[i]<>'"') then - begin - if not(quoted) then - begin - if i>counter then - AsmWrite(','); - AsmWrite('"'); - end; - AsmWrite(tai_string(hp).str[i]); - quoted:=true; - end { if > 31 and < 128 and ord('"') } - else - begin + ait_real_32bit : AsmWriteLn(#9#9'DD'#9+single2str(tai_real_32bit(hp).value)); + ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(tai_real_64bit(hp).value)); + ait_real_80bit : AsmWriteLn(#9#9'DT'#9+extended2str(tai_real_80bit(hp).value)); + ait_comp_64bit : AsmWriteLn(#9#9'DQ'#9+comp2str(tai_real_80bit(hp).value)); + ait_string : begin + counter := 0; + lines := tai_string(hp).len div line_length; + { separate lines in different parts } + if tai_string(hp).len > 0 then + Begin + for j := 0 to lines-1 do + begin + AsmWrite(#9#9'DB'#9); + quoted:=false; + for i:=counter to counter+line_length-1 do + begin + { it is an ascii character. } + if (ord(tai_string(hp).str[i])>31) and + (ord(tai_string(hp).str[i])<128) and + (tai_string(hp).str[i]<>'"') then + begin + if not(quoted) then + begin + if i>counter then + AsmWrite(','); + AsmWrite('"'); + end; + AsmWrite(tai_string(hp).str[i]); + quoted:=true; + end { if > 31 and < 128 and ord('"') } + else + begin + if quoted then + AsmWrite('"'); + if i>counter then + AsmWrite(','); + quoted:=false; + AsmWrite(tostr(ord(tai_string(hp).str[i]))); + end; + end; { end for i:=0 to... } + if quoted then AsmWrite('"'); + AsmWrite(target_info.newline); + counter := counter+line_length; + end; { end for j:=0 ... } + { do last line of lines } + if counter<tai_string(hp).len then + AsmWrite(#9#9'DB'#9); + quoted:=false; + for i:=counter to tai_string(hp).len-1 do + begin + { it is an ascii character. } + if (ord(tai_string(hp).str[i])>31) and + (ord(tai_string(hp).str[i])<128) and + (tai_string(hp).str[i]<>'"') then + begin + if not(quoted) then + begin + if i>counter then + AsmWrite(','); + AsmWrite('"'); + end; + AsmWrite(tai_string(hp).str[i]); + quoted:=true; + end { if > 31 and < 128 and " } + else + begin if quoted then - AsmWrite('"'); + AsmWrite('"'); if i>counter then AsmWrite(','); quoted:=false; AsmWrite(tostr(ord(tai_string(hp).str[i]))); - end; - end; { end for i:=0 to... } - if quoted then AsmWrite('"'); - AsmWrite(target_info.newline); - counter := counter+line_length; - end; { end for j:=0 ... } - { do last line of lines } - if counter<tai_string(hp).len then - AsmWrite(#9#9'DB'#9); - quoted:=false; - for i:=counter to tai_string(hp).len-1 do - begin - { it is an ascii character. } - if (ord(tai_string(hp).str[i])>31) and - (ord(tai_string(hp).str[i])<128) and - (tai_string(hp).str[i]<>'"') then + end; + end; { end for i:=0 to... } + if quoted then + AsmWrite('"'); + end; + AsmLn; + end; + ait_label : begin + if tai_label(hp).l.is_used then + begin + AsmWrite(tai_label(hp).l.name); + if assigned(hp.next) and not(tai(hp.next).typ in + [ait_const_32bit,ait_const_16bit,ait_const_8bit, + ait_const_rva_symbol, + ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then + AsmWriteLn(':') + else + DoNotSplitLine:=true; + end; + end; + ait_direct : begin + AsmWritePChar(tai_direct(hp).str); + AsmLn; + end; + ait_symbol : begin + if tai_symbol(hp).is_global then + AsmWriteLn(#9'PUBLIC'#9+tai_symbol(hp).sym.name); + AsmWrite(tai_symbol(hp).sym.name); + if assigned(hp.next) and not(tai(hp.next).typ in + [ait_const_32bit,ait_const_16bit,ait_const_8bit, + ait_const_rva_symbol, + ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then + AsmWriteLn(':') + end; + ait_symbol_end : begin + end; + ait_instruction : begin + taicpu(hp).CheckNonCommutativeOpcodes; + taicpu(hp).SetOperandOrder(op_intel); + { Reset } + suffix:=''; + prefix:= ''; + { We need to explicitely set + word prefix to get selectors + to be pushed in 2 bytes PM } + if (taicpu(hp).opsize=S_W) and + ( + ( + (taicpu(hp).opcode=A_PUSH) or + (taicpu(hp).opcode=A_POP) + ) and + (taicpu(hp).oper[0]^.typ=top_reg) and + is_segment_reg(taicpu(hp).oper[0]^.reg) + ) then + AsmWriteln(#9#9'DB'#9'066h'); + + { added prefix instructions, must be on same line as opcode } + if (taicpu(hp).ops = 0) and + ((taicpu(hp).opcode = A_REP) or + (taicpu(hp).opcode = A_LOCK) or + (taicpu(hp).opcode = A_REPE) or + (taicpu(hp).opcode = A_REPNZ) or + (taicpu(hp).opcode = A_REPZ) or + (taicpu(hp).opcode = A_REPNE)) then + Begin + prefix:=std_op2str[taicpu(hp).opcode]+#9; + hp:=tai(hp.next); + { this is theorically impossible... } + if hp=nil then + begin + AsmWriteLn(#9#9+prefix); + break; + end; + { nasm prefers prefix on a line alone + AsmWriteln(#9#9+prefix); but not masm PM + prefix:=''; } + if aktoutputformat in [as_i386_nasmcoff,as_i386_nasmwin32,as_i386_nasmwdosx, + as_i386_nasmelf,as_i386_nasmobj,as_i386_nasmbeos] then + begin + AsmWriteln(prefix); + prefix:=''; + end; + end + else + prefix:= ''; + if (aktoutputformat = as_i386_wasm) and + (taicpu(hp).opsize=S_W) and + (taicpu(hp).opcode=A_PUSH) and + (taicpu(hp).oper[0]^.typ=top_const) then + begin + AsmWriteln(#9#9'DB 66h,68h ; pushw imm16'); + AsmWrite(#9#9'DW'); + end + else + AsmWrite(#9#9+prefix+std_op2str[taicpu(hp).opcode]+cond2str[taicpu(hp).condition]+suffix); + if taicpu(hp).ops<>0 then begin - if not(quoted) then + if is_calljmp(taicpu(hp).opcode) then + begin + AsmWrite(#9); + WriteOper_jmp(taicpu(hp).oper[0]^,taicpu(hp).opsize); + end + else + begin + for i:=0to taicpu(hp).ops-1 do begin - if i>counter then - AsmWrite(','); - AsmWrite('"'); + if i=0 then + AsmWrite(#9) + else + AsmWrite(','); + WriteOper(taicpu(hp).oper[i]^,taicpu(hp).opsize,taicpu(hp).opcode,(i=2)); end; - AsmWrite(tai_string(hp).str[i]); - quoted:=true; - end { if > 31 and < 128 and " } - else + end; + end; + AsmLn; + end; +{$ifdef GDB} + ait_stabn, + ait_stabs, + ait_force_line, +ait_stab_function_name : ; +{$endif GDB} + ait_cutobject : begin + { only reset buffer if nothing has changed } + if AsmSize=AsmStartSize then + AsmClear + else begin - if quoted then - AsmWrite('"'); - if i>counter then - AsmWrite(','); - quoted:=false; - AsmWrite(tostr(ord(tai_string(hp).str[i]))); + if LasTSecType<>sec_none then + AsmWriteLn('_'+secnames[LasTSecType]+#9#9'ENDS'); + AsmLn; + AsmWriteLn(#9'END'); + AsmClose; + DoAssemble; + AsmCreate(tai_cutobject(hp).place); end; - end; { end for i:=0 to... } - if quoted then - AsmWrite('"'); - end; - AsmLn; - end; - ait_label : - begin - if tai_label(hp).l.is_used then - begin - AsmWrite(tai_label(hp).l.name); - if assigned(hp.next) and not(tai(hp.next).typ in - [ait_const_32bit,ait_const_16bit,ait_const_8bit, - ait_const_rva_symbol, - ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then - AsmWriteLn(':') - else - DoNotSplitLine:=true; - end; - end; - ait_symbol : - begin - if tai_symbol(hp).is_global then - AsmWriteLn(#9'PUBLIC'#9+tai_symbol(hp).sym.name); - AsmWrite(tai_symbol(hp).sym.name); - if assigned(hp.next) and not(tai(hp.next).typ in - [ait_const_32bit,ait_const_16bit,ait_const_8bit, - ait_const_rva_symbol, - ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then - AsmWriteLn(':') - end; - ait_symbol_end : - begin - end; - ait_instruction : - begin - taicpu(hp).CheckNonCommutativeOpcodes; - taicpu(hp).SetOperandOrder(op_intel); - { Reset } - suffix:=''; - prefix:= ''; - { We need to explicitely set - word prefix to get selectors - to be pushed in 2 bytes PM } - if (taicpu(hp).opsize=S_W) and - ( - ( - (taicpu(hp).opcode=A_PUSH) or - (taicpu(hp).opcode=A_POP) - ) and - (taicpu(hp).oper[0]^.typ=top_reg) and - is_segment_reg(taicpu(hp).oper[0]^.reg) - ) then - AsmWriteln(#9#9'DB'#9'066h'); - - { added prefix instructions, must be on same line as opcode } - if (taicpu(hp).ops = 0) and - ((taicpu(hp).opcode = A_REP) or - (taicpu(hp).opcode = A_LOCK) or - (taicpu(hp).opcode = A_REPE) or - (taicpu(hp).opcode = A_REPNZ) or - (taicpu(hp).opcode = A_REPZ) or - (taicpu(hp).opcode = A_REPNE)) then - Begin - prefix:=std_op2str[taicpu(hp).opcode]+#9; - hp:=tai(hp.next); - { this is theorically impossible... } - if hp=nil then - begin - AsmWriteLn(#9#9+prefix); - break; - end; - { nasm prefers prefix on a line alone - AsmWriteln(#9#9+prefix); but not masm PM - prefix:=''; } - if target_asm.id in [as_i386_nasmcoff,as_i386_nasmwin32,as_i386_nasmwdosx, - as_i386_nasmelf,as_i386_nasmobj,as_i386_nasmbeos] then - begin - AsmWriteln(prefix); - prefix:=''; + { avoid empty files } + while assigned(hp.next) and (tai(hp.next).typ in [ait_cutobject,ait_section,ait_comment]) do + begin + if tai(hp.next).typ=ait_section then + lasTSecType:=tai_section(hp.next).sectype; + hp:=tai(hp.next); + end; + AsmWriteLn(#9'.386p'); + AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA'); + AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP'); + { I was told that this isn't necesarry because } + { the labels generated by FPC are unique (FK) } + { AsmWriteLn(#9'LOCALS '+target_asm.labelprefix); } + if lasTSectype<>sec_none then + AsmWriteLn('_'+secnames[lasTSectype]+#9#9+ + 'SEGMENT'#9'PARA PUBLIC USE32 '''+ + secnames[lasTSectype]+''''); + AsmStartSize:=AsmSize; end; - end - else - prefix:= ''; - if (target_asm.id = as_i386_wasm) and - (taicpu(hp).opsize=S_W) and - (taicpu(hp).opcode=A_PUSH) and - (taicpu(hp).oper[0]^.typ=top_const) then - begin - AsmWriteln(#9#9'DB 66h,68h ; pushw imm16'); - AsmWrite(#9#9'DW'); - end - else if (target_asm.id=as_x86_64_masm) and - (taicpu(hp).opcode=A_MOVQ) then - AsmWrite(#9#9'mov') - else - AsmWrite(#9#9+prefix+std_op2str[taicpu(hp).opcode]+cond2str[taicpu(hp).condition]+suffix); - if taicpu(hp).ops<>0 then - begin - if is_calljmp(taicpu(hp).opcode) then - begin - AsmWrite(#9); - WriteOper_jmp(taicpu(hp).oper[0]^,taicpu(hp).opsize); - end - else - begin - for i:=0to taicpu(hp).ops-1 do - begin - if i=0 then - AsmWrite(#9) - else - AsmWrite(','); - WriteOper(taicpu(hp).oper[i]^,taicpu(hp).opsize,taicpu(hp).opcode,(i=2)); - end; - end; - end; - AsmLn; - end; - - ait_stab, - ait_force_line, - ait_function_name : ; - - ait_cutobject : - begin - { only reset buffer if nothing has changed } - if AsmSize=AsmStartSize then - AsmClear - else - begin - if LasTSecType<>sec_none then - AsmWriteLn('_'+secnames[LasTSecType]+#9#9'ENDS'); - AsmLn; - AsmWriteLn(#9'END'); - AsmClose; - DoAssemble; - AsmCreate(tai_cutobject(hp).place); - end; - { avoid empty files } - while assigned(hp.next) and (tai(hp.next).typ in [ait_cutobject,ait_section,ait_comment]) do - begin - if tai(hp.next).typ=ait_section then - lasTSecType:=tai_section(hp.next).sectype; - hp:=tai(hp.next); - end; - AsmWriteLn(#9'.386p'); - AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA'); - AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP'); - { I was told that this isn't necesarry because } - { the labels generated by FPC are unique (FK) } - { AsmWriteLn(#9'LOCALS '+target_asm.labelprefix); } - if lasTSectype<>sec_none then - AsmWriteLn('_'+secnames[lasTSectype]+#9#9+ - 'SEGMENT'#9'PARA PUBLIC USE32 '''+ - secnames[lasTSectype]+''''); - AsmStartSize:=AsmSize; - end; ait_marker : begin if tai_marker(hp).kind=InlineStart then @@ -787,24 +737,8 @@ implementation else if tai_marker(hp).kind=InlineEnd then dec(InlineLevel); end; - - ait_directive : - begin - case tai_directive(hp).directive of - asd_nasm_import : - AsmWrite('import '); - asd_extern : - AsmWrite('EXTRN '); - else - internalerror(200509192); - end; - if assigned(tai_directive(hp).name) then - AsmWrite(tai_directive(hp).name^); - AsmLn; - end; - - else - internalerror(10000); + else + internalerror(10000); end; hp:=tai(hp.next); end; @@ -817,32 +751,27 @@ implementation begin if tasmsymbol(p).defbind=AB_EXTERNAL then begin - case target_asm.id of - as_i386_masm,as_i386_wasm: - currentasmlist.AsmWriteln(#9'EXTRN'#9+p.name - +': NEAR'); - as_x86_64_masm: - currentasmlist.AsmWriteln(#9'EXTRN'#9+p.name - +': PROC'); - else - currentasmlist.AsmWriteln(#9'EXTRN'#9+p.name); - end; + if (aktoutputformat in [as_i386_masm,as_i386_wasm]) then + currentasmlist.AsmWriteln(#9'EXTRN'#9+p.name + +': NEAR') + else + currentasmlist.AsmWriteln(#9'EXTRN'#9+p.name); end; end; - procedure tx86IntelAssembler.WriteExternals; + procedure T386IntelAssembler.WriteExternals; begin currentasmlist:=self; objectlibrary.symbolsearch.foreach_static(@writeexternal,nil); end; - function tx86intelassembler.DoAssemble : boolean; + function t386intelassembler.DoAssemble : boolean; var f : file; begin DoAssemble:=Inherited DoAssemble; { masm does not seem to recognize specific extensions and uses .obj allways PM } - if (target_asm.id in [as_i386_masm,as_i386_wasm]) then + if (aktoutputformat in [as_i386_masm,as_i386_wasm]) then begin if not(cs_asm_extern in aktglobalswitches) then begin @@ -859,36 +788,34 @@ implementation end; - procedure tx86IntelAssembler.WriteAsmList; - var - hal : tasmlist; + procedure T386IntelAssembler.WriteAsmList; begin {$ifdef EXTDEBUG} if assigned(current_module.mainsource) then comment(v_info,'Start writing intel-styled assembler output for '+current_module.mainsource^); {$endif} LasTSecType:=sec_none; - if target_asm.id<>as_x86_64_masm then + AsmWriteLn(#9'.386p'); + { masm 6.11 does not seem to like LOCALS PM } + if (aktoutputformat = as_i386_tasm) then begin - AsmWriteLn(#9'.386p'); - { masm 6.11 does not seem to like LOCALS PM } - if (target_asm.id = as_i386_tasm) then - begin - AsmWriteLn(#9'LOCALS '+target_asm.labelprefix); - end; - AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA'); - AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP'); - AsmLn; + AsmWriteLn(#9'LOCALS '+target_asm.labelprefix); end; + AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA'); + AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP'); + AsmLn; WriteExternals; - for hal:=low(Tasmlist) to high(Tasmlist) do - begin - AsmWriteLn(target_asm.comment+'Begin asmlist '+TasmlistStr[hal]); - writetree(asmlist[hal]); - AsmWriteLn(target_asm.comment+'End asmlist '+TasmlistStr[hal]); - end; + { INTEL ASM doesn't support stabs + WriteTree(debuglist);} + + WriteTree(codesegment); + WriteTree(datasegment); + WriteTree(consts); + WriteTree(rttilist); + WriteTree(resourcestringlist); + WriteTree(bsssegment); AsmWriteLn(#9'END'); AsmLn; @@ -941,25 +868,8 @@ implementation comment : '; '; ); - as_x86_64_masm_info : tasminfo = - ( - id : as_x86_64_masm; - idtxt : 'MASM'; - asmbin : 'ml64'; - asmcmd : '/c /Cp $ASM /Fo$OBJ'; - supported_target : system_any; { what should I write here ?? } - flags : [af_allowdirect,af_needar]; - labelprefix : '@@'; - comment : '; '; - ); - initialization -{$ifdef x86_64} - RegisterAssembler(as_x86_64_masm_info,tx86IntelAssembler); -{$endif x86_64} -{$ifdef i386} - RegisterAssembler(as_i386_tasm_info,tx86IntelAssembler); - RegisterAssembler(as_i386_masm_info,tx86IntelAssembler); - RegisterAssembler(as_i386_wasm_info,tx86IntelAssembler); -{$endif i386} + RegisterAssembler(as_i386_tasm_info,T386IntelAssembler); + RegisterAssembler(as_i386_masm_info,T386IntelAssembler); + RegisterAssembler(as_i386_wasm_info,T386IntelAssembler); end. diff --git a/compiler/i386/ag386nsm.pas b/compiler/i386/ag386nsm.pas index 7cda5495c1..682aa8c966 100644 --- a/compiler/i386/ag386nsm.pas +++ b/compiler/i386/ag386nsm.pas @@ -355,10 +355,9 @@ interface procedure T386NasmAssembler.WriteSection(atype:tasmsectiontype;const aname:string); const secnames : array[tasmsectiontype] of string[12] = ('', - '.text','.data','.rodata','.bss','.tbss', + '.text','.data','.rodata','.bss', 'common', '.note', - '.text', '.stab','.stabstr', '.idata2','.idata4','.idata5','.idata6','.idata7','.edata', '.eh_frame', @@ -381,6 +380,9 @@ interface end; procedure T386NasmAssembler.WriteTree(p:taasmoutput); + const + regallocstr : array[tregalloctype] of string[10]=(' allocated',' released',' sync',' resized'); + tempallocstr : array[boolean] of string[10]=(' released',' allocated'); var s : string; hp : tai; @@ -397,10 +399,10 @@ interface if not assigned(p) then exit; InlineLevel:=0; - { lineinfo is only needed for al_procedures (PFV) } + { lineinfo is only needed for codesegment (PFV) } do_line:=(cs_asm_source in aktglobalswitches) or ((cs_lineinfo in aktmoduleswitches) - and (p=asmlist[al_procedures])); + and (p=codesegment)); hp:=tai(p.first); while assigned(hp) do begin @@ -642,6 +644,12 @@ interface AsmWriteLn(tai_label(hp).l.name+':'); end; + ait_direct : + begin + AsmWritePChar(tai_direct(hp).str); + AsmLn; + end; + ait_symbol : begin if tai_symbol(hp).is_global then @@ -711,10 +719,12 @@ interface AsmLn; end; end; - - ait_stab, +{$ifdef GDB} + ait_stabn, + ait_stabs, ait_force_line, - ait_function_name : ; + ait_stab_function_name : ; +{$endif GDB} ait_cutobject : begin @@ -745,21 +755,6 @@ interface else if tai_marker(hp).kind=InlineEnd then dec(InlineLevel); - ait_directive : - begin - case tai_directive(hp).directive of - asd_nasm_import : - AsmWrite('import '); - asd_extern : - AsmWrite('EXTERN '); - else - internalerror(200509191); - end; - if assigned(tai_directive(hp).name) then - AsmWrite(tai_directive(hp).name^); - AsmLn; - end; - else internalerror(10000); end; @@ -785,8 +780,6 @@ interface procedure T386NasmAssembler.WriteAsmList; - var - hal : tasmlist; begin {$ifdef EXTDEBUG} if assigned(current_module.mainsource) then @@ -802,12 +795,21 @@ interface WriteExternals; - for hal:=low(Tasmlist) to high(Tasmlist) do - begin - AsmWriteLn(target_asm.comment+'Begin asmlist '+TasmlistStr[hal]); - writetree(asmlist[hal]); - AsmWriteLn(target_asm.comment+'End asmlist '+TasmlistStr[hal]); - end; + { Nasm doesn't support stabs + WriteTree(debuglist);} + + WriteTree(codesegment); + WriteTree(datasegment); + WriteTree(consts); + WriteTree(rttilist); + WriteTree(resourcestringlist); + WriteTree(bsssegment); + Writetree(importssection); + { exports are written by DLLTOOL + if we use it so don't insert it twice (PM) } + if not UseDeffileForExports and assigned(exportssection) then + Writetree(exportssection); + Writetree(resourcesection); AsmLn; {$ifdef EXTDEBUG} diff --git a/compiler/i386/cgcpu.pas b/compiler/i386/cgcpu.pas index 0a9f58e2a8..57cbe66370 100644 --- a/compiler/i386/cgcpu.pas +++ b/compiler/i386/cgcpu.pas @@ -83,7 +83,7 @@ unit cgcpu; else rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_EBX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP]); rg[R_MMXREGISTER]:=trgcpu.create(R_MMXREGISTER,R_SUBNONE,[RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7],first_mm_imreg,[]); - rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBWHOLE,[RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7],first_mm_imreg,[]); + rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE,[RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7],first_mm_imreg,[]); rgfpu:=Trgx86fpu.create; end; @@ -170,7 +170,7 @@ unit cgcpu; if use_push(cgpara) then begin { Record copy? } - if (cgpara.size in [OS_NO,OS_F64]) or (size=OS_NO) then + if (cgpara.size=OS_NO) or (size=OS_NO) then begin cgpara.check_simple_location; len:=align(cgpara.intsize,cgpara.alignment); @@ -199,25 +199,23 @@ unit cgcpu; begin with r do begin -{$ifndef segment_threadvars} if (segment<>NR_NO) then cgmessage(cg_e_cant_use_far_pointer_there); -{$endif} if use_push(cgpara) then begin cgpara.check_simple_location; opsize:=tcgsize2opsize[OS_ADDR]; - if (segment=NR_NO) and (base=NR_NO) and (index=NR_NO) then + if (base=NR_NO) and (index=NR_NO) then begin if assigned(symbol) then list.concat(Taicpu.Op_sym_ofs(A_PUSH,opsize,symbol,offset)) else list.concat(Taicpu.Op_const(A_PUSH,opsize,offset)); end - else if (segment=NR_NO) and (base=NR_NO) and (index<>NR_NO) and + else if (base=NR_NO) and (index<>NR_NO) and (offset=0) and (scalefactor=0) and (symbol=nil) then list.concat(Taicpu.Op_reg(A_PUSH,opsize,index)) - else if (segment=NR_NO) and (base<>NR_NO) and (index=NR_NO) and + else if (base<>NR_NO) and (index=NR_NO) and (offset=0) and (symbol=nil) then list.concat(Taicpu.Op_reg(A_PUSH,opsize,base)) else @@ -334,8 +332,8 @@ unit cgcpu; { so we have to access every page first } if target_info.system=system_i386_win32 then begin - objectlibrary.getjumplabel(again); - objectlibrary.getjumplabel(ok); + objectlibrary.getlabel(again); + objectlibrary.getlabel(ok); a_label(list,again); list.concat(Taicpu.op_const_reg(A_CMP,S_L,winstackpagesize,NR_EDI)); a_jmp_cond(list,OC_B,ok); diff --git a/compiler/i386/cpunode.pas b/compiler/i386/cpunode.pas index 857a2241a3..02abe520eb 100644 --- a/compiler/i386/cpunode.pas +++ b/compiler/i386/cpunode.pas @@ -45,11 +45,11 @@ unit cpunode; after the generic one (FK) } nx86set, - nx86con, nx86cnv, n386add, n386cal, + n386con, n386mem, n386set, n386inl, diff --git a/compiler/i386/cpupara.pas b/compiler/i386/cpupara.pas index 05e55b6c9c..0b9dfc164b 100644 --- a/compiler/i386/cpupara.pas +++ b/compiler/i386/cpupara.pas @@ -111,19 +111,6 @@ unit cpupara; end; end; end; - system_i386_darwin : - begin - case def.deftype of - recorddef : - begin - if (def.size <= 8) then - begin - result := false; - exit; - end; - end; - end; - end; end; result:=inherited ret_in_param(def,calloption); end; @@ -417,23 +404,14 @@ unit cpupara; internalerror(200501163); while (paralen>0) do begin + { We can allocate at maximum 32 bits per location } + if paralen>sizeof(aint) then + l:=sizeof(aint) + else + l:=paralen; paraloc:=hp.paraloc[side].add_location; paraloc^.loc:=LOC_REFERENCE; - { single and double need a single location } - if (paracgsize in [OS_F64,OS_F32]) then - begin - paraloc^.size:=paracgsize; - l:=paralen; - end - else - begin - { We can allocate at maximum 32 bits per location } - if paralen>sizeof(aint) then - l:=sizeof(aint) - else - l:=paralen; - paraloc^.size:=int_cgsize(l); - end; + paraloc^.size:=int_cgsize(l); if side=callerside then paraloc^.reference.index:=NR_STACK_POINTER_REG else @@ -530,23 +508,14 @@ unit cpupara; internalerror(200501163); while (paralen>0) do begin + { We can allocate at maximum 32 bits per location } + if paralen>sizeof(aint) then + l:=sizeof(aint) + else + l:=paralen; paraloc:=hp.paraloc[side].add_location; paraloc^.loc:=LOC_REFERENCE; - { Extended and double need a single location } - if (paracgsize in [OS_F64,OS_F32]) then - begin - paraloc^.size:=paracgsize; - l:=paralen; - end - else - begin - { We can allocate at maximum 32 bits per location } - if paralen>sizeof(aint) then - l:=sizeof(aint) - else - l:=paralen; - paraloc^.size:=int_cgsize(l); - end; + paraloc^.size:=int_cgsize(l); if side=callerside then paraloc^.reference.index:=NR_STACK_POINTER_REG else diff --git a/compiler/i386/cpupi.pas b/compiler/i386/cpupi.pas index c714ef0791..bd5e882e96 100644 --- a/compiler/i386/cpupi.pas +++ b/compiler/i386/cpupi.pas @@ -41,7 +41,7 @@ unit cpupi; uses cutils, - systems,globals, + globals, tgobj, cpubase; @@ -56,10 +56,7 @@ unit cpupi; begin { align to 4 bytes at least otherwise all those subl $2,%esp are meaningless PM } - if (target_info.system <> system_i386_darwin) then - result:=Align(tg.direction*tg.lasttemp,min(aktalignment.localalignmin,4)) - else - result:=Align(tg.direction*tg.lasttemp,min(aktalignment.localalignmin,16)); + result:=Align(tg.direction*tg.lasttemp,min(aktalignment.localalignmin,4)); end; diff --git a/compiler/i386/cputarg.pas b/compiler/i386/cputarg.pas index ebad2d1290..133a6056fd 100644 --- a/compiler/i386/cputarg.pas +++ b/compiler/i386/cputarg.pas @@ -50,8 +50,8 @@ implementation {$ifndef NOTARGETOS2} ,t_os2 {$endif} - {$ifndef NOTARGETWIN} - ,t_win + {$ifndef NOTARGETWIN32} + ,t_win32 {$endif} {$ifndef NOTARGETNETWARE} ,t_nwm @@ -83,34 +83,11 @@ implementation ,ag386nsm {$endif} {$ifndef NOAG386INT} - ,agx86int + ,ag386int {$endif} ,ogcoff ,ogelf - -{************************************** - Assembler Readers -**************************************} - - {$ifndef NoRa386Int} - ,ra386int - {$endif NoRa386Int} - {$ifndef NoRa386Att} - ,ra386att - {$endif NoRa386Att} - -{************************************** - Debuginfo -**************************************} - - {$ifndef NoDbgStabs} - ,dbgstabs - {$endif NoDbgStabs} - {$ifndef NoDbgDwarf} - ,dbgdwarf - {$endif NoDbgDwarf} - ; end. diff --git a/compiler/i386/csopt386.pas b/compiler/i386/csopt386.pas index 4ced3a816a..b22a3461f8 100644 --- a/compiler/i386/csopt386.pas +++ b/compiler/i386/csopt386.pas @@ -1026,11 +1026,19 @@ begin if getLastInstruction(hp,prev) then with ptaiprop(prev.optinfo)^ do begin - newOrgRegRState := byte(longint(regs[orgReg].rState) + - longint(ptaiprop(hp.optinfo)^.regs[newReg].rState) - regs[newReg].rstate); +{$ifopt r+} +{$define rangeon} +{$r-} +{$endif} + newOrgRegRState := regs[orgReg].rState + + ptaiprop(hp.optinfo)^.regs[newReg].rState - regs[newReg].rstate; if writeStateToo then - newOrgRegWState := byte(longint(regs[orgReg].wState) + - longint(ptaiprop(hp.optinfo)^.regs[newReg].wState) - regs[newReg].wstate); + newOrgRegWState := regs[orgReg].wState + + ptaiprop(hp.optinfo)^.regs[newReg].wState - regs[newReg].wstate; +{$ifdef rangeon} +{$undef rangeon} +{$r+} +{$endif} end else with ptaiprop(hp.optinfo)^.regs[newReg] do diff --git a/compiler/i386/daopt386.pas b/compiler/i386/daopt386.pas index 7c08d9f667..047ce79cc0 100644 --- a/compiler/i386/daopt386.pas +++ b/compiler/i386/daopt386.pas @@ -57,8 +57,7 @@ const OS_F32,OS_F64,OS_F80,OS_C64,OS_F128, OS_M32, OS_ADDR,OS_NO,OS_NO, - OS_NO, - OS_NO); + OS_NO,OS_NO); @@ -1090,7 +1089,7 @@ end; function labelCanBeSkipped(p: tai_label): boolean; begin - labelCanBeSkipped := not(p.l.is_used) or (p.l.labeltype<>alt_jump); + labelCanBeSkipped := not(p.l.is_used) or p.l.is_addr; end; {******************* The Data Flow Analyzer functions ********************} @@ -1130,7 +1129,7 @@ begin ((p.typ in (SkipInstr - [ait_RegAlloc])) or ((p.typ = ait_label) and labelCanBeSkipped(tai_label(p))) or - ((p.typ = ait_marker) and + ((p.typ = ait_marker) and (tai_Marker(p).Kind in [AsmBlockend,inlinestart,inlineend]))) do p := tai(p.next); while assigned(p) and @@ -2366,7 +2365,9 @@ begin end; {$endif JumpAnal} - ait_stab, ait_force_line, ait_function_name:; +{$ifdef GDB} + ait_stabs, ait_stabn, ait_stab_function_name:; +{$endif GDB} ait_align: ; { may destroy flags !!! } ait_instruction: begin diff --git a/compiler/i386/i386int.inc b/compiler/i386/i386int.inc index 428a64f8cf..e3e7264834 100644 --- a/compiler/i386/i386int.inc +++ b/compiler/i386/i386int.inc @@ -565,5 +565,5 @@ 'movsldup', 'movabs', 'movsxd', -'cqo' +'cdo' ); diff --git a/compiler/i386/i386op.inc b/compiler/i386/i386op.inc index 4c011681b0..f4688a72f3 100644 --- a/compiler/i386/i386op.inc +++ b/compiler/i386/i386op.inc @@ -565,5 +565,5 @@ A_MOVSHDUP, A_MOVSLDUP, A_MOVABS, A_MOVSXD, -A_CQO +A_CDO ); diff --git a/compiler/i386/i386prop.inc b/compiler/i386/i386prop.inc index df064ad42e..8b2c1bd6ec 100644 --- a/compiler/i386/i386prop.inc +++ b/compiler/i386/i386prop.inc @@ -215,11 +215,11 @@ (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), @@ -383,10 +383,6 @@ (Ch: (Ch_ROp1, Ch_WOp2, Ch_RFLAGS)), (Ch: (Ch_None, Ch_None, Ch_None)), (Ch: (Ch_RFLAGS, Ch_WOp1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), @@ -412,8 +408,6 @@ (Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), (Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), (Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), @@ -426,21 +420,27 @@ (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), -(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), @@ -493,10 +493,6 @@ (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), @@ -530,8 +526,6 @@ (Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), (Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), (Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), @@ -541,14 +535,20 @@ (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), diff --git a/compiler/i386/n386add.pas b/compiler/i386/n386add.pas index 92e9ef29ea..67a710fe0a 100644 --- a/compiler/i386/n386add.pas +++ b/compiler/i386/n386add.pas @@ -168,7 +168,7 @@ interface begin if cs_check_overflow in aktlocalswitches then begin - objectlibrary.getjumplabel(hl4); + objectlibrary.getlabel(hl4); if unsigned then cg.a_jmp_flags(exprasmlist,F_AE,hl4) else @@ -364,7 +364,7 @@ interface emit_reg(A_MUL,S_L,r); if cs_check_overflow in aktlocalswitches then begin - objectlibrary.getjumplabel(hl4); + objectlibrary.getlabel(hl4); cg.a_jmp_flags(exprasmlist,F_AE,hl4); cg.a_call_name(exprasmlist,'FPC_OVERFLOW'); cg.a_label(exprasmlist,hl4); diff --git a/compiler/x86/nx86con.pas b/compiler/i386/n386con.pas index 123f94cde8..d2389b6702 100644 --- a/compiler/x86/nx86con.pas +++ b/compiler/i386/n386con.pas @@ -19,7 +19,7 @@ **************************************************************************** } -unit nx86con; +unit n386con; {$i fpcdefs.inc} @@ -29,7 +29,7 @@ interface node,ncon,ncgcon; type - tx86realconstnode = class(tcgrealconstnode) + ti386realconstnode = class(tcgrealconstnode) function pass_1 : tnode;override; procedure pass_2;override; end; @@ -38,7 +38,6 @@ implementation uses systems,globals, - symdef, defutil, cpubase, cga,cgx86,cgobj,cgbase,cgutils; @@ -47,10 +46,10 @@ implementation TI386REALCONSTNODE *****************************************************************************} - function tx86realconstnode.pass_1 : tnode; + function ti386realconstnode.pass_1 : tnode; begin result:=nil; - if is_number_float(value_real) and not(use_sse(resulttype.def)) and (value_real=1.0) or (value_real=0.0) then + if is_number_float(value_real) and (value_real=1.0) or (value_real=0.0) then begin expectloc:=LOC_FPUREGISTER; registersfpu:=1; @@ -59,19 +58,19 @@ implementation expectloc:=LOC_CREFERENCE; end; - procedure tx86realconstnode.pass_2; + procedure ti386realconstnode.pass_2; begin if is_number_float(value_real) then begin - if (value_real=1.0) and not(use_sse(resulttype.def)) then + if (value_real=1.0) then begin emit_none(A_FLD1,S_NO); location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def)); location.register:=NR_ST; tcgx86(cg).inc_fpu_stack; end - else if (value_real=0.0) and not(use_sse(resulttype.def)) then + else if (value_real=0.0) then begin emit_none(A_FLDZ,S_NO); location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def)); @@ -87,5 +86,5 @@ implementation begin - crealconstnode:=tx86realconstnode; + crealconstnode:=ti386realconstnode; end. diff --git a/compiler/i386/n386mat.pas b/compiler/i386/n386mat.pas index 8135b95f88..1a740dad79 100644 --- a/compiler/i386/n386mat.pas +++ b/compiler/i386/n386mat.pas @@ -113,7 +113,7 @@ implementation begin { a jump, but less operations } emit_reg_reg(A_TEST,S_L,hreg1,hreg1); - objectlibrary.getjumplabel(hl); + objectlibrary.getlabel(hl); cg.a_jmp_flags(exprasmlist,F_NS,hl); if power=1 then emit_reg(A_INC,S_L,hreg1) @@ -253,9 +253,9 @@ implementation { the damned shift instructions work only til a count of 32 } { so we've to do some tricks here } - objectlibrary.getjumplabel(l1); - objectlibrary.getjumplabel(l2); - objectlibrary.getjumplabel(l3); + objectlibrary.getlabel(l1); + objectlibrary.getlabel(l2); + objectlibrary.getlabel(l3); emit_const_reg(A_CMP,S_L,64,NR_ECX); cg.a_jmp_flags(exprasmlist,F_L,l1); emit_reg_reg(A_XOR,S_L,hreg64lo,hreg64lo); diff --git a/compiler/i386/n386set.pas b/compiler/i386/n386set.pas index 9a52860b36..1d2ff6a92f 100644 --- a/compiler/i386/n386set.pas +++ b/compiler/i386/n386set.pas @@ -82,24 +82,30 @@ implementation last : TConstExprInt; indexreg : tregister; href : treference; + jumpsegment : TAAsmOutput; - procedure genitem(list:taasmoutput;t : pcaselabel); + procedure genitem(t : pcaselabel); var i : aint; begin if assigned(t^.less) then - genitem(list,t^.less); + genitem(t^.less); { fill possible hole } for i:=last+1 to t^._low-1 do - list.concat(Tai_const.Create_sym(elselabel)); + jumpSegment.concat(Tai_const.Create_sym(elselabel)); for i:=t^._low to t^._high do - list.concat(Tai_const.Create_sym(blocklabel(t^.blockid))); + jumpSegment.concat(Tai_const.Create_sym(blocklabel(t^.blockid))); last:=t^._high; if assigned(t^.greater) then - genitem(list,t^.greater); + genitem(t^.greater); end; begin + if (cs_create_smart in aktmoduleswitches) or + (af_smartlink_sections in target_asm.flags) then + jumpsegment:=current_procinfo.aktlocaldata + else + jumpsegment:=datasegment; if not(jumptable_no_range) then begin { case expr less than min_ => goto elselabel } @@ -107,7 +113,7 @@ implementation { case expr greater than max_ => goto elselabel } cg.a_cmp_const_reg_label(exprasmlist,opsize,jmp_gt,aint(max_),hregister,elselabel); end; - objectlibrary.getjumplabel(table); + objectlibrary.getlabel(table); { make it a 32bit register } indexreg:=cg.makeregsize(exprasmlist,hregister,OS_INT); cg.a_load_reg_reg(exprasmlist,opsize,OS_INT,hregister,indexreg); @@ -118,10 +124,11 @@ implementation href.scalefactor:=4; emit_ref(A_JMP,S_NO,href); { generate jump table } - new_section(current_procinfo.aktlocaldata,sec_data,current_procinfo.procdef.mangledname,sizeof(aint)); - current_procinfo.aktlocaldata.concat(Tai_label.Create(table)); + if not(cs_littlesize in aktglobalswitches) then + jumpSegment.concat(Tai_Align.Create_Op(4,0)); + jumpSegment.concat(Tai_label.Create(table)); last:=min_; - genitem(current_procinfo.aktlocaldata,hp); + genitem(hp); end; diff --git a/compiler/i386/popt386.pas b/compiler/i386/popt386.pas index b38be5e40d..db6218ad84 100644 --- a/compiler/i386/popt386.pas +++ b/compiler/i386/popt386.pas @@ -507,7 +507,7 @@ var insertllitem(asml,p1,p1.next,tai_comment.Create( strpnew('previous label inserted')))); {$endif finaldestdebug} - objectlibrary.getjumplabel(l); + objectlibrary.getlabel(l); insertllitem(asml,p1,p1.next,tai_label.Create(l)); tasmlabel(taicpu(hp).oper[0]^.ref^.symbol).decrefs; hp.oper[0]^.ref^.symbol := l; diff --git a/compiler/m68k/aasmcpu.pas b/compiler/m68k/aasmcpu.pas index 924b089d83..ce420e95d4 100644 --- a/compiler/m68k/aasmcpu.pas +++ b/compiler/m68k/aasmcpu.pas @@ -27,7 +27,7 @@ interface uses cclasses,aasmtai, - aasmbase,globals,verbose,symtype, + aasmbase,globals,verbose, cpubase,cpuinfo,cgbase,cgutils; @@ -40,7 +40,6 @@ type taicpu = class(tai_cpu_abstract) opsize : topsize; - constructor op_none(op : tasmop); constructor op_none(op : tasmop;_size : topsize); constructor op_reg(op : tasmop;_size : topsize;_op1 : tregister); @@ -82,9 +81,6 @@ type constructor op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint); constructor op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference); - function is_same_reg_move(regtype: Tregistertype):boolean;override; - function spilling_get_operation_type(opnr: longint): topertype;override; - private procedure loadregset(opidx:longint;const s:tcpuregisterset); procedure init(_size : topsize); { this need to be called by all constructor } @@ -148,13 +144,6 @@ type end; - constructor taicpu.op_none(op : tasmop); - begin - inherited create(op); - init(S_NO); - end; - - constructor taicpu.op_none(op : tasmop;_size : topsize); begin inherited create(op); @@ -428,54 +417,9 @@ type end; - function taicpu.is_same_reg_move(regtype: Tregistertype):boolean; - begin - result:=(((opcode=A_MOVE) or (opcode=A_EXG)) and - (regtype = R_INTREGISTER) and - (ops=2) and - (oper[0]^.typ=top_reg) and - (oper[1]^.typ=top_reg) and - (oper[0]^.reg=oper[1]^.reg) - ) or - ((opcode=A_FMOVE) and - (regtype = R_FPUREGISTER) and - (ops=2) and - (oper[0]^.typ=top_reg) and - (oper[1]^.typ=top_reg) and - (oper[0]^.reg=oper[1]^.reg) - ); - end; - - - function taicpu.spilling_get_operation_type(opnr: longint): topertype; - begin - case opcode of - A_MOVE, A_MOVEQ, A_ADD, A_ADDQ, A_SUB, A_SUBQ: - if opnr=0 then begin -// writeln('move/etc write'); - result:=operand_write; - end else begin -// writeln('move/etc read'); - result:=operand_read; - end; - else - writeln('other opcode: ',dword(opcode),' (faked value returned)',opnr); - result:=operand_write; - end; - // fake - -// internalerror(200404091); - end; - function spilling_create_load(const ref:treference;r:tregister): tai; begin -// writeln('spilling_create_load'); - case getregtype(r) of - R_INTREGISTER : - result:=taicpu.op_ref_reg(A_MOVE,S_L,ref,r); - R_FPUREGISTER : begin end; - end; -{ + { case getregtype(r) of R_INTREGISTER : result:=taicpu.op_ref_reg(A_LD,ref,r); @@ -492,22 +436,12 @@ type end else internalerror(200401041); - end; - } + end;} end; function spilling_create_store(r:tregister; const ref:treference): tai; begin -// writeln('spilling_create_store'); - case getregtype(r) of - R_INTREGISTER : - result:=taicpu.op_reg_ref(A_MOVE,S_L,r,ref); - R_FPUREGISTER : - begin -// result:=taicpu.op_reg_ref(A_FMOVE,R_SUBFS,r,ref); - end; - end; {case getregtype(r) of R_INTREGISTER : result:=taicpu.op_reg_ref(A_ST,r,ref); diff --git a/compiler/m68k/agcpugas.pas b/compiler/m68k/agcpugas.pas index f6ab696ca3..f93ee60d07 100644 --- a/compiler/m68k/agcpugas.pas +++ b/compiler/m68k/agcpugas.pas @@ -199,7 +199,7 @@ interface end else getopstr:=getreferencestring(o.ref^); - top_regset: + top_reglist: begin hs:=''; for i:=RS_D0 to RS_D7 do diff --git a/compiler/m68k/cgcpu.pas b/compiler/m68k/cgcpu.pas index 8142c3cb9e..f3c849ec91 100644 --- a/compiler/m68k/cgcpu.pas +++ b/compiler/m68k/cgcpu.pas @@ -88,8 +88,8 @@ unit cgcpu; end; tcg64f68k = class(tcg64f32) - procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG; size: tcgsize; regsrc,regdst : tregister64);override; - procedure a_op64_const_reg(list : taasmoutput;op:TOpCG; size: tcgsize; value : int64;regdst : tregister64);override; + procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);override; + procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;value : int64;regdst : tregister64);override; end; { This function returns true if the reference+offset is valid. @@ -886,16 +886,14 @@ unit cgcpu; begin popaddress := false; -// writeln('concatcopy:',len); - { this should never occur } if len > 65535 then internalerror(0); - - hregister := getintregister(list,OS_INT); + hregister := cg.getintregister(list,OS_INT); // if delsource then // reference_release(list,source); + { from 12 bytes movs is being used } if {(not loadref) and} ((len<=8) or (not(cs_littlesize in aktglobalswitches) and (len<=12))) then begin @@ -905,8 +903,8 @@ unit cgcpu; { move a dword x times } for i:=1 to helpsize do begin - a_load_ref_reg(list,OS_INT,OS_INT,srcref,hregister); - a_load_reg_ref(list,OS_INT,OS_INT,hregister,dstref); + cg.a_load_ref_reg(list,OS_INT,OS_INT,srcref,hregister); + cg.a_load_reg_ref(list,OS_INT,OS_INT,hregister,dstref); inc(srcref.offset,4); inc(dstref.offset,4); dec(len,4); @@ -914,8 +912,8 @@ unit cgcpu; { move a word } if len>1 then begin - a_load_ref_reg(list,OS_16,OS_16,srcref,hregister); - a_load_reg_ref(list,OS_16,OS_16,hregister,dstref); + cg.a_load_ref_reg(list,OS_16,OS_16,srcref,hregister); + cg.a_load_reg_ref(list,OS_16,OS_16,hregister,dstref); inc(srcref.offset,2); inc(dstref.offset,2); dec(len,2); @@ -923,14 +921,14 @@ unit cgcpu; { move a single byte } if len>0 then begin - a_load_ref_reg(list,OS_8,OS_8,srcref,hregister); - a_load_reg_ref(list,OS_8,OS_8,hregister,dstref); + cg.a_load_ref_reg(list,OS_8,OS_8,srcref,hregister); + cg.a_load_reg_ref(list,OS_8,OS_8,hregister,dstref); end end else begin - iregister:=getaddressregister(list); - jregister:=getaddressregister(list); + iregister:=cg.getaddressregister(list); + jregister:=cg.getaddressregister(list); { reference for move (An)+,(An)+ } reference_reset(hp1); hp1.base := iregister; { source register } @@ -944,9 +942,9 @@ unit cgcpu; { if loadref then cg.a_load_ref_reg(list,OS_INT,OS_INT,source,iregister) else} - a_loadaddr_ref_reg(list,source,iregister); + cg.a_loadaddr_ref_reg(list,source,iregister); - a_loadaddr_ref_reg(list,dest,jregister); + cg.a_loadaddr_ref_reg(list,dest,jregister); { double word move only on 68020+ machines } { because of possible alignment problems } @@ -956,12 +954,12 @@ unit cgcpu; helpsize := len - len mod 4; len := len mod 4; list.concat(taicpu.op_const_reg(A_MOVE,S_L,helpsize div 4,hregister)); - objectlibrary.getjumplabel(hl2); - a_jmp_always(list,hl2); - objectlibrary.getjumplabel(hl); - a_label(list,hl); + objectlibrary.getlabel(hl2); + cg.a_jmp_always(list,hl2); + objectlibrary.getlabel(hl); + cg.a_label(list,hl); list.concat(taicpu.op_ref_ref(A_MOVE,S_L,hp1,hp2)); - a_label(list,hl2); + cg.a_label(list,hl2); list.concat(taicpu.op_reg_sym(A_DBRA,S_L,hregister,hl)); if len > 1 then begin @@ -976,18 +974,18 @@ unit cgcpu; { Fast 68010 loop mode with no possible alignment problems } helpsize := len; list.concat(taicpu.op_const_reg(A_MOVE,S_L,helpsize,hregister)); - objectlibrary.getjumplabel(hl2); - a_jmp_always(list,hl2); - objectlibrary.getjumplabel(hl); - a_label(list,hl); + objectlibrary.getlabel(hl2); + cg.a_jmp_always(list,hl2); + objectlibrary.getlabel(hl); + cg.a_label(list,hl); list.concat(taicpu.op_ref_ref(A_MOVE,S_B,hp1,hp2)); - a_label(list,hl2); + cg.a_label(list,hl2); list.concat(taicpu.op_reg_sym(A_DBRA,S_L,hregister,hl)); end; { restore the registers that we have just used olny if they are used! } - ungetcpuregister(list, iregister); - ungetcpuregister(list, jregister); + cg.ungetcpuregister(list, iregister); + cg.ungetcpuregister(list, jregister); if jregister = NR_A1 then hp2.base := NR_NO; if iregister = NR_A0 then @@ -999,8 +997,7 @@ unit cgcpu; // if delsource then // tg.ungetiftemp(list,source); -// Not needed? (KB) -// ungetcpuregister(list,hregister); + cg.ungetcpuregister(list,hregister); end; procedure tcg68k.g_overflowcheck(list: taasmoutput; const l:tlocation; def:tdef); @@ -1096,8 +1093,8 @@ unit cgcpu; { restore the PC counter (push it on the stack) } reference_reset_base(ref,NR_STACK_POINTER_REG,0); ref.direction:=dir_dec; - cg.a_reg_alloc(list,hregister); list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hregister,ref)); + cg.a_reg_alloc(list,hregister); list.concat(taicpu.op_none(A_RTS,S_NO)); end; end; @@ -1203,7 +1200,7 @@ unit cgcpu; {****************************************************************************} { TCG64F68K } {****************************************************************************} - procedure tcg64f68k.a_op64_reg_reg(list : taasmoutput;op:TOpCG;size: tcgsize; regsrc,regdst : tregister64); + procedure tcg64f68k.a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64); var hreg1, hreg2 : tregister; opcode : tasmop; @@ -1265,7 +1262,7 @@ unit cgcpu; end; - procedure tcg64f68k.a_op64_const_reg(list : taasmoutput;op:TOpCG;size: tcgsize; value : int64;regdst : tregister64); + procedure tcg64f68k.a_op64_const_reg(list : taasmoutput;op:TOpCG;value : int64;regdst : tregister64); var lowvalue : cardinal; highvalue : cardinal; diff --git a/compiler/m68k/cpubase.pas b/compiler/m68k/cpubase.pas index c378fdb086..9fcc0b619a 100644 --- a/compiler/m68k/cpubase.pas +++ b/compiler/m68k/cpubase.pas @@ -108,7 +108,7 @@ unit cpubase; { Available Superregisters } {$i r68ksup.inc} - { ? whatever... } + { No Subregisters } R_SUBWHOLE = R_SUBNONE; { Available Registers } @@ -256,21 +256,19 @@ unit cpubase; NR_STACK_POINTER_REG = NR_SP; RS_STACK_POINTER_REG = RS_SP; {# Frame pointer register } -{$warning FIX ME!!! frame pointer is A5 on Amiga, but A6 on unixes?} - NR_FRAME_POINTER_REG = NR_A5; - RS_FRAME_POINTER_REG = RS_A5; + NR_FRAME_POINTER_REG = NR_A6; + RS_FRAME_POINTER_REG = RS_A6; {# Register for addressing absolute data in a position independant way, such as in PIC code. The exact meaning is ABI specific. For further information look at GCC source : PIC_OFFSET_TABLE_REGNUM } -{$warning FIX ME!!! pic offset reg conflicts with frame pointer?} NR_PIC_OFFSET_REG = NR_A5; { Return address for DWARF } {$warning TODO just a guess!} NR_RETURN_ADDRESS_REG = NR_A0; { Results are returned in this register (32-bit values) } NR_FUNCTION_RETURN_REG = NR_D0; - RS_FUNCTION_RETURN_REG = RS_D0; + RS_FUNCTION_RETURN_REG = NR_D0; { Low part of 64bit return value } NR_FUNCTION_RETURN64_LOW_REG = NR_D0; RS_FUNCTION_RETURN64_LOW_REG = RS_D0; @@ -406,11 +404,11 @@ implementation begin case s of OS_8,OS_S8: - cgsize2subreg:=R_SUBWHOLE; + cgsize2subreg:=R_SUBL; OS_16,OS_S16: - cgsize2subreg:=R_SUBWHOLE; + cgsize2subreg:=R_SUBW; OS_32,OS_S32: - cgsize2subreg:=R_SUBWHOLE; + cgsize2subreg:=R_SUBD; else internalerror(200301231); end; diff --git a/compiler/m68k/cpupara.pas b/compiler/m68k/cpupara.pas index 579009fdde..3ee882dcf0 100644 --- a/compiler/m68k/cpupara.pas +++ b/compiler/m68k/cpupara.pas @@ -30,8 +30,8 @@ unit cpupara; uses globtype, cpubase, - symconst,symtype,symdef,symsym, - parabase,paramgr,cgbase; + symconst,symdef,symsym, + parabase,paramgr; type { Returns the location for the nr-st 32 Bit int parameter @@ -42,12 +42,7 @@ unit cpupara; tm68kparamanager = class(tparamanager) procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara);override; function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override; - function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override; private - procedure init_values(var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword); - function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist; - var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword):longint; - procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee); function parseparaloc(p : tparavarsym;const s : string) : boolean;override; end; @@ -57,7 +52,7 @@ unit cpupara; verbose, globals, systems, - cpuinfo,cgutils, + cpuinfo,cgbase, defutil; procedure tm68kparamanager.getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara); @@ -81,320 +76,43 @@ unit cpupara; end; end; - function getparaloc(p : tdef) : tcgloc; - - begin - { Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER - if push_addr_param for the def is true - } - case p.deftype of - orddef: - result:=LOC_REGISTER; - floatdef: - result:=LOC_FPUREGISTER; - enumdef: - result:=LOC_REGISTER; - pointerdef: - result:=LOC_REGISTER; - formaldef: - result:=LOC_REGISTER; - classrefdef: - result:=LOC_REGISTER; - recorddef: - if (target_info.abi<>abi_powerpc_aix) then - result:=LOC_REFERENCE - else - result:=LOC_REGISTER; - objectdef: - if is_object(p) then - result:=LOC_REFERENCE - else - result:=LOC_REGISTER; - stringdef: - if is_shortstring(p) or is_longstring(p) then - result:=LOC_REFERENCE - else - result:=LOC_REGISTER; - procvardef: - if (po_methodpointer in tprocvardef(p).procoptions) then - result:=LOC_REFERENCE - else - result:=LOC_REGISTER; - filedef: - result:=LOC_REGISTER; - arraydef: - result:=LOC_REFERENCE; - setdef: - if is_smallset(p) then - result:=LOC_REGISTER - else - result:=LOC_REFERENCE; - variantdef: - result:=LOC_REFERENCE; - { avoid problems with errornous definitions } - errordef: - result:=LOC_REGISTER; - else - internalerror(2002071001); - end; - end; - - -{$warning copied from ppc cg, needs work} - function tm68kparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean; - begin - result:=false; - { var,out always require address } - if varspez in [vs_var,vs_out] then - begin - result:=true; - exit; - end; - case def.deftype of - variantdef, - formaldef : - result:=true; - recorddef: - result:=true; - arraydef: - result:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or - is_open_array(def) or - is_array_of_const(def) or - is_array_constructor(def); - objectdef : - result:=is_object(def); - setdef : - result:=(tsetdef(def).settype<>smallset); - stringdef : - result:=tstringdef(def).string_typ in [st_shortstring,st_longstring]; - procvardef : - result:=po_methodpointer in tprocvardef(def).procoptions; - end; - end; - - procedure tm68kparamanager.init_values(var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword); - begin - cur_stack_offset:=8; - curintreg:=RS_D0; - curfloatreg:=RS_FP0; - end; - - procedure tm68kparamanager.create_funcretloc_info(p: tabstractprocdef; side: tcallercallee); - var - retcgsize: tcgsize; - begin - { Constructors return self instead of a boolean } - if (p.proctypeoption=potype_constructor) then - retcgsize:=OS_ADDR - else - retcgsize:=def_cgsize(p.rettype.def); - - location_reset(p.funcretloc[side],LOC_INVALID,OS_NO); - { void has no location } - if is_void(p.rettype.def) then - begin - location_reset(p.funcretloc[side],LOC_VOID,OS_NO); - exit; - end; - { Return in FPU register? } - if p.rettype.def.deftype=floatdef then - begin - p.funcretloc[side].loc:=LOC_FPUREGISTER; - p.funcretloc[side].register:=NR_FPU_RESULT_REG; - p.funcretloc[side].size:=retcgsize; - end - else - { Return in register? } - if not ret_in_param(p.rettype.def,p.proccalloption) then - begin - if retcgsize in [OS_64,OS_S64] then - begin - { low 32bits } - p.funcretloc[side].loc:=LOC_REGISTER; - p.funcretloc[side].size:=OS_64; - if side=callerside then - p.funcretloc[side].register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG - else - p.funcretloc[side].register64.reglo:=NR_FUNCTION_RETURN64_LOW_REG; - { high 32bits } - if side=calleeside then - p.funcretloc[side].register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG - else - p.funcretloc[side].register64.reghi:=NR_FUNCTION_RETURN64_HIGH_REG; - end - else - begin - p.funcretloc[side].loc:=LOC_REGISTER; - p.funcretloc[side].size:=retcgsize; - if side=callerside then - p.funcretloc[side].register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(retcgsize)) - else - p.funcretloc[side].register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(retcgsize)); - end; - end - else - begin - p.funcretloc[side].loc:=LOC_REFERENCE; - p.funcretloc[side].size:=retcgsize; - end; - end; function tm68kparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint; var - cur_stack_offset: aword; - curintreg, curfloatreg: tsuperregister; - begin - init_values(curintreg,curfloatreg,cur_stack_offset); - - result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,cur_stack_offset); - - create_funcretloc_info(p,side); - end; - - function tm68kparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist; - var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword):longint; - var paraloc : pcgparalocation; hp : tparavarsym; paracgsize : tcgsize; - paralen : aint; + paralen : longint; parasize : longint; - paradef : tdef; i : longint; - loc : tcgloc; - nextintreg, - nextfloatreg : tsuperregister; - stack_offset : longint; - begin - result:=0; - nextintreg:=curintreg; - nextfloatreg:=curfloatreg; - stack_offset:=cur_stack_offset; - parasize:=0; - for i:=0 to p.paras.count-1 do begin - hp:=tparavarsym(paras[i]); - paradef:=hp.vartype.def; - - { syscall for AmigaOS can have already a paraloc set } - if (vo_has_explicit_paraloc in hp.varoptions) then - begin - if not(vo_is_syscall_lib in hp.varoptions) then - internalerror(200506051); - continue; - end; + hp:=tparavarsym(p.paras[i]); + hp.paraloc[side].reset; - { currently only support C-style array of const } if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) and - is_array_of_const(paradef) then + is_array_of_const(hp.vartype.def) then begin paraloc:=hp.paraloc[side].add_location; { hack: the paraloc must be valid, but is not actually used } - paraloc^.loc:=LOC_REGISTER; - paraloc^.register:=NR_D0; + paraloc^.loc:=LOC_REFERENCE; + if side=callerside then + paraloc^.reference.index:=NR_STACK_POINTER_REG + else + paraloc^.reference.index:=NR_FRAME_POINTER_REG; paraloc^.size:=OS_ADDR; + paraloc^.reference.offset:=0; break; end; - if (hp.varspez in [vs_var,vs_out]) or - push_addr_param(hp.varspez,paradef,p.proccalloption) or - is_open_array(paradef) or - is_array_of_const(paradef) then - begin - paradef:=voidpointertype.def; - loc:=LOC_REGISTER; - paracgsize := OS_ADDR; - paralen := tcgsize2size[OS_ADDR]; - end - else - begin - if not is_special_array(paradef) then - paralen:=paradef.size - else - paralen:=tcgsize2size[def_cgsize(paradef)]; - - loc:=getparaloc(paradef); - paracgsize:=def_cgsize(paradef); - { for things like formaldef } - if (paracgsize=OS_NO) then - begin - paracgsize:=OS_ADDR; - paralen := tcgsize2size[OS_ADDR]; - end; - end; - hp.paraloc[side].alignment:=std_param_align; - hp.paraloc[side].size:=paracgsize; - hp.paraloc[side].intsize:=paralen; - - if (paralen = 0) then - if (paradef.deftype = recorddef) then - begin - paraloc:=hp.paraloc[side].add_location; - paraloc^.loc := LOC_VOID; - end - else - internalerror(200506052); - { can become < 0 for e.g. 3-byte records } - while (paralen > 0) do - begin - paraloc:=hp.paraloc[side].add_location; - if (loc = LOC_REGISTER) and - (nextintreg <= RS_D7) then - begin - //writeln('loc register'); - paraloc^.loc := loc; - { make sure we don't lose whether or not the type is signed } - if (paradef.deftype <> orddef) then - paracgsize := int_cgsize(paralen); - if (paracgsize in [OS_NO,OS_64,OS_S64]) then - paraloc^.size := OS_INT - else - paraloc^.size := paracgsize; - paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBNONE); - inc(nextintreg); - dec(paralen,tcgsize2size[paraloc^.size]); - end - else if (loc = LOC_FPUREGISTER) and - (nextfloatreg <= RS_FP7) then - begin - writeln('loc fpuregister'); - paraloc^.loc:=loc; - paraloc^.size := paracgsize; - paraloc^.register:=newreg(R_FPUREGISTER,nextfloatreg,R_SUBWHOLE); - inc(nextfloatreg); - dec(paralen,tcgsize2size[paraloc^.size]); - end - else { LOC_REFERENCE } - begin - writeln('loc reference'); - paraloc^.loc:=LOC_REFERENCE; - paraloc^.size:=int_cgsize(paralen); - if (side = callerside) then - paraloc^.reference.index:=NR_STACK_POINTER_REG - else - paraloc^.reference.index:=NR_FRAME_POINTER_REG; - paraloc^.reference.offset:=stack_offset; - inc(stack_offset,align(paralen,4)); - paralen := 0; - end; - end; - end; - result:=stack_offset; -// writeln('stack offset:',stack_offset); - end; - - -{ - - if push_addr_param(hp.varspez,paradef,p.proccalloption) then + if push_addr_param(hp.varspez,hp.vartype.def,p.proccalloption) then paracgsize:=OS_ADDR else begin - paracgsize:=def_cgsize(paradef); + paracgsize:=def_cgsize(hp.vartype.def); if paracgsize=OS_NO then paracgsize:=OS_ADDR; end; @@ -409,10 +127,9 @@ unit cpupara; paraloc^.reference.index:=NR_FRAME_POINTER_REG; paraloc^.reference.offset:=target_info.first_parm_offset+parasize; end; - create_funcretloc_info(p,side); result:=parasize; end; -} + function tm68kparamanager.parseparaloc(p : tparavarsym;const s : string) : boolean; var diff --git a/compiler/m68k/cputarg.pas b/compiler/m68k/cputarg.pas index e337035a95..7624def33d 100644 --- a/compiler/m68k/cputarg.pas +++ b/compiler/m68k/cputarg.pas @@ -36,15 +36,8 @@ implementation **************************************} {$ifndef NOTARGETLINUX} - ,t_linux + ,t_linux,t_amiga {$endif} - ,t_amiga - -{************************************** - Assembler Readers -**************************************} - - ,ra68kmot {************************************** Assemblers diff --git a/compiler/m68k/n68kmat.pas b/compiler/m68k/n68kmat.pas index f1bf8a4248..31134b034d 100644 --- a/compiler/m68k/n68kmat.pas +++ b/compiler/m68k/n68kmat.pas @@ -114,7 +114,7 @@ implementation secondpass(left); location_copy(location,left.location); location_force_reg(exprasmlist,location,OS_64,false); - cg64.a_op64_loc_reg(exprasmlist,OP_NOT,OS_64,location, + cg64.a_op64_loc_reg(exprasmlist,OP_NOT,location, joinreg64(location.register64.reglo,location.register64.reghi)); end else @@ -143,7 +143,7 @@ implementation if aktoptprocessor <> MC68000 then begin { verify if denominator is zero } - objectlibrary.getjumplabel(continuelabel); + objectlibrary.getlabel(continuelabel); { compare against zero, if not zero continue } cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_NE,0,denum,continuelabel); // paraloc1.init; @@ -189,7 +189,7 @@ implementation if aktoptprocessor <> MC68000 then begin { verify if denominator is zero } - objectlibrary.getjumplabel(continuelabel); + objectlibrary.getlabel(continuelabel); { compare against zero, if not zero continue } cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_NE,0,denum,continuelabel); // cg.a_param_const(exprasmlist, OS_S32,200,paramanager.getintparaloc(pocall_default,1)); @@ -204,7 +204,7 @@ implementation { we extend the sign to the high doword register by inverting } { all the bits. } exprasmlist.concat(taicpu.op_reg(A_CLR,S_L,tmpreg)); - objectlibrary.getjumplabel(signlabel); + objectlibrary.getlabel(signlabel); exprasmlist.concat(taicpu.op_reg(A_TST,S_L,tmpreg)); cg.a_cmp_const_reg_label(exprasmlist,OS_S32,OC_A,0,tmpreg,signlabel); { its a negative value, therefore change sign } diff --git a/compiler/m68k/ncpuadd.pas b/compiler/m68k/ncpuadd.pas index 695f623128..82c6429b8d 100644 --- a/compiler/m68k/ncpuadd.pas +++ b/compiler/m68k/ncpuadd.pas @@ -264,9 +264,9 @@ implementation if isjump then begin otl:=truelabel; - objectlibrary.getjumplabel(truelabel); + objectlibrary.getlabel(truelabel); ofl:=falselabel; - objectlibrary.getjumplabel(falselabel); + objectlibrary.getlabel(falselabel); end; secondpass(left); if left.location.loc in [LOC_FLAGS,LOC_JUMP] then @@ -281,9 +281,9 @@ implementation if isjump then begin otl:=truelabel; - objectlibrary.getjumplabel(truelabel); + objectlibrary.getlabel(truelabel); ofl:=falselabel; - objectlibrary.getjumplabel(falselabel); + objectlibrary.getlabel(falselabel); end; secondpass(right); if right.location.loc in [LOC_FLAGS,LOC_JUMP] then diff --git a/compiler/m68k/ra68k.pas b/compiler/m68k/ra68k.pas deleted file mode 100755 index 3b7c24dc8d..0000000000 --- a/compiler/m68k/ra68k.pas +++ /dev/null @@ -1,363 +0,0 @@ -{ - Copyright (c) 1998-2003 by Carl Eric Codere and Peter Vreman - - Handles the common 68k assembler reader routines - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit ra68k; - -{$i fpcdefs.inc} - - interface - - uses - aasmbase,aasmtai,aasmcpu, - cpubase,rautils,cclasses; - - type - Tm68kOperand=class(TOperand) - end; - - Tm68kInstruction=class(TInstruction) - opsize : topsize; - function ConcatInstruction(p : taasmoutput):tai;override; - function ConcatLabeledInstr(p : taasmoutput):tai; - end; - - implementation - - uses - verbose,cgbase; - -{***************************************************************************** - TM68kInstruction -*****************************************************************************} - - function TM68kInstruction.ConcatInstruction(p : taasmoutput):tai; - var - fits : boolean; - begin - result:=nil; - fits := FALSE; - { setup specific opcodetions for first pass } - - { Setup special operands } - { Convert to general form as to conform to the m68k opcode table } - if (opcode = A_ADDA) or (opcode = A_ADDI) - then opcode := A_ADD - else - { CMPM excluded because of GAS v1.34 BUG } - if (opcode = A_CMPA) or - (opcode = A_CMPI) then - opcode := A_CMP - else - if opcode = A_EORI then - opcode := A_EOR - else - if opcode = A_MOVEA then - opcode := A_MOVE - else - if opcode = A_ORI then - opcode := A_OR - else - if (opcode = A_SUBA) or (opcode = A_SUBI) then - opcode := A_SUB; - - { Setup operand types } - -(* - in opcode <> A_MOVEM then - begin - - while not(fits) do - begin - { set the opcodetion cache, if the opcodetion } - { occurs the first time } - if (it[i].i=opcode) and (ins_cache[opcode]=-1) then - ins_cache[opcode]:=i; - - if (it[i].i=opcode) and (instr.ops=it[i].ops) then - begin - { first fit } - case instr.ops of - 0 : begin - fits:=true; - break; - end; - 1 : - begin - if (optyp1 and it[i].o1)<>0 then - begin - fits:=true; - break; - end; - end; - 2 : if ((optyp1 and it[i].o1)<>0) and - ((optyp2 and it[i].o2)<>0) then - begin - fits:=true; - break; - end - 3 : if ((optyp1 and it[i].o1)<>0) and - ((optyp2 and it[i].o2)<>0) and - ((optyp3 and it[i].o3)<>0) then - begin - fits:=true; - break; - end; - end; { end case } - end; { endif } - if it[i].i=A_NONE then - begin - { NO MATCH! } - Message(asmr_e_invalid_combination_opcode_and_operand); - exit; - end; - inc(i); - end; { end while } - *) - fits:=TRUE; - - { We add the opcode to the opcode linked list } - if fits then - begin - case ops of - 0: - if opsize <> S_NO then - result:=(taicpu.op_none(opcode,opsize)) - else - result:=(taicpu.op_none(opcode,S_NO)); - 1: begin - case operands[1].opr.typ of - OPR_SYMBOL: - begin - result:=(taicpu.op_sym_ofs(opcode, - opsize, operands[1].opr.symbol,operands[1].opr.symofs)); - end; - OPR_CONSTANT: - begin - result:=(taicpu.op_const(opcode, - opsize, operands[1].opr.val)); - end; - OPR_REGISTER: - result:=(taicpu.op_reg(opcode,opsize,operands[1].opr.reg)); - OPR_REFERENCE: - if opsize <> S_NO then - begin - result:=(taicpu.op_ref(opcode, - opsize,operands[1].opr.ref)); - end - else - begin - { special jmp and call case with } - { symbolic references. } - if opcode in [A_BSR,A_JMP,A_JSR,A_BRA,A_PEA] then - begin - result:=(taicpu.op_ref(opcode, - S_NO,operands[1].opr.ref)); - end - else - Message(asmr_e_invalid_opcode_and_operand); - end; - OPR_NONE: - Message(asmr_e_invalid_opcode_and_operand); - else - begin - Message(asmr_e_invalid_opcode_and_operand); - end; - end; - end; - 2: begin - { source } - case operands[1].opr.typ of - { reg,reg } - { reg,ref } - OPR_REGISTER: - begin - case operands[2].opr.typ of - OPR_REGISTER: - begin - result:=(taicpu.op_reg_reg(opcode, - opsize,operands[1].opr.reg,operands[2].opr.reg)); - end; - OPR_REFERENCE: - result:=(taicpu.op_reg_ref(opcode, - opsize,operands[1].opr.reg,operands[2].opr.ref)); - else { else case } - begin - Message(asmr_e_invalid_opcode_and_operand); - end; - end; { end second operand case for OPR_REGISTER } - end; - { regset, ref } - OPR_regset: - begin - case operands[2].opr.typ of - OPR_REFERENCE : - result:=(taicpu.op_regset_ref(opcode, - opsize,operands[1].opr.regset,operands[2].opr.ref)); - else - begin - Message(asmr_e_invalid_opcode_and_operand); - end; - end; { end second operand case for OPR_regset } - end; - - { const,reg } - { const,const } - { const,ref } - OPR_CONSTANT: - case operands[2].opr.typ of - { constant, constant does not have a specific size. } - OPR_CONSTANT: - result:=(taicpu.op_const_const(opcode, - S_NO,operands[1].opr.val,operands[2].opr.val)); - OPR_REFERENCE: - begin - result:=(taicpu.op_const_ref(opcode, - opsize,operands[1].opr.val, - operands[2].opr.ref)) - end; - OPR_REGISTER: - begin - result:=(taicpu.op_const_reg(opcode, - opsize,operands[1].opr.val, - operands[2].opr.reg)) - end; - else - begin - Message(asmr_e_invalid_opcode_and_operand); - end; - end; { end second operand case for OPR_CONSTANT } - { ref,reg } - { ref,ref } - OPR_REFERENCE: - case operands[2].opr.typ of - OPR_REGISTER: - begin - result:=(taicpu.op_ref_reg(opcode, - opsize,operands[1].opr.ref, - operands[2].opr.reg)); - end; - OPR_regset: - begin - result:=(taicpu.op_ref_regset(opcode, - opsize,operands[1].opr.ref, - operands[2].opr.regset)); - end; - OPR_REFERENCE: { special opcodes } - result:=(taicpu.op_ref_ref(opcode, - opsize,operands[1].opr.ref, - operands[2].opr.ref)); - else - begin - Message(asmr_e_invalid_opcode_and_operand); - end; - end; { end second operand case for OPR_REFERENCE } - OPR_SYMBOL: case operands[2].opr.typ of - OPR_REFERENCE: - begin - result:=(taicpu.op_sym_ofs_ref(opcode, - opsize,operands[1].opr.symbol,operands[1].opr.symofs, - operands[2].opr.ref)) - end; - OPR_REGISTER: - begin - result:=(taicpu.op_sym_ofs_reg(opcode, - opsize,operands[1].opr.symbol,operands[1].opr.symofs, - operands[2].opr.reg)) - end; - else - begin - Message(asmr_e_invalid_opcode_and_operand); - end; - end; { end second operand case for OPR_SYMBOL } - else - begin - Message(asmr_e_invalid_opcode_and_operand); - end; - end; { end first operand case } - end; - 3: begin - if (opcode = A_DIVSL) or (opcode = A_DIVUL) or (opcode = A_MULU) - or (opcode = A_MULS) or (opcode = A_DIVS) or (opcode = A_DIVU) then - begin - if (operands[1].opr.typ <> OPR_REGISTER) - or (operands[2].opr.typ <> OPR_REGISTER) - or (operands[3].opr.typ <> OPR_REGISTER) then - begin - Message(asmr_e_invalid_opcode_and_operand); - end - else - begin - result:=(taicpu. op_reg_reg_reg(opcode,opsize, - operands[1].opr.reg,operands[2].opr.reg,operands[3].opr.reg)); - end; - end - else - Message(asmr_e_invalid_opcode_and_operand); - end; - end; { end case } - end; - if assigned(result) then - p.concat(result); - end; - - - function TM68kInstruction.ConcatLabeledInstr(p : taasmoutput):tai; - begin - if ((opcode >= A_BCC) and (opcode <= A_BVS)) or - (opcode = A_BRA) or (opcode = A_BSR) or - (opcode = A_JMP) or (opcode = A_JSR) or - ((opcode >= A_FBEQ) and (opcode <= A_FBNGLE)) then - begin - if ops > 2 then - Message(asmr_e_invalid_opcode_and_operand) - else if operands[1].opr.typ <> OPR_SYMBOL then - Message(asmr_e_invalid_opcode_and_operand) - else if (operands[1].opr.typ = OPR_SYMBOL) and - (ops = 1) then - if assigned(operands[1].opr.symbol) and - (operands[1].opr.symofs=0) then - result:=taicpu.op_sym(opcode,S_NO, - operands[1].opr.symbol) - else - Message(asmr_e_invalid_opcode_and_operand); - end - else if ((opcode >= A_DBCC) and (opcode <= A_DBF)) - or ((opcode >= A_FDBEQ) and (opcode <= A_FDBNGLE)) then - begin - if (ops<>2) or - (operands[1].opr.typ <> OPR_REGISTER) or - (operands[2].opr.typ <> OPR_SYMBOL) or - (operands[2].opr.symofs <> 0) then - Message(asmr_e_invalid_opcode_and_operand) - else - result:=taicpu.op_reg_sym(opcode,opsize,operands[1].opr.reg, - operands[2].opr.symbol); - end - else - Message(asmr_e_invalid_opcode_and_operand); - if assigned(result) then - p.concat(result); - end; - - - - -end. diff --git a/compiler/m68k/ra68kmot.pas b/compiler/m68k/ra68kmot.pas index 11f8442c46..0e345c0482 100644 --- a/compiler/m68k/ra68kmot.pas +++ b/compiler/m68k/ra68kmot.pas @@ -48,11 +48,7 @@ unit ra68kmot; uses - cutils, - globtype,cclasses,cpubase, - symconst, - aasmbase, - rabase,rasm,ra68k,rautils; + rasm; type tasmtoken = ( @@ -66,50 +62,77 @@ unit ra68kmot; {------------------ Assembler Operators --------------------} AS_MOD,AS_SHL,AS_SHR,AS_NOT,AS_AND,AS_OR,AS_XOR); - tasmkeyword = string[10]; - tm68kmotreader = class(tasmreader) - actasmtoken : tasmtoken; - prevasmtoken : tasmtoken; - procedure SetupTables; - function Assemble: tlinkedlist;override; - function is_asmopcode(const s: string) : boolean; - Function is_asmdirective(const s: string):boolean; - function is_register(const s:string):boolean; - procedure GetToken; - function consume(t : tasmtoken):boolean; - function findopcode(s: string; var opsize: topsize): tasmop; - Function BuildExpression(allow_symbol : boolean; asmsym : pstring) : longint; - Procedure BuildConstant(maxvalue: longint); - Procedure BuildRealConstant(typ : tfloattype); - Procedure BuildScaling(const oper:tm68koperand); - Function BuildRefExpression: longint; - procedure BuildReference(const oper:tm68koperand); - Procedure BuildOperand(const oper:tm68koperand); - Procedure BuildStringConstant(asciiz: boolean); - Procedure BuildOpCode(instr:Tm68kinstruction); + actasmtoken: tasmtoken; + actasmpattern: string; + destructor destroy;override; end; Implementation uses + { common } + cutils,cclasses, { global } - globals,verbose, + globtype,globals,verbose, systems, { aasm } - cpuinfo,aasmtai,aasmcpu, - cgbase, + cpuinfo,aasmbase,aasmtai,aasmcpu, { symtable } - symbase,symtype,symsym,symtable, + symconst,symbase,symtype,symsym,symtable, { pass 1 } nbas, { parser } scanner,agcpugas, - itcpugas + rautils ; const + { this variable is TRUE if the lookup tables have already been setup } + { for fast access. On the first call to assemble the tables are setup } + { and stay set up. } + _asmsorted: boolean = FALSE; + firstasmreg = R_D0; + lastasmreg = R_FPSR; + +type + tiasmops = array[firstop..lastop] of string[7]; + piasmops = ^tiasmops; + + tasmkeyword = string[6]; + +var + { sorted tables of opcodes } + iasmops: piasmops; + { uppercased tables of registers } + iasmregs: array[firstasmreg..lastasmreg] of string[6]; + +const + regname_count=17; + regname_count_bsstart=16; + + regname2regnum:array[0..regname_count-1] of regname2regnumrec=( + (name:'A0'; number:NR_A0), + (name:'A1'; number:NR_A1), + (name:'A2'; number:NR_A2), + (name:'A3'; number:NR_A3), + (name:'A4'; number:NR_A4), + (name:'A5'; number:NR_A5), + (name:'A6'; number:NR_A6), + (name:'A7'; number:NR_A7), + (name:'D0'; number:NR_D0), + (name:'D1'; number:NR_D1), + (name:'D2'; number:NR_D2), + (name:'D3'; number:NR_D3), + (name:'D4'; number:NR_D4), + (name:'D5'; number:NR_D5), + (name:'D6'; number:NR_D6), + (name:'D7'; number:NR_D7), + (name:'SP'; number:NR_A7)); + + +const firstdirective = AS_DB; lastdirective = AS_END; firstoperator = AS_MOD; @@ -126,99 +149,137 @@ const _asmoperators : array[0.._count_asmoperators] of tasmkeyword = ( 'MOD','SHL','SHR','NOT','AND','OR','XOR'); - token2str : array[tasmtoken] of tasmkeyword=( - 'NONE','LABEL','LLABEL','STRING','HEXNUM','OCTALNUM', - 'BINNUM',',','[',']','(', - ')',':','.','+','-','*','INTNUM', - 'SEPARATOR','ID','REGISTER','OPCODE','/','APPT','REALNUM', - 'ALIGN', - {------------------ Assembler directives --------------------} - 'DB','DW','DD','XDEF','END', - {------------------ Assembler Operators --------------------} - 'MOD','SHL','SHR','NOT','AND','OR','XOR'); const firsttoken : boolean = TRUE; operandnum : byte = 0; - procedure tm68kmotreader.SetupTables; - { creates uppercased symbol tables for speed access } - var - i : tasmop; - str2opentry: tstr2opentry; - Begin - { opcodes } - iasmops:=TDictionary.Create; - iasmops.delete_doubles:=true; - for i:=firstop to lastop do - begin - str2opentry:=tstr2opentry.createname(upper(gas_op2str[i])); - str2opentry.op:=i; - iasmops.insert(str2opentry); - end; - end; + Procedure SetupTables; + { creates uppercased symbol tables for speed access } + var + i: tasmop; + j: tregister; + begin + {Message(asmr_d_creating_lookup_tables);} + { opcodes } + new(iasmops); + for i:=firstop to lastop do + iasmops^[i] := upper(gas_op2str[i]); + { opcodes } + for j.enum:=firstasmreg to lastasmreg do + iasmregs[j.enum] := upper(std_reg2str[j.enum]); + end; {---------------------------------------------------------------------} { Routines for the tokenizing } {---------------------------------------------------------------------} - function tm68kmotreader.is_asmopcode(const s: string):boolean; - var - str2opentry: tstr2opentry; - hs : string; - j : byte; - Begin - is_asmopcode:=false; - { first of all we remove the suffix } - j:=pos('.',s); - if j>0 then - hs:=copy(s,3,255) - else - hs:=s; + function regnum_search(const s:string):Tnewregister; - str2opentry:=tstr2opentry(iasmops.search(hs)); - if assigned(str2opentry) then - begin - actopcode:=str2opentry.op; - actasmtoken:=AS_OPCODE; - is_asmopcode:=true; - exit; - end; - end; + {Searches the register number that belongs to the register in s. + s must be in uppercase!.} + + var i,p:byte; + + begin + {Binary search.} + p:=0; + i:=regname_count_bsstart; + while i<>0 do + begin + if (p+i<regname_count) and (upper(regname2regnum[p+i].name)<=s) then + p:=p+i; + i:=i shr 1; + end; + if upper(regname2regnum[p].name)=s then + regnum_search:=regname2regnum[p].number + else + regnum_search:=NR_NO; + end; + + function is_asmopcode(s: string):Boolean; + {*********************************************************************} + { FUNCTION is_asmopcode(s: string):Boolean } + { Description: Determines if the s string is a valid opcode } + { if so returns TRUE otherwise returns FALSE. } + { Remark: Suffixes are also checked, as long as they are valid. } + {*********************************************************************} + var + i: tasmop; + j: byte; + begin + is_asmopcode := FALSE; + { first of all we remove the suffix } + j:=pos('.',s); + if j<>0 then + delete(s,j,2); + for i:=firstop to lastop do + begin + if s = iasmops^[i] then + begin + is_asmopcode:=TRUE; + exit; + end; + end; + end; - Function tm68kmotreader.is_asmdirective(const s: string):boolean; + Procedure is_asmdirective(const s: string; var token: tasmtoken); + {*********************************************************************} + { FUNCTION is_asmdirective(s: string; var token: tinteltoken):Boolean } + { Description: Determines if the s string is a valid directive } + { (an operator can occur in operand fields, while a directive cannot) } + { if so returns the directive token, otherwise does not change token.} + {*********************************************************************} var i:byte; begin - result:=false; for i:=0 to _count_asmdirectives do begin if s=_asmdirectives[i] then begin - actasmtoken := tasmtoken(longint(firstdirective)+i); - result:=true; + token := tasmtoken(longint(firstdirective)+i); exit; end; end; end; - function tm68kmotreader.is_register(const s:string):boolean; - begin - is_register:=false; - actasmregister:=gas_regnum_search(lower(s)); - if actasmregister<>NR_NO then - begin - is_register:=true; - actasmtoken:=AS_REGISTER; - end; - end; + Procedure is_register(const s: string; var token: tasmtoken); + {*********************************************************************} + { PROCEDURE is_register(s: string; var token: tinteltoken); } + { Description: Determines if the s string is a valid register, if } + { so return token equal to A_REGISTER, otherwise does not change token} + {*********************************************************************} + var + i: tregister; + begin + if regnum_search(s)=NR_NO then + begin + for i.enum:=firstasmreg to lastasmreg do + begin + if s=iasmregs[i.enum] then + begin + token := AS_REGISTER; + exit; + end; + end; + { take care of other name for sp } + if s = 'A7' then + begin + token:=AS_REGISTER; + exit; + end; + end + else + token:=AS_REGISTER; + end; - Procedure tm68kmotreader.GetToken; + + Function GetToken: tasmtoken; {*********************************************************************} { FUNCTION GetToken: tinteltoken; } { Description: This routine returns intel assembler tokens and } @@ -236,11 +297,11 @@ const while c in [' ',#9] do c:=current_scanner.asmgetchar; - if not (c in [#10,#13,'{',';']) then + if not (c in [newline,#13,'{',';']) then current_scanner.gettokenpos; { Possiblities for first token in a statement: } { Local Label, Label, Directive, Prefix or Opcode.... } - if firsttoken and not (c in [#10,#13,'{',';']) then + if firsttoken and not (c in [newline,#13,'{',';']) then begin firsttoken := FALSE; @@ -271,7 +332,7 @@ const end; { end case } { let us point to the next character } c := current_scanner.asmgetchar; - actasmtoken := token; + gettoken := token; exit; end; @@ -281,14 +342,21 @@ const Message(asmr_e_none_label_contain_at); If is_asmopcode(actasmpattern) then + begin + gettoken := AS_OPCODE; exit; - if is_asmdirective(actasmpattern) then + end; + is_asmdirective(actasmpattern, token); + if (token <> AS_NONE) then + begin + gettoken := token; exit + end else - begin - actasmtoken := AS_NONE; - Message1(asmr_e_invalid_or_missing_opcode,actasmpattern); - end; + begin + gettoken := AS_NONE; + Message1(asmr_e_invalid_or_missing_opcode,actasmpattern); + end; end else { else firsttoken } { Here we must handle all possible cases } @@ -306,7 +374,7 @@ const c := current_scanner.asmgetchar; end; uppervar(actasmpattern); - actasmtoken := AS_ID; + gettoken := AS_ID; exit; end; { identifier, register, opcode, prefix or directive } @@ -321,19 +389,29 @@ const uppervar(actasmpattern); If is_asmopcode(actasmpattern) then + begin + gettoken := AS_OPCODE; + exit; + end; + is_register(actasmpattern, token); + {is_asmoperator(actasmpattern,token);} + is_asmdirective(actasmpattern,token); + { if found } + if (token <> AS_NONE) then + begin + gettoken := token; exit; - if is_register(actasmpattern) then - exit; - if is_asmdirective(actasmpattern) then - exit; + end { this is surely an identifier } - actasmtoken := AS_ID; + else + token := AS_ID; + gettoken := token; exit; end; { override operator... not supported } '&': begin c:=current_scanner.asmgetchar; - actasmtoken := AS_AND; + gettoken := AS_AND; end; { string or character } '''' : @@ -344,7 +422,7 @@ const if c = '''' then begin c:=current_scanner.asmgetchar; - if c=#10 then + if c=newline then begin Message(scan_f_string_exceeds_line); break; @@ -357,7 +435,7 @@ const begin actasmpattern:=actasmpattern+''''; c:=current_scanner.asmgetchar; - if c=#10 then + if c=newline then begin Message(scan_f_string_exceeds_line); break; @@ -369,7 +447,7 @@ const begin actasmpattern:=actasmpattern+c; c:=current_scanner.asmgetchar; - if c=#10 then + if c=newline then begin Message(scan_f_string_exceeds_line); break @@ -380,7 +458,7 @@ const else break; { end if } end; { end while } token:=AS_STRING; - actasmtoken := token; + gettoken := token; exit; end; '$' : begin @@ -390,51 +468,51 @@ const actasmpattern := actasmpattern + c; c := current_scanner.asmgetchar; end; - actasmtoken := AS_HEXNUM; + gettoken := AS_HEXNUM; exit; end; ',' : begin - actasmtoken := AS_COMMA; + gettoken := AS_COMMA; c:=current_scanner.asmgetchar; exit; end; '(' : begin - actasmtoken := AS_LPAREN; + gettoken := AS_LPAREN; c:=current_scanner.asmgetchar; exit; end; ')' : begin - actasmtoken := AS_RPAREN; + gettoken := AS_RPAREN; c:=current_scanner.asmgetchar; exit; end; ':' : begin - actasmtoken := AS_COLON; + gettoken := AS_COLON; c:=current_scanner.asmgetchar; exit; end; { '.' : begin - actasmtoken := AS_DOT; + gettoken := AS_DOT; c:=current_scanner.asmgetchar; exit; end; } '+' : begin - actasmtoken := AS_PLUS; + gettoken := AS_PLUS; c:=current_scanner.asmgetchar; exit; end; '-' : begin - actasmtoken := AS_MINUS; + gettoken := AS_MINUS; c:=current_scanner.asmgetchar; exit; end; '*' : begin - actasmtoken := AS_STAR; + gettoken := AS_STAR; c:=current_scanner.asmgetchar; exit; end; '/' : begin - actasmtoken := AS_SLASH; + gettoken := AS_SLASH; c:=current_scanner.asmgetchar; exit; end; @@ -444,7 +522,7 @@ const if c <> '<' then Message(asmr_e_invalid_char_smaller); { still assume << } - actasmtoken := AS_SHL; + gettoken := AS_SHL; c := current_scanner.asmgetchar; exit; end; @@ -454,22 +532,22 @@ const if c <> '>' then Message(asmr_e_invalid_char_greater); { still assume << } - actasmtoken := AS_SHR; + gettoken := AS_SHR; c := current_scanner.asmgetchar; exit; end; '|' : begin - actasmtoken := AS_OR; + gettoken := AS_OR; c := current_scanner.asmgetchar; exit; end; '^' : begin - actasmtoken := AS_XOR; + gettoken := AS_XOR; c := current_scanner.asmgetchar; exit; end; '#' : begin - actasmtoken:=AS_APPT; + gettoken:=AS_APPT; c:=current_scanner.asmgetchar; exit; end; @@ -480,7 +558,7 @@ const actasmpattern := actasmpattern + c; c := current_scanner.asmgetchar; end; - actasmtoken := AS_BINNUM; + gettoken := AS_BINNUM; exit; end; { integer number } @@ -492,21 +570,21 @@ const actasmpattern := actasmpattern + c; c:= current_scanner.asmgetchar; end; - actasmtoken := AS_INTNUM; + gettoken := AS_INTNUM; exit; end; ';' : begin repeat c:=current_scanner.asmgetchar; - until c=#10; + until c=newline; firsttoken := TRUE; - actasmtoken:=AS_SEPARATOR; + gettoken:=AS_SEPARATOR; end; - '{',#13,#10 : begin + '{',#13,newline : begin c:=current_scanner.asmgetchar; firsttoken := TRUE; - actasmtoken:=AS_SEPARATOR; + gettoken:=AS_SEPARATOR; end; else begin @@ -522,27 +600,61 @@ const { Routines for the parsing } {---------------------------------------------------------------------} - function tm68kmotreader.consume(t : tasmtoken):boolean; - begin - Consume:=true; - if t<>actasmtoken then - begin - Message2(scan_f_syn_expected,token2str[t],token2str[actasmtoken]); - Consume:=false; - end; - repeat - gettoken; - until actasmtoken<>AS_NONE; + procedure consume(t : tasmtoken); + + begin + if t<>actasmtoken then + Message(asmr_e_syntax_error); + actasmtoken:=gettoken; + { if the token must be ignored, then } + { get another token to parse. } + if actasmtoken = AS_NONE then + actasmtoken := gettoken; end; - function tm68kmotreader.findopcode(s: string; var opsize: topsize): tasmop; + + + + function findregister(const s : string): tregister; + {*********************************************************************} + { FUNCTION findregister(s: string):tasmop; } + { Description: Determines if the s string is a valid register, } + { if so returns correct tregister token, or R_NO if not found. } + {*********************************************************************} + var + i: tregister; + begin + i.enum:=R_INTREGISTER; + i.number:=regnum_search(s); + if i.number=NR_NO then + begin + findregister.enum := R_NO; + for i.enum:=firstasmreg to lastasmreg do + if s = iasmregs[i.enum] then + begin + findregister := i; + exit; + end; + if s = 'A7' then + begin + findregister.enum := R_SP; + exit; + end; + end + else + findregister:=i; + end; + + + function findopcode(s: string; var opsize: topsize): tasmop; {*********************************************************************} { FUNCTION findopcode(s: string): tasmop; } { Description: Determines if the s string is a valid opcode } { if so returns correct tasmop token. } {*********************************************************************} var + i: tasmop; j: byte; op_size: string; begin @@ -566,13 +678,18 @@ const { delete everything starting from dot } delete(s,j,length(s)); end; - result:=actopcode; + for i:=firstop to lastop do + if s = iasmops^[i] then + begin + findopcode:=i; + exit; + end; end; - Function tm68kmotreader.BuildExpression(allow_symbol : boolean; asmsym : pstring) : longint; + Function BuildExpression(allow_symbol : boolean; asmsym : pstring) : longint; {*********************************************************************} { FUNCTION BuildExpression: longint } { Description: This routine calculates a constant expression to } @@ -689,11 +806,11 @@ const if assigned(sym) then begin case sym.typ of - paravarsym, - localvarsym : + varsym : begin - Message(asmr_e_no_local_or_para_allowed); - hs:=tabstractvarsym(sym).mangledname; + if sym.owner.symtabletype in [localsymtable,parasymtable] then + Message(asmr_e_no_local_or_para_allowed); + hs:=tvarsym(sym).mangledname; end; typedconstsym : hs:=ttypedconstsym(sym).mangledname; @@ -730,7 +847,7 @@ const Consume(AS_INTNUM); end; AS_BINNUM: begin - tempstr := tostr(ParseVal(actasmpattern,2)); + tempstr := tostr(ValBinary(actasmpattern)); if tempstr = '' then Message(asmr_e_error_converting_binary); expr:=expr+tempstr; @@ -738,14 +855,14 @@ const end; AS_HEXNUM: begin - tempstr := tostr(ParseVal(actasmpattern,16)); + tempstr := tostr(ValHexadecimal(actasmpattern)); if tempstr = '' then Message(asmr_e_error_converting_hexadecimal); expr:=expr+tempstr; Consume(AS_HEXNUM); end; AS_OCTALNUM: begin - tempstr := tostr(ParseVal(actasmpattern,8)); + tempstr := tostr(ValOctal(actasmpattern)); if tempstr = '' then Message(asmr_e_error_converting_octal); expr:=expr+tempstr; @@ -781,7 +898,7 @@ const end; - Procedure tm68kmotreader.BuildRealConstant(typ : tfloattype); + Procedure BuildRealConstant(typ : tfloattype); {*********************************************************************} { PROCEDURE BuilRealConst } { Description: This routine calculates a constant expression to } @@ -884,7 +1001,7 @@ const end; - Procedure tm68kmotreader.BuildConstant(maxvalue: longint); + Procedure BuildConstant(maxvalue: longint); {*********************************************************************} { PROCEDURE BuildConstant } { Description: This routine takes care of parsing a DB,DD,or DW } @@ -897,17 +1014,21 @@ const { EXIT CONDITION: On exit the routine should point to AS_SEPARATOR. } {*********************************************************************} var + strlength: byte; expr: string; + tempstr: string; value : longint; begin Repeat Case actasmtoken of AS_STRING: begin - if maxvalue <> $ff then + if maxvalue = $ff then + strlength := 1 + else Message(asmr_e_string_not_allowed_as_const); expr := actasmpattern; if length(expr) > 1 then - Message(asmr_e_string_not_allowed_as_const); + Message(asmr_e_string_not_allowed_as_const); Consume(AS_STRING); Case actasmtoken of AS_COMMA: Consume(AS_COMMA); @@ -953,7 +1074,26 @@ const end; - Procedure TM68kMotreader.BuildScaling(const oper:tm68koperand); + + + + +{**************************************************************************** + Tm68kOperand +****************************************************************************} + +type + TM68kOperand=class(TOperand) + Procedure BuildOperand;override; + private + labeled : boolean; + Procedure BuildReference; + Function BuildRefExpression: longint; + Procedure BuildScaling; + end; + + + Procedure TM68kOperand.BuildScaling; {*********************************************************************} { Takes care of parsing expression starting from the scaling value } { up to and including possible field specifiers. } @@ -965,14 +1105,14 @@ const code: integer; begin Consume(AS_STAR); - if (oper.opr.ref.scalefactor <> 0) - and (oper.opr.ref.scalefactor <> 1) then + if (opr.ref.scalefactor <> 0) + and (opr.ref.scalefactor <> 1) then Message(asmr_e_wrong_base_index); case actasmtoken of AS_INTNUM: str := actasmpattern; - AS_HEXNUM: str := Tostr(ParseVal(actasmpattern,16)); - AS_BINNUM: str := Tostr(ParseVal(actasmpattern,2)); - AS_OCTALNUM: str := Tostr(ParseVal(actasmpattern,8)); + AS_HEXNUM: str := Tostr(ValHexadecimal(actasmpattern)); + AS_BINNUM: str := Tostr(ValBinary(actasmpattern)); + AS_OCTALNUM: str := Tostr(ValOctal(actasmpattern)); else Message(asmr_e_syntax_error); end; @@ -981,17 +1121,17 @@ const Message(asmr_e_wrong_scale_factor); if ((l = 2) or (l = 4) or (l = 8) or (l = 1)) and (code = 0) then begin - oper.opr.ref.scalefactor := l; + opr.ref.scalefactor := l; end else begin Message(asmr_e_wrong_scale_factor); - oper.opr.ref.scalefactor := 0; + opr.ref.scalefactor := 0; end; - if oper.opr.ref.index = NR_NO then + if opr.ref.index.enum = R_NO then begin Message(asmr_e_wrong_base_index); - oper.opr.ref.scalefactor := 0; + opr.ref.scalefactor := 0; end; { Consume the scaling number } Consume(actasmtoken); @@ -1008,7 +1148,7 @@ const end; - Function TM68kMotreader.BuildRefExpression: longint; + Function TM68kOperand.BuildRefExpression: longint; {*********************************************************************} { FUNCTION BuildRefExpression: longint } { Description: This routine calculates a constant expression to } @@ -1105,7 +1245,7 @@ const Consume(AS_INTNUM); end; AS_BINNUM: begin - tempstr := Tostr(ParseVal(actasmpattern,2)); + tempstr := Tostr(ValBinary(actasmpattern)); if tempstr = '' then Message(asmr_e_error_converting_binary); expr:=expr+tempstr; @@ -1113,14 +1253,14 @@ const end; AS_HEXNUM: begin - tempstr := Tostr(ParseVal(actasmpattern,16)); + tempstr := Tostr(ValHexadecimal(actasmpattern)); if tempstr = '' then Message(asmr_e_error_converting_hexadecimal); expr:=expr+tempstr; Consume(AS_HEXNUM); end; AS_OCTALNUM: begin - tempstr := Tostr(ParseVal(actasmpattern,8)); + tempstr := Tostr(ValOctal(actasmpattern)); if tempstr = '' then Message(asmr_e_error_converting_octal); expr:=expr+tempstr; @@ -1152,7 +1292,7 @@ const { EXIT CONDITION: On exit the routine should point to either the } { AS_COMMA or AS_SEPARATOR token. } {*********************************************************************} - procedure TM68kMotreader.BuildReference(const oper:tm68koperand); + procedure TM68kOperand.BuildReference; var l:longint; code: integer; @@ -1163,7 +1303,7 @@ const { // (reg ... // } AS_REGISTER: begin - oper.opr.ref.base := actasmregister; + opr.ref.base := findregister(actasmpattern); Consume(AS_REGISTER); { can either be a register or a right parenthesis } { // (reg) // } @@ -1173,10 +1313,10 @@ const Consume(AS_RPAREN); if actasmtoken = AS_PLUS then begin - if (oper.opr.ref.direction <> dir_none) then + if (opr.ref.direction <> dir_none) then Message(asmr_e_no_inc_and_dec_together) else - oper.opr.ref.direction := dir_inc; + opr.ref.direction := dir_inc; Consume(AS_PLUS); end; if not (actasmtoken in [AS_COMMA,AS_SEPARATOR]) then @@ -1192,8 +1332,8 @@ const Consume(AS_COMMA); if actasmtoken = AS_REGISTER then begin - oper.opr.ref.index := - actasmregister; + opr.ref.index := + findregister(actasmpattern); Consume(AS_REGISTER); { check for scaling ... } case actasmtoken of @@ -1211,7 +1351,7 @@ const end; AS_STAR: begin - BuildScaling(oper); + BuildScaling; end; else begin @@ -1233,9 +1373,9 @@ const begin case actasmtoken of AS_INTNUM: str := actasmpattern; - AS_HEXNUM: str := Tostr(ParseVal(actasmpattern,16)); - AS_BINNUM: str := Tostr(ParseVal(actasmpattern,2)); - AS_OCTALNUM: str := Tostr(ParseVal(actasmpattern,8)); + AS_HEXNUM: str := Tostr(ValHexadecimal(actasmpattern)); + AS_BINNUM: str := Tostr(ValBinary(actasmpattern)); + AS_OCTALNUM: str := Tostr(ValOctal(actasmpattern)); else Message(asmr_e_syntax_error); end; @@ -1244,7 +1384,7 @@ const if code <> 0 then Message(asmr_e_invalid_reference_syntax) else - oper.opr.ref.offset := l; + opr.ref.offset := l; Consume(AS_RPAREN); if not (actasmtoken in [AS_COMMA,AS_SEPARATOR]) then begin @@ -1267,44 +1407,46 @@ const - Procedure TM68kMotreader.BuildOperand(const oper:tm68koperand); + Procedure TM68kOperand.BuildOperand; {*********************************************************************} { EXIT CONDITION: On exit the routine should point to either the } { AS_COMMA or AS_SEPARATOR token. } {*********************************************************************} var tempstr: string; + expr: string; lab: tasmlabel; l : longint; i: Tsuperregister; r:Tregister; hl: tasmlabel; reg_one, reg_two: tregister; - regset: tcpuregisterset; + reglist: Tsupregset; begin - regset := []; + reglist := []; tempstr := ''; + expr := ''; case actasmtoken of { // Memory reference // } AS_LPAREN: begin - Oper.InitRef; - BuildReference(oper); + InitRef; + BuildReference; end; { // Constant expression // } AS_APPT: begin Consume(AS_APPT); - if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then + if not (opr.typ in [OPR_NONE,OPR_CONSTANT]) then Message(asmr_e_invalid_operand_type); { identifiers are handled by BuildExpression } - oper.opr.typ := OPR_CONSTANT; - oper.opr.val :=BuildExpression(true,@tempstr); + opr.typ := OPR_CONSTANT; + opr.val :=BuildExpression(true,@tempstr); if tempstr<>'' then begin - l:=oper.opr.val; - oper.opr.typ := OPR_SYMBOL; - oper.opr.symofs := l; - oper.opr.symbol := objectlibrary.newasmsymbol(tempstr,AB_EXTERNAL,AT_FUNCTION); + l:=opr.val; + opr.typ := OPR_SYMBOL; + opr.symofs := l; + opr.symbol := objectlibrary.newasmsymbol(tempstr,AB_EXTERNAL,AT_FUNCTION); end; end; { // Constant memory offset . // } @@ -1312,21 +1454,21 @@ const AS_HEXNUM,AS_INTNUM, AS_BINNUM,AS_OCTALNUM,AS_PLUS: begin - Oper.InitRef; - oper.opr.ref.offset:=BuildRefExpression; - BuildReference(oper); + InitRef; + opr.ref.offset:=BuildRefExpression; + BuildReference; end; { // A constant expression, or a Variable ref. // } AS_ID: begin - Oper.InitRef; + InitRef; if actasmpattern[1] = '@' then { // Label or Special symbol reference // } begin if actasmpattern = '@RESULT' then - oper.SetUpResult + SetUpResult else if actasmpattern = 'SELF' then - oper.SetUpSelf + SetUpSelf else if (actasmpattern = '@CODE') or (actasmpattern = '@DATA') then Message(asmr_w_CODE_and_DATA_not_supported) @@ -1336,10 +1478,10 @@ const if actasmpattern = '' then Message(asmr_e_null_label_ref_not_allowed); CreateLocalLabel(actasmpattern,lab,false); - oper.opr.typ := OPR_SYMBOL; - oper.opr.symbol := lab; - oper.opr.symofs := 0; -// labeled := TRUE; + opr.typ := OPR_SYMBOL; + opr.symbol := lab; + opr.symofs := 0; + labeled := TRUE; end; Consume(AS_ID); if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then @@ -1352,9 +1494,9 @@ const { is it a constant ? } if SearchIConstant(actasmpattern,l) then begin - Oper.InitRef; - oper.opr.ref.offset:=BuildRefExpression; - BuildReference(oper); + InitRef; + opr.ref.offset:=BuildRefExpression; + BuildReference; end else { is it a label variable ? } begin @@ -1363,21 +1505,33 @@ const { emit it as a label. } if SearchLabel(actasmpattern,hl,false) then begin - oper.opr.typ := OPR_SYMBOL; - oper.opr.symbol := hl; - oper.opr.symofs := 0; -// labeled := TRUE; + opr.typ := OPR_SYMBOL; + opr.symbol := hl; + opr.symofs := 0; + labeled := TRUE; Consume(AS_ID); if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then Message(asmr_e_syntax_error); end else - Message1(sym_e_unknown_id,actasmpattern); + { is it a normal variable ? } + if (cs_compilesystem in aktmoduleswitches) then + begin + if not SetupDirectVar(expr) then + begin + { not found, finally ... add it anyways ... } + Message1(asmr_w_id_supposed_external,expr); + opr.ref.symbol:=objectlibrary.newasmsymbol(expr,AB_EXTERNAL,AT_FUNCTION); + end; + end + else + Message1(sym_e_unknown_id,actasmpattern); + expr := actasmpattern; Consume(AS_ID); case actasmtoken of AS_LPAREN: { indexing } - BuildReference(oper); + BuildReference; AS_SEPARATOR,AS_COMMA: ; else Message(asmr_e_syntax_error); @@ -1391,19 +1545,19 @@ const Consume(AS_MINUS); if actasmtoken = AS_LPAREN then begin - Oper.InitRef; + InitRef; { indicate pre-decrement mode } - oper.opr.ref.direction := dir_dec; - BuildReference(oper); + opr.ref.direction := dir_dec; + BuildReference; end else if actasmtoken in [AS_OCTALNUM,AS_HEXNUM,AS_BINNUM,AS_INTNUM] then begin - Oper.InitRef; - oper.opr.ref.offset:=BuildRefExpression; + InitRef; + opr.ref.offset:=BuildRefExpression; { negate because was preceded by a negative sign! } - oper.opr.ref.offset:=-oper.opr.ref.offset; - BuildReference(oper); + opr.ref.offset:=-opr.ref.offset; + BuildReference; end else begin @@ -1420,20 +1574,20 @@ const { // Simple register // } if (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA) then begin - if not (oper.opr.typ in [OPR_NONE,OPR_REGISTER]) then + if not (opr.typ in [OPR_NONE,OPR_REGISTER]) then Message(asmr_e_invalid_operand_type); - oper.opr.typ := OPR_REGISTER; - oper.opr.reg := actasmregister; + opr.typ := OPR_REGISTER; + opr.reg := findregister(tempstr); end else { HERE WE MUST HANDLE THE SPECIAL CASE OF MOVEM AND FMOVEM } { // Individual register listing // } if (actasmtoken = AS_SLASH) then begin - r:=actasmregister; - if getregtype(r)<>R_INTREGISTER then + r:=findregister(tempstr); + if r.enum<>R_INTREGISTER then internalerror(200302191); - include(regset,getsupreg(r)); + reglist := [r.number shr 8]; Consume(AS_SLASH); if actasmtoken = AS_REGISTER then begin @@ -1441,10 +1595,11 @@ const begin case actasmtoken of AS_REGISTER: begin - if getregtype(r)<>R_INTREGISTER then - internalerror(200302191); - include(regset,getsupreg(r)); - Consume(AS_REGISTER); + r:=findregister(tempstr); + if r.enum<>R_INTREGISTER then + internalerror(200302191); + reglist := reglist + [r.number shr 8]; + Consume(AS_REGISTER); end; AS_SLASH: Consume(AS_SLASH); AS_SEPARATOR,AS_COMMA: break; @@ -1455,8 +1610,8 @@ const end; end; { end case } end; { end while } - oper.opr.typ:= OPR_regset; - oper.opr.regset := regset; + opr.typ:= OPR_REGLIST; + opr.reglist := reglist; end else { error recovery ... } @@ -1471,7 +1626,7 @@ const if (actasmtoken = AS_MINUS) then begin Consume(AS_MINUS); - reg_one:=actasmregister; + reg_one:=findregister(tempstr); if actasmtoken <> AS_REGISTER then begin Message(asmr_e_invalid_reg_list_in_movem); @@ -1481,15 +1636,15 @@ const else begin { determine the register range ... } - reg_two:=actasmregister; - if getregtype(reg_two)<>R_INTREGISTER then + reg_two:=findregister(actasmpattern); + if reg_two.enum<>R_INTREGISTER then internalerror(200302191); - if getsupreg(reg_one) > getsupreg(reg_two) then - for i:=getsupreg(reg_two) to getsupreg(reg_one) do - include(regset,i) + if reg_one.enum > reg_two.enum then + for i:=reg_two.number shr 8 to reg_one.number shr 8 do + reglist:=reglist+[i] else - for i:=getsupreg(reg_one) to getsupreg(reg_two) do - include(regset,i); + for i:=reg_one.number shr 8 to reg_two.number shr 8 do + reglist:=reglist+[i]; Consume(AS_REGISTER); if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then begin @@ -1498,8 +1653,8 @@ const Consume(actasmtoken); end; { set up instruction } - oper.opr.typ:= OPR_regset; - oper.opr.regset := regset; + opr.typ:= OPR_REGLIST; + opr.reglist := reglist; end; end else @@ -1512,11 +1667,11 @@ const if (actasmtoken = AS_REGISTER) then begin { set up old field, since register is valid } - oper.opr.typ := OPR_REGISTER; - oper.opr.reg := actasmregister; + opr.typ := OPR_REGISTER; + opr.reg := findregister(tempstr); Inc(operandnum); - oper.opr.typ := OPR_REGISTER; - oper.opr.reg := actasmregister; + opr.typ := OPR_REGISTER; + opr.reg := findregister(actasmpattern); Consume(AS_REGISTER); if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then begin @@ -1551,7 +1706,9 @@ const - Procedure tm68kmotreader.BuildStringConstant(asciiz: boolean); + + + Procedure BuildStringConstant(asciiz: boolean); {*********************************************************************} { PROCEDURE BuildStringConstant } { Description: Takes care of a ASCII, or ASCIIZ directive. } @@ -1590,7 +1747,333 @@ const end; - Procedure TM68kmotReader.BuildOpCode(instr:Tm68kinstruction); +{***************************************************************************** + TM68kInstruction +*****************************************************************************} + + type + TM68kInstruction=class(TInstruction) + procedure InitOperands;override; + procedure ConcatInstruction(p : taasmoutput);override; + Procedure ConcatLabeledInstr(p : taasmoutput); + end; + + procedure TM68kInstruction.InitOperands; + var + i : longint; + begin + for i:=1 to max_operands do + Operands[i]:=TM68kOperand.Create; + end; + + + procedure TM68kInstruction.ConcatInstruction(p : taasmoutput); + var + fits : boolean; + begin + fits := FALSE; + { setup specific opcodetions for first pass } + + { Setup special operands } + { Convert to general form as to conform to the m68k opcode table } + if (opcode = A_ADDA) or (opcode = A_ADDI) + then opcode := A_ADD + else + { CMPM excluded because of GAS v1.34 BUG } + if (opcode = A_CMPA) or + (opcode = A_CMPI) then + opcode := A_CMP + else + if opcode = A_EORI then + opcode := A_EOR + else + if opcode = A_MOVEA then + opcode := A_MOVE + else + if opcode = A_ORI then + opcode := A_OR + else + if (opcode = A_SUBA) or (opcode = A_SUBI) then + opcode := A_SUB; + + { Setup operand types } + +(* + in opcode <> A_MOVEM then + begin + + while not(fits) do + begin + { set the opcodetion cache, if the opcodetion } + { occurs the first time } + if (it[i].i=opcode) and (ins_cache[opcode]=-1) then + ins_cache[opcode]:=i; + + if (it[i].i=opcode) and (instr.ops=it[i].ops) then + begin + { first fit } + case instr.ops of + 0 : begin + fits:=true; + break; + end; + 1 : + begin + if (optyp1 and it[i].o1)<>0 then + begin + fits:=true; + break; + end; + end; + 2 : if ((optyp1 and it[i].o1)<>0) and + ((optyp2 and it[i].o2)<>0) then + begin + fits:=true; + break; + end + 3 : if ((optyp1 and it[i].o1)<>0) and + ((optyp2 and it[i].o2)<>0) and + ((optyp3 and it[i].o3)<>0) then + begin + fits:=true; + break; + end; + end; { end case } + end; { endif } + if it[i].i=A_NONE then + begin + { NO MATCH! } + Message(asmr_e_invalid_combination_opcode_and_operand); + exit; + end; + inc(i); + end; { end while } + *) + fits:=TRUE; + + { We add the opcode to the opcode linked list } + if fits then + begin + case ops of + 0: + if opsize <> S_NO then + p.concat((taicpu.op_none(opcode,opsize))) + else + p.concat((taicpu.op_none(opcode,S_NO))); + 1: begin + case operands[1].opr.typ of + OPR_SYMBOL: + begin + p.concat((taicpu.op_sym_ofs(opcode, + opsize, operands[1].opr.symbol,operands[1].opr.symofs))); + end; + OPR_CONSTANT: + begin + p.concat((taicpu.op_const(opcode, + opsize, operands[1].opr.val))); + end; + OPR_REGISTER: + p.concat((taicpu.op_reg(opcode,opsize,operands[1].opr.reg))); + OPR_REFERENCE: + if opsize <> S_NO then + begin + p.concat((taicpu.op_ref(opcode, + opsize,operands[1].opr.ref))); + end + else + begin + { special jmp and call case with } + { symbolic references. } + if opcode in [A_BSR,A_JMP,A_JSR,A_BRA,A_PEA] then + begin + p.concat((taicpu.op_ref(opcode, + S_NO,operands[1].opr.ref))); + end + else + Message(asmr_e_invalid_opcode_and_operand); + end; + OPR_NONE: + Message(asmr_e_invalid_opcode_and_operand); + else + begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; + end; + 2: begin + { source } + case operands[1].opr.typ of + { reg,reg } + { reg,ref } + OPR_REGISTER: + begin + case operands[2].opr.typ of + OPR_REGISTER: + begin + p.concat((taicpu.op_reg_reg(opcode, + opsize,operands[1].opr.reg,operands[2].opr.reg))); + end; + OPR_REFERENCE: + p.concat((taicpu.op_reg_ref(opcode, + opsize,operands[1].opr.reg,operands[2].opr.ref))); + else { else case } + begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end second operand case for OPR_REGISTER } + end; + { reglist, ref } + OPR_REGLIST: + begin + case operands[2].opr.typ of + OPR_REFERENCE : + p.concat((taicpu.op_reglist_ref(opcode, + opsize,operands[1].opr.reglist,operands[2].opr.ref))); + else + begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end second operand case for OPR_REGLIST } + end; + + { const,reg } + { const,const } + { const,ref } + OPR_CONSTANT: + case operands[2].opr.typ of + { constant, constant does not have a specific size. } + OPR_CONSTANT: + p.concat((taicpu.op_const_const(opcode, + S_NO,operands[1].opr.val,operands[2].opr.val))); + OPR_REFERENCE: + begin + p.concat((taicpu.op_const_ref(opcode, + opsize,operands[1].opr.val, + operands[2].opr.ref))) + end; + OPR_REGISTER: + begin + p.concat((taicpu.op_const_reg(opcode, + opsize,operands[1].opr.val, + operands[2].opr.reg))) + end; + else + begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end second operand case for OPR_CONSTANT } + { ref,reg } + { ref,ref } + OPR_REFERENCE: + case operands[2].opr.typ of + OPR_REGISTER: + begin + p.concat((taicpu.op_ref_reg(opcode, + opsize,operands[1].opr.ref, + operands[2].opr.reg))); + end; + OPR_REGLIST: + begin + p.concat((taicpu.op_ref_reglist(opcode, + opsize,operands[1].opr.ref, + operands[2].opr.reglist))); + end; + OPR_REFERENCE: { special opcodes } + p.concat((taicpu.op_ref_ref(opcode, + opsize,operands[1].opr.ref, + operands[2].opr.ref))); + else + begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end second operand case for OPR_REFERENCE } + OPR_SYMBOL: case operands[2].opr.typ of + OPR_REFERENCE: + begin + p.concat((taicpu.op_sym_ofs_ref(opcode, + opsize,operands[1].opr.symbol,operands[1].opr.symofs, + operands[2].opr.ref))) + end; + OPR_REGISTER: + begin + p.concat((taicpu.op_sym_ofs_reg(opcode, + opsize,operands[1].opr.symbol,operands[1].opr.symofs, + operands[2].opr.reg))) + end; + else + begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end second operand case for OPR_SYMBOL } + else + begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end first operand case } + end; + 3: begin + if (opcode = A_DIVSL) or (opcode = A_DIVUL) or (opcode = A_MULU) + or (opcode = A_MULS) or (opcode = A_DIVS) or (opcode = A_DIVU) then + begin + if (operands[1].opr.typ <> OPR_REGISTER) + or (operands[2].opr.typ <> OPR_REGISTER) + or (operands[3].opr.typ <> OPR_REGISTER) then + begin + Message(asmr_e_invalid_opcode_and_operand); + end + else + begin + p.concat((taicpu. op_reg_reg_reg(opcode,opsize, + operands[1].opr.reg,operands[2].opr.reg,operands[3].opr.reg))); + end; + end + else + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end case } + end; + end; + + + procedure TM68kInstruction.ConcatLabeledInstr(p : taasmoutput); + begin + if ((opcode >= A_BCC) and (opcode <= A_BVS)) or + (opcode = A_BRA) or (opcode = A_BSR) or + (opcode = A_JMP) or (opcode = A_JSR) or + ((opcode >= A_FBEQ) and (opcode <= A_FBNGLE)) then + begin + if ops > 2 then + Message(asmr_e_invalid_opcode_and_operand) + else if operands[1].opr.typ <> OPR_SYMBOL then + Message(asmr_e_invalid_opcode_and_operand) + else if (operands[1].opr.typ = OPR_SYMBOL) and + (ops = 1) then + if assigned(operands[1].opr.symbol) and + (operands[1].opr.symofs=0) then + p.concat(taicpu.op_sym(opcode,S_NO, + operands[1].opr.symbol)) + else + Message(asmr_e_invalid_opcode_and_operand); + end + else if ((opcode >= A_DBCC) and (opcode <= A_DBF)) + or ((opcode >= A_FDBEQ) and (opcode <= A_FDBNGLE)) then + begin + if (ops<>2) or + (operands[1].opr.typ <> OPR_REGISTER) or + (operands[2].opr.typ <> OPR_SYMBOL) or + (operands[2].opr.symofs <> 0) then + Message(asmr_e_invalid_opcode_and_operand) + else + p.concat(taicpu.op_reg_sym(opcode,opsize,operands[1].opr.reg, + operands[2].opr.symbol)); + end + else + Message(asmr_e_invalid_opcode_and_operand); + end; + + + + Procedure TM68kReader.BuildOpCode(instr:Tm68kinstruction); {*********************************************************************} { PROCEDURE BuildOpcode; } { Description: Parses the intel opcode and operands, and writes it } @@ -1599,9 +2082,13 @@ const { EXIT CONDITION: On exit the routine should point to AS_SEPARATOR. } { On ENTRY: Token should point to AS_OPCODE } {*********************************************************************} - var + var asmtok: tasmop; + expr: string; operandnum : longint; begin + expr := ''; + asmtok := A_NONE; { assmume no prefix } + { // opcode // } { allow for newline as in gas styled syntax } { under DOS you get two AS_SEPARATOR !! } @@ -1617,7 +2104,7 @@ const end else begin - Instr.opcode := findopcode(actasmpattern,instr.opsize); + Instr.opcode := findopcode(actasmpattern,opsize); Consume(AS_OPCODE); { // Zero operand opcode ? // } if actasmtoken = AS_SEPARATOR then @@ -1640,7 +2127,7 @@ const { // End of asm operands for this opcode // } AS_SEPARATOR: ; else - BuildOperand(Instr.Operands[operandnum] as tm68koperand); + Instr.Operands[operandnum].BuildOperand; end; { end case } end; { end while } end; @@ -1648,10 +2135,12 @@ const - function tm68kmotreader.Assemble: tlinkedlist; + function tm68kreader.Assemble: tlinkedlist; var hl: tasmlabel; - instr : TM68kInstruction; + labelptr,nextlabel : tasmlabel; + commname : string; + instr : TM68kInstruction; begin Message(asmr_d_start_reading); firsttoken := TRUE; @@ -1666,7 +2155,7 @@ const { setup label linked list } LocalLabelList:=TLocalLabelList.Create; c:=current_scanner.asmgetchar; - gettoken; + actasmtoken:=gettoken; while actasmtoken<>AS_END do begin case actasmtoken of @@ -1699,7 +2188,7 @@ const AS_DD: begin Consume(AS_DD); - BuildConstant(longint($ffffffff)); + BuildConstant($ffffffff); end; AS_XDEF: begin @@ -1718,7 +2207,7 @@ const end; AS_OPCODE: begin - instr:=TM68kInstruction.Create(tm68koperand); + instr:=TM68kInstruction.Create; BuildOpcode(instr); { instr.AddReferenceSizes;} { instr.SetInstructionOpsize;} @@ -1777,14 +2266,6 @@ const casmreader : tm68kmotreader; ); - asmmode_m68k_standard_info : tasmmodeinfo = - ( - id : asmmode_standard; - idtxt : 'STANDARD'; - casmreader : tm68kmotreader; - ); - begin - RegisterAsmMode(asmmode_m68k_mot_info); - RegisterAsmMode(asmmode_m68k_standard_info); + RegisterAsmMode(asmmode_i386_intel_info); end. diff --git a/compiler/m68k/rgcpu.pas b/compiler/m68k/rgcpu.pas index 4911fca540..bd104b21d2 100644 --- a/compiler/m68k/rgcpu.pas +++ b/compiler/m68k/rgcpu.pas @@ -20,6 +20,7 @@ **************************************************************************** } +{$i fpcdefs.inc} unit rgcpu; {$i fpcdefs.inc} diff --git a/compiler/msg/errore.msg b/compiler/msg/errore.msg index 01caec5f83..ae4b40dc7c 100644 --- a/compiler/msg/errore.msg +++ b/compiler/msg/errore.msg @@ -1016,10 +1016,6 @@ parser_e_protected_or_private_expected=03214_E_Protected or private expected % \var{strict} can be only used together with \var{protected} or \var{private}. parser_e_illegal_slice=03215_E_SLICE can't be used outside of parameter list % \var{slice} can be used only for arguments accepting an open array parameter -parser_e_dispinterface_cant_have_parent=03216_E_A DISPINTERFACE can't have a parent class -% A DISPINMTERFACE is a special type of interface which can't have a parent class -parser_e_dispinterface_needs_a_guid=03217_E_A DISPINTERFACE needs a guid -% A DISPINMTERFACE needs always an interface identification % \end{description} # # Type Checking @@ -1510,7 +1506,7 @@ cg_e_break_not_allowed=06044_E_BREAK not allowed % You're trying to use \var{break} outside a loop construction. cg_e_continue_not_allowed=06045_E_CONTINUE not allowed % You're trying to use \var{continue} outside a loop construction. -cg_f_unknown_compilerproc=06046_F_Unknown compilerproc "$1". Check if you use the correct run time library. +cg_f_unknown_compiler=06046_F_Unknown compilerproc "$1". Check if you use the correct run time library. % The compiler expects that the runtime library contains some subrountines. If you see this error % and you didn't mess with the runtime library, it's very likely that the runtime library % you're using doesn't match the used compiler. If you changed the runtime library this error means @@ -2274,8 +2270,6 @@ S*2Aas_assemble using GNU AS **2Mgpc_tries to be gpc compatible **2Mmacpas_tries to be compatible to the macintosh pascal dialects **1n_don't read the default config file -**1N<x>_node tree optimizations -**2Nu_unroll loops **1o<x>_change the name of the executable produced to <x> **1O<x>_optimizations: 3*2Oa_<type>=<values> set alignment @@ -2341,7 +2335,6 @@ S*2Aas_assemble using GNU AS 3*2Twatcom_Watcom compatible DOS extender 3*2Twdosx_WDOSX DOS extender 3*2Twin32_Windows 32 Bit -3*2Twince_Windows CE 4*2Tlinux_Linux 6*2Tamiga_Commodore Amiga 6*2Tatari_Atari ST/STe/TT @@ -2349,7 +2342,6 @@ S*2Aas_assemble using GNU AS 6*2Tmacos_Macintosh m68k (not supported) 6*2Tpalmos_PalmOS A*2Tlinux_Linux -A*2Twince_Windows CE P*2Tdarwin_Darwin and MacOS X on PowerPC P*2Tlinux_Linux on PowerPC P*2Tmacos_MacOS (classic) on PowerPC diff --git a/compiler/msgidx.inc b/compiler/msgidx.inc index f0294ba868..839905cfcc 100644 --- a/compiler/msgidx.inc +++ b/compiler/msgidx.inc @@ -286,8 +286,6 @@ const parser_e_arithmetic_operation_overflow=03213; parser_e_protected_or_private_expected=03214; parser_e_illegal_slice=03215; - parser_e_dispinterface_cant_have_parent=03216; - parser_e_dispinterface_needs_a_guid=03217; type_e_mismatch=04000; type_e_incompatible_types=04001; type_e_not_equal_types=04002; @@ -414,7 +412,7 @@ const cg_e_localsize_too_big=06043; cg_e_break_not_allowed=06044; cg_e_continue_not_allowed=06045; - cg_f_unknown_compilerproc=06046; + cg_f_unknown_compiler=06046; asmr_d_start_reading=07000; asmr_d_finish_reading=07001; asmr_e_none_label_contain_at=07002; @@ -663,9 +661,9 @@ const option_info=11024; option_help_pages=11025; - MsgTxtSize = 39282; + MsgTxtSize = 39103; MsgIdxMax : array[1..20] of longint=( - 19,73,218,59,59,47,100,20,135,60, + 19,73,216,59,59,47,100,20,135,60, 40,1,1,1,1,1,1,1,1,1 ); diff --git a/compiler/msgtxt.inc b/compiler/msgtxt.inc index 0c38e0d26a..4009e4bd51 100644 --- a/compiler/msgtxt.inc +++ b/compiler/msgtxt.inc @@ -1,7 +1,7 @@ {$ifdef Delphi} -const msgtxt : array[0..000163] of string[240]=( +const msgtxt : array[0..000162] of string[240]=( {$else Delphi} -const msgtxt : array[0..000163,1..240] of char=( +const msgtxt : array[0..000162,1..240] of char=( {$endif Delphi} '01000_T_Compiler: $1'#000+ '01001_D_Compiler OS: $1'#000+ @@ -320,638 +320,630 @@ const msgtxt : array[0..000163,1..240] of char=( '03213_E_Overflow in arithmetic operation'#000+ '03214_E_Prote','cted or private expected'#000+ '03215_E_SLICE can'#039't be used outside of parameter list'#000+ - '03216_E_A DISPINTERFACE can'#039't have a parent class'#000+ - '03217_E_A DISPINTERFACE needs a guid'#000+ '04000_E_Type mismatch'#000+ '04001_E_Incompatible types: got "$1" expected "$2"'#000+ - '0','4002_E_Type mismatch between "$1" and "$2"'#000+ + '04002_E_Type mismatch between "$1" and "$2"'#000+ '04003_E_Type identifier expected'#000+ - '04004_E_Variable identifier expected'#000+ + '04004_E_Var','iable identifier expected'#000+ '04005_E_Integer expression expected, but got "$1"'#000+ '04006_E_Boolean expression expected, but got "$1"'#000+ - '04007_E_Ordinal expression ','expected'#000+ + '04007_E_Ordinal expression expected'#000+ '04008_E_pointer type expected, but got "$1"'#000+ - '04009_E_class type expected, but got "$1"'#000+ + '04009_E_class type expected, but g','ot "$1"'#000+ '04011_E_Can'#039't evaluate constant expression'#000+ '04012_E_Set elements are not compatible'#000+ '04013_E_Operation not implemented for sets'#000+ - '04014_W_Automatic t','ype conversion from floating type to COMP which i'+ - 's an integer type'#000+ - '04015_H_use DIV instead to get an integer result'#000+ + '04014_W_Automatic type conversion from floating type to COMP which is '+ + 'an integer type'#000+ + '04015_H_use DIV inst','ead to get an integer result'#000+ '04016_E_string types doesn'#039't match, because of $V+ mode'#000+ '04017_E_succ or pred on enums with assignments not possible'#000+ - '04018_E_','Can'#039't read or write variables of this type'#000+ - '04019_E_Can'#039't use readln or writeln on typed file'#000+ + '04018_E_Can'#039't read or write variables of this type'#000+ + '04019_E_Can'#039't use readln or writeln on typed',' file'#000+ '04020_E_Can'#039't use read or write on untyped file.'#000+ '04021_E_Type conflict between set elements'#000+ - '04022_W_lo/hi(dword/qword) returns the upper/lower word','/dword'#000+ + '04022_W_lo/hi(dword/qword) returns the upper/lower word/dword'#000+ '04023_E_Integer or real expression expected'#000+ - '04024_E_Wrong type "$1" in array constructor'#000+ + '04024_E_Wrong type "$1" in array con','structor'#000+ '04025_E_Incompatible type for arg no. $1: Got "$2", expected "$3"'#000+ '04026_E_Method (variable) and Procedure (variable) are not compatible'#000+ - '04027_E_','Illegal constant passed to internal math function'#000+ - '04028_E_Can'#039't get the address of constants'#000+ + '04027_E_Illegal constant passed to internal math function'#000+ + '04028_E_Can'#039't get the address of cons','tants'#000+ '04029_E_Argument can'#039't be assigned to'#000+ '04030_E_Can'#039't assign local procedure/function to procedure variabl'+ 'e'#000+ - '04031_E_Can'#039't assign values to an address',#000+ + '04031_E_Can'#039't assign values to an address'#000+ '04032_E_Can'#039't assign values to const variable'#000+ '04033_E_Array type required'#000+ - '04034_E_interface type expected, but got "$1"'#000+ + '04034_E_inte','rface type expected, but got "$1"'#000+ '04035_W_Mixing signed expressions and longwords gives a 64bit result'#000+ - '04036_W_Mixing signed expressions and cardinals he','re may cause a ran'+ - 'ge check error'#000+ - '04037_E_Typecast has different size ($1 -> $2) in assignment'#000+ + '04036_W_Mixing signed expressions and cardinals here may cause a range'+ + ' check error'#000+ + '04037_E_Typecast has different size ($1 -> $2) in assi','gnment'#000+ '04038_E_enums with assignments can'#039't be used as array index'#000+ '04039_E_Class or Object types "$1" and "$2" are not related'#000+ - '04040_W_Class types "$1" a','nd "$2" are not related'#000+ + '04040_W_Class types "$1" and "$2" are not related'#000+ '04041_E_Class or interface type expected, but got "$1"'#000+ - '04042_E_Type "$1" is not completely defined'#000+ + '04042_E_','Type "$1" is not completely defined'#000+ '04043_W_String literal has more characters than short string length'#000+ - '04044_W_Comparison is always false due to range o','f values'#000+ + '04044_W_Comparison is always false due to range of values'#000+ '04045_W_Comparison is always true due to range of values'#000+ - '04046_W_Constructing a class "$1" with abstract methods'#000+ + '04046_W_Constructing ','a class "$1" with abstract methods'#000+ '04047_H_The left operand of the IN operator should be byte sized'#000+ - '04048_W_Type size mismatch, possible loss of data / r','ange check erro'+ - 'r'#000+ - '04049_H_Type size mismatch, possible loss of data / range check error'#000+ + '04048_W_Type size mismatch, possible loss of data / range check error'#000+ + '04049_H_Type size mismatch, possible loss of data / range check error'#000, '04050_E_The address of an abstract method can'#039't be taken'#000+ '04051_E_The operator is not applicable for the operand type'#000+ - '04052_E_Constant Expression expected',#000+ + '04052_E_Constant Expression expected'#000+ '04053_E_Operation "$1" not supported for types "$2" and "$3"'#000+ - '04054_E_Illegal type conversion: "$1" to "$2"'#000+ + '04054_E_Illegal type conv','ersion: "$1" to "$2"'#000+ '04055_H_Conversion between ordinals and pointers is not portable'#000+ '04056_W_Conversion between ordinals and pointers is not portable'#000+ - '04','057_E_Can'#039't determine which overloaded function to call'#000+ - '04058_E_Illegal counter variable'#000+ + '04057_E_Can'#039't determine which overloaded function to call'#000+ + '04058_E_Illegal counter variabl','e'#000+ '05000_E_Identifier not found "$1"'#000+ '05001_F_Internal Error in SymTableStack()'#000+ '05002_E_Duplicate identifier "$1"'#000+ - '05003_H_Identifier already defined in $1 ','at line $2'#000+ + '05003_H_Identifier already defined in $1 at line $2'#000+ '05004_E_Unknown identifier "$1"'#000+ - '05005_E_Forward declaration not solved "$1"'#000+ + '05005_E_Forward declaration not solved "$1"'#000, '05007_E_Error in type definition'#000+ '05009_E_Forward type not resolved "$1"'#000+ '05010_E_Only static variables can be used in static methods or outside'+ ' methods'#000+ - '05','012_F_record or class type expected'#000+ - '05013_E_Instances of classes or objects with an abstract method are no'+ - 't allowed'#000+ + '05012_F_record or class type expected'#000+ + '05013_E_Instances of classes or objects with an abs','tract method are '+ + 'not allowed'#000+ '05014_W_Label not defined "$1"'#000+ '05015_E_Label used but not defined "$1"'#000+ '05016_E_Illegal label declaration'#000+ - '05017_E_GOTO and LA','BEL are not supported (use switch -Sg)'#000+ + '05017_E_GOTO and LABEL are not supported (use switch -Sg)'#000+ '05018_E_Label not found'#000+ - '05019_E_identifier isn'#039't a label'#000+ + '05019_E_identifier isn'#039't',' a label'#000+ '05020_E_label already defined'#000+ '05021_E_illegal type declaration of set elements'#000+ '05022_E_Forward class definition not resolved "$1"'#000+ - '05023_H_Unit "','$1" not used in $2'#000+ + '05023_H_Unit "$1" not used in $2'#000+ '05024_H_Parameter "$1" not used'#000+ - '05025_N_Local variable "$1" not used'#000+ + '05025_N_Local variable "$1" not used',#000+ '05026_H_Value parameter "$1" is assigned but never used'#000+ '05027_N_Local variable "$1" is assigned but never used'#000+ '05028_H_Local $1 "$2" is not used'#000+ - '05029_N','_Private field "$1.$2" is never used'#000+ - '05030_N_Private field "$1.$2" is assigned but never used'#000+ + '05029_N_Private field "$1.$2" is never used'#000+ + '05030_N_Private field "$1.$2" is assigned but neve','r used'#000+ '05031_N_Private method "$1.$2" never used'#000+ '05032_E_Set type expected'#000+ '05033_W_Function result does not seem to be set'#000+ - '05034_W_Type "$1" is not align','ed correctly in current record for C'#000+ + '05034_W_Type "$1" is not aligned correctly in current record for C'#000+ '05035_E_Unknown record field identifier "$1"'#000+ - '05036_W_Local variable "$1" does not seem to be initialized'#000+ + '05036','_W_Local variable "$1" does not seem to be initialized'#000+ '05037_W_Variable "$1" does not seem to be initialized'#000+ '05038_E_identifier idents no member "$1"'#000+ - '050','39_H_Found declaration: $1'#000+ + '05039_H_Found declaration: $1'#000+ '05040_E_Data element too large'#000+ - '05042_E_No matching implementation for interface method "$1" found'#000+ + '05042_E_No matching implement','ation for interface method "$1" found'#000+ '05043_W_Symbol "$1" is deprecated'#000+ '05044_W_Symbol "$1" is not portable'#000+ '05055_W_Symbol "$1" is not implemented'#000+ - '05056_','E_Can'#039't create unique type from this type'#000+ - '05057_H_Local variable "$1" does not seem to be initialized'#000+ + '05056_E_Can'#039't create unique type from this type'#000+ + '05057_H_Local variable "$1" does not seem to ','be initialized'#000+ '05058_H_Variable "$1" does not seem to be initialized'#000+ '06009_E_Parameter list size exceeds 65535 bytes'#000+ - '06012_E_File types must be var param','eters'#000+ + '06012_E_File types must be var parameters'#000+ '06013_E_The use of a far pointer isn'#039't allowed there'#000+ - '06015_E_EXPORT declared functions can'#039't be called'#000+ + '06015_E_EXPORT declared func','tions can'#039't be called'#000+ '06016_W_Possible illegal call of constructor or destructor'#000+ '06017_N_Inefficient code'#000+ '06018_W_unreachable code'#000+ - '06020_E_Abstract metho','ds can'#039't be called directly'#000+ + '06020_E_Abstract methods can'#039't be called directly'#000+ '06027_DL_Register $1 weight $2 $3'#000+ - '06029_DL_Stack frame is omitted'#000+ + '06029_DL_Stack frame is o','mitted'#000+ '06031_E_Object or class methods can'#039't be inline.'#000+ '06032_E_Procvar calls cannot be inline.'#000+ '06033_E_No code for inline procedure stored'#000+ - '06035_E_Eleme','nt zero of an ansi/wide- or longstring can'#039't be acc'+ - 'essed, use (set)length instead'#000+ - '06037_E_Constructors or destructors can not be called inside a '#039'wi'+ - 'th'#039' clause'#000+ + '06035_E_Element zero of an ansi/wide- or longstring can'#039't be acces'+ + 'sed, use (set)length instead'#000+ + '06037','_E_Constructors or destructors can not be called inside a '#039'w'+ + 'ith'#039' clause'#000+ '06038_E_Cannot call message handler methods directly'#000+ - '06039_E_Jump in or outside o','f an exception block'#000+ - '06040_E_Control flow statements aren'#039't allowed in a finally block'#000+ + '06039_E_Jump in or outside of an exception block'#000+ + '06040_E_Control flow statements aren'#039't allowed in a finally block'#000, '06041_W_Parameters size exceeds limit for certain cpu'#039's'#000+ '06042_W_Local variable size exceed limit for certain cpu'#039's'#000+ - '06043_E_Local variables size exceeds s','upported limit'#000+ + '06043_E_Local variables size exceeds supported limit'#000+ '06044_E_BREAK not allowed'#000+ '06045_E_CONTINUE not allowed'#000+ - '06046_F_Unknown compilerproc "$1". Check if you use the correct run ti'+ - 'me library.'#000+ + '06046_F_Unknown c','ompilerproc "$1". Check if you use the correct run '+ + 'time library.'#000+ '07000_DL_Starting $1 styled assembler parsing'#000+ - '07001_DL_Finished $1 styled assembler pars','ing'#000+ + '07001_DL_Finished $1 styled assembler parsing'#000+ '07002_E_Non-label pattern contains @'#000+ '07004_E_Error building record offset'#000+ - '07005_E_OFFSET used without identifier'#000+ + '07005_E_O','FFSET used without identifier'#000+ '07006_E_TYPE used without identifier'#000+ '07007_E_Cannot use local variable or parameters here'#000+ '07008_E_need to use OFFSET here'#000+ - '0','7009_E_need to use $ here'#000+ + '07009_E_need to use $ here'#000+ '07010_E_Cannot use multiple relocatable symbols'#000+ - '07011_E_Relocatable symbol can only be added'#000+ + '07011_E_Reloc','atable symbol can only be added'#000+ '07012_E_Invalid constant expression'#000+ '07013_E_Relocatable symbol is not allowed'#000+ '07014_E_Invalid reference syntax'#000+ - '07015_E_Yo','u can not reach $1 from that code'#000+ - '07016_E_Local symbols/labels aren'#039't allowed as references'#000+ + '07015_E_You can not reach $1 from that code'#000+ + '07016_E_Local symbols/labels aren'#039't allowed as refere','nces'#000+ '07017_E_Invalid base and index register usage'#000+ '07018_W_Possible error in object field handling'#000+ '07019_E_Wrong scale factor specified'#000+ - '07020_E_Multiple ','index register usage'#000+ + '07020_E_Multiple index register usage'#000+ '07021_E_Invalid operand type'#000+ - '07022_E_Invalid string as opcode operand: $1'#000+ + '07022_E_Invalid string as opcode oper','and: $1'#000+ '07023_W_@CODE and @DATA not supported'#000+ '07024_E_Null label references are not allowed'#000+ '07025_E_Divide by zero in asm evaluator'#000+ - '07026_E_Illegal expre','ssion'#000+ + '07026_E_Illegal expression'#000+ '07027_E_escape sequence ignored: $1'#000+ '07028_E_Invalid symbol reference'#000+ - '07029_W_Fwait can cause emulation problems with emu387'#000+ + '07029_W_Fwai','t can cause emulation problems with emu387'#000+ '07030_W_$1 without operand translated into $1P'#000+ '07031_W_ENTER instruction is not supported by Linux kernel'#000+ - '0703','2_W_Calling an overload function in assembler'#000+ - '07033_E_Unsupported symbol type for operand'#000+ + '07032_W_Calling an overload function in assembler'#000+ + '07033_E_Unsupported symbol type for opera','nd'#000+ '07034_E_Constant value out of bounds'#000+ '07035_E_Error converting decimal $1'#000+ '07036_E_Error converting octal $1'#000+ '07037_E_Error converting binary $1'#000+ - '07038_E_','Error converting hexadecimal $1'#000+ + '07038_E_Error converting hexadecimal $1'#000+ '07039_H_$1 translated to $2'#000+ - '07040_W_$1 is associated to an overloaded function'#000+ + '07040_W_$1 is associated to',' an overloaded function'#000+ '07041_E_Cannot use SELF outside a method'#000+ '07042_E_Cannot use OLDEBP outside a nested procedure'#000+ - '07043_W_Procedures can'#039't return any',' value in asm code'#000+ + '07043_W_Procedures can'#039't return any value in asm code'#000+ '07044_E_SEG not supported'#000+ - '07045_E_Size suffix and destination or source size do not match'#000+ + '07045_E_Size suffix and destination or sou','rce size do not match'#000+ '07046_W_Size suffix and destination or source size do not match'#000+ '07047_E_Assembler syntax error'#000+ - '07048_E_Invalid combination of opcod','e and operands'#000+ + '07048_E_Invalid combination of opcode and operands'#000+ '07049_E_Assembler syntax error in operand'#000+ - '07050_E_Assembler syntax error in constant'#000+ + '07050_E_Assembler syntax error',' in constant'#000+ '07051_E_Invalid String expression'#000+ '07052_W_constant with symbol $1 for address which is not on a pointer'#000+ '07053_E_Unrecognized opcode $1'#000+ - '07054','_E_Invalid or missing opcode'#000+ + '07054_E_Invalid or missing opcode'#000+ '07055_E_Invalid combination of prefix and opcode: $1'#000+ - '07056_E_Invalid combination of override and opcode: $1'#000+ + '07056','_E_Invalid combination of override and opcode: $1'#000+ '07057_E_Too many operands on line'#000+ '07058_W_NEAR ignored'#000+ '07059_W_FAR ignored'#000+ - '07060_E_Duplicate local symb','ol $1'#000+ + '07060_E_Duplicate local symbol $1'#000+ '07061_E_Undefined local symbol $1'#000+ '07062_E_Unknown label identifier $1'#000+ - '07063_E_Invalid register name'#000+ + '07063_E_Inv','alid register name'#000+ '07064_E_Invalid floating point register name'#000+ '07066_W_Modulo not supported'#000+ '07067_E_Invalid floating point constant $1'#000+ - '07068_E_Invalid f','loating point expression'#000+ + '07068_E_Invalid floating point expression'#000+ '07069_E_Wrong symbol type'#000+ - '07070_E_Cannot index a local var or parameter with a register'#000+ + '07070_E_Cannot index a local var or ','parameter with a register'#000+ '07071_E_Invalid segment override expression'#000+ '07072_W_Identifier $1 supposed external'#000+ '07073_E_Strings not allowed as constants'#000+ - '07','074_No type of variable specified'#000+ + '07074_No type of variable specified'#000+ '07075_E_assembler code not returned to text section'#000+ - '07076_E_Not a directive or local symbol $1'#000+ + '0','7076_E_Not a directive or local symbol $1'#000+ '07077_E_Using a defined name as a local label'#000+ '07078_E_Dollar token is used without an identifier'#000+ - '07079_W_32bit ','constant created for address'#000+ - '07080_N_.align is target specific, use .balign or .p2align'#000+ + '07079_W_32bit constant created for address'#000+ + '07080_N_.align is target specific, use .balign or .p2align',#000+ '07081_E_Can'#039't access fields directly for parameters'#000+ '07082_E_Can'#039't access fields of objects/classes directly'#000+ - '07083_E_No size specified and unable to dete','rmine the size of the op'+ - 'erands'#000+ + '07083_E_No size specified and unable to determine the size of the oper'+ + 'ands'#000+ '07084_E_Cannot use RESULT in this function'#000+ - '07086_W_"$1" without operand translated into "$1 %st,%st(1)"'#000+ + '07086_W_"$1" ','without operand translated into "$1 %st,%st(1)"'#000+ '07087_W_"$1 %st(n)" translated into "$1 %st,%st(n)"'#000+ '07088_W_"$1 %st(n)" translated into "$1 %st(n),%st"'#000+ - '0','7089_E_Char < not allowed here'#000+ + '07089_E_Char < not allowed here'#000+ '07090_E_Char > not allowed here'#000+ - '07093_W_ALIGN not supported'#000+ + '07093_W_ALIGN not suppor','ted'#000+ '07094_E_Inc and Dec cannot be together'#000+ '07095_E_Invalid reglist for movem'#000+ '07096_E_Reglist invalid for opcode'#000+ '07097_E_Higher cpu mode required ($1)'#000+ - '070','98_W_No size specified and unable to determine the size of the op'+ - 'erands, using DWORD as default'#000+ + '07098_W_No size specified and unable to determine the size of the oper'+ + 'ands, using DWORD as',' default'#000+ '07099_E_Syntax error while trying to parse a shifter operand'#000+ '08000_F_Too many assembler files'#000+ '08001_F_Selected assembler output not supported'#000+ - '08','002_F_Comp not supported'#000+ + '08002_F_Comp not supported'#000+ '08003_F_Direct not support for binary writers'#000+ - '08004_E_Allocating of data is only allowed in bss section'#000+ + '08004_E_Allocati','ng of data is only allowed in bss section'#000+ '08005_F_No binary writer selected'#000+ '08006_E_Asm: Opcode $1 not in table'#000+ - '08007_E_Asm: $1 invalid combination of op','code and operands'#000+ + '08007_E_Asm: $1 invalid combination of opcode and operands'#000+ '08008_E_Asm: 16 Bit references not supported'#000+ - '08009_E_Asm: Invalid effective address'#000+ + '08009_E_Asm: Invalid eff','ective address'#000+ '08010_E_Asm: Immediate or reference expected'#000+ '08011_E_Asm: $1 value exceeds bounds $2'#000+ '08012_E_Asm: Short jump is out of range $1'#000+ - '08013_E_As','m: Undefined label $1'#000+ + '08013_E_Asm: Undefined label $1'#000+ '08014_E_Asm: Comp type not supported for this target'#000+ - '08015_E_Asm: Extended type not supported for this target'#000+ + '08015_E_Asm:',' Extended type not supported for this target'#000+ '08016_E_Asm: Duplicate label $1'#000+ '08017_E_Asm: Redefined label $1'#000+ '08018_E_Asm: First defined here'#000+ - '08019_E_Asm:',' Invalid register $1'#000+ + '08019_E_Asm: Invalid register $1'#000+ '09000_W_Source operating system redefined'#000+ - '09001_I_Assembling (pipe) $1'#000+ + '09001_I_Assembling (pipe',') $1'#000+ '09002_E_Can'#039't create assembler file: $1'#000+ '09003_E_Can'#039't create object file: $1'#000+ '09004_E_Can'#039't create archive file: $1'#000+ - '09005_E_Assembler $1 not found, s','witching to external assembling'#000+ + '09005_E_Assembler $1 not found, switching to external assembling'#000+ '09006_T_Using assembler: $1'#000+ - '09007_E_Error while assembling exitcode $1'#000+ + '09007_E_Error while assembl','ing exitcode $1'#000+ '09008_E_Can'#039't call the assembler, error $1 switching to external a'+ 'ssembling'#000+ '09009_I_Assembling $1'#000+ - '09010_I_Assembling with smartlinking $1',#000+ + '09010_I_Assembling with smartlinking $1'#000+ '09011_W_Object $1 not found, Linking may fail !'#000+ - '09012_W_Library $1 not found, Linking may fail !'#000+ + '09012_W_Library $1 not found, Linking ','may fail !'#000+ '09013_E_Error while linking'#000+ '09014_E_Can'#039't call the linker, switching to external linking'#000+ '09015_I_Linking $1'#000+ - '09016_E_Util $1 not found, switchi','ng to external linking'#000+ + '09016_E_Util $1 not found, switching to external linking'#000+ '09017_T_Using util $1'#000+ - '09018_E_Creation of Executables not supported'#000+ + '09018_E_Creation of Executables not suppor','ted'#000+ '09019_E_Creation of Dynamic/Shared Libraries not supported'#000+ '09020_I_Closing script $1'#000+ - '09021_E_resource compiler not found, switching to external mode'#000, + '09021_E_resource compiler not found, switching to external mode'#000+ '09022_I_Compiling resource $1'#000+ - '09023_T_unit $1 can'#039't be statically linked, switching to smart lin'+ - 'king'#000+ + '09023_T_unit $1 can'#039't be statically linked, switching to ','smart l'+ + 'inking'#000+ '09024_T_unit $1 can'#039't be smart linked, switching to static linking'+ #000+ '09025_T_unit $1 can'#039't be shared linked, switching to static linkin'+ 'g'#000+ - '0902','6_E_unit $1 can'#039't be smart or static linked'#000+ - '09027_E_unit $1 can'#039't be shared or static linked'#000+ + '09026_E_unit $1 can'#039't be smart or static linked'#000+ + '09027_E_unit $1 can'#039't be shared or static l','inked'#000+ '09028_D_Calling resource compiler "$1" with "$2" as command line'#000+ '09128_F_Can'#039't post process executable $1'#000+ '09129_F_Can'#039't open executable $1'#000+ - '09130_X_','Size of Code: $1 bytes'#000+ + '09130_X_Size of Code: $1 bytes'#000+ '09131_X_Size of initialized data: $1 bytes'#000+ - '09132_X_Size of uninitialized data: $1 bytes'#000+ + '09132_X_Size of unini','tialized data: $1 bytes'#000+ '09133_X_Stack space reserved: $1 bytes'#000+ '09134_X_Stack space commited: $1 bytes'#000+ '10000_T_Unitsearch: $1'#000+ '10001_T_PPU Loading $1'#000+ - '10002','_U_PPU Name: $1'#000+ + '10002_U_PPU Name: $1'#000+ '10003_U_PPU Flags: $1'#000+ '10004_U_PPU Crc: $1'#000+ '10005_U_PPU Time: $1'#000+ - '10006_U_PPU File too short'#000+ + '10006_U_','PPU File too short'#000+ '10007_U_PPU Invalid Header (no PPU at the begin)'#000+ '10008_U_PPU Invalid Version $1'#000+ '10009_U_PPU is compiled for another processor'#000+ - '10010_U_','PPU is compiled for an other target'#000+ + '10010_U_PPU is compiled for an other target'#000+ '10011_U_PPU Source: $1'#000+ '10012_U_Writing $1'#000+ - '10013_F_Can'#039't Write PPU-File'#000+ + '10013_F_C','an'#039't Write PPU-File'#000+ '10014_F_Error reading PPU-File'#000+ '10015_F_unexpected end of PPU-File'#000+ '10016_F_Invalid PPU-File entry: $1'#000+ '10017_F_PPU Dbx count problem'#000+ - '10','018_E_Illegal unit name: $1'#000+ + '10018_E_Illegal unit name: $1'#000+ '10019_F_Too much units'#000+ - '10020_F_Circular unit reference between $1 and $2'#000+ + '10020_F_Circular unit reference betw','een $1 and $2'#000+ '10021_F_Can'#039't compile unit $1, no sources available'#000+ '10022_F_Can'#039't find unit $1'#000+ '10023_W_Unit $1 was not found but $2 exists'#000+ - '10024_F_Unit $1 ','searched but $2 found'#000+ + '10024_F_Unit $1 searched but $2 found'#000+ '10025_W_Compiling the system unit requires the -Us switch'#000+ - '10026_F_There were $1 errors compiling module, stopping'#000+ + '10026_F','_There were $1 errors compiling module, stopping'#000+ '10027_U_Load from $1 ($2) unit $3'#000+ '10028_U_Recompiling $1, checksum changed for $2'#000+ - '10029_U_Recompiling $1',', source found only'#000+ + '10029_U_Recompiling $1, source found only'#000+ '10030_U_Recompiling unit, static lib is older than ppufile'#000+ - '10031_U_Recompiling unit, shared lib is older than ppufile'#000+ + '10031_U_','Recompiling unit, shared lib is older than ppufile'#000+ '10032_U_Recompiling unit, obj and asm are older than ppufile'#000+ - '10033_U_Recompiling unit, obj is older th','an asm'#000+ + '10033_U_Recompiling unit, obj is older than asm'#000+ '10034_U_Parsing interface of $1'#000+ '10035_U_Parsing implementation of $1'#000+ - '10036_U_Second load for unit $1'#000+ + '10036_U_Sec','ond load for unit $1'#000+ '10037_U_PPU Check file $1 time $2'#000+ '10040_W_Can'#039't recompile unit $1, but found modifed include files'#000+ - '10041_H_File $1 is newer than Rel','ease PPU file $2'#000+ + '10041_H_File $1 is newer than Release PPU file $2'#000+ '10042_U_Using a unit which was not compiled with correct FPU mode'#000+ - '10043_U_Loading interface units from $1'#000+ + '1004','3_U_Loading interface units from $1'#000+ '10044_U_Loading implementation units from $1'#000+ '10045_U_Interface CRC changed for unit $1'#000+ - '10046_U_Implementation CRC cha','nged for unit $1'#000+ + '10046_U_Implementation CRC changed for unit $1'#000+ '10047_U_Finished compiling unit $1'#000+ - '10048_U_Add dependency of $1 to $2'#000+ + '10048_U_Add dependency of $1 to $2'#000, '10049_U_No reload, is caller: $1'#000+ '10050_U_No reload, already in second compile: $1'#000+ '10051_U_Flag for reload: $1'#000+ '10052_U_Forced reloading'#000+ - '10053_U_Previous s','tate of $1: $2'#000+ + '10053_U_Previous state of $1: $2'#000+ '10054_U_Already compiling $1, setting second compile'#000+ - '10055_U_Loading unit $1'#000+ + '10055_U_Loading uni','t $1'#000+ '10056_U_Finished loading unit $1'#000+ '10057_U_Registering new unit $1'#000+ '10058_U_Re-resolving unit $1'#000+ - '10059_U_Skipping re-resolving unit $1, still loading u','sed units'#000+ + '10059_U_Skipping re-resolving unit $1, still loading used units'#000+ '11000_$1 [options] <inputfile> [options]'#000+ - '11001_W_Only one source file supported'#000+ + '11001_W_Only one source file support','ed'#000+ '11002_W_DEF file can be created only for OS/2'#000+ '11003_E_nested response files are not supported'#000+ '11004_F_No source file name in command line'#000+ - '11005_N_No o','ption inside $1 config file'#000+ + '11005_N_No option inside $1 config file'#000+ '11006_E_Illegal parameter: $1'#000+ - '11007_H_-? writes help pages'#000+ + '11007_H_-? writes help pages'#000, '11008_F_Too many config files nested'#000+ '11009_F_Unable to open file $1'#000+ '11010_D_Reading further options from $1'#000+ '11011_W_Target is already set to: $1'#000+ - '11012_W_','Shared libs not supported on DOS platform, reverting to stat'+ - 'ic'#000+ - '11013_F_too many IF(N)DEFs'#000+ + '11012_W_Shared libs not supported on DOS platform, reverting to static'+ + #000+ + '11013_F_too many IF(N)DE','Fs'#000+ '11014_F_too many ENDIFs'#000+ '11015_F_open conditional at the end of the file'#000+ '11016_W_Debug information generation is not supported by this executab'+ 'le'#000+ - '11017','_H_Try recompiling with -dGDB'#000+ + '11017_H_Try recompiling with -dGDB'#000+ '11018_E_You are using the obsolete switch $1'#000+ - '11019_E_You are using the obsolete switch $1, please use $2'#000+ + '11019_E_You ','are using the obsolete switch $1, please use $2'#000+ '11020_N_Switching assembler to default source writing assembler'#000+ - '11021_W_Assembler output selected "$1" is',' not compatible with "$2"'#000+ + '11021_W_Assembler output selected "$1" is not compatible with "$2"'#000+ '11022_W_"$1" assembler use forced'#000+ - '11026_T_Reading options from file $1'#000+ + '11026_T_Reading options fro','m file $1'#000+ '11027_T_Reading options from environment $1'#000+ '11028_D_Handling option "$1"'#000+ '11029__*** press enter ***'#000+ '11030_H_Start of reading config file $1'#000+ - '110','31_H_End of reading config file $1'#000+ + '11031_H_End of reading config file $1'#000+ '11032_D_interpreting option "$1"'#000+ - '11036_D_interpreting firstpass option "$1"'#000+ + '11036_D_interpretin','g firstpass option "$1"'#000+ '11033_D_interpreting file option "$1"'#000+ '11034_D_Reading config file "$1"'#000+ '11035_D_found source file name "$1"'#000+ - '11039_E_Unknown code p','age'#000+ + '11039_E_Unknown code page'#000+ '11023_Free Pascal Compiler version $FPCVERSION [$FPCDATE] for $FPCCPU'#010+ - 'Copyright (c) 1993-2005 by Florian Klaempfl'#000+ + 'Copyright (c)',' 1993-2005 by Florian Klaempfl'#000+ '11024_Free Pascal Compiler version $FPCVERSION'#010+ #010+ 'Compiler Date : $FPCDATE'#010+ 'Compiler CPU Target: $FPCCPU'#010+ #010+ - 'Supported targ','ets:'#010+ + 'Supported targets:'#010+ ' $OSTARGETS'#010+ #010+ 'Supported CPU instruction sets:'#010+ ' $INSTRUCTIONSETS'#010+ #010+ - 'Supported FPU instruction sets:'#010+ + 'Supported FPU in','struction sets:'#010+ ' $FPUINSTRUCTIONSETS'#010+ #010+ 'This program comes under the GNU General Public Licence'#010+ 'For more information read COPYING.FPC'#010+ #010+ - 'Report bugs,suggest','ions etc to:'#010+ + 'Report bugs,suggestions etc to:'#010+ ' bugrep@freepascal.org'#000+ - '11025_**0*_put + after a boolean switch option to enable it, - to disa'+ - 'ble it'#010+ + '11025_**0*_put + after a boolean sw','itch option to enable it, - to di'+ + 'sable it'#010+ '**1a_the compiler doesn'#039't delete the generated assembler file'#010+ '**2al_list sourcecode lines in assembler file'#010+ - '**2','an_list node info in assembler file'#010+ - '*L2ap_use pipes instead of creating temporary assembler files'#010+ + '**2an_list node info in assembler file'#010+ + '*L2ap_use pipes instead of creating temporary assem','bler files'#010+ '**2ar_list register allocation/release info in assembler file'#010+ '**2at_list temp allocation/release info in assembler file'#010+ - '**1A<x>_output format:',#010+ + '**1A<x>_output format:'#010+ '**2Adefault_use default assembler'#010+ '3*2Aas_assemble using GNU AS'#010+ - '3*2Anasmcoff_coff (Go32v2) file using Nasm'#010+ + '3*2Anasmcoff_coff (Go32','v2) file using Nasm'#010+ '3*2Anasmelf_elf32 (Linux) file using Nasm'#010+ '3*2Anasmwin32_Win32 object file using Nasm'#010+ - '3*2Anasmwdosx_Win32/WDOSX object file using Nasm',#010+ + '3*2Anasmwdosx_Win32/WDOSX object file using Nasm'#010+ '3*2Awasm_obj file using Wasm (Watcom)'#010+ '3*2Anasmobj_obj file using Nasm'#010+ - '3*2Amasm_obj file using Masm (Microsoft)'#010+ + '3*2Amasm_obj fil','e using Masm (Microsoft)'#010+ '3*2Atasm_obj file using Tasm (Borland)'#010+ '3*2Aelf_elf32 (Linux) using internal writer'#010+ - '3*2Acoff_coff (Go32v2) using internal writer'#010, + '3*2Acoff_coff (Go32v2) using internal writer'#010+ '3*2Apecoff_pecoff (Win32) using internal writer'#010+ '4*2Aas_assemble using GNU AS'#010+ - '6*2Aas_Unix o-file using GNU AS'#010+ + '6*2Aas_Uni','x o-file using GNU AS'#010+ '6*2Agas_GNU Motorola assembler'#010+ '6*2Amit_MIT Syntax (old GAS)'#010+ '6*2Amot_Standard Motorola assembler'#010+ 'A*2Aas_assemble using GNU AS'#010+ - 'P*2Aas','_assemble using GNU AS'#010+ + 'P*2Aas_assemble using GNU AS'#010+ 'S*2Aas_assemble using GNU AS'#010+ '**1b_generate browser info'#010+ - '**2bl_generate local symbol info'#010+ + '**2bl_ge','nerate local symbol info'#010+ '**1B_build all modules'#010+ '**1C<x>_code generation options:'#010+ '**2Cc<x>_set default calling convention to <x>'#010+ - '**2CD_create also dynamic',' library (not supported)'#010+ + '**2CD_create also dynamic library (not supported)'#010+ '**2Ce_Compilation with emulated floating point opcodes'#010+ - '**2Cf<x>_Select fpu instruction set to use, see fpc -i for possible va'+ - 'lues'#010+ + '**2Cf<x','>_Select fpu instruction set to use, see fpc -i for possible '+ + 'values'#010+ '**2Cg_Generate PIC code'#010+ '**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#010+ - '**2Ci_IO-','checking'#010+ + '**2Ci_IO-checking'#010+ '**2Cn_omit linking stage'#010+ '**2Co_check overflow of integer operations'#010+ - '**2Cp<x>_select instruction set, see fpc -i for possible values'#010+ + '**2Cp<x>_s','elect instruction set, see fpc -i for possible values'#010+ '**2Cr_range checking'#010+ '**2CR_verify object method call validity'#010+ '**2Cs<n>_set stack size to <n>'#010+ - '**2Ct_','stack checking'#010+ + '**2Ct_stack checking'#010+ '**2CX_create also smartlinked library'#010+ '**1d<x>_defines the symbol <x>'#010+ - '**1D_generate a DEF file'#010+ + '**1','D_generate a DEF file'#010+ '**2Dd<x>_set description to <x>'#010+ '**2Dv<x>_set DLL version to <x>'#010+ '*O2Dw_PM application'#010+ '**1e<x>_set path to executable'#010+ - '**1E_same as -C','n'#010+ + '**1E_same as -Cn'#010+ '**1F<x>_set file names and paths:'#010+ - '**2Fa<x>[,y]_for a program load first units <x> and [y] before uses is'+ - ' parsed'#010+ + '**2Fa<x>[,y]_for a program load first units <x> and',' [y] before uses '+ + 'is parsed'#010+ '**2Fc<x>_sets input codepage to <x>'#010+ '**2FD<x>_sets the directory where to search for compiler utilities'#010+ - '**2Fe<x>_redirect error',' output to <x>'#010+ + '**2Fe<x>_redirect error output to <x>'#010+ '**2FE<x>_set exe/unit output path to <x>'#010+ - '**2Fi<x>_adds <x> to include path'#010+ + '**2Fi<x>_adds <x> to include pa','th'#010+ '**2Fl<x>_adds <x> to library path'#010+ '**2FL<x>_uses <x> as dynamic linker'#010+ '**2Fo<x>_adds <x> to object path'#010+ '**2Fr<x>_load error message file <x>'#010+ - '**2Fu<x>_a','dds <x> to unit path'#010+ + '**2Fu<x>_adds <x> to unit path'#010+ '**2FU<x>_set unit output path to <x>, overrides -FE'#010+ - '*g1g_generate debugger information:'#010+ + '*g1g_generate ','debugger information:'#010+ '*g2gc_generate checks for pointers'#010+ '*g2gd_use dbx'#010+ '*g2gg_use gsym'#010+ '*g2gh_use heap trace unit (for memory leak debugging)'#010+ - '*g2gl_use lin','e info unit to show more info for backtraces'#010+ - '*g2gv_generates programs tracable with valgrind'#010+ + '*g2gl_use line info unit to show more info for backtraces'#010+ + '*g2gv_generates programs traceable with va','lgrind'#010+ '*g2gw_generate dwarf debugging info'#010+ '**1i_information'#010+ '**2iD_return compiler date'#010+ '**2iV_return compiler version'#010+ '**2iSO_return compiler OS'#010+ - '**2iSP_retu','rn compiler processor'#010+ + '**2iSP_return compiler processor'#010+ '**2iTO_return target OS'#010+ '**2iTP_return target processor'#010+ - '**1I<x>_adds <x> to include path'#010+ + '**1I<x>_a','dds <x> to include path'#010+ '**1k<x>_Pass <x> to the linker'#010+ '**1l_write logo'#010+ '**1M<x>_set language mode to <x>'#010+ '**2Mfpc_free pascal dialect (default)'#010+ - '**2Mobjfpc_s','witch some Delphi 2 extensions on'#010+ + '**2Mobjfpc_switch some Delphi 2 extensions on'#010+ '**2Mdelphi_tries to be Delphi compatible'#010+ - '**2Mtp_tries to be TP/BP 7.0 compatible'#010+ + '**2Mtp_trie','s to be TP/BP 7.0 compatible'#010+ '**2Mgpc_tries to be gpc compatible'#010+ '**2Mmacpas_tries to be compatible to the macintosh pascal dialects'#010+ - '**1n_don'#039't read the def','ault config file'#010+ - '**1N<x>_node tree optimizations'#010+ - '**2Nu_unroll loops'#010+ + '**1n_don'#039't read the default config file'#010+ '**1o<x>_change the name of the executable produced to <x>'#010+ - '**1O<x>_optimizations:'#010+ + '**1O<x>_opt','imizations:'#010+ '3*2Oa_<type>=<values> set alignment'#010+ '3*2Og_generate smaller code'#010+ - '3*2OG_generate faster code ','(default)'#010+ + '3*2OG_generate faster code (default)'#010+ '**2Or_keep certain variables in registers'#010+ '3*2Ou_enable uncertain optimizations (see docs)'#010+ - '3*2O1_level 1 optimizations (quick optimizations)'#010+ + '3*2O1_level 1 optimizations (quick op','timizations)'#010+ '3*2O2_level 2 optimizations (-O1 + slower optimizations)'#010+ - '3*2O3_level 3 optimizations (-O2 ','repeatedly, max 5 times)'#010+ + '3*2O3_level 3 optimizations (-O2 repeatedly, max 5 times)'#010+ '3*2Op<x>_target processor:'#010+ '3*3Op1_set target processor to 386/486'#010+ - '3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#010+ + '3*3Op2_set target processor to Pentium/Pentium','MMX (tm)'#010+ '3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#010+ '6*2Og_generate smaller code'#010+ - '6*2OG_genera','te faster code (default)'#010+ + '6*2OG_generate faster code (default)'#010+ '6*2Ox_optimize maximum (still BUGGY!!!)'#010+ '6*2O0_set target processor to a MC68000'#010+ - '6*2O2_set target processor to a MC68020+ (default)'#010+ + '6*2O2_set target processor to a ','MC68020+ (default)'#010+ '**1pg_generate profile code for gprof (defines FPC_PROFILE)'#010+ - '**1R<x>_assembler readin','g style:'#010+ + '**1R<x>_assembler reading style:'#010+ '**2Rdefault_use default assembler'#010+ '3*2Ratt_read AT&T style assembler'#010+ '3*2Rintel_read Intel style assembler'#010+ - '6*2RMOT_read motorola style assembler'#010+ + '6*2RMOT_read motorola s','tyle assembler'#010+ '**1S<x>_syntax options:'#010+ '**2S2_same as -Mobjfpc'#010+ - '**2Sc_supports operators like C (*=,+=,/=',' and -=)'#010+ + '**2Sc_supports operators like C (*=,+=,/= and -=)'#010+ '**2Sa_include assertion code.'#010+ '**2Sd_same as -Mdelphi'#010+ '**2Se<x>_error options. <x> is a combination of the following:'#010+ - '**3*_<n> : compiler stops after the <n> errors (default is 1)'#010+ + '**3*_<n> : c','ompiler stops after the <n> errors (default is 1)'#010+ '**3*_w : compiler stops also after warnings'#010+ - '**3*_n : ','compiler stops also after notes'#010+ + '**3*_n : compiler stops also after notes'#010+ '**3*_h : compiler stops also after hints'#010+ '**2Sg_allow LABEL and GOTO'#010+ '**2Sh_Use ansistrings'#010+ - '**2Si_support C++ styled INLINE'#010+ + '**2Si_support C','++ styled INLINE'#010+ '**2Sk_load fpcylix unit'#010+ '**2SI<x>_set interface style to <x>'#010+ - '**3SIcom_COM compatible in','terface (default)'#010+ + '**3SIcom_COM compatible interface (default)'#010+ '**3SIcorba_CORBA compatible interface'#010+ '**2Sm_support macros like C (global)'#010+ '**2So_same as -Mtp'#010+ '**2Sp_same as -Mgpc'#010+ - '**2Ss_constructor name must be init (destructor must be done)'#010+ + '**2Ss','_constructor name must be init (destructor must be done)'#010+ '**2St_allow static keyword in objects'#010+ - '**1s_don',#039't call assembler and linker'#010+ + '**1s_don'#039't call assembler and linker'#010+ '**2sh_Generate script to link on host'#010+ '**2st_Generate script to link on target'#010+ - '**2sr_Skip register allocation phase (use with -alr)'#010+ + '**2sr_Skip register allocation',' phase (use with -alr)'#010+ '**1T<x>_Target operating system:'#010+ - '3*2Temx_OS/2 via EMX (including EMX/RSX extende','r)'#010+ + '3*2Temx_OS/2 via EMX (including EMX/RSX extender)'#010+ '3*2Tfreebsd_FreeBSD'#010+ '3*2Tgo32v2_Version 2 of DJ Delorie DOS extender'#010+ '3*2Tlinux_Linux'#010+ '3*2Tnetbsd_NetBSD'#010+ - '3*2Tnetware_Novell Netware Module (clib)'#010+ + '3*2Tnetware_Novell Netware Modul','e (clib)'#010+ '3*2Tnetwlibc_Novell Netware Module (libc)'#010+ '3*2Topenbsd_OpenBSD'#010+ '3*2Tos2_OS/2 / eComStation'#010+ - '3*2Ts','unos_SunOS/Solaris'#010+ + '3*2Tsunos_SunOS/Solaris'#010+ '3*2Twatcom_Watcom compatible DOS extender'#010+ '3*2Twdosx_WDOSX DOS extender'#010+ '3*2Twin32_Windows 32 Bit'#010+ - '3*2Twince_Windows CE'#010+ '4*2Tlinux_Linux'#010+ - '6*2Tamiga_Commodore Amiga'#010+ + '6*2Tam','iga_Commodore Amiga'#010+ '6*2Tatari_Atari ST/STe/TT'#010+ '6*2Tlinux_Linux-68k'#010+ - '6*2Tmacos_Macint','osh m68k (not supported)'#010+ + '6*2Tmacos_Macintosh m68k (not supported)'#010+ '6*2Tpalmos_PalmOS'#010+ 'A*2Tlinux_Linux'#010+ - 'A*2Twince_Windows CE'#010+ 'P*2Tdarwin_Darwin and MacOS X on PowerPC'#010+ 'P*2Tlinux_Linux on PowerPC'#010+ - 'P*2Tmacos_MacOS (classic) on PowerPC'#010+ + 'P*2Tmacos_MacOS (classic) on Po','werPC'#010+ 'P*2Tmorphos_MorphOS'#010+ 'S*2Tlinux_Linux'#010+ - '**1u<x>_undefines t','he symbol <x>'#010+ + '**1u<x>_undefines the symbol <x>'#010+ '**1U_unit options:'#010+ '**2Un_don'#039't check the unit name'#010+ '**2Ur_generate release unit files'#010+ '**2Us_compile a system unit'#010+ - '**1v<x>_Be verbose. <x> is a combination of the following letters:'#010+ - '**2*_e : Show errors (default) 0 : Show ','nothing (except errors'+ - ')'#010+ + '**1v<x>_Be verbose. <x> is a combination of the foll','owing letters:'#010+ + '**2*_e : Show errors (default) 0 : Show nothing (except errors)'#010+ '**2*_w : Show warnings u : Show unit info'#010+ '**2*_n : Show notes t : Show tried/used files'#010+ - '**2*_h : Show hints c : Show conditionals'#010+ - '**2*_i : Show general info d',' : Show debug info'#010+ + '**2*_h : Show hints ',' c : Show conditionals'#010+ + '**2*_i : Show general info d : Show debug info'#010+ '**2*_l : Show linenumbers r : Rhide/GCC compatibility mode'#010+ '**2*_a : Show everything x : Executable info (Win32 only)'#010+ - '**2*_b : Write file names messages with full path'#010+ - '**2*_v : write fpcdebug.txt wit','h p : Write tree.log with parse t'+ - 'ree'#010+ + '**2*_b : Write file ','names messages with full path'#010+ + '**2*_v : write fpcdebug.txt with p : Write tree.log with parse tre'+ + 'e'#010+ '**2*_ lots of debugging info'#010+ '3*1W<x>_Win32-like target options'#010+ '3*2WB_Create a relocatable image'#010+ - '3*2WB<x>_Set Image base to Hexadecimal <x> value'#010+ + '3*2WB<x>_Set Image base to Hexadecimal ','<x> value'#010+ '3*2WC_Specify console type application'#010+ - '3*2WD_Use DE','FFILE to export functions of DLL or EXE'#010+ + '3*2WD_Use DEFFILE to export functions of DLL or EXE'#010+ '3*2WF_Specify full-screen type application (OS/2 only)'#010+ '3*2WG_Specify graphic type application'#010+ - '3*2WN_Do not generate relocation code (necessary for debugging)'#010+ + '3*2WN_Do not generate relocation code (necess','ary for debugging)'#010+ '3*2WR_Generate relocation code'#010+ - 'P*2WC_Speci','fy console type application (MacOS only)'#010+ + 'P*2WC_Specify console type application (MacOS only)'#010+ 'P*2WG_Specify graphic type application (MacOS only)'#010+ 'P*2WT_Specify tool type application (MPW tool, MacOS only)'#010+ '**1X_executable options:'#010+ - '**2Xc_pass --shared to the linker (Unix only)'#010+ - '**2Xd_don'#039't use s','tandard library search path (needed for cross c'+ - 'ompile)'#010+ + '**','2Xc_pass --shared to the linker (Unix only)'#010+ + '**2Xd_don'#039't use standard library search path (needed for cross com'+ + 'pile)'#010+ '**2XD_try to link units dynamic (defines FPC_LINK_DYNAMIC)'#010+ '**2Xm_generate link map'#010+ - '**2XM<x>_set the name of the '#039'main'#039' program routine (default i'+ - 's '#039'main'#039')'#010+ - '**2XP<x>_prepend the ','binutils names with the prefix <x>'#010+ + '**2XM<x>_set the name of the '#039'ma','in'#039' program routine (default'+ + ' is '#039'main'#039')'#010+ + '**2XP<x>_prepend the binutils names with the prefix <x>'#010+ '**2Xr<x>_set library search path to <x> (needed for cross compile)'#010+ '**2Xs_strip all symbols from executable'#010+ - '**2XS_try to link units static (default) (defines FPC_LINK_STATIC)'#010+ - '**2Xt_link with static librarie','s (-static is passed to linker)'#010+ + '**2XS_try to link units static (defau','lt) (defines FPC_LINK_STATIC)'#010+ + '**2Xt_link with static libraries (-static is passed to linker)'#010+ '**2XX_try to link units smart (defines FPC_LINK_SMART)'#010+ '**1*_'#010+ '**1?_shows this help'#010+ diff --git a/compiler/nadd.pas b/compiler/nadd.pas index d4e45c7cb3..a8ffafe824 100644 --- a/compiler/nadd.pas +++ b/compiler/nadd.pas @@ -28,15 +28,13 @@ unit nadd; interface uses - node,symtype; + node; type taddnode = class(tbinopnode) - resultrealtype : ttype; constructor create(tt : tnodetype;l,r : tnode);override; function pass_1 : tnode;override; function det_resulttype:tnode;override; - function simplify : tnode;override; {$ifdef state_tracking} function track_state_pass(exec_known:boolean):boolean;override; {$endif} @@ -48,7 +46,7 @@ interface { only implements "muln" nodes, the rest always has to be done in } { the code generator for performance reasons (JM) } function first_add64bitint: tnode; virtual; - +{$ifdef cpufpemu} { This routine calls internal runtime library helpers for all floating point arithmetic in the case where the emulation switches is on. Otherwise @@ -56,6 +54,7 @@ interface the code generation phase. } function first_addfloat : tnode; virtual; +{$endif cpufpemu} end; taddnodeclass = class of taddnode; @@ -74,7 +73,7 @@ implementation {$ENDIF MACOS_USE_FAKE_SYSUTILS} globtype,systems, cutils,verbose,globals,widestr, - symconst,symdef,symsym,symtable,defutil,defcmp, + symconst,symtype,symdef,symsym,symtable,defutil,defcmp, cgbase, htypechk,pass_1, nbas,nmat,ncnv,ncon,nset,nopt,ncal,ninl,nmem,nutils, @@ -103,7 +102,7 @@ implementation if t2.def.deftype=floatdef then begin { when a comp or currency is used, use always the - best float type to calculate the result } + best type to calculate the result } if (tfloatdef(t2.def).typ in [s64comp,s64currency]) or (tfloatdef(t2.def).typ in [s64comp,s64currency]) then result:=pbestrealtype^ @@ -124,552 +123,37 @@ implementation end; - function taddnode.simplify : tnode; - var - t : tnode; - lt,rt : tnodetype; - rd,ld : tdef; - rv,lv : tconstexprint; - rvd,lvd : bestreal; - ws1,ws2 : pcompilerwidestring; - concatstrings : boolean; - c1,c2 : array[0..1] of char; - s1,s2 : pchar; - l1,l2 : longint; - resultset : Tconstset; - b : boolean; - begin - result:=nil; - { is one a real float, then both need to be floats, this - need to be done before the constant folding so constant - operation on a float and int are also handled } - resultrealtype:=pbestrealtype^; - if (right.resulttype.def.deftype=floatdef) or (left.resulttype.def.deftype=floatdef) then - begin - { when both floattypes are already equal then use that - floattype for results } - if (right.resulttype.def.deftype=floatdef) and - (left.resulttype.def.deftype=floatdef) and - (tfloatdef(left.resulttype.def).typ=tfloatdef(right.resulttype.def).typ) then - resultrealtype:=left.resulttype - { when there is a currency type then use currency, but - only when currency is defined as float } - else - if (is_currency(right.resulttype.def) or - is_currency(left.resulttype.def)) and - ((s64currencytype.def.deftype = floatdef) or - (nodetype <> slashn)) then - begin - resultrealtype:=s64currencytype; - inserttypeconv(right,resultrealtype); - inserttypeconv(left,resultrealtype); - end - else - begin - resultrealtype:=getbestreal(left.resulttype,right.resulttype); - inserttypeconv(right,resultrealtype); - inserttypeconv(left,resultrealtype); - end; - end; - - { If both operands are constant and there is a widechar - or widestring then convert everything to widestring. This - allows constant folding like char+widechar } - if is_constnode(right) and is_constnode(left) and - (is_widestring(right.resulttype.def) or - is_widestring(left.resulttype.def) or - is_widechar(right.resulttype.def) or - is_widechar(left.resulttype.def)) then - begin - inserttypeconv(right,cwidestringtype); - inserttypeconv(left,cwidestringtype); - end; - - { load easier access variables } - rd:=right.resulttype.def; - ld:=left.resulttype.def; - rt:=right.nodetype; - lt:=left.nodetype; - - if (nodetype = slashn) and - (((rt = ordconstn) and - (tordconstnode(right).value = 0)) or - ((rt = realconstn) and - (trealconstnode(right).value_real = 0.0))) then - begin - if (cs_check_range in aktlocalswitches) or - (cs_check_overflow in aktlocalswitches) then - begin - result:=crealconstnode.create(1,pbestrealtype^); - Message(parser_e_division_by_zero); - exit; - end; - end; - - - { both are int constants } - if ( - ( - is_constintnode(left) and - is_constintnode(right) - ) or - ( - is_constboolnode(left) and - is_constboolnode(right) and - (nodetype in [slashn,ltn,lten,gtn,gten,equaln,unequaln,andn,xorn,orn]) - ) or - ( - is_constenumnode(left) and - is_constenumnode(right) and - allowenumop(nodetype)) - ) or - ( - (lt = pointerconstn) and - is_constintnode(right) and - (nodetype in [addn,subn]) - ) or - ( - (lt in [pointerconstn,niln]) and - (rt in [pointerconstn,niln]) and - (nodetype in [ltn,lten,gtn,gten,equaln,unequaln,subn]) - ) then - begin - t:=nil; - { when comparing/substracting pointers, make sure they are } - { of the same type (JM) } - if (lt = pointerconstn) and (rt = pointerconstn) then - begin - if not(cs_extsyntax in aktmoduleswitches) and - not(nodetype in [equaln,unequaln]) then - CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename) - else - if (nodetype <> subn) and - is_voidpointer(rd) then - inserttypeconv(right,left.resulttype) - else if (nodetype <> subn) and - is_voidpointer(ld) then - inserttypeconv(left,right.resulttype) - else if not(equal_defs(ld,rd)) then - IncompatibleTypes(ld,rd); - end - else if (ld.deftype=enumdef) and (rd.deftype=enumdef) then - begin - if not(equal_defs(ld,rd)) then - inserttypeconv(right,left.resulttype); - end; - - { load values } - case lt of - ordconstn: - lv:=tordconstnode(left).value; - pointerconstn: - lv:=tpointerconstnode(left).value; - niln: - lv:=0; - else - internalerror(2002080202); - end; - case rt of - ordconstn: - rv:=tordconstnode(right).value; - pointerconstn: - rv:=tpointerconstnode(right).value; - niln: - rv:=0; - else - internalerror(2002080203); - end; - if (lt = pointerconstn) and - (rt <> pointerconstn) then - rv := rv * tpointerdef(left.resulttype.def).pointertype.def.size; - if (rt = pointerconstn) and - (lt <> pointerconstn) then - lv := lv * tpointerdef(right.resulttype.def).pointertype.def.size; - case nodetype of - addn : - begin - {$ifopt Q-} - {$define OVERFLOW_OFF} - {$Q+} - {$endif} - try - if (lt=pointerconstn) then - t := cpointerconstnode.create(lv+rv,left.resulttype) - else - if is_integer(ld) then - t := genintconstnode(lv+rv) - else - t := cordconstnode.create(lv+rv,left.resulttype,(ld.deftype<>enumdef)); - except - on E:EIntOverflow do - begin - Message(parser_e_arithmetic_operation_overflow); - { Recover } - t:=genintconstnode(0) - end; - end; - {$ifdef OVERFLOW_OFF} - {$Q-} - {$undef OVERFLOW_OFF} - {$endif} - end; - subn : - begin - {$ifopt Q-} - {$define OVERFLOW_OFF} - {$Q+} - {$endif} - try - if (lt=pointerconstn) then - begin - { pointer-pointer results in an integer } - if (rt=pointerconstn) then - t := genintconstnode((lv-rv) div tpointerdef(ld).pointertype.def.size) - else - t := cpointerconstnode.create(lv-rv,left.resulttype); - end - else - begin - if is_integer(ld) then - t:=genintconstnode(lv-rv) - else - t:=cordconstnode.create(lv-rv,left.resulttype,(ld.deftype<>enumdef)); - end; - except - on E:EIntOverflow do - begin - Message(parser_e_arithmetic_operation_overflow); - { Recover } - t:=genintconstnode(0) - end; - end; - {$ifdef OVERFLOW_OFF} - {$Q-} - {$undef OVERFLOW_OFF} - {$endif} - end; - muln : - begin - {$ifopt Q-} - {$define OVERFLOW_OFF} - {$Q+} - {$endif} - try - if (torddef(ld).typ <> u64bit) or - (torddef(rd).typ <> u64bit) then - t:=genintconstnode(lv*rv) - else - t:=genintconstnode(int64(qword(lv)*qword(rv))); - except - on E:EIntOverflow do - begin - Message(parser_e_arithmetic_operation_overflow); - { Recover } - t:=genintconstnode(0) - end; - end; - {$ifdef OVERFLOW_OFF} - {$Q-} - {$undef OVERFLOW_OFF} - {$endif} - end; - xorn : - if is_integer(ld) then - t:=genintconstnode(lv xor rv) - else - t:=cordconstnode.create(lv xor rv,left.resulttype,true); - orn : - if is_integer(ld) then - t:=genintconstnode(lv or rv) - else - t:=cordconstnode.create(lv or rv,left.resulttype,true); - andn : - if is_integer(ld) then - t:=genintconstnode(lv and rv) - else - t:=cordconstnode.create(lv and rv,left.resulttype,true); - ltn : - t:=cordconstnode.create(ord(lv<rv),booltype,true); - lten : - t:=cordconstnode.create(ord(lv<=rv),booltype,true); - gtn : - t:=cordconstnode.create(ord(lv>rv),booltype,true); - gten : - t:=cordconstnode.create(ord(lv>=rv),booltype,true); - equaln : - t:=cordconstnode.create(ord(lv=rv),booltype,true); - unequaln : - t:=cordconstnode.create(ord(lv<>rv),booltype,true); - slashn : - begin - { int/int becomes a real } - rvd:=rv; - lvd:=lv; - t:=crealconstnode.create(lvd/rvd,resultrealtype); - end; - else - begin - CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); - t:=cnothingnode.create; - end; - end; - result:=t; - exit; - end; - - { both real constants ? } - if (lt=realconstn) and (rt=realconstn) then - begin - lvd:=trealconstnode(left).value_real; - rvd:=trealconstnode(right).value_real; - case nodetype of - addn : - t:=crealconstnode.create(lvd+rvd,resultrealtype); - subn : - t:=crealconstnode.create(lvd-rvd,resultrealtype); - muln : - t:=crealconstnode.create(lvd*rvd,resultrealtype); - starstarn, - caretn : - begin - if lvd<0 then - begin - Message(parser_e_invalid_float_operation); - t:=crealconstnode.create(0,resultrealtype); - end - else if lvd=0 then - t:=crealconstnode.create(1.0,resultrealtype) - else - t:=crealconstnode.create(exp(ln(lvd)*rvd),resultrealtype); - end; - slashn : - t:=crealconstnode.create(lvd/rvd,resultrealtype); - ltn : - t:=cordconstnode.create(ord(lvd<rvd),booltype,true); - lten : - t:=cordconstnode.create(ord(lvd<=rvd),booltype,true); - gtn : - t:=cordconstnode.create(ord(lvd>rvd),booltype,true); - gten : - t:=cordconstnode.create(ord(lvd>=rvd),booltype,true); - equaln : - t:=cordconstnode.create(ord(lvd=rvd),booltype,true); - unequaln : - t:=cordconstnode.create(ord(lvd<>rvd),booltype,true); - else - begin - CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); - t:=cnothingnode.create; - end; - end; - result:=t; - exit; - end; - - { first, we handle widestrings, so we can check later for } - { stringconstn only } - - { widechars are converted above to widestrings too } - { this isn't veryy efficient, but I don't think } - { that it does matter that much (FK) } - if (lt=stringconstn) and (rt=stringconstn) and - (tstringconstnode(left).st_type=st_widestring) and - (tstringconstnode(right).st_type=st_widestring) then - begin - initwidestring(ws1); - initwidestring(ws2); - copywidestring(pcompilerwidestring(tstringconstnode(left).value_str),ws1); - copywidestring(pcompilerwidestring(tstringconstnode(right).value_str),ws2); - case nodetype of - addn : - begin - concatwidestrings(ws1,ws2); - t:=cstringconstnode.createwstr(ws1); - end; - ltn : - t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<0),booltype,true); - lten : - t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<=0),booltype,true); - gtn : - t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>0),booltype,true); - gten : - t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>=0),booltype,true); - equaln : - t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)=0),booltype,true); - unequaln : - t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<>0),booltype,true); - else - begin - CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); - t:=cnothingnode.create; - end; - end; - donewidestring(ws1); - donewidestring(ws2); - result:=t; - exit; - end; - - { concating strings ? } - concatstrings:=false; - - if (lt=ordconstn) and (rt=ordconstn) and - is_char(ld) and is_char(rd) then - begin - c1[0]:=char(byte(tordconstnode(left).value)); - c1[1]:=#0; - l1:=1; - c2[0]:=char(byte(tordconstnode(right).value)); - c2[1]:=#0; - l2:=1; - s1:=@c1; - s2:=@c2; - concatstrings:=true; - end - else if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then - begin - s1:=tstringconstnode(left).value_str; - l1:=tstringconstnode(left).len; - c2[0]:=char(byte(tordconstnode(right).value)); - c2[1]:=#0; - s2:=@c2; - l2:=1; - concatstrings:=true; - end - else if (lt=ordconstn) and (rt=stringconstn) and is_char(ld) then - begin - c1[0]:=char(byte(tordconstnode(left).value)); - c1[1]:=#0; - l1:=1; - s1:=@c1; - s2:=tstringconstnode(right).value_str; - l2:=tstringconstnode(right).len; - concatstrings:=true; - end - else if (lt=stringconstn) and (rt=stringconstn) then - begin - s1:=tstringconstnode(left).value_str; - l1:=tstringconstnode(left).len; - s2:=tstringconstnode(right).value_str; - l2:=tstringconstnode(right).len; - concatstrings:=true; - end; - if concatstrings then - begin - case nodetype of - addn : - t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2,st_conststring); - ltn : - t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<0),booltype,true); - lten : - t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<=0),booltype,true); - gtn : - t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>0),booltype,true); - gten : - t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>=0),booltype,true); - equaln : - t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)=0),booltype,true); - unequaln : - t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<>0),booltype,true); - else - begin - CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); - t:=cnothingnode.create; - end; - end; - result:=t; - exit; - end; - - { set constant evaluation } - if (right.nodetype=setconstn) and - not assigned(tsetconstnode(right).left) and - (left.nodetype=setconstn) and - not assigned(tsetconstnode(left).left) then - begin - { check if size adjusting is needed, only for left - to right as the other way is checked in the typeconv } - if (tsetdef(right.resulttype.def).settype=smallset) and - (tsetdef(left.resulttype.def).settype<>smallset) then - right.resulttype.setdef(tsetdef.create(tsetdef(right.resulttype.def).elementtype,255)); - { check base types } - inserttypeconv(left,right.resulttype); - - if codegenerror then - begin - { recover by only returning the left part } - result:=left; - left:=nil; - exit; - end; - case nodetype of - addn : - begin - resultset:=tsetconstnode(right).value_set^ + tsetconstnode(left).value_set^; - t:=csetconstnode.create(@resultset,left.resulttype); - end; - muln : - begin - resultset:=tsetconstnode(right).value_set^ * tsetconstnode(left).value_set^; - t:=csetconstnode.create(@resultset,left.resulttype); - end; - subn : - begin - resultset:=tsetconstnode(left).value_set^ - tsetconstnode(right).value_set^; - t:=csetconstnode.create(@resultset,left.resulttype); - end; - symdifn : - begin - resultset:=tsetconstnode(right).value_set^ >< tsetconstnode(left).value_set^; - t:=csetconstnode.create(@resultset,left.resulttype); - end; - unequaln : - begin - b:=tsetconstnode(right).value_set^ <> tsetconstnode(left).value_set^; - t:=cordconstnode.create(byte(b),booltype,true); - end; - equaln : - begin - b:=tsetconstnode(right).value_set^ = tsetconstnode(left).value_set^; - t:=cordconstnode.create(byte(b),booltype,true); - end; - lten : - begin - b:=tsetconstnode(left).value_set^ <= tsetconstnode(right).value_set^; - t:=cordconstnode.create(byte(b),booltype,true); - end; - gten : - begin - b:=tsetconstnode(left).value_set^ >= tsetconstnode(right).value_set^; - t:=cordconstnode.create(byte(b),booltype,true); - end; - else - begin - CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); - t:=cnothingnode.create; - end; - end; - result:=t; - exit; - end; - - end; + function taddnode.det_resulttype:tnode; + function allowenumop(nt:tnodetype):boolean; + begin + result:=(nt in [equaln,unequaln,ltn,lten,gtn,gten]) or + ((cs_allow_enum_calc in aktlocalswitches) and + (nt in [addn,subn])); + end; - function taddnode.det_resulttype:tnode; var - hp : tnode; - lt,rt : tnodetype; - rd,ld : tdef; - htype : ttype; - ot : tnodetype; - hsym : tfieldvarsym; - i : longint; - strtype : tstringtype; - b : boolean; + hp,t : tnode; + lt,rt : tnodetype; + rd,ld : tdef; + htype : ttype; + ot : tnodetype; + hsym : tfieldvarsym; + concatstrings : boolean; + resultset : Tconstset; + i : longint; + b : boolean; + c1,c2 : array[0..1] of char; + s1,s2 : pchar; + ws1,ws2 : pcompilerwidestring; + l1,l2 : longint; + rv,lv : tconstexprint; + rvd,lvd : bestreal; + resultrealtype : ttype; + strtype: tstringtype; {$ifdef state_tracking} - factval : Tnode; - change : boolean; + factval : Tnode; + change : boolean; {$endif} begin @@ -738,15 +222,518 @@ implementation end; end; - result:=simplify; - if assigned(result) then - exit; + { is one a real float, then both need to be floats, this + need to be done before the constant folding so constant + operation on a float and int are also handled } + resultrealtype:=pbestrealtype^; + if (right.resulttype.def.deftype=floatdef) or (left.resulttype.def.deftype=floatdef) then + begin + { when both floattypes are already equal then use that + floattype for results } + if (right.resulttype.def.deftype=floatdef) and + (left.resulttype.def.deftype=floatdef) and + (tfloatdef(left.resulttype.def).typ=tfloatdef(right.resulttype.def).typ) then + resultrealtype:=left.resulttype + { when there is a currency type then use currency, but + only when currency is defined as float } + else + if (is_currency(right.resulttype.def) or + is_currency(left.resulttype.def)) and + ((s64currencytype.def.deftype = floatdef) or + (nodetype <> slashn)) then + begin + resultrealtype:=s64currencytype; + inserttypeconv(right,resultrealtype); + inserttypeconv(left,resultrealtype); + end + else + begin + resultrealtype:=getbestreal(left.resulttype,right.resulttype); + inserttypeconv(right,resultrealtype); + inserttypeconv(left,resultrealtype); + end; + end; - { load easier access variables } - rd:=right.resulttype.def; - ld:=left.resulttype.def; - rt:=right.nodetype; - lt:=left.nodetype; + { If both operands are constant and there is a widechar + or widestring then convert everything to widestring. This + allows constant folding like char+widechar } + if is_constnode(right) and is_constnode(left) and + (is_widestring(right.resulttype.def) or + is_widestring(left.resulttype.def) or + is_widechar(right.resulttype.def) or + is_widechar(left.resulttype.def)) then + begin + inserttypeconv(right,cwidestringtype); + inserttypeconv(left,cwidestringtype); + end; + + { load easier access variables } + rd:=right.resulttype.def; + ld:=left.resulttype.def; + rt:=right.nodetype; + lt:=left.nodetype; + + if (nodetype = slashn) and + (((rt = ordconstn) and + (tordconstnode(right).value = 0)) or + ((rt = realconstn) and + (trealconstnode(right).value_real = 0.0))) then + begin + if (cs_check_range in aktlocalswitches) or + (cs_check_overflow in aktlocalswitches) then + begin + result:=crealconstnode.create(1,pbestrealtype^); + Message(parser_e_division_by_zero); + exit; + end; + end; + + + { both are int constants } + if ( + ( + is_constintnode(left) and + is_constintnode(right) + ) or + ( + is_constboolnode(left) and + is_constboolnode(right) and + (nodetype in [slashn,ltn,lten,gtn,gten,equaln,unequaln,andn,xorn,orn]) + ) or + ( + is_constenumnode(left) and + is_constenumnode(right) and + allowenumop(nodetype)) + ) or + ( + (lt = pointerconstn) and + is_constintnode(right) and + (nodetype in [addn,subn]) + ) or + ( + (lt in [pointerconstn,niln]) and + (rt in [pointerconstn,niln]) and + (nodetype in [ltn,lten,gtn,gten,equaln,unequaln,subn]) + ) then + begin + t:=nil; + { when comparing/substracting pointers, make sure they are } + { of the same type (JM) } + if (lt = pointerconstn) and (rt = pointerconstn) then + begin + if not(cs_extsyntax in aktmoduleswitches) and + not(nodetype in [equaln,unequaln]) then + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename) + else + if (nodetype <> subn) and + is_voidpointer(rd) then + inserttypeconv(right,left.resulttype) + else if (nodetype <> subn) and + is_voidpointer(ld) then + inserttypeconv(left,right.resulttype) + else if not(equal_defs(ld,rd)) then + IncompatibleTypes(ld,rd); + end + else if (ld.deftype=enumdef) and (rd.deftype=enumdef) then + begin + if not(equal_defs(ld,rd)) then + inserttypeconv(right,left.resulttype); + end; + + { load values } + case lt of + ordconstn: + lv:=tordconstnode(left).value; + pointerconstn: + lv:=tpointerconstnode(left).value; + niln: + lv:=0; + else + internalerror(2002080202); + end; + case rt of + ordconstn: + rv:=tordconstnode(right).value; + pointerconstn: + rv:=tpointerconstnode(right).value; + niln: + rv:=0; + else + internalerror(2002080203); + end; + if (lt = pointerconstn) and + (rt <> pointerconstn) then + rv := rv * tpointerdef(left.resulttype.def).pointertype.def.size; + if (rt = pointerconstn) and + (lt <> pointerconstn) then + lv := lv * tpointerdef(right.resulttype.def).pointertype.def.size; + case nodetype of + addn : + begin + {$ifopt Q-} + {$define OVERFLOW_OFF} + {$Q+} + {$endif} + try + if (lt=pointerconstn) then + t := cpointerconstnode.create(lv+rv,left.resulttype) + else + if is_integer(ld) then + t := genintconstnode(lv+rv) + else + t := cordconstnode.create(lv+rv,left.resulttype,(ld.deftype<>enumdef)); + except + on E:EIntOverflow do + begin + Message(parser_e_arithmetic_operation_overflow); + { Recover } + t:=genintconstnode(0) + end; + end; + {$ifdef OVERFLOW_OFF} + {$Q-} + {$undef OVERFLOW_OFF} + {$endif} + end; + subn : + begin + {$ifopt Q-} + {$define OVERFLOW_OFF} + {$Q+} + {$endif} + try + if (lt=pointerconstn) then + begin + { pointer-pointer results in an integer } + if (rt=pointerconstn) then + t := genintconstnode((lv-rv) div tpointerdef(ld).pointertype.def.size) + else + t := cpointerconstnode.create(lv-rv,left.resulttype); + end + else + begin + if is_integer(ld) then + t:=genintconstnode(lv-rv) + else + t:=cordconstnode.create(lv-rv,left.resulttype,(ld.deftype<>enumdef)); + end; + except + on E:EIntOverflow do + begin + Message(parser_e_arithmetic_operation_overflow); + { Recover } + t:=genintconstnode(0) + end; + end; + {$ifdef OVERFLOW_OFF} + {$Q-} + {$undef OVERFLOW_OFF} + {$endif} + end; + muln : + begin + {$ifopt Q-} + {$define OVERFLOW_OFF} + {$Q+} + {$endif} + try + if (torddef(ld).typ <> u64bit) or + (torddef(rd).typ <> u64bit) then + t:=genintconstnode(lv*rv) + else + t:=genintconstnode(int64(qword(lv)*qword(rv))); + except + on E:EIntOverflow do + begin + Message(parser_e_arithmetic_operation_overflow); + { Recover } + t:=genintconstnode(0) + end; + end; + {$ifdef OVERFLOW_OFF} + {$Q-} + {$undef OVERFLOW_OFF} + {$endif} + end; + xorn : + if is_integer(ld) then + t:=genintconstnode(lv xor rv) + else + t:=cordconstnode.create(lv xor rv,left.resulttype,true); + orn : + if is_integer(ld) then + t:=genintconstnode(lv or rv) + else + t:=cordconstnode.create(lv or rv,left.resulttype,true); + andn : + if is_integer(ld) then + t:=genintconstnode(lv and rv) + else + t:=cordconstnode.create(lv and rv,left.resulttype,true); + ltn : + t:=cordconstnode.create(ord(lv<rv),booltype,true); + lten : + t:=cordconstnode.create(ord(lv<=rv),booltype,true); + gtn : + t:=cordconstnode.create(ord(lv>rv),booltype,true); + gten : + t:=cordconstnode.create(ord(lv>=rv),booltype,true); + equaln : + t:=cordconstnode.create(ord(lv=rv),booltype,true); + unequaln : + t:=cordconstnode.create(ord(lv<>rv),booltype,true); + slashn : + begin + { int/int becomes a real } + rvd:=rv; + lvd:=lv; + t:=crealconstnode.create(lvd/rvd,resultrealtype); + end; + else + begin + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + t:=cnothingnode.create; + end; + end; + result:=t; + exit; + end; + + { both real constants ? } + if (lt=realconstn) and (rt=realconstn) then + begin + lvd:=trealconstnode(left).value_real; + rvd:=trealconstnode(right).value_real; + case nodetype of + addn : + t:=crealconstnode.create(lvd+rvd,resultrealtype); + subn : + t:=crealconstnode.create(lvd-rvd,resultrealtype); + muln : + t:=crealconstnode.create(lvd*rvd,resultrealtype); + starstarn, + caretn : + begin + if lvd<0 then + begin + Message(parser_e_invalid_float_operation); + t:=crealconstnode.create(0,resultrealtype); + end + else if lvd=0 then + t:=crealconstnode.create(1.0,resultrealtype) + else + t:=crealconstnode.create(exp(ln(lvd)*rvd),resultrealtype); + end; + slashn : + t:=crealconstnode.create(lvd/rvd,resultrealtype); + ltn : + t:=cordconstnode.create(ord(lvd<rvd),booltype,true); + lten : + t:=cordconstnode.create(ord(lvd<=rvd),booltype,true); + gtn : + t:=cordconstnode.create(ord(lvd>rvd),booltype,true); + gten : + t:=cordconstnode.create(ord(lvd>=rvd),booltype,true); + equaln : + t:=cordconstnode.create(ord(lvd=rvd),booltype,true); + unequaln : + t:=cordconstnode.create(ord(lvd<>rvd),booltype,true); + else + begin + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + t:=cnothingnode.create; + end; + end; + result:=t; + exit; + end; + + { first, we handle widestrings, so we can check later for } + { stringconstn only } + + { widechars are converted above to widestrings too } + { this isn't veryy efficient, but I don't think } + { that it does matter that much (FK) } + if (lt=stringconstn) and (rt=stringconstn) and + (tstringconstnode(left).st_type=st_widestring) and + (tstringconstnode(right).st_type=st_widestring) then + begin + initwidestring(ws1); + initwidestring(ws2); + copywidestring(pcompilerwidestring(tstringconstnode(left).value_str),ws1); + copywidestring(pcompilerwidestring(tstringconstnode(right).value_str),ws2); + case nodetype of + addn : + begin + concatwidestrings(ws1,ws2); + t:=cstringconstnode.createwstr(ws1); + end; + ltn : + t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<0),booltype,true); + lten : + t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<=0),booltype,true); + gtn : + t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>0),booltype,true); + gten : + t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>=0),booltype,true); + equaln : + t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)=0),booltype,true); + unequaln : + t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<>0),booltype,true); + else + begin + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + t:=cnothingnode.create; + end; + end; + donewidestring(ws1); + donewidestring(ws2); + result:=t; + exit; + end; + + { concating strings ? } + concatstrings:=false; + + if (lt=ordconstn) and (rt=ordconstn) and + is_char(ld) and is_char(rd) then + begin + c1[0]:=char(byte(tordconstnode(left).value)); + c1[1]:=#0; + l1:=1; + c2[0]:=char(byte(tordconstnode(right).value)); + c2[1]:=#0; + l2:=1; + s1:=@c1; + s2:=@c2; + concatstrings:=true; + end + else if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then + begin + s1:=tstringconstnode(left).value_str; + l1:=tstringconstnode(left).len; + c2[0]:=char(byte(tordconstnode(right).value)); + c2[1]:=#0; + s2:=@c2; + l2:=1; + concatstrings:=true; + end + else if (lt=ordconstn) and (rt=stringconstn) and is_char(ld) then + begin + c1[0]:=char(byte(tordconstnode(left).value)); + c1[1]:=#0; + l1:=1; + s1:=@c1; + s2:=tstringconstnode(right).value_str; + l2:=tstringconstnode(right).len; + concatstrings:=true; + end + else if (lt=stringconstn) and (rt=stringconstn) then + begin + s1:=tstringconstnode(left).value_str; + l1:=tstringconstnode(left).len; + s2:=tstringconstnode(right).value_str; + l2:=tstringconstnode(right).len; + concatstrings:=true; + end; + if concatstrings then + begin + case nodetype of + addn : + t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2); + ltn : + t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<0),booltype,true); + lten : + t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<=0),booltype,true); + gtn : + t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>0),booltype,true); + gten : + t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>=0),booltype,true); + equaln : + t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)=0),booltype,true); + unequaln : + t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<>0),booltype,true); + else + begin + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + t:=cnothingnode.create; + end; + end; + result:=t; + exit; + end; + + { set constant evaluation } + if (right.nodetype=setconstn) and + not assigned(tsetconstnode(right).left) and + (left.nodetype=setconstn) and + not assigned(tsetconstnode(left).left) then + begin + { check if size adjusting is needed, only for left + to right as the other way is checked in the typeconv } + if (tsetdef(right.resulttype.def).settype=smallset) and + (tsetdef(left.resulttype.def).settype<>smallset) then + right.resulttype.setdef(tsetdef.create(tsetdef(right.resulttype.def).elementtype,255)); + { check base types } + inserttypeconv(left,right.resulttype); + + if codegenerror then + begin + { recover by only returning the left part } + result:=left; + left:=nil; + exit; + end; + case nodetype of + addn : + begin + resultset:=tsetconstnode(right).value_set^ + tsetconstnode(left).value_set^; + t:=csetconstnode.create(@resultset,left.resulttype); + end; + muln : + begin + resultset:=tsetconstnode(right).value_set^ * tsetconstnode(left).value_set^; + t:=csetconstnode.create(@resultset,left.resulttype); + end; + subn : + begin + resultset:=tsetconstnode(left).value_set^ - tsetconstnode(right).value_set^; + t:=csetconstnode.create(@resultset,left.resulttype); + end; + symdifn : + begin + resultset:=tsetconstnode(right).value_set^ >< tsetconstnode(left).value_set^; + t:=csetconstnode.create(@resultset,left.resulttype); + end; + unequaln : + begin + b:=tsetconstnode(right).value_set^ <> tsetconstnode(left).value_set^; + t:=cordconstnode.create(byte(b),booltype,true); + end; + equaln : + begin + b:=tsetconstnode(right).value_set^ = tsetconstnode(left).value_set^; + t:=cordconstnode.create(byte(b),booltype,true); + end; + lten : + begin + b:=tsetconstnode(left).value_set^ <= tsetconstnode(right).value_set^; + t:=cordconstnode.create(byte(b),booltype,true); + end; + gten : + begin + b:=tsetconstnode(left).value_set^ >= tsetconstnode(right).value_set^; + t:=cordconstnode.create(byte(b),booltype,true); + end; + else + begin + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + t:=cnothingnode.create; + end; + end; + result:=t; + exit; + end; { but an int/int gives real/real! } if nodetype=slashn then @@ -1087,18 +1074,10 @@ implementation end; end { pointer comparision and subtraction } - else if ( - (rd.deftype=pointerdef) and (ld.deftype=pointerdef) - ) or - { compare/add pchar to variable (not stringconst) char arrays - by addresses like BP/Delphi } - ( - (nodetype in [equaln,unequaln,subn,addn]) and - ( - ((is_pchar(ld) or (lt=niln)) and is_chararray(rd) and (rt<>stringconstn)) or - ((is_pchar(rd) or (rt=niln)) and is_chararray(ld) and (lt<>stringconstn)) - ) - ) then + else if ((rd.deftype=pointerdef) and (ld.deftype=pointerdef)) or + { compare pchar to char arrays by addresses like BP/Delphi } + ((is_pchar(ld) or (lt=niln)) and is_chararray(rd)) or + ((is_pchar(rd) or (rt=niln)) and is_chararray(ld)) then begin { convert char array to pointer } if is_chararray(rd) then @@ -1334,16 +1313,16 @@ implementation if not assigned(hsym) then internalerror(200412043); { For methodpointers compare only tmethodpointer.proc } - if (rd.deftype=procvardef) and + if (rd.deftype=procvardef) and (not tprocvardef(rd).is_addressonly) then - begin + begin right:=csubscriptnode.create( hsym, ctypeconvnode.create_internal(right,methodpointertype)); - end; - if (ld.deftype=procvardef) and - (not tprocvardef(ld).is_addressonly) then - begin + end; + if (ld.deftype=procvardef) and + (not tprocvardef(ld).is_addressonly) then + begin left:=csubscriptnode.create( hsym, ctypeconvnode.create_internal(left,methodpointertype)); @@ -1801,7 +1780,8 @@ implementation end; - function taddnode.first_addfloat : tnode; +{$ifdef cpufpemu} + function taddnode.first_addfloat: tnode; var procname: string[31]; { do we need to reverse the result ? } @@ -1815,102 +1795,43 @@ implementation if not (cs_fp_emulation in aktmoduleswitches) then exit; - if not(target_info.system in system_wince) then - begin - case tfloatdef(left.resulttype.def).typ of - s32real: - procname:='float32'; - s64real: - procname:='float64'; - {!!! not yet implemented - s128real: - } - else - internalerror(2005082601); - end; - - case nodetype of - addn: - procname:=procname+'_add'; - muln: - procname:=procname+'_mul'; - subn: - procname:=procname+'_sub'; - slashn: - procname:=procname+'_div'; - ltn: - procname:=procname+'_lt'; - lten: - procname:=procname+'_le'; - gtn: - begin - procname:=procname+'_le'; - notnode:=true; - end; - gten: - begin - procname:=procname+'_lt'; - notnode:=true; - end; - equaln: - procname:=procname+'_eq'; - unequaln: - begin - procname:=procname+'_eq'; - notnode:=true; - end; - else - CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),left.resulttype.def.typename,right.resulttype.def.typename); + case nodetype of + addn : procname := 'fpc_single_add'; + muln : procname := 'fpc_single_mul'; + subn : procname := 'fpc_single_sub'; + slashn : procname := 'fpc_single_div'; + ltn : procname := 'fpc_single_lt'; + lten: procname := 'fpc_single_le'; + gtn: + begin + procname := 'fpc_single_le'; + notnode := true; end; - end - else - begin - case nodetype of - addn: - procname:='ADD'; - muln: - procname:='MUL'; - subn: - procname:='SUB'; - slashn: - procname:='DIV'; - ltn: - procname:='LT'; - lten: - procname:='LE'; - gtn: - procname:='GT'; - gten: - procname:='GE'; - equaln: - procname:='EQ'; - unequaln: - procname:='NE'; - else - CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),left.resulttype.def.typename,right.resulttype.def.typename); + gten: + begin + procname := 'fpc_single_lt'; + notnode := true; end; - case tfloatdef(left.resulttype.def).typ of - s32real: - procname:=procname+'S'; - s64real: - procname:=procname+'D'; - {!!! not yet implemented - s128real: - } - else - internalerror(2005082602); + equaln: procname := 'fpc_single_eq'; + unequaln : + begin + procname := 'fpc_single_eq'; + notnode := true; end; - - end; - result:=ccallnode.createintern(procname,ccallparanode.create(right, + else + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),left.resulttype.def.typename,right.resulttype.def.typename); + end; + { convert the arguments (explicitely) to fpc_normal_set's } + result := ccallnode.createintern(procname,ccallparanode.create(right, ccallparanode.create(left,nil))); left:=nil; right:=nil; { do we need to reverse the result } if notnode then - result:=cnotnode.create(result); + result := cnotnode.create(result); end; +{$endif cpufpemu} function taddnode.pass_1 : tnode; @@ -1939,12 +1860,9 @@ implementation if nodetype=slashn then begin {$ifdef cpufpemu} - if (aktfputype=fpu_soft) or (cs_fp_emulation in aktmoduleswitches) then - begin - result:=first_addfloat; - if assigned(result) then - exit; - end; + result := first_addfloat; + if assigned(result) then + exit; {$endif cpufpemu} expectloc:=LOC_FPUREGISTER; { maybe we need an integer register to save } @@ -2147,12 +2065,9 @@ implementation else if (rd.deftype=floatdef) or (ld.deftype=floatdef) then begin {$ifdef cpufpemu} - if (aktfputype=fpu_soft) or (cs_fp_emulation in aktmoduleswitches) then - begin - result:=first_addfloat; - if assigned(result) then - exit; - end; + result := first_addfloat; + if assigned(result) then + exit; {$endif cpufpemu} if nodetype in [addn,subn,muln,andn,orn,xorn] then expectloc:=LOC_FPUREGISTER diff --git a/compiler/nbas.pas b/compiler/nbas.pas index 18c786b55f..027d201f7e 100644 --- a/compiler/nbas.pas +++ b/compiler/nbas.pas @@ -61,7 +61,7 @@ interface procedure ppuwrite(ppufile:tcompilerppufile);override; procedure buildderefimpl;override; procedure derefimpl;override; - function _getcopy : tnode;override; + function getcopy : tnode;override; function pass_1 : tnode;override; function det_resulttype:tnode;override; function docompare(p: tnode): boolean; override; @@ -123,7 +123,7 @@ interface procedure ppuwrite(ppufile:tcompilerppufile);override; procedure buildderefimpl;override; procedure derefimpl;override; - function _getcopy: tnode; override; + function getcopy: tnode; override; function pass_1 : tnode; override; function det_resulttype: tnode; override; function docompare(p: tnode): boolean; override; @@ -137,7 +137,7 @@ interface constructor create_offset(const temp: ttempcreatenode;aoffset:longint); constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override; - function _getcopy: tnode; override; + function getcopy: tnode; override; procedure derefnode;override; function pass_1 : tnode; override; function det_resulttype : tnode; override; @@ -160,7 +160,7 @@ interface constructor create_normal_temp(const temp: ttempcreatenode); constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override; - function _getcopy: tnode; override; + function getcopy: tnode; override; procedure derefnode;override; function pass_1: tnode; override; function det_resulttype: tnode; override; @@ -624,11 +624,11 @@ implementation end; - function tasmnode._getcopy: tnode; + function tasmnode.getcopy: tnode; var n: tasmnode; begin - n := tasmnode(inherited _getcopy); + n := tasmnode(inherited getcopy); if assigned(p_asm) then begin n.p_asm:=taasmoutput.create; @@ -636,7 +636,7 @@ implementation end else n.p_asm := nil; n.currenttai:=currenttai; - result:=n; + getcopy := n; end; @@ -690,11 +690,11 @@ implementation (not tpointerdef(_restype.def).pointertype.def.needs_inittable)); end; - function ttempcreatenode._getcopy: tnode; + function ttempcreatenode.getcopy: tnode; var n: ttempcreatenode; begin - n := ttempcreatenode(inherited _getcopy); + n := ttempcreatenode(inherited getcopy); n.size := size; new(n.tempinfo); @@ -807,11 +807,11 @@ implementation end; - function ttemprefnode._getcopy: tnode; + function ttemprefnode.getcopy: tnode; var n: ttemprefnode; begin - n := ttemprefnode(inherited _getcopy); + n := ttemprefnode(inherited getcopy); n.offset := offset; if assigned(tempinfo^.hookoncopy) then @@ -944,11 +944,11 @@ implementation end; - function ttempdeletenode._getcopy: tnode; + function ttempdeletenode.getcopy: tnode; var n: ttempdeletenode; begin - n := ttempdeletenode(inherited _getcopy); + n := ttempdeletenode(inherited getcopy); n.release_to_normal := release_to_normal; if assigned(tempinfo^.hookoncopy) then diff --git a/compiler/ncal.pas b/compiler/ncal.pas index 4ea78a5d43..20c829c1a3 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -1,8 +1,8 @@ { - This file implements the node for sub procedure calling. - Copyright (c) 1998-2002 by Florian Klaempfl + This file implements the node for sub procedure calling. + This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or @@ -86,6 +86,10 @@ interface methodpointerinit, methodpointerdone : tblocknode; methodpointer : tnode; +{$ifdef PASS2INLINE} + { inline function body } + inlinecode : tnode; +{$endif PASS2INLINE} { varargs parasyms } varargsparas : tvarargsparalist; { node that specifies where the result should be put for calls } @@ -111,7 +115,7 @@ interface procedure ppuwrite(ppufile:tcompilerppufile);override; procedure buildderefimpl;override; procedure derefimpl;override; - function _getcopy : tnode;override; + function getcopy : tnode;override; { Goes through all symbols in a class and subclasses and calls verify abstract for each . } @@ -152,7 +156,7 @@ interface destructor destroy;override; constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override; - function _getcopy : tnode;override; + function getcopy : tnode;override; procedure insertintolist(l : tnodelist);override; procedure get_paratype; procedure insert_typeconv(do_count : boolean); @@ -383,7 +387,7 @@ type begin maybe_load_para_in_temp(p); hightree:=caddnode.create(subn,geninlinenode(in_length_x,false,p.getcopy), - cordconstnode.create(1,sinttype,false)); + cordconstnode.create(1,s32inttype,false)); loadconst:=false; end; end; @@ -392,13 +396,13 @@ type len:=0; end; if loadconst then - hightree:=cordconstnode.create(len,sinttype,true) + hightree:=cordconstnode.create(len,s32inttype,true) else begin if not assigned(hightree) then internalerror(200304071); { Need to use explicit, because it can also be a enum } - hightree:=ctypeconvnode.create_internal(hightree,sinttype); + hightree:=ctypeconvnode.create_internal(hightree,s32inttype); end; result:=hightree; end; @@ -454,13 +458,13 @@ type end; - function tcallparanode._getcopy : tnode; + function tcallparanode.getcopy : tnode; var n : tcallparanode; begin - n:=tcallparanode(inherited _getcopy); + n:=tcallparanode(inherited getcopy); n.callparaflags:=callparaflags; n.parasym:=parasym; result:=n; @@ -789,6 +793,9 @@ type methodpointerdone:=nil; procdefinition:=nil; _funcretnode:=nil; +{$ifdef PASS2INLINE} + inlinecode:=nil; +{$endif PASS2INLINE} paralength:=-1; varargsparas:=nil; end; @@ -805,6 +812,9 @@ type procdefinition:=nil; callnodeflags:=[cnf_return_value_used]; _funcretnode:=nil; +{$ifdef PASS2INLINE} + inlinecode:=nil; +{$endif PASS2INLINE} paralength:=-1; varargsparas:=nil; end; @@ -827,8 +837,8 @@ type searchsym(upper(name),srsym,symowner); end; if not assigned(srsym) or - (srsym.typ<>procsym) then - Message1(cg_f_unknown_compilerproc,name); + (srsym.typ <> procsym) then + Message1(cg_f_unknown_compiler,name); self.create(params,tprocsym(srsym),symowner,nil,[]); end; @@ -898,6 +908,9 @@ type methodpointerinit.free; methodpointerdone.free; _funcretnode.free; +{$ifdef PASS2INLINE} + inlinecode.free; +{$endif PASS2INLINE} if assigned(varargsparas) then begin for i:=0 to varargsparas.count-1 do @@ -922,6 +935,9 @@ type methodpointerinit:=tblocknode(ppuloadnode(ppufile)); methodpointerdone:=tblocknode(ppuloadnode(ppufile)); _funcretnode:=ppuloadnode(ppufile); +{$ifdef PASS2INLINE} + inlinecode:=ppuloadnode(ppufile); +{$endif PASS2INLINE} end; @@ -935,6 +951,9 @@ type ppuwritenode(ppufile,methodpointerinit); ppuwritenode(ppufile,methodpointerdone); ppuwritenode(ppufile,_funcretnode); +{$ifdef PASS2INLINE} + ppuwritenode(ppufile,inlinecode); +{$endif PASS2INLINE} end; @@ -951,6 +970,10 @@ type methodpointerdone.buildderefimpl; if assigned(_funcretnode) then _funcretnode.buildderefimpl; +{$ifdef PASS2INLINE} + if assigned(inlinecode) then + inlinecode.buildderefimpl; +{$endif PASS2INLINE} end; @@ -972,6 +995,10 @@ type methodpointerdone.derefimpl; if assigned(_funcretnode) then _funcretnode.derefimpl; +{$ifdef PASS2INLINE} + if assigned(inlinecode) then + inlinecode.derefimpl; +{$endif PASS2INLINE} { Connect parasyms } pt:=tcallparanode(left); while assigned(pt) and @@ -989,7 +1016,7 @@ type end; - function tcallnode._getcopy : tnode; + function tcallnode.getcopy : tnode; var n : tcallnode; i : integer; @@ -1001,7 +1028,7 @@ type the can reference methodpointer } oldleft:=left; left:=nil; - n:=tcallnode(inherited _getcopy); + n:=tcallnode(inherited getcopy); left:=oldleft; n.symtableprocentry:=symtableprocentry; n.symtableproc:=symtableproc; @@ -1009,28 +1036,33 @@ type n.restype := restype; n.callnodeflags := callnodeflags; if assigned(methodpointerinit) then - n.methodpointerinit:=tblocknode(methodpointerinit._getcopy) + n.methodpointerinit:=tblocknode(methodpointerinit.getcopy) else n.methodpointerinit:=nil; { methodpointerinit is copied, now references to the temp will also be copied correctly. We can now copy the parameters and methodpointer } if assigned(left) then - n.left:=left._getcopy + n.left:=left.getcopy else n.left:=nil; if assigned(methodpointer) then - n.methodpointer:=methodpointer._getcopy + n.methodpointer:=methodpointer.getcopy else n.methodpointer:=nil; if assigned(methodpointerdone) then - n.methodpointerdone:=tblocknode(methodpointerdone._getcopy) + n.methodpointerdone:=tblocknode(methodpointerdone.getcopy) else n.methodpointerdone:=nil; if assigned(_funcretnode) then - n._funcretnode:=_funcretnode._getcopy + n._funcretnode:=_funcretnode.getcopy else n._funcretnode:=nil; - +{$ifdef PASS2INLINE} + if assigned(inlinecode) then + n.inlinecode:=inlinecode.getcopy + else + n.inlinecode:=nil; +{$endif PASS2INLINE} if assigned(varargsparas) then begin n.varargsparas:=tvarargsparalist.create; @@ -2171,7 +2203,6 @@ type funcretnode := ctemprefnode.create(tempnode); para.left.free; para.left := ctemprefnode.create(tempnode); - addstatement(deletestatement,ctempdeletenode.create_normal_temp(tempnode)); end end @@ -2246,13 +2277,9 @@ type if assigned(funcretnode) and (cnf_return_value_used in callnodeflags) then addstatement(createstatement,funcretnode.getcopy); - { consider it must not be inlined if called again inside the args or itself } exclude(procdefinition.procoptions,po_inline); - - dosimplify(createblock); - firstpass(createblock); include(procdefinition.procoptions,po_inline); { return inlined block } diff --git a/compiler/ncgadd.pas b/compiler/ncgadd.pas index f85f03cbd2..56865542ea 100644 --- a/compiler/ncgadd.pas +++ b/compiler/ncgadd.pas @@ -99,9 +99,9 @@ interface if isjump then begin otl:=truelabel; - objectlibrary.getjumplabel(truelabel); + objectlibrary.getlabel(truelabel); ofl:=falselabel; - objectlibrary.getjumplabel(falselabel); + objectlibrary.getlabel(falselabel); end; secondpass(left); if left.location.loc in [LOC_FLAGS,LOC_JUMP] then @@ -121,9 +121,9 @@ interface if isjump then begin otl:=truelabel; - objectlibrary.getjumplabel(truelabel); + objectlibrary.getlabel(truelabel); ofl:=falselabel; - objectlibrary.getjumplabel(falselabel); + objectlibrary.getlabel(falselabel); end; secondpass(right); if right.location.loc in [LOC_FLAGS,LOC_JUMP] then @@ -386,7 +386,7 @@ interface andn : begin otl:=truelabel; - objectlibrary.getjumplabel(truelabel); + objectlibrary.getlabel(truelabel); secondpass(left); maketojumpbool(exprasmlist,left,lr_load_regvars); cg.a_label(exprasmlist,truelabel); @@ -395,7 +395,7 @@ interface orn : begin ofl:=falselabel; - objectlibrary.getjumplabel(falselabel); + objectlibrary.getlabel(falselabel); secondpass(left); maketojumpbool(exprasmlist,left,lr_load_regvars); cg.a_label(exprasmlist,falselabel); diff --git a/compiler/ncgbas.pas b/compiler/ncgbas.pas index 39761affdb..c4e14794f3 100644 --- a/compiler/ncgbas.pas +++ b/compiler/ncgbas.pas @@ -338,7 +338,7 @@ interface if nf_block_with_exit in flags then begin oldexitlabel:=current_procinfo.aktexitlabel; - objectlibrary.getjumplabel(current_procinfo.aktexitlabel); + objectlibrary.getlabel(current_procinfo.aktexitlabel); end; { do second pass on left node } diff --git a/compiler/ncgcal.pas b/compiler/ncgcal.pas index 30cc7db5b2..2005233937 100644 --- a/compiler/ncgcal.pas +++ b/compiler/ncgcal.pas @@ -46,6 +46,10 @@ interface tcgcallnode = class(tcallnode) private procedure release_para_temps; + procedure normal_pass_2; +{$ifdef PASS2INLINE} + procedure inlined_pass_2; +{$endif PASS2INLINE} procedure pushparas; procedure freeparas; protected @@ -77,6 +81,10 @@ implementation systems, cutils,verbose,globals, symconst,symtable,defutil,paramgr, +{$ifdef GDB} + strings, + gdb, +{$endif GDB} cgbase,pass_2, aasmbase,aasmtai, nbas,nmem,nld,ncnv,nutils, @@ -130,7 +138,7 @@ implementation location_force_reg(exprasmlist,left.location,def_cgsize(left.resulttype.def),false); { Handle Floating point types differently } - if (left.resulttype.def.deftype=floatdef) and not(cs_fp_emulation in aktmoduleswitches) then + if left.resulttype.def.deftype=floatdef then begin {$ifdef i386} if tempcgpara.location^.loc<>LOC_REFERENCE then @@ -345,8 +353,8 @@ implementation begin otlabel:=truelabel; oflabel:=falselabel; - objectlibrary.getjumplabel(truelabel); - objectlibrary.getjumplabel(falselabel); + objectlibrary.getlabel(truelabel); + objectlibrary.getlabel(falselabel); secondpass(left); { release memory for refcnt out parameters } @@ -357,7 +365,12 @@ implementation cg.g_decrrefcount(exprasmlist,left.resulttype.def,href); end; - paramanager.createtempparaloc(exprasmlist,aktcallnode.procdefinition.proccalloption,parasym,tempcgpara); +{$ifdef PASS2INLINE} + if assigned(aktcallnode.inlinecode) then + paramanager.duplicateparaloc(exprasmlist,aktcallnode.procdefinition.proccalloption,parasym,tempcgpara) + else +{$endif PASS2INLINE} + paramanager.createtempparaloc(exprasmlist,aktcallnode.procdefinition.proccalloption,parasym,tempcgpara); { handle varargs first, because parasym is not valid } if (cpf_varargs_para in callparaflags) then @@ -690,7 +703,10 @@ implementation { better check for the real location of the parameter here, when stack passed parameters are saved temporary in registers, checking for the tmpparaloc.loc is wrong } - paramanager.freeparaloc(exprasmlist,ppn.tempcgpara); +{$ifdef PASS2INLINE} + if not assigned(inlinecode) then +{$endif PASS2INLINE} + paramanager.freeparaloc(exprasmlist,ppn.tempcgpara); tmpparaloc:=ppn.tempcgpara.location; sizeleft:=ppn.tempcgpara.intsize; callerparaloc:=ppn.parasym.paraloc[callerside].location; @@ -730,37 +746,42 @@ implementation end; LOC_REFERENCE: begin +{$ifdef PASS2INLINE} + if not assigned(inlinecode) then +{$endif PASS2INLINE} + begin {$ifdef cputargethasfixedstack} - { Can't have a data copied to the stack, every location - must contain a valid size field } - - if (ppn.tempcgpara.size=OS_NO) and - ((tmpparaloc^.loc<>LOC_REFERENCE) or - assigned(tmpparaloc^.next)) then - internalerror(200501281); - reference_reset_base(href,callerparaloc^.reference.index,callerparaloc^.reference.offset); - { copy parameters in case they were moved to a temp. location because we've a fixed stack } - case tmpparaloc^.loc of - LOC_REFERENCE: - begin - reference_reset_base(htempref,tmpparaloc^.reference.index,tmpparaloc^.reference.offset); - { use concatcopy, because it can also be a float which fails when - load_ref_ref is used } - if (ppn.tempcgpara.size <> OS_NO) then - cg.g_concatcopy(exprasmlist,htempref,href,tcgsize2size[tmpparaloc^.size]) - else - cg.g_concatcopy(exprasmlist,htempref,href,sizeleft) - end; - LOC_REGISTER: - cg.a_load_reg_ref(exprasmlist,tmpparaloc^.size,tmpparaloc^.size,tmpparaloc^.register,href); - LOC_FPUREGISTER: - cg.a_loadfpu_reg_ref(exprasmlist,tmpparaloc^.size,tmpparaloc^.register,href); - LOC_MMREGISTER: - cg.a_loadmm_reg_ref(exprasmlist,tmpparaloc^.size,tmpparaloc^.size,tmpparaloc^.register,href,mms_movescalar); - else - internalerror(200402081); - end; + { Can't have a data copied to the stack, every location + must contain a valid size field } + + if (ppn.tempcgpara.size=OS_NO) and + ((tmpparaloc^.loc<>LOC_REFERENCE) or + assigned(tmpparaloc^.next)) then + internalerror(200501281); + reference_reset_base(href,callerparaloc^.reference.index,callerparaloc^.reference.offset); + { copy parameters in case they were moved to a temp. location because we've a fixed stack } + case tmpparaloc^.loc of + LOC_REFERENCE: + begin + reference_reset_base(htempref,tmpparaloc^.reference.index,tmpparaloc^.reference.offset); + { use concatcopy, because it can also be a float which fails when + load_ref_ref is used } + if (ppn.tempcgpara.size <> OS_NO) then + cg.g_concatcopy(exprasmlist,htempref,href,tcgsize2size[tmpparaloc^.size]) + else + cg.g_concatcopy(exprasmlist,htempref,href,sizeleft) + end; + LOC_REGISTER: + cg.a_load_reg_ref(exprasmlist,tmpparaloc^.size,tmpparaloc^.size,tmpparaloc^.register,href); + LOC_FPUREGISTER: + cg.a_loadfpu_reg_ref(exprasmlist,tmpparaloc^.size,tmpparaloc^.register,href); + LOC_MMREGISTER: + cg.a_loadmm_reg_ref(exprasmlist,tmpparaloc^.size,tmpparaloc^.size,tmpparaloc^.register,href,mms_movescalar); + else + internalerror(200402081); + end; {$endif cputargethasfixedstack} + end; end; end; dec(sizeleft,tcgsize2size[tmpparaloc^.size]); @@ -783,7 +804,11 @@ implementation begin if (ppn.left.nodetype<>nothingn) then begin - if (ppn.parasym.paraloc[callerside].location^.loc <> LOC_REFERENCE) then + if +{$ifdef PASS2INLINE} + not assigned(inlinecode) or +{$endif PASS2INLINE} + (ppn.parasym.paraloc[callerside].location^.loc <> LOC_REFERENCE) then paramanager.freeparaloc(exprasmlist,ppn.parasym.paraloc[callerside]); end; ppn:=tcgcallparanode(ppn.right); @@ -792,7 +817,7 @@ implementation - procedure tcgcallnode.pass_2; + procedure tcgcallnode.normal_pass_2; var regs_to_save_int, regs_to_save_fpu, @@ -807,9 +832,6 @@ implementation not procdefinition.has_paraloc_info then internalerror(200305264); - if assigned(methodpointerinit) then - secondpass(methodpointerinit); - if resulttype.def.needs_inittable and not paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) and not assigned(funcretnode) then @@ -1038,17 +1060,228 @@ implementation (right=nil) and not(po_virtualmethod in procdefinition.procoptions) then begin - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_IOCHECK'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end; { release temps of paras } release_para_temps; + end; + + +{$ifdef PASS2INLINE} + procedure tcgcallnode.inlined_pass_2; + var + oldaktcallnode : tcallnode; + oldprocinfo : tprocinfo; + oldinlining_procedure : boolean; + inlineentrycode,inlineexitcode : TAAsmoutput; +{$ifdef GDB} + startlabel,endlabel : tasmlabel; + pp : pchar; + mangled_length : longint; +{$endif GDB} + begin + if not(assigned(procdefinition) and (procdefinition.deftype=procdef)) then + internalerror(200305262); + + oldinlining_procedure:=inlining_procedure; + oldprocinfo:=current_procinfo; + { we're inlining a procedure } + inlining_procedure:=true; + + { Add inling start } +{$ifdef GDB} + exprasmlist.concat(Tai_force_line.Create); +{$endif GDB} + exprasmList.concat(Tai_Marker.Create(InlineStart)); +{$ifdef extdebug} + exprasmList.concat(tai_comment.Create(strpnew('Start of inlined proc '+tprocdef(procdefinition).procsym.name))); +{$endif extdebug} + + { calculate registers to pass the parameters } + paramanager.create_inline_paraloc_info(procdefinition); + + { Allocate parameters and locals } + gen_alloc_inline_parast(exprasmlist,tprocdef(procdefinition)); + gen_alloc_inline_funcret(exprasmlist,tprocdef(procdefinition)); + gen_alloc_symtable(exprasmlist,tprocdef(procdefinition).localst); + + { if we allocate the temp. location for ansi- or widestrings } + { already here, we avoid later a push/pop } + if resulttype.def.needs_inittable and + not paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) then + begin + tg.gettemptyped(exprasmlist,resulttype.def,tt_normal,refcountedtemp); + cg.g_decrrefcount(exprasmlist,resulttype.def,refcountedtemp); + end; + { Push parameters, still use the old current_procinfo. This + is required that have the correct information available like + _class and nested procedure } + oldaktcallnode:=aktcallnode; + aktcallnode:=self; + if assigned(left) then + begin + tcallparanode(left).secondcallparan; + pushparas; + end; + aktcallnode:=oldaktcallnode; + + { create temp procinfo that will be used for the inlinecode tree } + current_procinfo:=cprocinfo.create(nil); + current_procinfo.procdef:=tprocdef(procdefinition); + current_procinfo.flags:=oldprocinfo.flags; + current_procinfo.aktlocaldata.destroy; + current_procinfo.aktlocaldata:=oldprocinfo.aktlocaldata; + + { when the oldprocinfo is also being inlined reuse the + inlining_procinfo } + if assigned(oldprocinfo.inlining_procinfo) then + current_procinfo.inlining_procinfo:=oldprocinfo.inlining_procinfo + else + current_procinfo.inlining_procinfo:=oldprocinfo; + + { takes care of local data initialization } + inlineentrycode:=TAAsmoutput.Create; + inlineexitcode:=TAAsmoutput.Create; + +{$ifdef GDB} + if (cs_debuginfo in aktmoduleswitches) and + not(cs_gdb_valgrind in aktglobalswitches) then + begin + objectlibrary.getaddrlabel(startlabel); + objectlibrary.getaddrlabel(endlabel); + cg.a_label(exprasmlist,startlabel); + + { Here we must include the para and local symtable info } + procdefinition.concatstabto(withdebuglist); + + mangled_length:=length(current_procinfo.inlining_procinfo.procdef.mangledname); + getmem(pp,mangled_length+50); + strpcopy(pp,'192,0,0,'+startlabel.name); + if (target_info.use_function_relative_addresses) then + begin + strpcopy(strend(pp),'-'); + strpcopy(strend(pp),current_procinfo.inlining_procinfo.procdef.mangledname); + end; + withdebugList.concat(Tai_stabn.Create(strnew(pp))); + end; +{$endif GDB} + + gen_load_para_value(inlineentrycode); + { now that we've loaded the para's, free them } + if assigned(left) then + freeparas; + gen_initialize_code(inlineentrycode); + if po_assembler in current_procinfo.procdef.procoptions then + inlineentrycode.insert(Tai_marker.Create(asmblockstart)); + exprasmList.concatlist(inlineentrycode); + + { process the inline code } + secondpass(inlinecode); + + cg.a_label(exprasmlist,current_procinfo.aktexitlabel); + gen_finalize_code(inlineexitcode); + gen_load_return_value(inlineexitcode); + if po_assembler in current_procinfo.procdef.procoptions then + inlineexitcode.concat(Tai_marker.Create(asmblockend)); + exprasmlist.concatlist(inlineexitcode); + + inlineentrycode.free; + inlineexitcode.free; +{$ifdef extdebug} + exprasmList.concat(tai_comment.Create(strpnew('End of inlined proc'))); +{$endif extdebug} + exprasmList.concat(Tai_Marker.Create(InlineEnd)); + + { handle function results } + if (not is_void(resulttype.def)) then + handle_return_value + else + location_reset(location,LOC_VOID,OS_NO); + + { perhaps i/o check ? } + if (cs_check_io in aktlocalswitches) and + (po_iocheck in procdefinition.procoptions) and + not(po_iocheck in current_procinfo.procdef.procoptions) and + { no IO check for methods and procedure variables } + (right=nil) and + not(po_virtualmethod in procdefinition.procoptions) then + begin + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); + cg.a_call_name(exprasmlist,'FPC_IOCHECK'); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); + end; + + { release temps of paras } + release_para_temps; + + { if return value is not used } + if (not is_void(resulttype.def)) and + (not(cnf_return_value_used in callnodeflags)) then + begin + if location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then + begin + { data which must be finalized ? } + if (resulttype.def.needs_inittable) then + cg.g_finalize(exprasmlist,resulttype.def,location.reference); + { release unused temp } + tg.ungetiftemp(exprasmlist,location.reference) + end + else if location.loc=LOC_FPUREGISTER then + begin +{$ifdef x86} + { release FPU stack } + emit_reg(A_FSTP,S_NO,NR_FPU_RESULT_REG); +{$endif x86} + end; + end; + + { Release parameters and locals } + gen_free_symtable(exprasmlist,tparasymtable(current_procinfo.procdef.parast)); + gen_free_symtable(exprasmlist,tlocalsymtable(current_procinfo.procdef.localst)); + +{$ifdef GDB} + if (cs_debuginfo in aktmoduleswitches) and + not(cs_gdb_valgrind in aktglobalswitches) then + begin + cg.a_label(exprasmlist,endlabel); + strpcopy(pp,'224,0,0,'+endlabel.name); + if (target_info.use_function_relative_addresses) then + begin + strpcopy(strend(pp),'-'); + strpcopy(strend(pp),current_procinfo.inlining_procinfo.procdef.mangledname); + end; + withdebugList.concat(Tai_stabn.Create(strnew(pp))); + freemem(pp,mangled_length+50); + end; +{$endif GDB} + + { restore } + current_procinfo.aktlocaldata:=nil; + current_procinfo.destroy; + current_procinfo:=oldprocinfo; + inlining_procedure:=oldinlining_procedure; + end; +{$endif PASS2INLINE} + + + procedure tcgcallnode.pass_2; + begin + if assigned(methodpointerinit) then + secondpass(methodpointerinit); + +{$ifdef PASS2INLINE} + if assigned(inlinecode) then + inlined_pass_2 + else +{$endif PASS2INLINE} + normal_pass_2; - if assigned(methodpointerdone) then - secondpass(methodpointerdone); + if assigned(methodpointerdone) then + secondpass(methodpointerdone); end; diff --git a/compiler/ncgcnv.pas b/compiler/ncgcnv.pas index cb2770adf5..409c892f99 100644 --- a/compiler/ncgcnv.pas +++ b/compiler/ncgcnv.pas @@ -33,7 +33,6 @@ interface tcgtypeconvnode = class(ttypeconvnode) procedure second_int_to_int;override; procedure second_cstring_to_pchar;override; - procedure second_cstring_to_int;override; procedure second_string_to_chararray;override; procedure second_array_to_pointer;override; procedure second_pointer_to_array;override; @@ -137,18 +136,17 @@ interface begin location_reset(location,LOC_REGISTER,OS_ADDR); case tstringdef(left.resulttype.def).string_typ of - st_conststring : - begin - location.register:=cg.getaddressregister(exprasmlist); - cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,location.register); - end; st_shortstring : begin inc(left.location.reference.offset); location.register:=cg.getaddressregister(exprasmlist); cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,location.register); end; + {$ifdef ansistring_bits} + st_ansistring16,st_ansistring32,st_ansistring64 : + {$else} st_ansistring : + {$endif} begin if (left.nodetype=stringconstn) and (str_length(left)=0) then @@ -182,6 +180,9 @@ interface else begin location.register:=cg.getintregister(exprasmlist,OS_INT); +{$ifdef fpc} +{$warning Todo: convert widestrings to ascii when typecasting them to pchars} +{$endif} cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_INT,left.location.reference, location.register); end; @@ -190,24 +191,26 @@ interface end; - procedure tcgtypeconvnode.second_cstring_to_int; - begin - { this can't happen because constants are already processed in - pass 1 } - internalerror(200510013); - end; + procedure tcgtypeconvnode.second_string_to_chararray; + var + arrsize: longint; - procedure tcgtypeconvnode.second_string_to_chararray; begin - if (left.nodetype = stringconstn) and - (tstringdef(left.resulttype.def).string_typ=st_conststring) then - begin - location_copy(location,left.location); - exit; - end; - { should be handled already in resulttype pass (JM) } - internalerror(200108292); + with tarraydef(resulttype.def) do + arrsize := highrange-lowrange+1; + if (left.nodetype = stringconstn) and + { left.length+1 since there's always a terminating #0 character (JM) } + (tstringconstnode(left).len+1 >= arrsize) and + (tstringdef(left.resulttype.def).string_typ=st_shortstring) then + begin + location_copy(location,left.location); + inc(location.reference.offset); + exit; + end + else + { should be handled already in resulttype pass (JM) } + internalerror(200108292); end; @@ -369,8 +372,8 @@ interface begin oldtruelabel:=truelabel; oldfalselabel:=falselabel; - objectlibrary.getjumplabel(truelabel); - objectlibrary.getjumplabel(falselabel); + objectlibrary.getlabel(truelabel); + objectlibrary.getlabel(falselabel); secondpass(left); location_copy(location,left.location); { byte(boolean) or word(wordbool) or longint(longbool) must } @@ -406,7 +409,7 @@ interface hr : treference; begin location_reset(location,LOC_REGISTER,OS_ADDR); - objectlibrary.getjumplabel(l1); + objectlibrary.getlabel(l1); case left.location.loc of LOC_CREGISTER,LOC_REGISTER: begin @@ -461,7 +464,7 @@ interface else internalerror(121120001); end; - objectlibrary.getjumplabel(l1); + objectlibrary.getlabel(l1); cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,location.register,l1); hd:=tobjectdef(left.resulttype.def); while assigned(hd) do diff --git a/compiler/ncgcon.pas b/compiler/ncgcon.pas index 336cc65a1c..5c775688d7 100644 --- a/compiler/ncgcon.pas +++ b/compiler/ncgcon.pas @@ -100,7 +100,7 @@ implementation if not assigned(lab_real) then begin { tries to find an old entry } - hp1:=tai(asmlist[al_typedconsts].first); + hp1:=tai(Consts.first); while assigned(hp1) do begin if hp1.typ=ait_label then @@ -138,17 +138,17 @@ implementation begin objectlibrary.getdatalabel(lastlabel); lab_real:=lastlabel; - maybe_new_object_file(asmlist[al_typedconsts]); - new_section(asmlist[al_typedconsts],sec_rodata,lastlabel.name,const_align(resulttype.def.size)); - asmlist[al_typedconsts].concat(Tai_label.Create(lastlabel)); + maybe_new_object_file(consts); + new_section(consts,sec_rodata,lastlabel.name,const_align(resulttype.def.size)); + Consts.concat(Tai_label.Create(lastlabel)); case realait of ait_real_32bit : begin - asmlist[al_typedconsts].concat(Tai_real_32bit.Create(ts32real(value_real))); + Consts.concat(Tai_real_32bit.Create(ts32real(value_real))); { range checking? } if ((cs_check_range in aktlocalswitches) or (cs_check_overflow in aktlocalswitches)) and - (tai_real_32bit(asmlist[al_typedconsts].last).value=double(MathInf)) then + (tai_real_32bit(Consts.Last).value=double(MathInf)) then Message(parser_e_range_check_error); end; @@ -156,47 +156,54 @@ implementation begin {$ifdef ARM} if hiloswapped then - asmlist[al_typedconsts].concat(Tai_real_64bit.Create_hiloswapped(ts64real(value_real))) + Consts.concat(Tai_real_64bit.Create_hiloswapped(ts64real(value_real))) else {$endif ARM} - asmlist[al_typedconsts].concat(Tai_real_64bit.Create(ts64real(value_real))); + Consts.concat(Tai_real_64bit.Create(ts64real(value_real))); { range checking? } if ((cs_check_range in aktlocalswitches) or (cs_check_overflow in aktlocalswitches)) and - (tai_real_64bit(asmlist[al_typedconsts].last).value=double(MathInf)) then + (tai_real_64bit(Consts.Last).value=double(MathInf)) then Message(parser_e_range_check_error); end; ait_real_80bit : begin - asmlist[al_typedconsts].concat(Tai_real_80bit.Create(value_real)); + Consts.concat(Tai_real_80bit.Create(value_real)); { range checking? } if ((cs_check_range in aktlocalswitches) or (cs_check_overflow in aktlocalswitches)) and - (tai_real_80bit(asmlist[al_typedconsts].last).value=double(MathInf)) then + (tai_real_80bit(Consts.Last).value=double(MathInf)) then Message(parser_e_range_check_error); end; {$ifdef cpufloat128} ait_real_128bit : begin - asmlist[al_typedconsts].concat(Tai_real_128bit.Create(value_real)); + Consts.concat(Tai_real_128bit.Create(value_real)); { range checking? } if ((cs_check_range in aktlocalswitches) or (cs_check_overflow in aktlocalswitches)) and - (tai_real_128bit(asmlist[al_typedconsts].last).value=double(MathInf)) then + (tai_real_128bit(Consts.Last).value=double(MathInf)) then Message(parser_e_range_check_error); end; {$endif cpufloat128} +{$ifdef ver1_0} + ait_comp_64bit : + Consts.concat(Tai_comp_64bit.Create(value_real)); +{$else ver1_0} { the round is necessary for native compilers where comp isn't a float } ait_comp_64bit : - if (value_real>9223372036854775807.0) or (value_real<-9223372036854775808.0) then - message(parser_e_range_check_error) - else - asmlist[al_typedconsts].concat(Tai_comp_64bit.Create(round(value_real))); + begin + if (value_real>9223372036854775807.0) or (value_real<-9223372036854775808.0) then + Message(parser_e_range_check_error) + else + Consts.concat(Tai_comp_64bit.Create(round(value_real))); + end; +{$endif ver1_0} else internalerror(10120); end; @@ -248,7 +255,11 @@ implementation i,mylength : longint; begin { for empty ansistrings we could return a constant 0 } + {$ifdef ansistring_bits} + if (st_type in [st_ansistring16,st_ansistring32,st_ansistring64,st_widestring]) and (len=0) then + {$else} if (st_type in [st_ansistring,st_widestring]) and (len=0) then + {$endif} begin location_reset(location,LOC_CONSTANT,OS_ADDR); location.value:=0; @@ -268,8 +279,8 @@ implementation { widestrings can't be reused yet } if not(is_widestring(resulttype.def)) then begin - { tries to find an old entry } - hp1:=tai(asmlist[al_typedconsts].first); + { tries to found an old entry } + hp1:=tai(Consts.first); while assigned(hp1) do begin if hp1.typ=ait_label then @@ -284,32 +295,58 @@ implementation (lastlabel<>nil) and (tai_string(hp1).len=mylength) then begin + { if shortstring then check the length byte first and + set the start index to 1 } case st_type of - st_conststring: + st_shortstring: begin - j:=0; - same_string:=true; - if len>0 then + if len=ord(tai_string(hp1).str[0]) then begin - for i:=0 to len-1 do + j:=1; + same_string:=true; + if len>0 then begin - if tai_string(hp1).str[j]<>value_str[i] then - begin - same_string:=false; - break; - end; - inc(j); + for i:=0 to len-1 do + begin + if tai_string(hp1).str[j]<>value_str[i] then + begin + same_string:=false; + break; + end; + inc(j); + end; end; end; end; - st_shortstring: + {$ifdef ansistring_bits} + st_ansistring16: begin - { if shortstring then check the length byte first and - set the start index to 1 } - if len=ord(tai_string(hp1).str[0]) then + { before the string the following sequence must be found: + <label> + constsymbol <datalabel> + const32 <len> + const32 <len> + const32 -1 + we must then return <label> to reuse + } + hp2:=tai(lastlabelhp.previous); + if assigned(hp2) and + (hp2.typ=ait_const_16bit) and + (tai_const(hp2).value=aword(-1)) and + assigned(hp2.previous) and + (tai(hp2.previous).typ=ait_const_16bit) and + (tai_const(hp2.previous).value=len) and + assigned(hp2.previous.previous) and + (tai(hp2.previous.previous).typ=ait_const_16bit) and + (tai_const(hp2.previous.previous).value=len) and + assigned(hp2.previous.previous.previous) and + (tai(hp2.previous.previous.previous).typ=ait_const_symbol) and + assigned(hp2.previous.previous.previous.previous) and + (tai(hp2.previous.previous.previous.previous).typ=ait_label) then begin - j:=1; + lastlabel:=tai_label(hp2.previous.previous.previous.previous).l; same_string:=true; + j:=0; if len>0 then begin for i:=0 to len-1 do @@ -324,7 +361,12 @@ implementation end; end; end; + {$endif} + {$ifdef ansistring_bits} + st_ansistring32, + {$else} st_ansistring, + {$endif} st_widestring : begin { before the string the following sequence must be found: @@ -363,6 +405,50 @@ implementation end; end; end; + {$ifdef ansistring_bits} + st_ansistring64: + begin + { before the string the following sequence must be found: + <label> + constsymbol <datalabel> + const32 <len> + const32 <len> + const32 -1 + we must then return <label> to reuse + } + hp2:=tai(lastlabelhp.previous); + if assigned(hp2) and + (hp2.typ=ait_const_64bit) and + (tai_const(hp2).value=aword(-1)) and + assigned(hp2.previous) and + (tai(hp2.previous).typ=ait_const_64bit) and + (tai_const(hp2.previous).value=len) and + assigned(hp2.previous.previous) and + (tai(hp2.previous.previous).typ=ait_const_64bit) and + (tai_const(hp2.previous.previous).value=len) and + assigned(hp2.previous.previous.previous) and + (tai(hp2.previous.previous.previous).typ=ait_const_symbol) and + assigned(hp2.previous.previous.previous.previous) and + (tai(hp2.previous.previous.previous.previous).typ=ait_label) then + begin + lastlabel:=tai_label(hp2.previous.previous.previous.previous).l; + same_string:=true; + j:=0; + if len>0 then + begin + for i:=0 to len-1 do + begin + if tai_string(hp1).str[j]<>value_str[i] then + begin + same_string:=false; + break; + end; + inc(j); + end; + end; + end; + end; + {$endif} end; { found ? } if same_string then @@ -381,56 +467,109 @@ implementation begin objectlibrary.getdatalabel(lastlabel); lab_str:=lastlabel; - maybe_new_object_file(asmlist[al_typedconsts]); - new_section(asmlist[al_typedconsts],sec_rodata,lastlabel.name,const_align(sizeof(aint))); - asmlist[al_typedconsts].concat(Tai_label.Create(lastlabel)); + maybe_new_object_file(consts); + new_section(consts,sec_rodata,lastlabel.name,const_align(sizeof(aint))); + Consts.concat(Tai_label.Create(lastlabel)); { generate an ansi string ? } case st_type of - st_ansistring: + {$ifdef ansistring_bits} + st_ansistring16: begin { an empty ansi string is nil! } if len=0 then - asmlist[al_typedconsts].concat(Tai_const.Create_sym(nil)) + Consts.concat(Tai_const.Create_ptr(0)) else begin objectlibrary.getdatalabel(l1); objectlibrary.getdatalabel(l2); - asmlist[al_typedconsts].concat(Tai_label.Create(l2)); - asmlist[al_typedconsts].concat(Tai_const.Create_sym(l1)); - asmlist[al_typedconsts].concat(Tai_const.Create_aint(-1)); - asmlist[al_typedconsts].concat(Tai_const.Create_aint(len)); - asmlist[al_typedconsts].concat(Tai_label.Create(l1)); - { include also terminating zero } - getmem(pc,len+1); + Consts.concat(Tai_label.Create(l2)); + Consts.concat(Tai_const_symbol.Create(l1)); + Consts.concat(Tai_const.Create_32bit(-1)); + Consts.concat(Tai_const.Create_32bit(len)); + Consts.concat(Tai_label.Create(l1)); + getmem(pc,len+2); move(value_str^,pc^,len); pc[len]:=#0; - asmlist[al_typedconsts].concat(Tai_string.Create_pchar(pc,len+1)); + { to overcome this problem we set the length explicitly } + { with the ending null char } + Consts.concat(Tai_string.Create_length_pchar(pc,len+1)); { return the offset of the real string } lab_str:=l2; end; end; + {$endif} + {$ifdef ansistring_bits}st_ansistring32:{$else}st_ansistring:{$endif} + begin + { an empty ansi string is nil! } + if len=0 then + Consts.concat(Tai_const.Create_sym(nil)) + else + begin + objectlibrary.getdatalabel(l1); + objectlibrary.getdatalabel(l2); + Consts.concat(Tai_label.Create(l2)); + Consts.concat(Tai_const.Create_sym(l1)); + Consts.concat(Tai_const.Create_aint(-1)); + Consts.concat(Tai_const.Create_aint(len)); + Consts.concat(Tai_label.Create(l1)); + getmem(pc,len+2); + move(value_str^,pc^,len); + pc[len]:=#0; + { to overcome this problem we set the length explicitly } + { with the ending null char } + Consts.concat(Tai_string.Create_length_pchar(pc,len+1)); + { return the offset of the real string } + lab_str:=l2; + end; + end; + {$ifdef ansistring_bits} + st_ansistring64: + begin + { an empty ansi string is nil! } + if len=0 then + Consts.concat(Tai_const.Create_ptr(0)) + else + begin + objectlibrary.getdatalabel(l1); + objectlibrary.getdatalabel(l2); + Consts.concat(Tai_label.Create(l2)); + Consts.concat(Tai_const_symbol.Create(l1)); + Consts.concat(Tai_const.Create_32bit(-1)); + Consts.concat(Tai_const.Create_32bit(len)); + Consts.concat(Tai_label.Create(l1)); + getmem(pc,len+2); + move(value_str^,pc^,len); + pc[len]:=#0; + { to overcome this problem we set the length explicitly } + { with the ending null char } + Consts.concat(Tai_string.Create_length_pchar(pc,len+1)); + { return the offset of the real string } + lab_str:=l2; + end; + end; + {$endif} st_widestring: begin { an empty wide string is nil! } if len=0 then - asmlist[al_typedconsts].concat(Tai_const.Create_sym(nil)) + Consts.concat(Tai_const.Create_sym(nil)) else begin objectlibrary.getdatalabel(l1); objectlibrary.getdatalabel(l2); - asmlist[al_typedconsts].concat(Tai_label.Create(l2)); - asmlist[al_typedconsts].concat(Tai_const.Create_sym(l1)); + Consts.concat(Tai_label.Create(l2)); + Consts.concat(Tai_const.Create_sym(l1)); { we use always UTF-16 coding for constants } { at least for now } { Consts.concat(Tai_const.Create_8bit(2)); } - asmlist[al_typedconsts].concat(Tai_const.Create_aint(-1)); - asmlist[al_typedconsts].concat(Tai_const.Create_aint(len*cwidechartype.def.size)); - asmlist[al_typedconsts].concat(Tai_label.Create(l1)); + consts.concat(Tai_const.Create_aint(-1)); + consts.concat(Tai_const.Create_aint(len*cwidechartype.def.size)); + consts.concat(Tai_label.Create(l1)); for i:=0 to len-1 do - asmlist[al_typedconsts].concat(Tai_const.Create_16bit(pcompilerwidestring(value_str)^.data[i])); + Consts.concat(Tai_const.Create_16bit(pcompilerwidestring(value_str)^.data[i])); { terminating zero } - asmlist[al_typedconsts].concat(Tai_const.Create_16bit(0)); + Consts.concat(Tai_const.Create_16bit(0)); { return the offset of the real string } lab_str:=l2; end; @@ -442,20 +581,14 @@ implementation l:=255 else l:=len; - { include length and terminating zero for quick conversion to pchar } - getmem(pc,l+2); - move(value_str^,pc[1],l); + { also length and terminating zero } + getmem(pc,l+3); + move(value_str^,pc[1],l+1); pc[0]:=chr(l); + { to overcome this problem we set the length explicitly } + { with the ending null char } pc[l+1]:=#0; - asmlist[al_typedconsts].concat(Tai_string.Create_pchar(pc,l+2)); - end; - st_conststring: - begin - { include terminating zero } - getmem(pc,len+1); - move(value_str^,pc[0],len); - pc[len]:=#0; - asmlist[al_typedconsts].concat(Tai_string.Create_pchar(pc,len+1)); + Consts.concat(Tai_string.Create_length_pchar(pc,l+2)); end; end; end; @@ -500,7 +633,7 @@ implementation if not assigned(lab_set) then begin { tries to found an old entry } - hp1:=tai(asmlist[al_typedconsts].first); + hp1:=tai(Consts.first); while assigned(hp1) do begin if hp1.typ=ait_label then @@ -551,9 +684,9 @@ implementation begin objectlibrary.getdatalabel(lastlabel); lab_set:=lastlabel; - maybe_new_object_file(asmlist[al_typedconsts]); - new_section(asmlist[al_typedconsts],sec_rodata,lastlabel.name,const_align(sizeof(aint))); - asmlist[al_typedconsts].concat(Tai_label.Create(lastlabel)); + maybe_new_object_file(consts); + new_section(consts,sec_rodata,lastlabel.name,const_align(sizeof(aint))); + Consts.concat(Tai_label.Create(lastlabel)); { already handled at the start of this method?? (JM) if tsetdef(resulttype.def).settype=smallset then begin @@ -564,7 +697,7 @@ implementation } begin for i:=0 to 31 do - asmlist[al_typedconsts].concat(Tai_const.Create_8bit(Psetbytes(value_set)^[i xor indexadjust])); + Consts.concat(Tai_const.Create_8bit(Psetbytes(value_set)^[i xor indexadjust])); end; end; end; @@ -595,13 +728,13 @@ implementation location_reset(location,LOC_CREFERENCE,OS_NO); { label for GUID } objectlibrary.getdatalabel(tmplabel); - asmlist[al_typedconsts].concat(tai_align.create(const_align(16))); - asmlist[al_typedconsts].concat(Tai_label.Create(tmplabel)); - asmlist[al_typedconsts].concat(Tai_const.Create_32bit(longint(value.D1))); - asmlist[al_typedconsts].concat(Tai_const.Create_16bit(value.D2)); - asmlist[al_typedconsts].concat(Tai_const.Create_16bit(value.D3)); - for i:=low(value.D4) to high(value.D4) do - asmlist[al_typedconsts].concat(Tai_const.Create_8bit(value.D4[i])); + consts.concat(tai_align.create(const_align(16))); + consts.concat(Tai_label.Create(tmplabel)); + consts.concat(Tai_const.Create_32bit(longint(value.D1))); + consts.concat(Tai_const.Create_16bit(value.D2)); + consts.concat(Tai_const.Create_16bit(value.D3)); + for i:=Low(value.D4) to High(value.D4) do + consts.concat(Tai_const.Create_8bit(value.D4[i])); location.reference.symbol:=tmplabel; end; diff --git a/compiler/ncgflw.pas b/compiler/ncgflw.pas index ca8ef23e08..c465633b8e 100644 --- a/compiler/ncgflw.pas +++ b/compiler/ncgflw.pas @@ -109,9 +109,9 @@ implementation begin location_reset(location,LOC_VOID,OS_NO); - objectlibrary.getjumplabel(lloop); - objectlibrary.getjumplabel(lcont); - objectlibrary.getjumplabel(lbreak); + objectlibrary.getlabel(lloop); + objectlibrary.getlabel(lcont); + objectlibrary.getlabel(lbreak); { arrange continue and breaklabels: } oldflowcontrol:=flowcontrol; oldclabel:=aktcontinuelabel; @@ -192,8 +192,8 @@ implementation otlabel:=truelabel; oflabel:=falselabel; - objectlibrary.getjumplabel(truelabel); - objectlibrary.getjumplabel(falselabel); + objectlibrary.getlabel(truelabel); + objectlibrary.getlabel(falselabel); secondpass(left); (* @@ -237,7 +237,7 @@ implementation begin if assigned(right) then begin - objectlibrary.getjumplabel(hl); + objectlibrary.getlabel(hl); { do go back to if line !! } (* if not(cs_regvars in aktglobalswitches) then @@ -345,22 +345,17 @@ implementation oldflowcontrol:=flowcontrol; oldclabel:=aktcontinuelabel; oldblabel:=aktbreaklabel; - objectlibrary.getjumplabel(aktcontinuelabel); - objectlibrary.getjumplabel(aktbreaklabel); - objectlibrary.getjumplabel(l3); + objectlibrary.getlabel(aktcontinuelabel); + objectlibrary.getlabel(aktbreaklabel); + objectlibrary.getlabel(l3); { only calculate reference } opsize := def_cgsize(left.resulttype.def); count_var_is_signed:=is_signed(left.resulttype.def); { first set the to value - because the count var can be in the expression ! } - do_loopvar_at_end:=(lnf_dont_mind_loopvar_on_exit in loopflags) - { if the loop is unrolled and there is a jump into the loop, - then we can't do the trick with incrementing the loop var only at the - end - } - and not(assigned(entrylabel)); + because the count var can be in the expression !! } + do_loopvar_at_end:=lnf_dont_mind_loopvar_on_exit in loopflags; secondpass(t1); { calculate pointer value and check if changeable and if so } @@ -768,7 +763,7 @@ implementation function tcglabelnode.getasmlabel : tasmlabel; begin if not(assigned(asmlabel)) then - objectlibrary.getjumplabel(asmlabel); + objectlibrary.getlabel(asmlabel); result:=asmlabel end; @@ -850,16 +845,16 @@ implementation paramanager.freeparaloc(exprasmlist,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc2); paramanager.freeparaloc(exprasmlist,paraloc3); - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_RAISEEXCEPTION'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end else begin - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK'); cg.a_call_name(exprasmlist,'FPC_RERAISE'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end; paraloc1.done; paraloc2.done; @@ -881,17 +876,17 @@ implementation var paraloc1 : tcgpara; begin - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_POPOBJECTSTACK'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); paraloc1.init; paramanager.getintparaloc(pocall_default,1,paraloc1); paramanager.allocparaloc(exprasmlist,paraloc1); cg.a_param_reg(exprasmlist,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc1); - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); paraloc1.done; end; @@ -938,20 +933,20 @@ implementation end; { get new labels for the control flow statements } - objectlibrary.getjumplabel(exittrylabel); - objectlibrary.getjumplabel(exitexceptlabel); + objectlibrary.getlabel(exittrylabel); + objectlibrary.getlabel(exitexceptlabel); if assigned(aktbreaklabel) then begin - objectlibrary.getjumplabel(breaktrylabel); - objectlibrary.getjumplabel(continuetrylabel); - objectlibrary.getjumplabel(breakexceptlabel); - objectlibrary.getjumplabel(continueexceptlabel); + objectlibrary.getlabel(breaktrylabel); + objectlibrary.getlabel(continuetrylabel); + objectlibrary.getlabel(breakexceptlabel); + objectlibrary.getlabel(continueexceptlabel); end; - objectlibrary.getjumplabel(exceptlabel); - objectlibrary.getjumplabel(doexceptlabel); - objectlibrary.getjumplabel(endexceptlabel); - objectlibrary.getjumplabel(lastonlabel); + objectlibrary.getlabel(exceptlabel); + objectlibrary.getlabel(doexceptlabel); + objectlibrary.getlabel(endexceptlabel); + objectlibrary.getlabel(lastonlabel); get_exception_temps(exprasmlist,excepttemps); new_exception(exprasmlist,excepttemps,exceptlabel); @@ -1003,15 +998,15 @@ implementation paramanager.allocparaloc(exprasmlist,paraloc1); cg.a_param_const(exprasmlist,OS_ADDR,-1,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc1); - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_CATCHES'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); paraloc1.done; { the destruction of the exception object must be also } { guarded by an exception frame } - objectlibrary.getjumplabel(doobjectdestroy); - objectlibrary.getjumplabel(doobjectdestroyandreraise); + objectlibrary.getlabel(doobjectdestroy); + objectlibrary.getlabel(doobjectdestroyandreraise); get_exception_temps(exprasmlist,destroytemps); new_exception(exprasmlist,destroytemps,doobjectdestroyandreraise); @@ -1025,18 +1020,18 @@ implementation free_exception(exprasmlist,destroytemps,0,doobjectdestroy,false); - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_POPSECONDOBJECTSTACK'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); paraloc1.init; paramanager.getintparaloc(pocall_default,1,paraloc1); paramanager.allocparaloc(exprasmlist,paraloc1); cg.a_param_reg(exprasmlist, OS_ADDR, NR_FUNCTION_RESULT_REG, paraloc1); paramanager.freeparaloc(exprasmlist,paraloc1); - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); paraloc1.done; { we don't need to restore esi here because reraise never } { returns } @@ -1059,9 +1054,9 @@ implementation cg.a_label(exprasmlist,exitexceptlabel); { we must also destroy the address frame which guards } { exception object } - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.g_exception_reason_load(exprasmlist,excepttemps.reasonbuf); cleanupobjectstack; cg.a_jmp_always(exprasmlist,oldaktexitlabel); @@ -1072,9 +1067,9 @@ implementation cg.a_label(exprasmlist,breakexceptlabel); { we must also destroy the address frame which guards } { exception object } - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.g_exception_reason_load(exprasmlist,excepttemps.reasonbuf); cleanupobjectstack; cg.a_jmp_always(exprasmlist,oldaktbreaklabel); @@ -1085,9 +1080,9 @@ implementation cg.a_label(exprasmlist,continueexceptlabel); { we must also destroy the address frame which guards } { exception object } - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.g_exception_reason_load(exprasmlist,excepttemps.reasonbuf); cleanupobjectstack; cg.a_jmp_always(exprasmlist,oldaktcontinuelabel); @@ -1097,9 +1092,9 @@ implementation begin { do some magic for exit in the try block } cg.a_label(exprasmlist,exittrylabel); - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.g_exception_reason_load(exprasmlist,excepttemps.reasonbuf); cg.a_jmp_always(exprasmlist,oldaktexitlabel); end; @@ -1107,9 +1102,9 @@ implementation if fc_break in tryflowcontrol then begin cg.a_label(exprasmlist,breaktrylabel); - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.g_exception_reason_load(exprasmlist,excepttemps.reasonbuf); cg.a_jmp_always(exprasmlist,oldaktbreaklabel); end; @@ -1117,9 +1112,9 @@ implementation if fc_continue in tryflowcontrol then begin cg.a_label(exprasmlist,continuetrylabel); - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_POPADDRSTACK'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.g_exception_reason_load(exprasmlist,excepttemps.reasonbuf); cg.a_jmp_always(exprasmlist,oldaktcontinuelabel); end; @@ -1166,7 +1161,7 @@ implementation oldflowcontrol:=flowcontrol; flowcontrol:=[]; - objectlibrary.getjumplabel(nextonlabel); + objectlibrary.getlabel(nextonlabel); { send the vmt parameter } reference_reset_symbol(href2,objectlibrary.newasmsymbol(excepttype.vmt_mangledname,AB_EXTERNAL,AT_DATA),0); @@ -1174,9 +1169,9 @@ implementation paramanager.allocparaloc(exprasmlist,paraloc1); cg.a_paramaddr_ref(exprasmlist,href2,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc1); - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_CATCHES'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); { is it this catch? No. go to next onlabel } cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,NR_FUNCTION_RESULT_REG,nextonlabel); @@ -1198,7 +1193,7 @@ implementation { in the case that another exception is risen we've to destroy the old one } - objectlibrary.getjumplabel(doobjectdestroyandreraise); + objectlibrary.getlabel(doobjectdestroyandreraise); { call setjmp, and jump to finally label on non-zero result } get_exception_temps(exprasmlist,excepttemps); @@ -1209,37 +1204,37 @@ implementation if assigned(right) then begin oldaktexitlabel:=current_procinfo.aktexitlabel; - objectlibrary.getjumplabel(exitonlabel); + objectlibrary.getlabel(exitonlabel); current_procinfo.aktexitlabel:=exitonlabel; if assigned(aktbreaklabel) then begin oldaktcontinuelabel:=aktcontinuelabel; oldaktbreaklabel:=aktbreaklabel; - objectlibrary.getjumplabel(breakonlabel); - objectlibrary.getjumplabel(continueonlabel); + objectlibrary.getlabel(breakonlabel); + objectlibrary.getlabel(continueonlabel); aktcontinuelabel:=continueonlabel; aktbreaklabel:=breakonlabel; end; secondpass(right); end; - objectlibrary.getjumplabel(doobjectdestroy); + objectlibrary.getlabel(doobjectdestroy); cg.a_label(exprasmlist,doobjectdestroyandreraise); free_exception(exprasmlist,excepttemps,0,doobjectdestroy,false); - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_POPSECONDOBJECTSTACK'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); paramanager.getintparaloc(pocall_default,1,paraloc1); paramanager.allocparaloc(exprasmlist,paraloc1); cg.a_param_reg(exprasmlist, OS_ADDR, NR_FUNCTION_RESULT_REG, paraloc1); paramanager.freeparaloc(exprasmlist,paraloc1); - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_DESTROYEXCEPTION'); - cg.deallocallcpuregisters(exprasmlist); - { we don't need to store/restore registers here because reraise never - returns } + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); + { we don't need to restore esi here because reraise never } + { returns } cg.a_call_name(exprasmlist,'FPC_RERAISE'); cg.a_label(exprasmlist,doobjectdestroy); @@ -1320,9 +1315,9 @@ implementation { check if child nodes do a break/continue/exit } oldflowcontrol:=flowcontrol; flowcontrol:=[]; - objectlibrary.getjumplabel(finallylabel); - objectlibrary.getjumplabel(endfinallylabel); - objectlibrary.getjumplabel(reraiselabel); + objectlibrary.getlabel(finallylabel); + objectlibrary.getlabel(endfinallylabel); + objectlibrary.getlabel(reraiselabel); { the finally block must catch break, continue and exit } { statements } @@ -1330,7 +1325,7 @@ implementation if implicitframe then exitfinallylabel:=finallylabel else - objectlibrary.getjumplabel(exitfinallylabel); + objectlibrary.getlabel(exitfinallylabel); current_procinfo.aktexitlabel:=exitfinallylabel; if assigned(aktbreaklabel) then begin @@ -1343,8 +1338,8 @@ implementation end else begin - objectlibrary.getjumplabel(breakfinallylabel); - objectlibrary.getjumplabel(continuefinallylabel); + objectlibrary.getlabel(breakfinallylabel); + objectlibrary.getlabel(continuefinallylabel); end; aktcontinuelabel:=continuefinallylabel; aktbreaklabel:=breakfinallylabel; diff --git a/compiler/ncginl.pas b/compiler/ncginl.pas index c32d6ccb32..77cc529964 100644 --- a/compiler/ncginl.pas +++ b/compiler/ncginl.pas @@ -196,8 +196,8 @@ implementation paramanager.getintparaloc(pocall_default,4,paraloc4); otlabel:=truelabel; oflabel:=falselabel; - objectlibrary.getjumplabel(truelabel); - objectlibrary.getjumplabel(falselabel); + objectlibrary.getlabel(truelabel); + objectlibrary.getlabel(falselabel); secondpass(tcallparanode(left).left); maketojumpbool(exprasmlist,tcallparanode(left).left,lr_load_regvars); cg.a_label(exprasmlist,falselabel); @@ -231,9 +231,9 @@ implementation paramanager.freeparaloc(exprasmlist,paraloc2); paramanager.freeparaloc(exprasmlist,paraloc3); paramanager.freeparaloc(exprasmlist,paraloc4); - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_ASSERT'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); location_freetemp(exprasmlist,hp3.location); location_freetemp(exprasmlist,hp2.location); cg.a_label(exprasmlist,truelabel); @@ -345,7 +345,7 @@ implementation begin { length in ansi/wide strings is at offset -sizeof(aint) } location_force_reg(exprasmlist,left.location,OS_ADDR,false); - objectlibrary.getjumplabel(lengthlab); + objectlibrary.getlabel(lengthlab); cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,left.location.register,lengthlab); reference_reset_base(href,left.location.register,-sizeof(aint)); hregister:=cg.makeregsize(exprasmlist,left.location.register,OS_INT); diff --git a/compiler/ncgld.pas b/compiler/ncgld.pas index 8e6ce01269..5609f6f6fa 100644 --- a/compiler/ncgld.pas +++ b/compiler/ncgld.pas @@ -141,7 +141,6 @@ implementation cg.a_load_ref_reg(exprasmlist,OS_ADDR,OS_ADDR,location.reference,hregister); reference_reset_base(location.reference,hregister,0); end -{$ifndef segment_threadvars} { Thread variable } else if (vo_is_thread_var in tabstractvarsym(symtableentry).varoptions) then begin @@ -155,8 +154,8 @@ implementation call and then the address load to be sure that the register that is used for returning is the same (PFV) } - objectlibrary.getjumplabel(norelocatelab); - objectlibrary.getjumplabel(endrelocatelab); + objectlibrary.getlabel(norelocatelab); + objectlibrary.getlabel(endrelocatelab); { make sure hregister can't allocate the register necessary for the parameter } paraloc1.init; paramanager.getintparaloc(pocall_default,1,paraloc1); @@ -170,9 +169,9 @@ implementation cg.a_param_ref(exprasmlist,OS_32,href,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc1); paraloc1.done; - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_reg(exprasmlist,hregister); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.getcpuregister(exprasmlist,NR_FUNCTION_RESULT_REG); cg.ungetcpuregister(exprasmlist,NR_FUNCTION_RESULT_REG); hregister:=cg.getaddressregister(exprasmlist); @@ -188,7 +187,6 @@ implementation cg.a_label(exprasmlist,endrelocatelab); location.reference.base:=hregister; end -{$endif} { Nested variable } else if assigned(left) then begin @@ -249,10 +247,6 @@ implementation reference_reset_symbol(location.reference,objectlibrary.newasmsymbol(tglobalvarsym(symtableentry).mangledname,AB_EXTERNAL,AT_DATA),0) else location:=tglobalvarsym(symtableentry).localloc; -{$ifdef segment_threadvars} - if (vo_is_thread_var in tabstractvarsym(symtableentry).varoptions) then - location.reference.segment:=NR_GS; -{$endif} end; end; else @@ -391,8 +385,8 @@ implementation otlabel:=truelabel; oflabel:=falselabel; - objectlibrary.getjumplabel(truelabel); - objectlibrary.getjumplabel(falselabel); + objectlibrary.getlabel(truelabel); + objectlibrary.getlabel(falselabel); { in most cases we can process first the right node which contains @@ -591,13 +585,6 @@ implementation else cg.g_concatcopy(exprasmlist,right.location.reference,left.location.reference,len); end; - LOC_MMREGISTER, - LOC_CMMREGISTER: - cg.a_loadmm_ref_reg(exprasmlist, - right.location.size, - left.location.size, - right.location.reference, - left.location.register,mms_movescalar); else internalerror(200203284); end; @@ -651,22 +638,13 @@ implementation fputyp:=tfloatdef(ttypeconvnode(right).left.resulttype.def).typ else fputyp:=s32real; - { we can't do direct moves between fpu and mm registers } - if left.location.loc in [LOC_MMREGISTER,LOC_CMMREGISTER] then - begin - location_force_mmregscalar(exprasmlist,right.location,false); - cg.a_loadmm_reg_reg(exprasmlist, - tfloat2tcgsize[fputyp],tfloat2tcgsize[fputyp], - right.location.register,left.location.register,mms_movescalar); - end - else - cg.a_loadfpu_reg_loc(exprasmlist, - tfloat2tcgsize[fputyp], - right.location.register,left.location); + cg.a_loadfpu_reg_loc(exprasmlist, + tfloat2tcgsize[fputyp], + right.location.register,left.location); end; LOC_JUMP : begin - objectlibrary.getjumplabel(hlabel); + objectlibrary.getlabel(hlabel); cg.a_label(exprasmlist,truelabel); cg.a_load_const_loc(exprasmlist,1,left.location); cg.a_jmp_always(exprasmlist,hlabel); diff --git a/compiler/ncgmat.pas b/compiler/ncgmat.pas index af03b0876a..765ffb6e62 100644 --- a/compiler/ncgmat.pas +++ b/compiler/ncgmat.pas @@ -304,7 +304,7 @@ implementation "Cardinal($ffffffff) div 16" overflows! (JM) } If is_signed(left.resulttype.def) Then Begin - objectlibrary.getjumplabel(hl); + objectlibrary.getlabel(hl); cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_GT,0,hreg1,hl); if power=1 then cg.a_op_const_reg(exprasmlist,OP_ADD,OS_INT,1,hreg1) @@ -327,7 +327,7 @@ implementation { verify if the divisor is zero, if so return an error immediately } - objectlibrary.getjumplabel(hl); + objectlibrary.getlabel(hl); cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_NE,0,hdenom,hl); paraloc1.init; paramanager.getintparaloc(pocall_default,1,paraloc1); diff --git a/compiler/ncgmem.pas b/compiler/ncgmem.pas index db342e3c7b..7e6894ce02 100644 --- a/compiler/ncgmem.pas +++ b/compiler/ncgmem.pas @@ -211,7 +211,7 @@ implementation else internalerror(200507031); end; - if (cs_use_heaptrc in aktglobalswitches) and + if (cs_gdb_heaptrc in aktglobalswitches) and (cs_checkpointer in aktlocalswitches) and not(cs_compilesystem in aktmoduleswitches) and not(tpointerdef(left.resulttype.def).is_far) and @@ -223,9 +223,9 @@ implementation cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc1); paraloc1.done; - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end; end; @@ -269,7 +269,7 @@ implementation end; end; { implicit deferencing } - if (cs_use_heaptrc in aktglobalswitches) and + if (cs_gdb_heaptrc in aktglobalswitches) and (cs_checkpointer in aktlocalswitches) and not(cs_compilesystem in aktmoduleswitches) then begin @@ -277,9 +277,9 @@ implementation paramanager.allocparaloc(exprasmlist,paraloc1); cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc1); - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end; end else if is_interfacecom(left.resulttype.def) then @@ -287,7 +287,7 @@ implementation tg.GetTempTyped(exprasmlist,left.resulttype.def,tt_normal,location.reference); cg.a_load_loc_ref(exprasmlist,OS_ADDR,left.location,location.reference); { implicit deferencing also for interfaces } - if (cs_use_heaptrc in aktglobalswitches) and + if (cs_gdb_heaptrc in aktglobalswitches) and (cs_checkpointer in aktlocalswitches) and not(cs_compilesystem in aktmoduleswitches) then begin @@ -295,9 +295,9 @@ implementation paramanager.allocparaloc(exprasmlist,paraloc1); cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc1); - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end; end else @@ -315,11 +315,70 @@ implementation *****************************************************************************} procedure tcgwithnode.pass_2; +{$ifdef WITHNODEDEBUG} + const + withlevel : longint = 0; + var + withstartlabel,withendlabel : tasmlabel; + pp : pchar; + mangled_length : longint; + refnode : tnode; +{$endif WITHNODEDEBUG} begin location_reset(location,LOC_VOID,OS_NO); +{$ifdef WITHNODEDEBUG} + if (cs_debuginfo in aktmoduleswitches) then + begin + { load reference } + if (withrefnode.nodetype=derefn) and + (tderefnode(withrefnode).left.nodetype=temprefn) then + refnode:=tderefnode(withrefnode).left + else + refnode:=withrefnode; + secondpass(refnode); + location_freetemp(exprasmlist,refnode.location); + if not(refnode.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then + internalerror(2003092810); + + inc(withlevel); + objectlibrary.getaddrlabel(withstartlabel); + objectlibrary.getaddrlabel(withendlabel); + cg.a_label(exprasmlist,withstartlabel); + withdebugList.concat(Tai_stabs.Create(strpnew( + '"with'+tostr(withlevel)+':'+tostr(symtablestack.getnewtypecount)+ + '=*'+tstoreddef(left.resulttype.def).numberstring+'",'+ + tostr(N_LSYM)+',0,0,'+tostr(refnode.location.reference.offset)))); + mangled_length:=length(current_procinfo.procdef.mangledname); + getmem(pp,mangled_length+50); + strpcopy(pp,'192,0,0,'+withstartlabel.name); + if (target_info.use_function_relative_addresses) then + begin + strpcopy(strend(pp),'-'); + strpcopy(strend(pp),current_procinfo.procdef.mangledname); + end; + withdebugList.concat(Tai_stabn.Create(strnew(pp))); + end; +{$endif WITHNODEDEBUG} + if assigned(left) then secondpass(left); + +{$ifdef WITHNODEDEBUG} + if (cs_debuginfo in aktmoduleswitches) then + begin + cg.a_label(exprasmlist,withendlabel); + strpcopy(pp,'224,0,0,'+withendlabel.name); + if (target_info.use_function_relative_addresses) then + begin + strpcopy(strend(pp),'-'); + strpcopy(strend(pp),current_procinfo.procdef.mangledname); + end; + withdebugList.concat(Tai_stabn.Create(strnew(pp))); + freemem(pp,mangled_length+50); + dec(withlevel); + end; +{$endif WITHNODEDEBUG} end; @@ -410,8 +469,8 @@ implementation hreg:=cg.getintregister(exprasmlist,OS_INT); cg.a_load_loc_reg(exprasmlist,OS_INT,right.location,hreg); end; - objectlibrary.getjumplabel(neglabel); - objectlibrary.getjumplabel(poslabel); + objectlibrary.getlabel(neglabel); + objectlibrary.getlabel(poslabel); cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_LT,0,hreg,poslabel); cg.a_cmp_loc_reg_label(exprasmlist,OS_INT,OC_BE,hightree.location,hreg,neglabel); cg.a_label(exprasmlist,poslabel); @@ -432,9 +491,9 @@ implementation cg.a_param_loc(exprasmlist,left.location,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc2); - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_DYNARRAY_RANGECHECK'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end else cg.g_rangecheck(exprasmlist,right.location,right.resulttype.def,left.resulttype.def); @@ -498,9 +557,9 @@ implementation paramanager.allocparaloc(exprasmlist,paraloc1); cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc1); - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_CHECKZERO'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end; { in ansistrings/widestrings S[1] is p<w>char(S)[0] !! } @@ -591,9 +650,9 @@ implementation cg.a_param_ref(exprasmlist,OS_INT,href,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc2); - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end; st_shortstring: @@ -680,9 +739,9 @@ implementation if isjump then begin otl:=truelabel; - objectlibrary.getjumplabel(truelabel); + objectlibrary.getlabel(truelabel); ofl:=falselabel; - objectlibrary.getjumplabel(falselabel); + objectlibrary.getlabel(falselabel); end; secondpass(right); @@ -730,9 +789,9 @@ implementation cg.a_param_ref(exprasmlist,OS_INT,href,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc1); paramanager.freeparaloc(exprasmlist,paraloc2); - cg.allocallcpuregisters(exprasmlist); + cg.alloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(exprasmlist,'FPC_'+upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK'); - cg.deallocallcpuregisters(exprasmlist); + cg.dealloccpuregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); end; st_shortstring: begin diff --git a/compiler/ncgopt.pas b/compiler/ncgopt.pas index 133fb025b3..da8aafbd72 100644 --- a/compiler/ncgopt.pas +++ b/compiler/ncgopt.pas @@ -135,7 +135,7 @@ begin if checklength then begin { is it already maximal? } - objectlibrary.getjumplabel(l); + objectlibrary.getlabel(l); if tg.istemp(left.location.reference) then len:=255 else diff --git a/compiler/ncgset.pas b/compiler/ncgset.pas index b9e9753c61..c95bc97de1 100644 --- a/compiler/ncgset.pas +++ b/compiler/ncgset.pas @@ -273,7 +273,7 @@ implementation { allocate a register for the result } location.register := cg.getintregister(exprasmlist,location.size); { Get a label to jump to the end } - objectlibrary.getjumplabel(l); + objectlibrary.getlabel(l); { clear the register value, indicating result is FALSE } cg.a_load_const_reg(exprasmlist,location.size,0,location.register); @@ -340,7 +340,7 @@ implementation end; { To compensate for not doing a second pass } right.location.reference.symbol:=nil; - objectlibrary.getjumplabel(l3); + objectlibrary.getlabel(l3); cg.a_jmp_always(exprasmlist,l3); { Now place the end label if IN success } cg.a_label(exprasmlist,l); @@ -597,7 +597,7 @@ implementation {$ifndef cpu64bit} if opsize in [OS_S64,OS_64] then begin - objectlibrary.getjumplabel(l1); + objectlibrary.getlabel(l1); cg.a_cmp_const_reg_label(exprasmlist, OS_32, OC_NE, aint(hi(int64(t^._low))),hregister2,l1); cg.a_cmp_const_reg_label(exprasmlist, OS_32, OC_EQ, aint(lo(int64(t^._low))),hregister, blocklabel(t^.blockid)); cg.a_label(exprasmlist,l1); @@ -621,7 +621,7 @@ implementation {$ifndef cpu64bit} if opsize in [OS_64,OS_S64] then begin - objectlibrary.getjumplabel(l1); + objectlibrary.getlabel(l1); cg.a_cmp_const_reg_label(exprasmlist, OS_32, jmp_lt, aint(hi(int64(t^._low))), hregister2, elselabel); cg.a_cmp_const_reg_label(exprasmlist, OS_32, jmp_gt, aint(hi(int64(t^._low))), @@ -640,7 +640,7 @@ implementation {$ifndef cpu64bit} if opsize in [OS_S64,OS_64] then begin - objectlibrary.getjumplabel(l1); + objectlibrary.getlabel(l1); cg.a_cmp_const_reg_label(exprasmlist, OS_32, jmp_lt, aint(hi(int64(t^._high))), hregister2, blocklabel(t^.blockid)); cg.a_cmp_const_reg_label(exprasmlist, OS_32, jmp_gt, aint(hi(int64(t^._high))), hregister2, @@ -696,10 +696,10 @@ implementation location_reset(location,LOC_VOID,OS_NO); { Allocate labels } - objectlibrary.getjumplabel(endlabel); - objectlibrary.getjumplabel(elselabel); + objectlibrary.getlabel(endlabel); + objectlibrary.getlabel(elselabel); for i:=0 to blocks.count-1 do - objectlibrary.getjumplabel(pcaseblock(blocks[i])^.blocklabel); + objectlibrary.getlabel(pcaseblock(blocks[i])^.blocklabel); with_sign:=is_signed(left.resulttype.def); if with_sign then @@ -720,9 +720,9 @@ implementation if left.location.loc=LOC_JUMP then begin otl:=truelabel; - objectlibrary.getjumplabel(truelabel); + objectlibrary.getlabel(truelabel); ofl:=falselabel; - objectlibrary.getjumplabel(falselabel); + objectlibrary.getlabel(falselabel); isjump:=true; end; secondpass(left); diff --git a/compiler/ncgutil.pas b/compiler/ncgutil.pas index 686d95bb34..a8cf3fed02 100644 --- a/compiler/ncgutil.pas +++ b/compiler/ncgutil.pas @@ -108,6 +108,10 @@ interface procedure gen_alloc_symtable(list:TAAsmoutput;st:tsymtable); procedure gen_free_symtable(list:TAAsmoutput;st:tsymtable); +{$ifdef PASS2INLINE} + procedure gen_alloc_inline_parast(list:TAAsmoutput;pd:tprocdef); + procedure gen_alloc_inline_funcret(list:TAAsmoutput;pd:tprocdef); +{$endif PASS2INLINE} { rtti and init/final } procedure generate_rtti(p:Ttypesym); @@ -118,12 +122,15 @@ interface implementation uses - version, + strings, cutils,cclasses, globals,systems,verbose, ppu,defutil, procinfo,paramgr,fmodule, - regvars,dwarf,dbgbase, + regvars,dwarf, +{$ifdef GDB} + gdb, +{$endif GDB} pass_1,pass_2, ncon,nld,nutils, tgobj,cgobj; @@ -350,17 +357,17 @@ implementation paramanager.freeparaloc(list,paraloc3); paramanager.freeparaloc(list,paraloc2); paramanager.freeparaloc(list,paraloc1); - cg.allocallcpuregisters(list); + cg.alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(list,'FPC_PUSHEXCEPTADDR'); - cg.deallocallcpuregisters(list); + cg.dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); paramanager.getintparaloc(pocall_default,1,paraloc1); paramanager.allocparaloc(list,paraloc1); cg.a_param_reg(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1); paramanager.freeparaloc(list,paraloc1); - cg.allocallcpuregisters(list); + cg.alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(list,'FPC_SETJMP'); - cg.deallocallcpuregisters(list); + cg.dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.g_exception_reason_save(list, t.reasonbuf); cg.a_cmp_const_reg_label(list,OS_S32,OC_NE,0,cg.makeregsize(list,NR_FUNCTION_RESULT_REG,OS_S32),exceptlabel); @@ -372,9 +379,9 @@ implementation procedure free_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean); begin - cg.allocallcpuregisters(list); + cg.alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(list,'FPC_POPADDRSTACK'); - cg.deallocallcpuregisters(list); + cg.dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); if not onlyfree then begin @@ -423,7 +430,7 @@ implementation begin cg.a_label(list,truelabel); cg.a_load_const_reg(list,OS_INT,1,hregister); - objectlibrary.getjumplabel(hl); + objectlibrary.getlabel(hl); cg.a_jmp_always(list,hl); cg.a_label(list,falselabel); cg.a_load_const_reg(list,OS_INT,0,hregister); @@ -509,7 +516,7 @@ implementation begin cg.a_label(list,truelabel); cg.a_load_const_reg(list,dst_size,1,hregister); - objectlibrary.getjumplabel(hl); + objectlibrary.getlabel(hl); cg.a_jmp_always(list,hl); cg.a_label(list,falselabel); cg.a_load_const_reg(list,dst_size,0,hregister); @@ -572,7 +579,7 @@ implementation begin cg.a_label(list,truelabel); cg.a_load_const_reg(list,dst_size,1,hregister); - objectlibrary.getjumplabel(hl); + objectlibrary.getlabel(hl); cg.a_jmp_always(list,hl); cg.a_label(list,falselabel); cg.a_load_const_reg(list,dst_size,0,hregister); @@ -829,14 +836,6 @@ implementation cg.a_load_const_reg(taasmoutput(arg),reg_cgsize(tglobalvarsym(p).localloc.register),0, tglobalvarsym(p).localloc.register); LOC_REFERENCE : ; - LOC_CMMREGISTER : - { clear the whole register } - cg.a_opmm_reg_reg(taasmoutput(arg),OP_XOR,reg_cgsize(tglobalvarsym(p).localloc.register), - tglobalvarsym(p).localloc.register, - tglobalvarsym(p).localloc.register, - nil); - LOC_CFPUREGISTER : - ; else internalerror(200410124); end; @@ -1206,9 +1205,6 @@ implementation cg.getcpuregister(list,funcretloc.register); cg.ungetcpuregister(list,funcretloc.register); end; - { we can't do direct moves between fpu and mm registers } - if restmploc.loc in [LOC_MMREGISTER,LOC_CMMREGISTER] then - location_force_fpureg(list,restmploc,false); cg.a_loadfpu_loc_reg(list,restmploc,funcretloc.register); end; LOC_MMREGISTER: @@ -1479,11 +1475,8 @@ implementation begin unget_para(paraloc^); gen_load_reg(paraloc^,currpara.localloc.register); - { data could come in two memory locations, for now - we simply ignore the sanity check (FK) if assigned(paraloc^.next) then internalerror(200410108); - } end; end; end; @@ -1497,11 +1490,6 @@ implementation { which is used to access the parameters in their original callee-side location } cg.a_reg_dealloc(list,NR_R12); {$endif powerpc} -{$ifdef powerpc64} - { unget the register that contains the stack pointer before the procedure entry, } - { which is used to access the parameters in their original callee-side location } - cg.a_reg_dealloc(list, NR_OLD_STACK_POINTER_REG); -{$endif powerpc64} end; @@ -1578,8 +1566,11 @@ implementation procedure gen_entry_code(list:TAAsmoutput); var + href : treference; paraloc1, - paraloc2 : tcgpara; + paraloc2, + paraloc3 : tcgpara; + hp : tused_unit; begin paraloc1.init; paraloc2.init; @@ -1595,9 +1586,9 @@ implementation if not (target_info.system in [system_i386_win32,system_i386_wdosx]) or not (current_procinfo.procdef.proctypeoption=potype_proginit) then begin - cg.allocallcpuregisters(list); + cg.alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl)); cg.g_profilecode(list); - cg.deallocallcpuregisters(list); + cg.dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_cdecl)); end; end; @@ -1610,14 +1601,34 @@ implementation { the parameters are already in the right registers } cg.a_call_name(list,target_info.cprefix+'FPC_SYSTEMMAIN'); end; - + { initialize units } - cg.allocallcpuregisters(list); + cg.alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(list,'FPC_INITIALIZEUNITS'); - cg.deallocallcpuregisters(list); + cg.dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); + +{$ifdef GDB} + if (cs_debuginfo in aktmoduleswitches) then + if target_info.system <> system_powerpc_macos then + begin + { include reference to all debuginfo sections of used units } + hp:=tused_unit(usedunits.first); + while assigned(hp) do + begin + If (hp.u.flags and uf_has_debuginfo)=uf_has_debuginfo then + current_procinfo.aktlocaldata.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',hp.u.globalsymtable,''),AT_DATA,0)); + hp:=tused_unit(hp.next); + end; + { include reference to debuginfo for this program } + current_procinfo.aktlocaldata.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',current_module.localsymtable,''),AT_DATA,0)); + end; +{$endif GDB} end; - list.concat(Tai_force_line.Create); +{$ifdef GDB} + if (cs_debuginfo in aktmoduleswitches) then + list.concat(Tai_force_line.Create); +{$endif GDB} {$ifdef OLDREGVARS} load_regvars(list,nil); @@ -1645,44 +1656,121 @@ implementation var hs : string; begin + { add symbol entry point as well as debug information } + { will be inserted in front of the rest of this list. } + { Insert alignment and assembler names } + { Align, gprof uses 16 byte granularity } + if (cs_profile in aktmoduleswitches) then + list.concat(Tai_align.create(16)) + else + list.concat(Tai_align.create(aktalignment.procalign)); + +{$ifdef GDB} + if (cs_debuginfo in aktmoduleswitches) then + begin + if (po_global in current_procinfo.procdef.procoptions) then + Tprocsym(current_procinfo.procdef.procsym).is_global:=true; + current_procinfo.procdef.concatstabto(list); + Tprocsym(current_procinfo.procdef.procsym).isstabwritten:=true; + end; +{$endif GDB} + repeat hs:=current_procinfo.procdef.aliasnames.getfirst; if hs='' then break; +{$ifdef GDB} + if (cs_debuginfo in aktmoduleswitches) and + target_info.use_function_relative_addresses then + list.concat(Tai_stab_function_name.create(strpnew(hs))); +{$endif GDB} if (cs_profile in aktmoduleswitches) or (po_global in current_procinfo.procdef.procoptions) then list.concat(Tai_symbol.createname_global(hs,AT_FUNCTION,0)) else list.concat(Tai_symbol.createname(hs,AT_FUNCTION,0)); - if target_info.use_function_relative_addresses then - list.concat(Tai_function_name.create(hs)); until false; - - current_procinfo.procdef.procstarttai:=tai(list.last); end; procedure gen_proc_symbol_end(list:Taasmoutput); +{$ifdef GDB} + var + stabsendlabel : tasmlabel; + mangled_length : longint; + p : pchar; +{$endif GDB} begin - if (current_procinfo.procdef.proctypeoption=potype_proginit) then + list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname)); +{$ifdef GDB} + if (cs_debuginfo in aktmoduleswitches) then begin - { Insert Ident of the compiler in the main .text section } - if (not (cs_create_smart in aktmoduleswitches)) then - begin - list.insert(Tai_align.Create(const_align(32))); - list.insert(Tai_string.Create('FPC '+full_version_string+ - ' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname)); - end; - - { Reference all DEBUGINFO sections from the main .text section } - if (cs_debuginfo in aktmoduleswitches) then - debuginfo.referencesections(list); + objectlibrary.getlabel(stabsendlabel); + cg.a_label(list,stabsendlabel); + { define calling EBP as pseudo local var PM } + { this enables test if the function is a local one !! } + {if assigned(current_procinfo.parent) and + (current_procinfo.procdef.parast.symtablelevel>normal_function_level) then + list.concat(Tai_stabs.Create(strpnew( + '"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+ + tostr(N_LSYM)+',0,0,'+tostr(current_procinfo.parent_framepointer_offset)))); } + + if assigned(current_procinfo.procdef.funcretsym) and + (tabstractnormalvarsym(current_procinfo.procdef.funcretsym).refs>0) then + begin + if tabstractnormalvarsym(current_procinfo.procdef.funcretsym).localloc.loc=LOC_REFERENCE then + begin +{$warning Need to add gdb support for ret in param register calling} + if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then + begin + list.concat(Tai_stabs.Create(strpnew( + '"'+current_procinfo.procdef.procsym.name+':X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+ + tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset)))); + if (m_result in aktmodeswitches) then + list.concat(Tai_stabs.Create(strpnew( + '"RESULT:X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+ + tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset)))) + end + else + begin + list.concat(Tai_stabs.Create(strpnew( + '"'+current_procinfo.procdef.procsym.name+':X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+ + tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset)))); + if (m_result in aktmodeswitches) then + list.concat(Tai_stabs.Create(strpnew( + '"RESULT:X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+ + tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset)))); + end; + end; + end; + mangled_length:=length(current_procinfo.procdef.mangledname); + getmem(p,2*mangled_length+50); + strpcopy(p,'192,0,0,'); + strpcopy(strend(p),current_procinfo.procdef.mangledname); + if (target_info.use_function_relative_addresses) then + begin + strpcopy(strend(p),'-'); + strpcopy(strend(p),current_procinfo.procdef.mangledname); + end; + list.concat(Tai_stabn.Create(strnew(p))); + {List.concat(Tai_stabn.Create(strpnew('192,0,0,' + +current_procinfo.procdef.mangledname)))); + p[0]:='2';p[1]:='2';p[2]:='4'; + strpcopy(strend(p),'_end');} + strpcopy(p,'224,0,0,'+stabsendlabel.name); + if (target_info.use_function_relative_addresses) then + begin + strpcopy(strend(p),'-'); + strpcopy(strend(p),current_procinfo.procdef.mangledname); + end; + list.concatlist(withdebuglist); + list.concat(Tai_stabn.Create(strnew(p))); + { strpnew('224,0,0,' + +current_procinfo.procdef.mangledname+'_end'))));} + freemem(p,2*mangled_length+50); end; - - list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname)); - - current_procinfo.procdef.procendtai:=tai(list.last); +{$endif GDB} end; @@ -1766,9 +1854,9 @@ implementation paramanager.allocparaloc(list,paraloc1); paramanager.freeparaloc(list,paraloc1); { Call the helper } - cg.allocallcpuregisters(list); + cg.alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); cg.a_call_name(list,'FPC_STACKCHECK'); - cg.deallocallcpuregisters(list); + cg.dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); paraloc1.done; end; @@ -1803,7 +1891,7 @@ implementation procedure gen_external_stub(list:taasmoutput;pd:tprocdef;const externalname:string); begin - { add the procedure to the al_procedures } + { add the procedure to the codesegment } maybe_new_object_file(list); new_section(list,sec_code,lower(pd.mangledname),aktalignment.procalign); list.concat(Tai_align.create(aktalignment.procalign)); @@ -1822,32 +1910,19 @@ implementation var l,varalign : longint; storefilepos : tfileposinfo; - list : Taasmoutput; - sectype : Tasmsectiontype; begin storefilepos:=aktfilepos; aktfilepos:=sym.fileinfo; l:=sym.getsize; - {$ifndef segment_threadvars} if (vo_is_thread_var in sym.varoptions) then inc(l,sizeof(aint)); - list:=asmlist[al_globals]; - sectype:=sec_bss; - {$else} - if (vo_is_thread_var in sym.varoptions) then - begin - list:=asmlist[al_threadvars]; - sectype:=sec_threadvar; - end - else - begin - list:=asmlist[al_globals]; - sectype:=sec_bss; - end; - {$endif} varalign:=var_align(l); - maybe_new_object_file(list); - new_section(list,sectype,lower(sym.mangledname),varalign); + maybe_new_object_file(bssSegment); + new_section(bssSegment,sec_bss,lower(sym.mangledname),varalign); +{$ifdef GDB} + if (cs_debuginfo in aktmoduleswitches) then + sym.concatstabto(bssSegment); +{$endif GDB} if (sym.owner.symtabletype=globalsymtable) or maybe_smartlink_symbol or DLLSource or @@ -1855,9 +1930,9 @@ implementation (po_inline in current_procinfo.procdef.procoptions)) or (vo_is_exported in sym.varoptions) or (vo_is_C_var in sym.varoptions) then - list.concat(Tai_datablock.create_global(sym.mangledname,l)) + bssSegment.concat(Tai_datablock.Create_global(sym.mangledname,l)) else - list.concat(Tai_datablock.create(sym.mangledname,l)); + bssSegment.concat(Tai_datablock.Create(sym.mangledname,l)); aktfilepos:=storefilepos; end; @@ -1966,8 +2041,8 @@ implementation { PIC, DLL and Threadvar need extra code and are handled in ncgld } if not((target_info.system=system_powerpc_darwin) and (cs_create_pic in aktmoduleswitches)) and - not(vo_is_dll_var in varoptions) {$ifndef segment_threadvars} and - not(vo_is_thread_var in varoptions) {$endif} then + not(vo_is_dll_var in varoptions) and + not(vo_is_thread_var in varoptions) then reference_reset_symbol(localloc.reference,objectlibrary.newasmsymbol(mangledname,AB_EXTERNAL,AT_DATA),0); end; else @@ -2044,6 +2119,139 @@ implementation end; +{$ifdef PASS2INLINE} + procedure gen_alloc_inline_parast(list:TAAsmoutput;pd:tprocdef); + var + sym : tsym; + calleeparaloc, + callerparaloc : pcgparalocation; + begin + if (po_assembler in pd.procoptions) then + exit; + sym:=tsym(pd.parast.symindex.first); + while assigned(sym) do + begin + if sym.typ=paravarsym then + begin + with tparavarsym(sym) do + begin + { for localloc <> LOC_REFERENCE, we need regvar support inside inlined procedures } + localloc.loc:=LOC_REFERENCE; + localloc.size:=int_cgsize(paramanager.push_size(varspez,vartype.def,pd.proccalloption)); + tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference); + calleeparaloc:=paraloc[calleeside].location; + callerparaloc:=paraloc[callerside].location; + while assigned(calleeparaloc) do + begin + if not assigned(callerparaloc) then + internalerror(200408281); + if calleeparaloc^.loc<>callerparaloc^.loc then + internalerror(200408282); + case calleeparaloc^.loc of + LOC_FPUREGISTER: + begin + calleeparaloc^.register:=cg.getfpuregister(list,calleeparaloc^.size); + callerparaloc^.register:=calleeparaloc^.register; + end; + LOC_REGISTER: + begin + calleeparaloc^.register:=cg.getintregister(list,calleeparaloc^.size); + callerparaloc^.register:=calleeparaloc^.register; + end; + LOC_MMREGISTER: + begin + calleeparaloc^.register:=cg.getmmregister(list,calleeparaloc^.size); + callerparaloc^.register:=calleeparaloc^.register; + end; + LOC_REFERENCE: + begin + calleeparaloc^.reference.offset := localloc.reference.offset; + calleeparaloc^.reference.index := localloc.reference.base; + callerparaloc^.reference.offset := localloc.reference.offset; + callerparaloc^.reference.index := localloc.reference.base; + end; + end; + calleeparaloc:=calleeparaloc^.next; + callerparaloc:=callerparaloc^.next; + end; + if cs_asm_source in aktglobalswitches then + begin + case localloc.loc of + LOC_REFERENCE : + list.concat(Tai_comment.Create(strpnew('Para '+realname+' allocated at '+ + std_regname(localloc.reference.base)+tostr_with_plus(localloc.reference.offset)))); + end; + end; + end; + end; + sym:=tsym(sym.indexnext); + end; + end; + + + procedure gen_alloc_inline_funcret(list:TAAsmoutput;pd:tprocdef); + var + callerparaloc : tlocation; + begin + if not assigned(pd.funcretsym) or + (po_assembler in pd.procoptions) then + exit; + { for localloc <> LOC_REFERENCE, we need regvar support inside inlined procedures } + with tabstractnormalvarsym(pd.funcretsym) do + begin + localloc.loc:=LOC_REFERENCE; + localloc.size:=int_cgsize(paramanager.push_size(varspez,vartype.def,pd.proccalloption)); + tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference); + callerparaloc:=pd.funcretloc[callerside]; + case pd.funcretloc[calleeside].loc of + LOC_FPUREGISTER: + begin + pd.funcretloc[calleeside].register:=cg.getfpuregister(list,pd.funcretloc[calleeside].size); + pd.funcretloc[callerside].register:=pd.funcretloc[calleeside].register; + end; + LOC_REGISTER: + begin + {$ifndef cpu64bit} + if callerparaloc.size in [OS_64,OS_S64] then + begin + end + else + {$endif cpu64bit} + begin + pd.funcretloc[calleeside].register:=cg.getintregister(list,pd.funcretloc[calleeside].size); + pd.funcretloc[callerside].register:=pd.funcretloc[calleeside].register; + end; + end; + LOC_MMREGISTER: + begin + pd.funcretloc[calleeside].register:=cg.getmmregister(list,pd.funcretloc[calleeside].size); + pd.funcretloc[callerside].register:=pd.funcretloc[calleeside].register; + end; + LOC_REFERENCE: + begin + pd.funcretloc[calleeside].reference.offset := localloc.reference.offset; + pd.funcretloc[calleeside].reference.index := localloc.reference.base; + pd.funcretloc[callerside].reference.offset := localloc.reference.offset; + pd.funcretloc[callerside].reference.index := localloc.reference.base; + end; + LOC_VOID: + ; + else + internalerror(200411191); + end; + if cs_asm_source in aktglobalswitches then + begin + case localloc.loc of + LOC_REFERENCE : + list.concat(Tai_comment.Create(strpnew('Funcret '+realname+' allocated at '+ + std_regname(localloc.reference.base)+tostr_with_plus(localloc.reference.offset)))); + end; + end; + end; + end; +{$endif PASS2INLINE} + + { persistent rtti generation } procedure generate_rtti(p:Ttypesym); var @@ -2069,11 +2277,11 @@ implementation def.rttitablesym:=rsym; { write rtti data } def.write_child_rtti_data(fullrtti); - maybe_new_object_file(asmlist[al_rtti]); - new_section(asmlist[al_rtti],sec_rodata,rsym.get_label.name,const_align(sizeof(aint))); - asmlist[al_rtti].concat(Tai_symbol.Create_global(rsym.get_label,0)); + maybe_new_object_file(rttilist); + new_section(rttilist,sec_rodata,rsym.get_label.name,const_align(sizeof(aint))); + rttiList.concat(Tai_symbol.Create_global(rsym.get_label,0)); def.write_rtti_data(fullrtti); - asmlist[al_rtti].concat(Tai_symbol_end.Create(rsym.get_label)); + rttiList.concat(Tai_symbol_end.Create(rsym.get_label)); end; end; @@ -2109,11 +2317,11 @@ implementation def.inittablesym:=rsym; { write inittable data } def.write_child_rtti_data(initrtti); - maybe_new_object_file(asmlist[al_rtti]); - new_section(asmlist[al_rtti],sec_rodata,rsym.get_label.name,const_align(sizeof(aint))); - asmlist[al_rtti].concat(Tai_symbol.Create_global(rsym.get_label,0)); + maybe_new_object_file(rttilist); + new_section(rttilist,sec_rodata,rsym.get_label.name,const_align(sizeof(aint))); + rttiList.concat(Tai_symbol.Create_global(rsym.get_label,0)); def.write_rtti_data(initrtti); - asmlist[al_rtti].concat(Tai_symbol_end.Create(rsym.get_label)); + rttiList.concat(Tai_symbol_end.Create(rsym.get_label)); end; end; diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas index 7678f7060f..542311e7f1 100644 --- a/compiler/ncnv.pas +++ b/compiler/ncnv.pas @@ -44,7 +44,7 @@ interface procedure ppuwrite(ppufile:tcompilerppufile);override; procedure buildderefimpl;override; procedure derefimpl;override; - function _getcopy : tnode;override; + function getcopy : tnode;override; procedure printnodeinfo(var t : text);override; function pass_1 : tnode;override; function det_resulttype:tnode;override; @@ -180,7 +180,7 @@ interface constructor create(l,r : tnode);virtual; function pass_1 : tnode;override; function det_resulttype:tnode;override; - function _getcopy: tnode;override; + function getcopy: tnode;override; destructor destroy; override; protected call: tnode; @@ -593,14 +593,14 @@ implementation end; - function ttypeconvnode._getcopy : tnode; + function ttypeconvnode.getcopy : tnode; var n : ttypeconvnode; begin - n:=ttypeconvnode(inherited _getcopy); + n:=ttypeconvnode(inherited getcopy); n.convtype:=convtype; n.totype:=totype; - _getcopy:=n; + getcopy:=n; end; procedure ttypeconvnode.printnodeinfo(var t : text); @@ -714,23 +714,13 @@ implementation arrsize := highrange-lowrange+1; end; if (left.nodetype = stringconstn) and - (tstringdef(left.resulttype.def).string_typ=st_conststring) then + { left.length+1 since there's always a terminating #0 character (JM) } + (tstringconstnode(left).len+1 >= arrsize) and + (tstringdef(left.resulttype.def).string_typ=st_shortstring) then begin - { if the array of char is large enough we can use the string - constant directly. This is handled in ncgcnv } - if (arrsize>=tstringconstnode(left).len) and - is_char(tarraydef(resulttype.def).elementtype.def) then - exit; - { Convert to wide/short/ansistring and call default helper } - if is_widechar(tarraydef(resulttype.def).elementtype.def) then - inserttypeconv(left,cwidestringtype) - else - begin - if tstringconstnode(left).len>255 then - inserttypeconv(left,cansistringtype) - else - inserttypeconv(left,cshortstringtype); - end; + { handled separately } + result := nil; + exit; end; if is_widechar(tarraydef(resulttype.def).elementtype.def) then chartype:='widechar' @@ -749,12 +739,47 @@ implementation var procname: string[31]; stringpara : tcallparanode; + pw : pcompilerwidestring; + pc : pchar; begin result:=nil; if left.nodetype=stringconstn then begin - tstringconstnode(left).changestringtype(resulttype); + { convert ascii 2 unicode } + {$ifdef ansistring_bits} + if (tstringdef(resulttype.def).string_typ=st_widestring) and + (tstringconstnode(left).st_type in [st_ansistring16,st_ansistring32, + st_ansistring64,st_shortstring,st_longstring]) then + {$else} + if (tstringdef(resulttype.def).string_typ=st_widestring) and + (tstringconstnode(left).st_type in [st_ansistring,st_shortstring,st_longstring]) then + {$endif} + begin + initwidestring(pw); + ascii2unicode(tstringconstnode(left).value_str,tstringconstnode(left).len,pw); + ansistringdispose(tstringconstnode(left).value_str,tstringconstnode(left).len); + pcompilerwidestring(tstringconstnode(left).value_str):=pw; + end + else + { convert unicode 2 ascii } + {$ifdef ansistring_bits} + if (tstringconstnode(left).st_type=st_widestring) and + (tstringdef(resulttype.def).string_typ in [st_ansistring16,st_ansistring32, + st_ansistring64,st_shortstring,st_longstring]) then + {$else} + if (tstringconstnode(left).st_type=st_widestring) and + (tstringdef(resulttype.def).string_typ in [st_ansistring,st_shortstring,st_longstring]) then + {$endif} + begin + pw:=pcompilerwidestring(tstringconstnode(left).value_str); + getmem(pc,getlengthwidestring(pw)+1); + unicode2ascii(pw,pc); + donewidestring(pw); + tstringconstnode(left).value_str:=pc; + end; + tstringconstnode(left).st_type:=tstringdef(resulttype.def).string_typ; + tstringconstnode(left).resulttype:=resulttype; result:=left; left:=nil; end @@ -2631,10 +2656,10 @@ implementation end; - function tasnode._getcopy: tnode; + function tasnode.getcopy: tnode; begin - result := inherited _getcopy; + result := inherited getcopy; if assigned(call) then tasnode(result).call := call.getcopy else diff --git a/compiler/ncon.pas b/compiler/ncon.pas index 492d8832fa..8d0cddc5f2 100644 --- a/compiler/ncon.pas +++ b/compiler/ncon.pas @@ -41,7 +41,7 @@ interface procedure ppuwrite(ppufile:tcompilerppufile);override; procedure buildderefimpl;override; procedure derefimpl;override; - function _getcopy : tnode;override; + function getcopy : tnode;override; function pass_1 : tnode;override; function det_resulttype:tnode;override; function docompare(p: tnode) : boolean; override; @@ -62,7 +62,7 @@ interface procedure ppuwrite(ppufile:tcompilerppufile);override; procedure buildderefimpl;override; procedure derefimpl;override; - function _getcopy : tnode;override; + function getcopy : tnode;override; function pass_1 : tnode;override; function det_resulttype:tnode;override; function docompare(p: tnode) : boolean; override; @@ -78,7 +78,7 @@ interface procedure ppuwrite(ppufile:tcompilerppufile);override; procedure buildderefimpl;override; procedure derefimpl;override; - function _getcopy : tnode;override; + function getcopy : tnode;override; function pass_1 : tnode;override; function det_resulttype:tnode;override; function docompare(p: tnode) : boolean; override; @@ -91,19 +91,18 @@ interface lab_str : tasmlabel; st_type : tstringtype; constructor createstr(const s : string;st:tstringtype);virtual; - constructor createpchar(s : pchar;l : longint;st:tstringtype);virtual; + constructor createpchar(s : pchar;l : longint);virtual; constructor createwstr(w : pcompilerwidestring);virtual; constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override; procedure buildderefimpl;override; procedure derefimpl;override; destructor destroy;override; - function _getcopy : tnode;override; + function getcopy : tnode;override; function pass_1 : tnode;override; function det_resulttype:tnode;override; function getpcharcopy : pchar; function docompare(p: tnode) : boolean; override; - procedure changestringtype(const newtype:ttype); end; tstringconstnodeclass = class of tstringconstnode; @@ -117,7 +116,7 @@ interface procedure ppuwrite(ppufile:tcompilerppufile);override; procedure buildderefimpl;override; procedure derefimpl;override; - function _getcopy : tnode;override; + function getcopy : tnode;override; function pass_1 : tnode;override; function det_resulttype:tnode;override; function docompare(p: tnode) : boolean; override; @@ -136,7 +135,7 @@ interface constructor create(const g:tguid);virtual; constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override; - function _getcopy : tnode;override; + function getcopy : tnode;override; function pass_1 : tnode;override; function det_resulttype:tnode;override; function docompare(p: tnode) : boolean; override; @@ -238,10 +237,12 @@ implementation conststring : begin len:=p.value.len; + if not(cs_ansistrings in aktlocalswitches) and (len>255) then + len:=255; getmem(pc,len+1); move(pchar(p.value.valueptr)^,pc^,len); pc[len]:=#0; - p1:=cstringconstnode.createpchar(pc,len,st_conststring); + p1:=cstringconstnode.createpchar(pc,len); end; constreal : p1:=crealconstnode.create(pbestreal(p.value.valueptr)^,pbestrealtype^); @@ -305,16 +306,16 @@ implementation end; - function trealconstnode._getcopy : tnode; + function trealconstnode.getcopy : tnode; var n : trealconstnode; begin - n:=trealconstnode(inherited _getcopy); + n:=trealconstnode(inherited getcopy); n.value_real:=value_real; n.lab_real:=lab_real; - _getcopy:=n; + getcopy:=n; end; function trealconstnode.det_resulttype:tnode; @@ -397,16 +398,16 @@ implementation end; - function tordconstnode._getcopy : tnode; + function tordconstnode.getcopy : tnode; var n : tordconstnode; begin - n:=tordconstnode(inherited _getcopy); + n:=tordconstnode(inherited getcopy); n.value:=value; n.restype := restype; - _getcopy:=n; + getcopy:=n; end; function tordconstnode.det_resulttype:tnode; @@ -482,16 +483,16 @@ implementation end; - function tpointerconstnode._getcopy : tnode; + function tpointerconstnode.getcopy : tnode; var n : tpointerconstnode; begin - n:=tpointerconstnode(inherited _getcopy); + n:=tpointerconstnode(inherited getcopy); n.value:=value; n.restype := restype; - _getcopy:=n; + getcopy:=n; end; function tpointerconstnode.det_resulttype:tnode; @@ -519,8 +520,10 @@ implementation *****************************************************************************} constructor tstringconstnode.createstr(const s : string;st:tstringtype); + var l : longint; + begin inherited create(stringconstn); l:=length(s); @@ -530,11 +533,30 @@ implementation move(s[1],value_str^,l); value_str[l]:=#0; lab_str:=nil; - st_type:=st; + if st=st_default then + begin + if cs_ansistrings in aktlocalswitches then + {$ifdef ansistring_bits} + case aktansistring_bits of + sb_16: + st_type:=st_ansistring16; + sb_32: + st_type:=st_ansistring32; + sb_64: + st_type:=st_ansistring64; + end + {$else} + st_type:=st_ansistring + {$endif} + else + st_type:=st_shortstring; + end + else + st_type:=st; end; - constructor tstringconstnode.createwstr(w : pcompilerwidestring); + begin inherited create(stringconstn); len:=getlengthwidestring(w); @@ -544,13 +566,28 @@ implementation st_type:=st_widestring; end; + constructor tstringconstnode.createpchar(s : pchar;l : longint); - constructor tstringconstnode.createpchar(s : pchar;l : longint;st:tstringtype); begin inherited create(stringconstn); len:=l; value_str:=s; - st_type:=st; + if (cs_ansistrings in aktlocalswitches) or + (len>255) then + {$ifdef ansistring_bits} + case aktansistring_bits of + sb_16: + st_type:=st_ansistring16; + sb_32: + st_type:=st_ansistring32; + sb_64: + st_type:=st_ansistring64; + end + {$else} + st_type:=st_ansistring + {$endif} + else + st_type:=st_shortstring; lab_str:=nil; end; @@ -615,13 +652,13 @@ implementation end; - function tstringconstnode._getcopy : tnode; + function tstringconstnode.getcopy : tnode; var n : tstringconstnode; begin - n:=tstringconstnode(inherited _getcopy); + n:=tstringconstnode(inherited getcopy); n.st_type:=st_type; n.len:=len; n.lab_str:=lab_str; @@ -632,29 +669,26 @@ implementation end else n.value_str:=getpcharcopy; - _getcopy:=n; + getcopy:=n; end; function tstringconstnode.det_resulttype:tnode; - var - l : aint; begin result:=nil; case st_type of - st_conststring : - begin - { handle and store as array[0..len-1] of char } - if len>0 then - l:=len-1 - else - l:=0; - resulttype.setdef(tarraydef.create(0,l,s32inttype)); - tarraydef(resulttype.def).setelementtype(cchartype); - end; st_shortstring : resulttype:=cshortstringtype; + {$ifdef ansistring_bits} + st_ansistring16: + resulttype:=cansistringtype16; + st_ansistring32: + resulttype:=cansistringtype32; + st_ansistring64: + resulttype:=cansistringtype64; + {$else} st_ansistring : resulttype:=cansistringtype; + {$endif} st_widestring : resulttype:=cwidestringtype; st_longstring : @@ -665,14 +699,17 @@ implementation function tstringconstnode.pass_1 : tnode; begin result:=nil; + {$ifdef ansistring_bits} + if (st_type in [st_ansistring16,st_ansistring32,st_ansistring64,st_widestring]) and + {$else} if (st_type in [st_ansistring,st_widestring]) and + {$endif} (len=0) then expectloc:=LOC_CONSTANT else expectloc:=LOC_CREFERENCE; end; - function tstringconstnode.getpcharcopy : pchar; var pc : pchar; @@ -696,39 +733,6 @@ implementation (lab_str = tstringconstnode(p).lab_str); end; - - procedure tstringconstnode.changestringtype(const newtype:ttype); - var - pw : pcompilerwidestring; - pc : pchar; - begin - if newtype.def.deftype<>stringdef then - internalerror(200510011); - { convert ascii 2 unicode } - if (tstringdef(newtype.def).string_typ=st_widestring) and - (st_type<>st_widestring) then - begin - initwidestring(pw); - ascii2unicode(value_str,len,pw); - ansistringdispose(value_str,len); - pcompilerwidestring(value_str):=pw; - end - else - { convert unicode 2 ascii } - if (st_type=st_widestring) and - (tstringdef(newtype.def).string_typ<>st_widestring) then - begin - pw:=pcompilerwidestring(value_str); - getmem(pc,getlengthwidestring(pw)+1); - unicode2ascii(pw,pc); - donewidestring(pw); - value_str:=pc; - end; - st_type:=tstringdef(newtype.def).string_typ; - resulttype:=newtype; - end; - - {***************************************************************************** TSETCONSTNODE *****************************************************************************} @@ -786,13 +790,13 @@ implementation end; - function tsetconstnode._getcopy : tnode; + function tsetconstnode.getcopy : tnode; var n : tsetconstnode; begin - n:=tsetconstnode(inherited _getcopy); + n:=tsetconstnode(inherited getcopy); if assigned(value_set) then begin new(n.value_set); @@ -802,7 +806,7 @@ implementation n.value_set:=nil; n.restype := restype; n.lab_set:=lab_set; - _getcopy:=n; + getcopy:=n; end; function tsetconstnode.det_resulttype:tnode; @@ -875,15 +879,15 @@ implementation end; - function tguidconstnode._getcopy : tnode; + function tguidconstnode.getcopy : tnode; var n : tguidconstnode; begin - n:=tguidconstnode(inherited _getcopy); + n:=tguidconstnode(inherited getcopy); n.value:=value; - _getcopy:=n; + getcopy:=n; end; function tguidconstnode.det_resulttype:tnode; diff --git a/compiler/nflw.pas b/compiler/nflw.pas index ec078951cc..e172aff73e 100644 --- a/compiler/nflw.pas +++ b/compiler/nflw.pas @@ -30,8 +30,7 @@ interface cclasses, node,cpubase, symnot, - symtype,symbase,symdef,symsym, - optunrol; + symtype,symbase,symdef,symsym; type { flags used by loop nodes } @@ -60,7 +59,7 @@ interface loopflags : tloopflags; constructor create(tt : tnodetype;l,r,_t1,_t2 : tnode);virtual; destructor destroy;override; - function _getcopy : tnode;override; + function getcopy : tnode;override; constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override; procedure buildderefimpl;override; @@ -137,7 +136,7 @@ interface procedure ppuwrite(ppufile:tcompilerppufile);override; procedure buildderefimpl;override; procedure derefimpl;override; - function _getcopy : tnode;override; + function getcopy : tnode;override; function det_resulttype:tnode;override; function pass_1 : tnode;override; function docompare(p: tnode): boolean; override; @@ -155,7 +154,7 @@ interface procedure ppuwrite(ppufile:tcompilerppufile);override; procedure buildderefimpl;override; procedure derefimpl;override; - function _getcopy : tnode;override; + function getcopy : tnode;override; function det_resulttype:tnode;override; function pass_1 : tnode;override; function docompare(p: tnode): boolean; override; @@ -169,7 +168,7 @@ interface procedure ppuwrite(ppufile:tcompilerppufile);override; procedure buildderefimpl;override; procedure derefimpl;override; - function _getcopy : tnode;override; + function getcopy : tnode;override; procedure insertintolist(l : tnodelist);override; function det_resulttype:tnode;override; function pass_1 : tnode;override; @@ -201,7 +200,7 @@ interface constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; function det_resulttype:tnode;override; function pass_1 : tnode;override; - function _getcopy : tnode;override; + function getcopy : tnode;override; function docompare(p: tnode): boolean; override; end; tonnodeclass = class of tonnode; @@ -293,23 +292,23 @@ implementation end; - function tloopnode._getcopy : tnode; + function tloopnode.getcopy : tnode; var p : tloopnode; begin - p:=tloopnode(inherited _getcopy); + p:=tloopnode(inherited getcopy); if assigned(t1) then - p.t1:=t1._getcopy + p.t1:=t1.getcopy else p.t1:=nil; if assigned(t2) then - p.t2:=t2._getcopy + p.t2:=t2.getcopy else p.t2:=nil; p.loopflags:=loopflags; - _getcopy:=p; + getcopy:=p; end; procedure tloopnode.insertintolist(l : tnodelist); @@ -690,24 +689,10 @@ implementation end; function tfornode.det_resulttype:tnode; - var - unrollres : tnode; begin result:=nil; resulttype:=voidtype; - { loop unrolling } - if cs_loopunroll in aktglobalswitches then - begin - unrollres:=unroll_loop(self); - if assigned(unrollres) then - begin - resulttypepass(unrollres); - result:=unrollres; - exit; - end; - end; - { process the loopvar, from and to, varstates are already set } resulttypepass(left); resulttypepass(right); @@ -989,12 +974,12 @@ implementation end; - function tgotonode._getcopy : tnode; + function tgotonode.getcopy : tnode; var p : tgotonode; i : aint; begin - p:=tgotonode(inherited _getcopy); + p:=tgotonode(inherited getcopy); { p.exceptionblock:=exceptionblock; { When we copying, we do an ugly trick to determine if the label used @@ -1091,11 +1076,11 @@ implementation end; - function tlabelnode._getcopy : tnode; + function tlabelnode.getcopy : tnode; var p : tlabelnode; begin - p:=tlabelnode(inherited _getcopy); + p:=tlabelnode(inherited getcopy); p.exceptionblock:=exceptionblock; result:=p; @@ -1149,16 +1134,16 @@ implementation end; - function traisenode._getcopy : tnode; + function traisenode.getcopy : tnode; var n : traisenode; begin - n:=traisenode(inherited _getcopy); + n:=traisenode(inherited getcopy); if assigned(frametree) then - n.frametree:=frametree._getcopy + n.frametree:=frametree.getcopy else n.frametree:=nil; - _getcopy:=n; + getcopy:=n; end; @@ -1368,11 +1353,11 @@ implementation end; - function tonnode._getcopy : tnode; + function tonnode.getcopy : tnode; var n : tonnode; begin - n:=tonnode(inherited _getcopy); + n:=tonnode(inherited getcopy); n.exceptsymtable:=exceptsymtable.getcopy; n.excepttype:=excepttype; result:=n; diff --git a/compiler/ninl.pas b/compiler/ninl.pas index 332f728d4d..2af90ab570 100644 --- a/compiler/ninl.pas +++ b/compiler/ninl.pas @@ -36,12 +36,12 @@ interface constructor create(number : byte;is_const:boolean;l : tnode);virtual; constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override; - function _getcopy : tnode;override; + function getcopy : tnode;override; function pass_1 : tnode;override; function det_resulttype:tnode;override; function docompare(p: tnode): boolean; override; { All the following routines currently - call compilerprocs, unless they are + call compilerproc's, unless they are overriden in which case, the code generator handles them. } @@ -116,11 +116,11 @@ implementation end; - function tinlinenode._getcopy : tnode; + function tinlinenode.getcopy : tnode; var n : tinlinenode; begin - n:=tinlinenode(inherited _getcopy); + n:=tinlinenode(inherited getcopy); n.inlinenumber:=inlinenumber; result:=n; end; diff --git a/compiler/nld.pas b/compiler/nld.pas index 739629b580..965e886f0d 100644 --- a/compiler/nld.pas +++ b/compiler/nld.pas @@ -47,7 +47,7 @@ interface procedure derefimpl;override; procedure set_mp(p:tnode); function is_addr_param_load:boolean; - function _getcopy : tnode;override; + function getcopy : tnode;override; function pass_1 : tnode;override; function det_resulttype:tnode;override; procedure mark_write;override; @@ -64,7 +64,7 @@ interface constructor create(l,r : tnode);virtual; constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override; - function _getcopy : tnode;override; + function getcopy : tnode;override; function pass_1 : tnode;override; function det_resulttype:tnode;override; {$ifdef state_tracking} @@ -83,7 +83,7 @@ interface tarrayconstructornode = class(tbinarynode) constructor create(l,r : tnode);virtual; - function _getcopy : tnode;override; + function getcopy : tnode;override; function pass_1 : tnode;override; function det_resulttype:tnode;override; function docompare(p: tnode): boolean; override; @@ -116,7 +116,7 @@ interface procedure ppuwrite(ppufile:tcompilerppufile);override; procedure buildderefimpl;override; procedure derefimpl;override; - function _getcopy : tnode;override; + function getcopy : tnode;override; function pass_1 : tnode;override; function det_resulttype:tnode;override; function docompare(p: tnode): boolean; override; @@ -213,12 +213,12 @@ implementation end; - function tloadnode._getcopy : tnode; + function tloadnode.getcopy : tnode; var n : tloadnode; begin - n:=tloadnode(inherited _getcopy); + n:=tloadnode(inherited getcopy); n.symtable:=symtable; n.symtableentry:=symtableentry; n.procdef:=procdef; @@ -478,15 +478,15 @@ implementation end; - function tassignmentnode._getcopy : tnode; + function tassignmentnode.getcopy : tnode; var n : tassignmentnode; begin - n:=tassignmentnode(inherited _getcopy); + n:=tassignmentnode(inherited getcopy); n.assigntype:=assigntype; - result:=n; + getcopy:=n; end; @@ -863,11 +863,11 @@ implementation end; - function tarrayconstructornode._getcopy : tnode; + function tarrayconstructornode.getcopy : tnode; var n : tarrayconstructornode; begin - n:=tarrayconstructornode(inherited _getcopy); + n:=tarrayconstructornode(inherited getcopy); result:=n; end; @@ -1164,11 +1164,11 @@ implementation end; - function trttinode._getcopy : tnode; + function trttinode.getcopy : tnode; var n : trttinode; begin - n:=trttinode(inherited _getcopy); + n:=trttinode(inherited getcopy); n.rttidef:=rttidef; n.rttitype:=rttitype; result:=n; diff --git a/compiler/nmat.pas b/compiler/nmat.pas index dffa161df7..ab56f4a6e9 100644 --- a/compiler/nmat.pas +++ b/compiler/nmat.pas @@ -1,5 +1,5 @@ { - Copyright (c) 2000-2005 by Florian Klaempfl + Copyright (c) 2000-2002 by Florian Klaempfl Type checking and register allocation for math nodes @@ -32,7 +32,6 @@ interface tmoddivnode = class(tbinopnode) function pass_1 : tnode;override; function det_resulttype:tnode;override; - function simplify : tnode;override; protected {$ifndef cpu64bit} { override the following if you want to implement } @@ -47,7 +46,6 @@ interface tshlshrnode = class(tbinopnode) function pass_1 : tnode;override; function det_resulttype:tnode;override; - function simplify : tnode;override; {$ifndef cpu64bit} { override the following if you want to implement } { parts explicitely in the code generator (CEC) @@ -63,7 +61,6 @@ interface constructor create(expr : tnode);virtual; function pass_1 : tnode;override; function det_resulttype:tnode;override; - function simplify : tnode;override; end; tunaryminusnodeclass = class of tunaryminusnode; @@ -71,7 +68,6 @@ interface constructor create(expr : tnode);virtual; function pass_1 : tnode;override; function det_resulttype:tnode;override; - function simplify : tnode;override; {$ifdef state_tracking} function track_state_pass(exec_known:boolean):boolean;override; {$endif} @@ -84,6 +80,7 @@ interface cunaryminusnode : tunaryminusnodeclass; cnotnode : tnotnodeclass; + implementation uses @@ -99,47 +96,11 @@ implementation TMODDIVNODE ****************************************************************************} - function tmoddivnode.simplify:tnode; - var - t : tnode; - rd,ld : torddef; - rv,lv : tconstexprint; - begin - result:=nil; - - if is_constintnode(right) and is_constintnode(left) then - begin - rd:=torddef(right.resulttype.def); - ld:=torddef(left.resulttype.def); - - rv:=tordconstnode(right).value; - lv:=tordconstnode(left).value; - - case nodetype of - modn: - if (torddef(ld).typ <> u64bit) or - (torddef(rd).typ <> u64bit) then - t:=genintconstnode(lv mod rv) - else - t:=genintconstnode(int64(qword(lv) mod qword(rv))); - divn: - if (torddef(ld).typ <> u64bit) or - (torddef(rd).typ <> u64bit) then - t:=genintconstnode(lv div rv) - else - t:=genintconstnode(int64(qword(lv) div qword(rv))); - end; - result:=t; - exit; - end; - end; - - function tmoddivnode.det_resulttype:tnode; var - hp,t : tnode; - rd,ld : torddef; - rv : tconstexprint; + hp,t : tnode; + rd,ld : torddef; + rv,lv : tconstexprint; begin result:=nil; resulttypepass(left); @@ -170,12 +131,29 @@ implementation { recover } rv:=1; end; + if is_constintnode(left) then + begin + lv:=tordconstnode(left).value; + + case nodetype of + modn: + if (torddef(ld).typ <> u64bit) or + (torddef(rd).typ <> u64bit) then + t:=genintconstnode(lv mod rv) + else + t:=genintconstnode(int64(qword(lv) mod qword(rv))); + divn: + if (torddef(ld).typ <> u64bit) or + (torddef(rd).typ <> u64bit) then + t:=genintconstnode(lv div rv) + else + t:=genintconstnode(int64(qword(lv) div qword(rv))); + end; + result:=t; + exit; + end; end; - result:=simplify; - if assigned(result) then - exit; - { allow operator overloading } t:=self; if isbinaryoverloaded(t) then @@ -447,27 +425,6 @@ implementation TSHLSHRNODE ****************************************************************************} - function tshlshrnode.simplify:tnode; - var - t : tnode; - begin - result:=nil; - { constant folding } - if is_constintnode(left) and is_constintnode(right) then - begin - case nodetype of - shrn: - t:=genintconstnode(tordconstnode(left).value shr tordconstnode(right).value); - shln: - t:=genintconstnode(tordconstnode(left).value shl tordconstnode(right).value); - end; - result:=t; - exit; - end; - - end; - - function tshlshrnode.det_resulttype:tnode; var t : tnode; @@ -480,9 +437,18 @@ implementation if codegenerror then exit; - result:=simplify; - if assigned(result) then - exit; + { constant folding } + if is_constintnode(left) and is_constintnode(right) then + begin + case nodetype of + shrn: + t:=genintconstnode(tordconstnode(left).value shr tordconstnode(right).value); + shln: + t:=genintconstnode(tordconstnode(left).value shl tordconstnode(right).value); + end; + result:=t; + exit; + end; { allow operator overloading } t:=self; @@ -569,25 +535,6 @@ implementation end; - function tunaryminusnode.simplify:tnode; - begin - result:=nil; - { constant folding } - if is_constintnode(left) then - begin - result:=genintconstnode(-tordconstnode(left).value); - exit; - end; - if is_constrealnode(left) then - begin - trealconstnode(left).value_real:=-trealconstnode(left).value_real; - result:=left; - left:=nil; - exit; - end; - end; - - function tunaryminusnode.det_resulttype : tnode; var t : tnode; @@ -598,9 +545,19 @@ implementation if codegenerror then exit; - result:=simplify; - if assigned(result) then - exit; + { constant folding } + if is_constintnode(left) then + begin + result:=genintconstnode(-tordconstnode(left).value); + exit; + end; + if is_constrealnode(left) then + begin + trealconstnode(left).value_real:=-trealconstnode(left).value_real; + result:=left; + left:=nil; + exit; + end; resulttype:=left.resulttype; if (left.resulttype.def.deftype=floatdef) then @@ -647,92 +604,50 @@ implementation { overridden by: } { i386 } function tunaryminusnode.pass_1 : tnode; - var - procname: string[31]; - temp: tnode; begin - result:=nil; - firstpass(left); - if codegenerror then - exit; - - if (cs_fp_emulation in aktmoduleswitches) and (left.resulttype.def.deftype=floatdef) then - begin - if not(target_info.system in system_wince) then - begin - case tfloatdef(resulttype.def).typ of - s32real: - procname:='float32_sub'; - s64real: - procname:='float64_sub'; - {!!! not yet implemented - s128real: - } - else - internalerror(2005082801); - end; - result:=ccallnode.createintern(procname,ccallparanode.create(crealconstnode.create(0,resulttype), - ccallparanode.create(left,nil))); - end - else - begin - case tfloatdef(resulttype.def).typ of - s32real: - procname:='NEGS'; - s64real: - procname:='NEGD'; - {!!! not yet implemented - s128real: - } - else - internalerror(2005082802); - end; - result:=ccallnode.createintern(procname,ccallparanode.create(left,nil)); - end; + result:=nil; + firstpass(left); + if codegenerror then + exit; - left:=nil; - end - else - begin - registersint:=left.registersint; - registersfpu:=left.registersfpu; + registersint:=left.registersint; + registersfpu:=left.registersfpu; {$ifdef SUPPORT_MMX} - registersmmx:=left.registersmmx; + registersmmx:=left.registersmmx; {$endif SUPPORT_MMX} - if (left.resulttype.def.deftype=floatdef) then - begin - if (left.expectloc<>LOC_REGISTER) and - (registersfpu<1) then - registersfpu:=1; - expectloc:=LOC_FPUREGISTER; - end + if (left.resulttype.def.deftype=floatdef) then + begin + if (left.expectloc<>LOC_REGISTER) and + (registersfpu<1) then + registersfpu:=1; + expectloc:=LOC_FPUREGISTER; + end {$ifdef SUPPORT_MMX} - else if (cs_mmx in aktlocalswitches) and - is_mmx_able_array(left.resulttype.def) then - begin - if (left.expectloc<>LOC_MMXREGISTER) and - (registersmmx<1) then - registersmmx:=1; - end + else if (cs_mmx in aktlocalswitches) and + is_mmx_able_array(left.resulttype.def) then + begin + if (left.expectloc<>LOC_MMXREGISTER) and + (registersmmx<1) then + registersmmx:=1; + end {$endif SUPPORT_MMX} {$ifndef cpu64bit} - else if is_64bit(left.resulttype.def) then - begin - if (left.expectloc<>LOC_REGISTER) and - (registersint<2) then - registersint:=2; - expectloc:=LOC_REGISTER; - end + else if is_64bit(left.resulttype.def) then + begin + if (left.expectloc<>LOC_REGISTER) and + (registersint<2) then + registersint:=2; + expectloc:=LOC_REGISTER; + end {$endif cpu64bit} - else if (left.resulttype.def.deftype=orddef) then - begin - if (left.expectloc<>LOC_REGISTER) and - (registersint<1) then - registersint:=1; - expectloc:=LOC_REGISTER; - end; - end; + else if (left.resulttype.def.deftype=orddef) then + begin + if (left.expectloc<>LOC_REGISTER) and + (registersint<1) then + registersint:=1; + expectloc:=LOC_REGISTER; + end; end; @@ -751,78 +666,11 @@ implementation end; - function tnotnode.simplify:tnode; - var - v : tconstexprint; - t : tnode; - tt : ttype; - begin - result:=nil; - { Try optmimizing ourself away } - if left.nodetype=notn then - begin - { Double not. Remove both } - result:=Tnotnode(left).left; - tnotnode(left).left:=nil; - exit; - end; - - if (left.nodetype in [ltn,lten,equaln,unequaln,gtn,gten]) then - begin - { Not of boolean expression. Turn around the operator and remove - the not. This is not allowed for sets with the gten/lten, - because there is no ltn/gtn support } - if (taddnode(left).left.resulttype.def.deftype<>setdef) or - (left.nodetype in [equaln,unequaln]) then - begin - result:=left; - left.nodetype:=boolean_reverse[left.nodetype]; - left:=nil; - exit; - end; - end; - - { constant folding } - if (left.nodetype=ordconstn) then - begin - v:=tordconstnode(left).value; - tt:=left.resulttype; - case torddef(left.resulttype.def).typ of - bool8bit, - bool16bit, - bool32bit : - begin - { here we do a boolean(byte(..)) type cast because } - { boolean(<int64>) is buggy in 1.00 } - v:=byte(not(boolean(byte(v)))); - end; - uchar, - uwidechar, - u8bit, - s8bit, - u16bit, - s16bit, - u32bit, - s32bit, - s64bit, - u64bit : - begin - v:=int64(not int64(v)); { maybe qword is required } - int_to_type(v,tt); - end; - else - CGMessage(type_e_mismatch); - end; - t:=cordconstnode.create(v,tt,true); - result:=t; - exit; - end; - end; - - function tnotnode.det_resulttype : tnode; var t : tnode; + tt : ttype; + v : tconstexprint; begin result:=nil; resulttypepass(left); @@ -832,9 +680,65 @@ implementation resulttype:=left.resulttype; - result:=simplify; - if assigned(result) then - exit; + { Try optmimizing ourself away } + if left.nodetype=notn then + begin + { Double not. Remove both } + result:=Tnotnode(left).left; + Tnotnode(left).left:=nil; + exit; + end; + + if (left.nodetype in [ltn,lten,equaln,unequaln,gtn,gten]) then + begin + { Not of boolean expression. Turn around the operator and remove + the not. This is not allowed for sets with the gten/lten, + because there is no ltn/gtn support } + if (taddnode(left).left.resulttype.def.deftype<>setdef) or + (left.nodetype in [equaln,unequaln]) then + begin + result:=left; + left.nodetype:=boolean_reverse[left.nodetype]; + left:=nil; + exit; + end; + end; + + { constant folding } + if (left.nodetype=ordconstn) then + begin + v:=tordconstnode(left).value; + tt:=left.resulttype; + case torddef(left.resulttype.def).typ of + bool8bit, + bool16bit, + bool32bit : + begin + { here we do a boolean(byte(..)) type cast because } + { boolean(<int64>) is buggy in 1.00 } + v:=byte(not(boolean(byte(v)))); + end; + uchar, + uwidechar, + u8bit, + s8bit, + u16bit, + s16bit, + u32bit, + s32bit, + s64bit, + u64bit : + begin + v:=int64(not int64(v)); { maybe qword is required } + int_to_type(v,tt); + end; + else + CGMessage(type_e_mismatch); + end; + t:=cordconstnode.create(v,tt,true); + result:=t; + exit; + end; if is_boolean(resulttype.def) then begin diff --git a/compiler/nmem.pas b/compiler/nmem.pas index 0e47b4e53e..aeb50a3aba 100644 --- a/compiler/nmem.pas +++ b/compiler/nmem.pas @@ -47,7 +47,7 @@ interface procedure derefimpl;override; function pass_1 : tnode;override; function det_resulttype:tnode;override; - function _getcopy : tnode;override; + function getcopy : tnode;override; end; tloadparentfpnodeclass = class of tloadparentfpnode; @@ -61,7 +61,7 @@ interface procedure mark_write;override; procedure buildderefimpl;override; procedure derefimpl;override; - function _getcopy : tnode;override; + function getcopy : tnode;override; function pass_1 : tnode;override; function det_resulttype:tnode;override; end; @@ -83,7 +83,7 @@ interface procedure ppuwrite(ppufile:tcompilerppufile);override; procedure buildderefimpl;override; procedure derefimpl;override; - function _getcopy : tnode;override; + function getcopy : tnode;override; function pass_1 : tnode;override; function docompare(p: tnode): boolean; override; function det_resulttype:tnode;override; @@ -107,7 +107,7 @@ interface destructor destroy;override; constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override; - function _getcopy : tnode;override; + function getcopy : tnode;override; function pass_1 : tnode;override; function docompare(p: tnode): boolean; override; function det_resulttype:tnode;override; @@ -218,13 +218,13 @@ implementation end; - function tloadparentfpnode._getcopy : tnode; + function tloadparentfpnode.getcopy : tnode; var p : tloadparentfpnode; begin - p:=tloadparentfpnode(inherited _getcopy); + p:=tloadparentfpnode(inherited getcopy); p.parentpd:=parentpd; - _getcopy:=p; + getcopy:=p; end; @@ -320,15 +320,15 @@ implementation end; - function taddrnode._getcopy : tnode; + function taddrnode.getcopy : tnode; var p : taddrnode; begin - p:=taddrnode(inherited _getcopy); + p:=taddrnode(inherited getcopy); p.getprocvardef:=getprocvardef; - _getcopy:=p; + getcopy:=p; end; @@ -558,15 +558,15 @@ implementation end; - function tsubscriptnode._getcopy : tnode; + function tsubscriptnode.getcopy : tnode; var p : tsubscriptnode; begin - p:=tsubscriptnode(inherited _getcopy); + p:=tsubscriptnode(inherited getcopy); p.vs:=vs; - _getcopy:=p; + getcopy:=p; end; @@ -641,17 +641,6 @@ implementation resulttypepass(left); resulttypepass(right); - { implicitly convert stringconstant to stringdef, - see tbs/tb0476.pp for a test } - if (left.nodetype=stringconstn) and - (tstringconstnode(left).st_type=st_conststring) then - begin - if tstringconstnode(left).len>255 then - inserttypeconv(left,cansistringtype) - else - inserttypeconv(left,cshortstringtype); - end; - { In p[1] p is always valid, it is not possible to declared a shortstring or normal array that has undefined number of elements. Dynamic array and @@ -881,17 +870,17 @@ implementation end; - function twithnode._getcopy : tnode; + function twithnode.getcopy : tnode; var p : twithnode; begin - p:=twithnode(inherited _getcopy); + p:=twithnode(inherited getcopy); p.withsymtable:=withsymtable; p.tablecount:=tablecount; if assigned(p.withrefnode) then - p.withrefnode:=withrefnode._getcopy + p.withrefnode:=withrefnode.getcopy else p.withrefnode:=nil; result:=p; diff --git a/compiler/nobj.pas b/compiler/nobj.pas index df059347c0..55281b1771 100644 --- a/compiler/nobj.pas +++ b/compiler/nobj.pas @@ -118,7 +118,7 @@ interface {$endif WITHDMT} { interfaces } function genintftable: tasmlabel; - { write the VMT to al_globals } + { write the VMT to datasegment } procedure writevmt; procedure writeinterfaceids; end; @@ -129,8 +129,10 @@ implementation uses strings, globals,verbose,systems, - symtable,symconst,symtype,defcmp, - dbgbase + symtable,symconst,symtype,defcmp +{$ifdef GDB} + ,gdb +{$endif GDB} ; @@ -261,13 +263,13 @@ implementation objectlibrary.getdatalabel(p^.nl); if assigned(p^.l) then writenames(p^.l); - asmlist[al_globals].concat(cai_align.create(const_align(sizeof(aint)))); - asmlist[al_globals].concat(Tai_label.Create(p^.nl)); + datasegment.concat(cai_align.create(const_align(sizeof(aint)))); + dataSegment.concat(Tai_label.Create(p^.nl)); len:=strlen(p^.data.messageinf.str); - asmlist[al_globals].concat(tai_const.create_8bit(len)); + datasegment.concat(tai_const.create_8bit(len)); getmem(ca,len+1); move(p^.data.messageinf.str^,ca^,len+1); - asmlist[al_globals].concat(Tai_string.Create_pchar(ca,len)); + dataSegment.concat(Tai_string.Create_pchar(ca)); if assigned(p^.r) then writenames(p^.r); end; @@ -279,8 +281,8 @@ implementation writestrentry(p^.l); { write name label } - asmlist[al_globals].concat(Tai_const.Create_sym(p^.nl)); - asmlist[al_globals].concat(Tai_const.Createname(p^.data.mangledname,AT_FUNCTION,0)); + dataSegment.concat(Tai_const.Create_sym(p^.nl)); + dataSegment.concat(Tai_const.Createname(p^.data.mangledname,AT_FUNCTION,0)); if assigned(p^.r) then writestrentry(p^.r); @@ -303,10 +305,10 @@ implementation { now start writing of the message string table } objectlibrary.getdatalabel(r); - asmlist[al_globals].concat(cai_align.create(const_align(sizeof(aint)))); - asmlist[al_globals].concat(Tai_label.Create(r)); + datasegment.concat(cai_align.create(const_align(sizeof(aint)))); + dataSegment.concat(Tai_label.Create(r)); genstrmsgtab:=r; - asmlist[al_globals].concat(Tai_const.Create_32bit(count)); + dataSegment.concat(Tai_const.Create_32bit(count)); if assigned(root) then begin writestrentry(root); @@ -321,8 +323,8 @@ implementation writeintentry(p^.l); { write name label } - asmlist[al_globals].concat(Tai_const.Create_32bit(p^.data.messageinf.i)); - asmlist[al_globals].concat(Tai_const.Createname(p^.data.mangledname,AT_FUNCTION,0)); + dataSegment.concat(Tai_const.Create_32bit(p^.data.messageinf.i)); + dataSegment.concat(Tai_const.Createname(p^.data.mangledname,AT_FUNCTION,0)); if assigned(p^.r) then writeintentry(p^.r); @@ -341,10 +343,10 @@ implementation { now start writing of the message string table } objectlibrary.getdatalabel(r); - asmlist[al_globals].concat(cai_align.create(const_align(sizeof(aint)))); - asmlist[al_globals].concat(Tai_label.Create(r)); + datasegment.concat(cai_align.create(const_align(sizeof(aint)))); + dataSegment.concat(Tai_label.Create(r)); genintmsgtab:=r; - asmlist[al_globals].concat(Tai_const.Create_32bit(count)); + dataSegment.concat(Tai_const.Create_32bit(count)); if assigned(root) then begin writeintentry(root); @@ -388,7 +390,7 @@ implementation begin if assigned(p^.l) then writedmtindexentry(p^.l); - al_globals.concat(Tai_const.Create_32bit(p^.data.messageinf.i)); + dataSegment.concat(Tai_const.Create_32bit(p^.data.messageinf.i)); if assigned(p^.r) then writedmtindexentry(p^.r); end; @@ -398,7 +400,7 @@ implementation begin if assigned(p^.l) then writedmtaddressentry(p^.l); - al_globals.concat(Tai_const_symbol.Createname(p^.data.mangledname,AT_FUNCTION,0)); + dataSegment.concat(Tai_const_symbol.Createname(p^.data.mangledname,AT_FUNCTION,0)); if assigned(p^.r) then writedmtaddressentry(p^.r); end; @@ -419,13 +421,13 @@ implementation begin objectlibrary.getdatalabel(r); gendmt:=r; - al_globals.concat(cai_align.create(const_align(sizeof(aint)))); - al_globals.concat(Tai_label.Create(r)); + datasegment.concat(cai_align.create(const_align(sizeof(aint)))); + dataSegment.concat(Tai_label.Create(r)); { entries for caching } - al_globals.concat(Tai_const.Create_ptr(0)); - al_globals.concat(Tai_const.Create_ptr(0)); + dataSegment.concat(Tai_const.Create_ptr(0)); + dataSegment.concat(Tai_const.Create_ptr(0)); - al_globals.concat(Tai_const.Create_32bit(count)); + dataSegment.concat(Tai_const.Create_32bit(count)); if assigned(root) then begin writedmtindexentry(root); @@ -475,16 +477,16 @@ implementation begin objectlibrary.getdatalabel(l); - asmlist[al_typedconsts].concat(cai_align.create(const_align(sizeof(aint)))); - asmlist[al_typedconsts].concat(Tai_label.Create(l)); - asmlist[al_typedconsts].concat(Tai_const.Create_8bit(length(tsym(p).realname))); - asmlist[al_typedconsts].concat(Tai_string.Create(tsym(p).realname)); + consts.concat(cai_align.create(const_align(sizeof(aint)))); + Consts.concat(Tai_label.Create(l)); + Consts.concat(Tai_const.Create_8bit(length(tsym(p).realname))); + Consts.concat(Tai_string.Create(tsym(p).realname)); - asmlist[al_globals].concat(Tai_const.Create_sym(l)); + dataSegment.concat(Tai_const.Create_sym(l)); if po_abstractmethod in pd.procoptions then - asmlist[al_globals].concat(Tai_const.Create_sym(nil)) + dataSegment.concat(Tai_const.Create_sym(nil)) else - asmlist[al_globals].concat(Tai_const.Createname(pd.mangledname,AT_FUNCTION,0)); + dataSegment.concat(Tai_const.Createname(pd.mangledname,AT_FUNCTION,0)); end; end; end; @@ -503,9 +505,9 @@ implementation if count>0 then begin objectlibrary.getdatalabel(l); - asmlist[al_globals].concat(cai_align.create(const_align(sizeof(aint)))); - asmlist[al_globals].concat(Tai_label.Create(l)); - asmlist[al_globals].concat(Tai_const.Create_32bit(count)); + datasegment.concat(cai_align.create(const_align(sizeof(aint)))); + dataSegment.concat(Tai_label.Create(l)); + dataSegment.concat(Tai_const.Create_32bit(count)); _class.symtable.foreach(@do_gen_published_methods,nil); genpublishedmethodstable:=l; end @@ -866,8 +868,11 @@ implementation begin implintf:=_class.implementedinterfaces; curintf:=implintf.interfaces(intfindex); - - section_symbol_start(rawdata,gintfgetvtbllabelname(intfindex),AT_DATA,true,sec_data,const_align(sizeof(aint))); + rawdata.concat(cai_align.create(const_align(sizeof(aint)))); + if maybe_smartlink_symbol then + rawdata.concat(Tai_symbol.Createname_global(gintfgetvtbllabelname(intfindex),AT_DATA ,0)) + else + rawdata.concat(Tai_symbol.Createname(gintfgetvtbllabelname(intfindex),AT_DATA,0)); proccount:=implintf.implproccount(intfindex); for i:=1 to proccount do begin @@ -877,7 +882,6 @@ implementation { create reference } rawdata.concat(Tai_const.Createname(tmps,AT_FUNCTION,0)); end; - section_symbol_end(rawdata,gintfgetvtbllabelname(intfindex)); end; @@ -902,17 +906,17 @@ implementation rawdata.concat(Tai_const.Create_16bit(curintf.iidguid^.D3)); for i:=Low(curintf.iidguid^.D4) to High(curintf.iidguid^.D4) do rawdata.concat(Tai_const.Create_8bit(curintf.iidguid^.D4[i])); - asmlist[al_globals].concat(Tai_const.Create_sym(tmplabel)); + dataSegment.concat(Tai_const.Create_sym(tmplabel)); end else begin { nil for Corba interfaces } - asmlist[al_globals].concat(Tai_const.Create_sym(nil)); + dataSegment.concat(Tai_const.Create_sym(nil)); end; { VTable } - asmlist[al_globals].concat(Tai_const.Createname(gintfgetvtbllabelname(contintfindex),AT_DATA,0)); + dataSegment.concat(Tai_const.Createname(gintfgetvtbllabelname(contintfindex),AT_DATA,0)); { IOffset field } - asmlist[al_globals].concat(Tai_const.Create_32bit(implintf.ioffsets(contintfindex))); + dataSegment.concat(Tai_const.Create_32bit(implintf.ioffsets(contintfindex))); { IIDStr } objectlibrary.getdatalabel(tmplabel); rawdata.concat(cai_align.create(const_align(sizeof(aint)))); @@ -922,7 +926,7 @@ implementation rawdata.concat(Tai_string.Create(upper(curintf.iidstr^))) else rawdata.concat(Tai_string.Create(curintf.iidstr^)); - asmlist[al_globals].concat(Tai_const.Create_sym(tmplabel)); + dataSegment.concat(Tai_const.Create_sym(tmplabel)); end; @@ -1033,7 +1037,7 @@ implementation max:=_class.implementedinterfaces.count; rawdata:=TAAsmOutput.Create; - asmlist[al_globals].concat(Tai_const.Create_16bit(max)); + dataSegment.concat(Tai_const.Create_16bit(max)); { Two pass, one for allocation and vtbl creation } for i:=1 to max do begin @@ -1058,7 +1062,7 @@ implementation _class.implementedinterfaces.setioffsets(i,_class.implementedinterfaces.ioffsets(j)); gintfgenentry(i,j,rawdata); end; - asmlist[al_globals].concatlist(rawdata); + dataSegment.concatlist(rawdata); rawdata.free; end; @@ -1158,8 +1162,8 @@ implementation { 2. step calc required fieldcount and their offsets in the object memory map and write data } objectlibrary.getdatalabel(intftable); - asmlist[al_globals].concat(cai_align.create(const_align(sizeof(aint)))); - asmlist[al_globals].concat(Tai_label.Create(intftable)); + dataSegment.concat(cai_align.create(const_align(sizeof(aint)))); + dataSegment.concat(Tai_label.Create(intftable)); { Optimize interface tables to reuse wrappers } gintfoptimizevtbls; { Write interface tables } @@ -1177,21 +1181,21 @@ implementation if assigned(_class.iidguid) then begin s:=make_mangledname('IID',_class.owner,_class.objname^); - maybe_new_object_file(asmlist[al_globals]); - new_section(asmlist[al_globals],sec_rodata,s,const_align(sizeof(aint))); - asmlist[al_globals].concat(Tai_symbol.Createname_global(s,AT_DATA,0)); - asmlist[al_globals].concat(Tai_const.Create_32bit(longint(_class.iidguid^.D1))); - asmlist[al_globals].concat(Tai_const.Create_16bit(_class.iidguid^.D2)); - asmlist[al_globals].concat(Tai_const.Create_16bit(_class.iidguid^.D3)); + maybe_new_object_file(dataSegment); + new_section(dataSegment,sec_rodata,s,const_align(sizeof(aint))); + dataSegment.concat(Tai_symbol.Createname_global(s,AT_DATA,0)); + dataSegment.concat(Tai_const.Create_32bit(longint(_class.iidguid^.D1))); + dataSegment.concat(Tai_const.Create_16bit(_class.iidguid^.D2)); + dataSegment.concat(Tai_const.Create_16bit(_class.iidguid^.D3)); for i:=Low(_class.iidguid^.D4) to High(_class.iidguid^.D4) do - asmlist[al_globals].concat(Tai_const.Create_8bit(_class.iidguid^.D4[i])); + dataSegment.concat(Tai_const.Create_8bit(_class.iidguid^.D4[i])); end; - maybe_new_object_file(asmlist[al_globals]); + maybe_new_object_file(dataSegment); s:=make_mangledname('IIDSTR',_class.owner,_class.objname^); - new_section(asmlist[al_globals],sec_rodata,s,0); - asmlist[al_globals].concat(Tai_symbol.Createname_global(s,AT_DATA,0)); - asmlist[al_globals].concat(Tai_const.Create_8bit(length(_class.iidstr^))); - asmlist[al_globals].concat(Tai_string.Create(_class.iidstr^)); + new_section(dataSegment,sec_rodata,s,0); + dataSegment.concat(Tai_symbol.Createname_global(s,AT_DATA,0)); + dataSegment.concat(Tai_const.Create_8bit(length(_class.iidstr^))); + dataSegment.concat(Tai_string.Create(_class.iidstr^)); end; @@ -1256,8 +1260,8 @@ implementation if is_class(_class) then begin objectlibrary.getdatalabel(classnamelabel); - maybe_new_object_file(asmlist[al_globals]); - new_section(asmlist[al_globals],sec_rodata,classnamelabel.name,const_align(sizeof(aint))); + maybe_new_object_file(dataSegment); + new_section(dataSegment,sec_rodata,classnamelabel.name,const_align(sizeof(aint))); { interface table } if _class.implementedinterfaces.count>0 then @@ -1266,9 +1270,9 @@ implementation methodnametable:=genpublishedmethodstable; fieldtablelabel:=_class.generate_field_table; { write class name } - asmlist[al_globals].concat(Tai_label.Create(classnamelabel)); - asmlist[al_globals].concat(Tai_const.Create_8bit(length(_class.objrealname^))); - asmlist[al_globals].concat(Tai_string.Create(_class.objrealname^)); + dataSegment.concat(Tai_label.Create(classnamelabel)); + dataSegment.concat(Tai_const.Create_8bit(length(_class.objrealname^))); + dataSegment.concat(Tai_string.Create(_class.objrealname^)); { generate message and dynamic tables } if (oo_has_msgstr in _class.objectoptions) then @@ -1278,21 +1282,30 @@ implementation end; { write debug info } - maybe_new_object_file(asmlist[al_globals]); - new_section(asmlist[al_globals],sec_rodata,_class.vmt_mangledname,const_align(sizeof(aint))); - asmlist[al_globals].concat(Tai_symbol.Createname_global(_class.vmt_mangledname,AT_DATA,0)); + maybe_new_object_file(dataSegment); + new_section(dataSegment,sec_rodata,_class.vmt_mangledname,const_align(sizeof(aint))); +{$ifdef GDB} + if (cs_debuginfo in aktmoduleswitches) then + begin + do_count_dbx:=true; + if assigned(_class.owner) and assigned(_class.owner.name) then + dataSegment.concat(Tai_stabs.Create(strpnew('"vmt_'+_class.owner.name^+_class.name+':S'+ + tstoreddef(vmttype.def).numberstring+'",'+tostr(N_STSYM)+',0,0,'+_class.vmt_mangledname))); + end; +{$endif GDB} + dataSegment.concat(Tai_symbol.Createname_global(_class.vmt_mangledname,AT_DATA,0)); { determine the size with symtable.datasize, because } { size gives back 4 for classes } - asmlist[al_globals].concat(Tai_const.Create(ait_const_ptr,tobjectsymtable(_class.symtable).datasize)); - asmlist[al_globals].concat(Tai_const.Create(ait_const_ptr,-int64(tobjectsymtable(_class.symtable).datasize))); + dataSegment.concat(Tai_const.Create(ait_const_ptr,tobjectsymtable(_class.symtable).datasize)); + dataSegment.concat(Tai_const.Create(ait_const_ptr,-int64(tobjectsymtable(_class.symtable).datasize))); {$ifdef WITHDMT} if _class.classtype=ct_object then begin if assigned(dmtlabel) then - asmlist[al_globals].concat(Tai_const_symbol.Create(dmtlabel))) + dataSegment.concat(Tai_const_symbol.Create(dmtlabel))) else - asmlist[al_globals].concat(Tai_const.Create_ptr(0)); + dataSegment.concat(Tai_const.Create_ptr(0)); end; {$endif WITHDMT} { write pointer to parent VMT, this isn't implemented in TP } @@ -1301,52 +1314,52 @@ implementation { it is not written for parents that don't have any vmt !! } if assigned(_class.childof) and (oo_has_vmt in _class.childof.objectoptions) then - asmlist[al_globals].concat(Tai_const.Createname(_class.childof.vmt_mangledname,AT_DATA,0)) + dataSegment.concat(Tai_const.Createname(_class.childof.vmt_mangledname,AT_DATA,0)) else - asmlist[al_globals].concat(Tai_const.Create_sym(nil)); + dataSegment.concat(Tai_const.Create_sym(nil)); { write extended info for classes, for the order see rtl/inc/objpash.inc } if is_class(_class) then begin { pointer to class name string } - asmlist[al_globals].concat(Tai_const.Create_sym(classnamelabel)); + dataSegment.concat(Tai_const.Create_sym(classnamelabel)); { pointer to dynamic table or nil } if (oo_has_msgint in _class.objectoptions) then - asmlist[al_globals].concat(Tai_const.Create_sym(intmessagetable)) + dataSegment.concat(Tai_const.Create_sym(intmessagetable)) else - asmlist[al_globals].concat(Tai_const.Create_sym(nil)); + dataSegment.concat(Tai_const.Create_sym(nil)); { pointer to method table or nil } - asmlist[al_globals].concat(Tai_const.Create_sym(methodnametable)); + dataSegment.concat(Tai_const.Create_sym(methodnametable)); { pointer to field table } - asmlist[al_globals].concat(Tai_const.Create_sym(fieldtablelabel)); + dataSegment.concat(Tai_const.Create_sym(fieldtablelabel)); { pointer to type info of published section } if (oo_can_have_published in _class.objectoptions) then - asmlist[al_globals].concat(Tai_const.Create_sym(_class.get_rtti_label(fullrtti))) + dataSegment.concat(Tai_const.Create_sym(_class.get_rtti_label(fullrtti))) else - asmlist[al_globals].concat(Tai_const.Create_sym(nil)); + dataSegment.concat(Tai_const.Create_sym(nil)); { inittable for con-/destruction } if _class.members_need_inittable then - asmlist[al_globals].concat(Tai_const.Create_sym(_class.get_rtti_label(initrtti))) + dataSegment.concat(Tai_const.Create_sym(_class.get_rtti_label(initrtti))) else - asmlist[al_globals].concat(Tai_const.Create_sym(nil)); + dataSegment.concat(Tai_const.Create_sym(nil)); { auto table } - asmlist[al_globals].concat(Tai_const.Create_sym(nil)); + dataSegment.concat(Tai_const.Create_sym(nil)); { interface table } if _class.implementedinterfaces.count>0 then - asmlist[al_globals].concat(Tai_const.Create_sym(interfacetable)) + dataSegment.concat(Tai_const.Create_sym(interfacetable)) else - asmlist[al_globals].concat(Tai_const.Create_sym(nil)); + dataSegment.concat(Tai_const.Create_sym(nil)); { table for string messages } if (oo_has_msgstr in _class.objectoptions) then - asmlist[al_globals].concat(Tai_const.Create_sym(strmessagetable)) + dataSegment.concat(Tai_const.Create_sym(strmessagetable)) else - asmlist[al_globals].concat(Tai_const.Create_sym(nil)); + dataSegment.concat(Tai_const.Create_sym(nil)); end; { write virtual methods } - writevirtualmethods(asmlist[al_globals]); - asmlist[al_globals].concat(Tai_const.create(ait_const_ptr,0)); + writevirtualmethods(dataSegment); + datasegment.concat(Tai_const.create(ait_const_ptr,0)); { write the size of the VMT } - asmlist[al_globals].concat(Tai_symbol_end.Createname(_class.vmt_mangledname)); + dataSegment.concat(Tai_symbol_end.Createname(_class.vmt_mangledname)); end; diff --git a/compiler/node.pas b/compiler/node.pas index 330833d5cf..372aa79e1b 100644 --- a/compiler/node.pas +++ b/compiler/node.pas @@ -304,10 +304,8 @@ interface function pass_1 : tnode;virtual;abstract; { dermines the resulttype of the node } function det_resulttype : tnode;virtual;abstract; - - { tries to simplify the node, returns a value <>nil if a simplified - node has been created } - function simplify : tnode;virtual; + { dermines the number of necessary temp. locations to evaluate + the node } {$ifdef state_tracking} { Does optimizations by keeping track of the variable states in a procedure } @@ -316,8 +314,6 @@ interface { For a t1:=t2 tree, mark the part of the tree t1 that gets written to (normally the loadnode) as write access. } procedure mark_write;virtual; - { dermines the number of necessary temp. locations to evaluate - the node } procedure det_temp;virtual;abstract; procedure pass_2;virtual;abstract; @@ -326,11 +322,8 @@ interface function isequal(p : tnode) : boolean; { to implement comparisation, override this method } function docompare(p : tnode) : boolean;virtual; - { wrapper for getcopy } - function getcopy : tnode; - - { does the real copying of a node } - function _getcopy : tnode;virtual; + { gets a copy of the node } + function getcopy : tnode;virtual; procedure insertintolist(l : tnodelist);virtual; { writes a node for debugging purpose, shouldn't be called } @@ -363,7 +356,7 @@ interface procedure concattolist(l : tlinkedlist);override; function ischild(p : tnode) : boolean;override; function docompare(p : tnode) : boolean;override; - function _getcopy : tnode;override; + function getcopy : tnode;override; procedure insertintolist(l : tnodelist);override; procedure left_max; procedure printnodedata(var t:text);override; @@ -383,7 +376,7 @@ interface function ischild(p : tnode) : boolean;override; function docompare(p : tnode) : boolean;override; procedure swapleftright; - function _getcopy : tnode;override; + function getcopy : tnode;override; procedure insertintolist(l : tnodelist);override; procedure left_right_max; procedure printnodedata(var t:text);override; @@ -724,12 +717,6 @@ implementation end; - function tnode.simplify : tnode; - begin - result:=nil; - end; - - destructor tnode.destroy; begin {$ifdef EXTDEBUG} @@ -818,12 +805,6 @@ implementation function tnode.getcopy : tnode; - begin - result:=_getcopy; - end; - - - function tnode._getcopy : tnode; var p : tnode; begin @@ -848,7 +829,7 @@ implementation p.firstpasscount:=firstpasscount; {$endif extdebug} { p.list:=list; } - result:=p; + getcopy:=p; end; @@ -921,16 +902,16 @@ implementation end; - function tunarynode._getcopy : tnode; + function tunarynode.getcopy : tnode; var p : tunarynode; begin - p:=tunarynode(inherited _getcopy); + p:=tunarynode(inherited getcopy); if assigned(left) then - p.left:=left._getcopy + p.left:=left.getcopy else p.left:=nil; - result:=p; + getcopy:=p; end; @@ -1052,16 +1033,16 @@ implementation end; - function tbinarynode._getcopy : tnode; + function tbinarynode.getcopy : tnode; var p : tbinarynode; begin - p:=tbinarynode(inherited _getcopy); + p:=tbinarynode(inherited getcopy); if assigned(right) then - p.right:=right._getcopy + p.right:=right.getcopy else p.right:=nil; - result:=p; + getcopy:=p; end; diff --git a/compiler/nopt.pas b/compiler/nopt.pas index d5cbb08f82..88d4a196fc 100644 --- a/compiler/nopt.pas +++ b/compiler/nopt.pas @@ -40,7 +40,7 @@ type { By default, pass_2 is the same as for addnode } { Only if there's a processor specific implementation, it } { will be overridden. } - function _getcopy: tnode; override; + function getcopy: tnode; override; function docompare(p: tnode): boolean; override; end; @@ -51,7 +51,7 @@ type { pass_1 must be overridden, otherwise we get an endless loop } function det_resulttype: tnode; override; function pass_1: tnode; override; - function _getcopy: tnode; override; + function getcopy: tnode; override; function docompare(p: tnode): boolean; override; protected procedure updatecurmaxlen; @@ -101,13 +101,13 @@ begin subnodetype := ts; end; -function taddoptnode._getcopy: tnode; +function taddoptnode.getcopy: tnode; var hp: taddoptnode; begin - hp := taddoptnode(inherited _getcopy); + hp := taddoptnode(inherited getcopy); hp.subnodetype := subnodetype; - _getcopy := hp; + getcopy := hp; end; function taddoptnode.docompare(p: tnode): boolean; @@ -143,13 +143,13 @@ begin include(current_procinfo.flags,pi_do_call); end; -function taddsstringoptnode._getcopy: tnode; +function taddsstringoptnode.getcopy: tnode; var hp: taddsstringoptnode; begin - hp := taddsstringoptnode(inherited _getcopy); + hp := taddsstringoptnode(inherited getcopy); hp.curmaxlen := curmaxlen; - _getcopy := hp; + getcopy := hp; end; function taddsstringoptnode.docompare(p: tnode): boolean; diff --git a/compiler/nset.pas b/compiler/nset.pas index 94870d0166..b8ec71963f 100644 --- a/compiler/nset.pas +++ b/compiler/nset.pas @@ -82,7 +82,7 @@ interface procedure ppuwrite(ppufile:tcompilerppufile);override; procedure buildderefimpl;override; procedure derefimpl;override; - function _getcopy : tnode;override; + function getcopy : tnode;override; procedure insertintolist(l : tnodelist);override; function det_resulttype:tnode;override; function pass_1 : tnode;override; @@ -655,15 +655,15 @@ implementation end; - function tcasenode._getcopy : tnode; + function tcasenode.getcopy : tnode; var n : tcasenode; i : longint; begin - n:=tcasenode(inherited _getcopy); + n:=tcasenode(inherited getcopy); if assigned(elseblock) then - n.elseblock:=elseblock._getcopy + n.elseblock:=elseblock.getcopy else n.elseblock:=nil; if assigned(labels) then @@ -677,12 +677,12 @@ implementation begin if not assigned(blocks[i]) then internalerror(200411302); - n.addblock(i,pcaseblock(blocks[i])^.statement._getcopy); + n.addblock(i,pcaseblock(blocks[i])^.statement.getcopy); end; end else n.labels:=nil; - _getcopy:=n; + getcopy:=n; end; procedure tcasenode.insertintolist(l : tnodelist); diff --git a/compiler/nutils.pas b/compiler/nutils.pas index 8af3f79d8a..ffe02de0a5 100644 --- a/compiler/nutils.pas +++ b/compiler/nutils.pas @@ -45,15 +45,12 @@ interface fen_norecurse_true ); - tforeachprocmethod = (pm_preprocess,pm_postprocess); - foreachnodefunction = function(var n: tnode; arg: pointer): foreachnoderesult of object; staticforeachnodefunction = function(var n: tnode; arg: pointer): foreachnoderesult; function foreachnode(var n: tnode; f: foreachnodefunction; arg: pointer): boolean; function foreachnodestatic(var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean; - function foreachnodestatic(procmethod : tforeachprocmethod;var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean; procedure load_procvar_from_calln(var p1:tnode); function maybe_call_procvar(var p1:tnode;tponly:boolean):boolean; @@ -71,9 +68,6 @@ interface function node_complexity(p: tnode): cardinal; procedure node_tree_set_filepos(var n:tnode;const filepos:tfileposinfo); - { tries to simplify the given node } - procedure dosimplify(var n : tnode); - implementation @@ -111,6 +105,9 @@ implementation begin { not in one statement, won't work because of b- } result := foreachnode(tcallnode(n).methodpointer,f,arg) or result; +{$ifdef PASS2INLINE} + result := foreachnode(tcallnode(n).inlinecode,f,arg) or result; +{$endif PASS2INLINE} end; ifn, whilerepeatn, forn: begin @@ -138,49 +135,13 @@ implementation end; - function foreachnodestatic(procmethod : tforeachprocmethod;var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean; - - function process_children(res : boolean) : boolean; - var - i: longint; - begin - result:=res; - case n.nodetype of - calln: - begin - result := foreachnodestatic(procmethod,tcallnode(n).methodpointer,f,arg) or result; - end; - ifn, whilerepeatn, forn: - begin - { not in one statement, won't work because of b- } - result := foreachnodestatic(procmethod,tloopnode(n).t1,f,arg) or result; - result := foreachnodestatic(procmethod,tloopnode(n).t2,f,arg) or result; - end; - raisen: - result := foreachnodestatic(traisenode(n).frametree,f,arg) or result; - casen: - begin - for i := 0 to tcasenode(n).blocks.count-1 do - if assigned(tcasenode(n).blocks[i]) then - result := foreachnodestatic(procmethod,pcaseblock(tcasenode(n).blocks[i])^.statement,f,arg) or result; - result := foreachnodestatic(procmethod,tcasenode(n).elseblock,f,arg) or result; - end; - end; - if n.inheritsfrom(tbinarynode) then - begin - result := foreachnodestatic(procmethod,tbinarynode(n).right,f,arg) or result; - result := foreachnodestatic(procmethod,tbinarynode(n).left,f,arg) or result; - end - else if n.inheritsfrom(tunarynode) then - result := foreachnodestatic(procmethod,tunarynode(n).left,f,arg) or result; - end; - + function foreachnodestatic(var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean; + var + i: longint; begin result := false; if not assigned(n) then exit; - if procmethod=pm_preprocess then - result:=process_children(result); case f(n,arg) of fen_norecurse_false: exit; @@ -195,15 +156,38 @@ implementation fen_false: result := false; } end; - if procmethod=pm_postprocess then - result:=process_children(result); - end; - - - function foreachnodestatic(var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean; - begin - result:=foreachnodestatic(pm_postprocess,n,f,arg); + case n.nodetype of + calln: + begin + result := foreachnodestatic(tcallnode(n).methodpointer,f,arg) or result; +{$ifdef PASS2INLINE} + result := foreachnodestatic(tcallnode(n).inlinecode,f,arg) or result; +{$endif PASS2INLINE} + end; + ifn, whilerepeatn, forn: + begin + { not in one statement, won't work because of b- } + result := foreachnodestatic(tloopnode(n).t1,f,arg) or result; + result := foreachnodestatic(tloopnode(n).t2,f,arg) or result; + end; + raisen: + result := foreachnodestatic(traisenode(n).frametree,f,arg) or result; + casen: + begin + for i := 0 to tcasenode(n).blocks.count-1 do + if assigned(tcasenode(n).blocks[i]) then + result := foreachnodestatic(pcaseblock(tcasenode(n).blocks[i])^.statement,f,arg) or result; + result := foreachnodestatic(tcasenode(n).elseblock,f,arg) or result; + end; end; + if n.inheritsfrom(tbinarynode) then + begin + result := foreachnodestatic(tbinarynode(n).right,f,arg) or result; + result := foreachnodestatic(tbinarynode(n).left,f,arg) or result; + end + else if n.inheritsfrom(tunarynode) then + result := foreachnodestatic(tunarynode(n).left,f,arg) or result; + end; procedure load_procvar_from_calln(var p1:tnode); @@ -298,13 +282,10 @@ implementation begin result:=cloadnode.create(srsym,srsymtable); include(result.flags,nf_is_self); + resulttypepass(result); end else - begin - result:=cerrornode.create; - CGMessage(parser_e_illegal_expression); - end; - resulttypepass(result); + CGMessage(parser_e_illegal_expression); end; @@ -316,13 +297,12 @@ implementation result:=nil; searchsym('result',srsym,srsymtable); if assigned(srsym) then - result:=cloadnode.create(srsym,srsymtable) - else begin - result:=cerrornode.create; - CGMessage(parser_e_illegal_expression); - end; - resulttypepass(result); + result:=cloadnode.create(srsym,srsymtable); + resulttypepass(result); + end + else + CGMessage(parser_e_illegal_expression); end; @@ -337,13 +317,10 @@ implementation begin result:=cloadnode.create(srsym,srsymtable); include(result.flags,nf_load_self_pointer); + resulttypepass(result); end else - begin - result:=cerrornode.create; - CGMessage(parser_e_illegal_expression); - end; - resulttypepass(result); + CGMessage(parser_e_illegal_expression); end; @@ -355,13 +332,12 @@ implementation result:=nil; searchsym('vmt',srsym,srsymtable); if assigned(srsym) then - result:=cloadnode.create(srsym,srsymtable) - else begin - result:=cerrornode.create; - CGMessage(parser_e_illegal_expression); - end; - resulttypepass(result); + result:=cloadnode.create(srsym,srsymtable); + resulttypepass(result); + end + else + CGMessage(parser_e_illegal_expression); end; @@ -583,37 +559,4 @@ implementation foreachnodestatic(n,@setnodefilepos,@filepos); end; -{$ifdef FPCMT} - threadvar -{$else FPCMT} - var -{$endif FPCMT} - treechanged : boolean; - - function callsimplify(var n: tnode; arg: pointer): foreachnoderesult; - var - hn : tnode; - begin - result:=fen_false; - - do_resulttypepass(n); - - hn:=n.simplify; - if assigned(hn) then - begin - treechanged:=true; - n:=hn; - end; - end; - - - { tries to simplify the given node calling the simplify method recursively } - procedure dosimplify(var n : tnode); - begin - repeat - treechanged:=false; - foreachnodestatic(pm_preprocess,n,@callsimplify,nil); - until not(treechanged); - end; - end. diff --git a/compiler/ogcoff.pas b/compiler/ogcoff.pas index 877905ad57..2eb31a4336 100644 --- a/compiler/ogcoff.pas +++ b/compiler/ogcoff.pas @@ -70,7 +70,8 @@ interface function sectionname(atype:tasmsectiontype;const aname:string):string;override; procedure writereloc(data,len:aint;p:tasmsymbol;relative:TAsmRelocationType);override; procedure writesymbol(p:tasmsymbol);override; - procedure writestab(offset:aint;ps:tasmsymbol;nidx,nother,line:longint;p:pchar);override; + procedure writestabs(offset:aint;p:pchar;nidx,nother,line:longint;reloc:boolean);override; + procedure writesymstabs(offset:aint;p:pchar;ps:tasmsymbol;nidx,nother,line:longint;reloc:boolean);override; procedure beforealloc;override; procedure beforewrite;override; procedure afteralloc;override; @@ -535,7 +536,7 @@ const go32v2stub : array[0..2047] of byte=( createsection(sec_code,'',0,[]); createsection(sec_data,'',0,[]); createsection(sec_bss,'',0,[]); - if (cs_use_lineinfo in aktglobalswitches) or + if (cs_gdb_lineinfo in aktglobalswitches) or (cs_debuginfo in aktmoduleswitches) then begin stabssec:=createsection(sec_stab,'',0,[]); @@ -553,10 +554,9 @@ const go32v2stub : array[0..2047] of byte=( function TCoffObjectData.sectionname(atype:tasmsectiontype;const aname:string):string; const secnames : array[tasmsectiontype] of string[16] = ('', - '.text','.data','.data','.bss','.threadvar', + '.text','.data','.data','.bss', 'common', '.note', - '.text', '.stab','.stabstr', '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata', '.eh_frame', @@ -660,16 +660,74 @@ const go32v2stub : array[0..2047] of byte=( end; - procedure tcoffobjectdata.writestab(offset:aint;ps:tasmsymbol;nidx,nother,line:longint;p:pchar); + procedure tcoffobjectdata.writestabs(offset:aint;p:pchar;nidx,nother,line:longint;reloc : boolean); var stab : coffstab; curraddr : longint; begin - { Win32 does not need an offset if a symbol relocation is used } - if win32 and - assigned(ps) and - (ps.currbind<>AB_LOCAL) then + { local var can be at offset -1 !! PM } + if reloc then + begin + if (offset=-1) then + begin + if currsec=nil then + offset:=0 + else + offset:=currsec.datasize; + end; + if (currsec<>nil) then + inc(offset,currsec.datapos); + end; + if assigned(p) and (p[0]<>#0) then + begin + stab.strpos:=stabstrsec.datasize; + stabstrsec.write(p^,strlen(p)+1); + end + else + stab.strpos:=0; + stab.ntype:=nidx; + stab.ndesc:=line; + stab.nother:=nother; + stab.nvalue:=offset; + StabsSec.write(stab,sizeof(stab)); + { when the offset is not 0 then write a relocation, take also the + hdrstab into account with the offset } + if reloc then + begin + { current address } + curraddr:=StabsSec.mempos+StabsSec.datasize; + if DLLSource and RelocSection then + { avoid relocation in the .stab section + because it ends up in the .reloc section instead } + StabsSec.addsectionreloc(curraddr-4,currsec,RELOC_RVA) + else + StabsSec.addsectionreloc(curraddr-4,currsec,RELOC_ABSOLUTE); + end; + end; + + + procedure tcoffobjectdata.writesymstabs(offset:aint;p:pchar;ps:tasmsymbol;nidx,nother,line:longint;reloc:boolean); + var + stab : coffstab; + curraddr : longint; + begin + { do not use the size stored in offset field + this is DJGPP specific ! PM } + if win32 then offset:=0; + { local var can be at offset -1 !! PM } + if reloc then + begin + if (offset=-1) then + begin + if currsec=nil then + offset:=0 + else + offset:=currsec.datasize; + end; + if (currsec<>nil) then + inc(offset,currsec.mempos); + end; if assigned(p) and (p[0]<>#0) then begin stab.strpos:=StabStrSec.datasize; @@ -682,9 +740,10 @@ const go32v2stub : array[0..2047] of byte=( stab.nother:=nother; stab.nvalue:=offset; StabsSec.write(stab,sizeof(stab)); - if assigned(ps) then + { when the offset is not 0 then write a relocation, take also the + hdrstab into account with the offset } + if reloc then begin - writesymbol(ps); { current address } curraddr:=StabsSec.mempos+StabsSec.datasize; if DLLSource and RelocSection then @@ -727,7 +786,7 @@ const go32v2stub : array[0..2047] of byte=( { create stabs sections if debugging } if (cs_debuginfo in aktmoduleswitches) then begin - writestab(0,nil,0,0,0,nil); + writestabs(0,nil,0,0,0,false); { write zero pchar and name together (PM) } s:=#0+SplitFileName(current_module.mainsource^)+#0; stabstrsec.write(s[1],length(s)); @@ -1017,9 +1076,11 @@ const go32v2stub : array[0..2047] of byte=( calculated more easily } if StabsSec<>nil then begin - { header stab } + { first stabs for main source } + writestabs(0,nil,0,0,0,false); s:=#0+SplitFileName(current_module.mainsource^)+#0; stabstrsec.write(s[1],length(s)); + { header stab } hstab.strpos:=1; hstab.ntype:=0; hstab.nother:=0; @@ -1040,12 +1101,7 @@ const go32v2stub : array[0..2047] of byte=( sympos:=datapos; { COFF header } fillchar(header,sizeof(coffheader),0); -{$ifdef i386} header.mach:=$14c; -{$endif i386} -{$ifdef arm} - header.mach:=$1c0; -{$endif arm} header.nsects:=nsects; header.sympos:=sympos; header.syms:=symbols.count+initsym; @@ -1558,12 +1614,7 @@ const go32v2stub : array[0..2047] of byte=( Comment(V_Error,'Error reading coff file'); exit; end; -{$ifdef i386} if header.mach<>$14c then -{$endif i386} -{$ifdef arm} - if header.mach<>$1c0 then -{$endif arm} begin Comment(V_Error,'Not a coff file'); exit; @@ -1705,6 +1756,7 @@ const go32v2stub : array[0..2047] of byte=( comment : ''; ); + const as_i386_pecoff_info : tasminfo = ( id : as_i386_pecoff; @@ -1729,39 +1781,9 @@ const go32v2stub : array[0..2047] of byte=( comment : ''; ); - as_i386_pecoffwince_info : tasminfo = - ( - id : as_i386_pecoffwince; - idtxt : 'PECOFFWINCE'; - asmbin : ''; - asmcmd : ''; - supported_target : system_i386_wince; - flags : [af_outputbinary]; - labelprefix : '.L'; - comment : ''; - ); - - - as_arm_pecoffwince_info : tasminfo = - ( - id : as_arm_pecoffwince; - idtxt : 'PECOFFWINCE'; - asmbin : ''; - asmcmd : ''; - supported_target : system_arm_wince; - flags : [af_outputbinary]; - labelprefix : '.L'; - comment : ''; - ); initialization -{$ifdef i386} RegisterAssembler(as_i386_coff_info,TCoffAssembler); RegisterAssembler(as_i386_pecoff_info,TPECoffAssembler); RegisterAssembler(as_i386_pecoffwdosx_info,TPECoffAssembler); - RegisterAssembler(as_i386_pecoffwince_info,TPECoffAssembler); -{$endif i386} -{$ifdef arm} - RegisterAssembler(as_arm_pecoffwince_info,TPECoffAssembler); -{$endif arm} end. diff --git a/compiler/ogelf.pas b/compiler/ogelf.pas index 175cc3f6bd..c2deba6166 100644 --- a/compiler/ogelf.pas +++ b/compiler/ogelf.pas @@ -72,7 +72,8 @@ interface function sectionname(atype:tasmsectiontype;const aname:string):string;override; procedure writereloc(data,len:aint;p:tasmsymbol;relative:TAsmRelocationType);override; procedure writesymbol(p:tasmsymbol);override; - procedure writestab(offset:aint;ps:tasmsymbol;nidx,nother,line:longint;p:pchar);override; + procedure writestabs(offset:aint;p:pchar;nidx,nother,line:longint;reloc:boolean);override; + procedure writesymstabs(offset:aint;p:pchar;ps:tasmsymbol;nidx,nother,line:longint;reloc:boolean);override; procedure beforealloc;override; procedure beforewrite;override; end; @@ -235,14 +236,7 @@ implementation AshType:=SHT_PROGBITS; AAlign:=max(sizeof(aint),AAlign); end; - sec_rodata : - begin -{$warning TODO Remove rodata hack} - Ashflags:=SHF_ALLOC or SHF_WRITE; - AshType:=SHT_PROGBITS; - AAlign:=max(sizeof(aint),AAlign); - end; - sec_bss,sec_threadvar : + sec_bss : begin Ashflags:=SHF_ALLOC or SHF_WRITE; AshType:=SHT_NOBITS; @@ -265,8 +259,6 @@ implementation AshType:=SHT_PROGBITS ; AAlign:=4;// max(sizeof(aint),AAlign); end; - else - internalerror(200509122); end; create_ext(Aname,Atype,Ashtype,Ashflags,0,0,Aalign,Aentsize); end; @@ -304,6 +296,8 @@ implementation ****************************************************************************} constructor telf32objectdata.create(const n:string); + var + s : string; begin inherited create(n); CAsmSection:=TElf32Section; @@ -320,9 +314,6 @@ implementation createsection(sec_code,'',0,[]); createsection(sec_data,'',0,[]); createsection(sec_bss,'',0,[]); -{$ifdef segment_threadvars} - createsection(sec_threadvar,'',0,[]); -{$endif} { create stabs sections if debugging } if (cs_debuginfo in aktmoduleswitches) then begin @@ -346,23 +337,23 @@ implementation const secnames : array[tasmsectiontype] of string[12] = ('', {$ifdef userodata} - '.text','.data','.rodata','.bss','.threadvar', + '.text','.data','.rodata','.bss', {$else userodata} - '.text','.data','.data','.bss','.threadvar', + '.text','.data','.data','.bss', {$endif userodata} 'common', '.note', - '.text', { darwin stubs } '.stab','.stabstr', '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata', '.eh_frame', '.debug_frame', - 'fpc' + 'fpc.resptrs' ); begin - if (use_smartlink_section and - (aname<>'')) or (atype=sec_fpc) then - result:=secnames[atype]+'.'+aname + if use_smartlink_section and + (atype<>sec_bss) and + (aname<>'') then + result:='.gnu.linkonce'+copy(secnames[atype],1,2)+'.'+aname else result:=secnames[atype]; end; @@ -394,7 +385,7 @@ implementation if currsec=nil then internalerror(200403292); {$ifdef userodata} - if currsec.sectype in [sec_rodata,sec_bss,sec_threadvar] then + if currsec.sectype in [sec_rodata,sec_bss] then internalerror(200408252); {$endif userodata} if assigned(p) then @@ -427,10 +418,20 @@ implementation end; - procedure telf32objectdata.writestab(offset:aint;ps:tasmsymbol;nidx,nother,line:longint;p:pchar); + procedure telf32objectdata.writestabs(offset:aint;p:pchar;nidx,nother,line:longint;reloc : boolean); var stab : telf32stab; begin + if reloc then + begin + if (offset=-1) then + begin + if currsec=nil then + offset:=0 + else + offset:=currsec.datasize; + end; + end; fillchar(stab,sizeof(telf32stab),0); if assigned(p) and (p[0]<>#0) then begin @@ -442,11 +443,32 @@ implementation stab.nother:=nother; stab.nvalue:=offset; stabssec.write(stab,sizeof(stab)); - if assigned(ps) then - begin - writesymbol(ps); - stabssec.addsymreloc(stabssec.datasize-4,ps,RELOC_ABSOLUTE); - end; + { when the offset is not 0 then write a relocation, take also the + hdrstab into account with the offset } + if reloc then + stabssec.addsectionreloc(stabssec.datasize-4,currsec,RELOC_ABSOLUTE); + end; + + + procedure telf32objectdata.writesymstabs(offset:aint;p:pchar;ps:tasmsymbol;nidx,nother,line:longint;reloc:boolean); + var + stab : telf32stab; + begin + fillchar(stab,sizeof(telf32stab),0); + if assigned(p) and (p[0]<>#0) then + begin + stab.strpos:=stabstrsec.datasize; + stabstrsec.write(p^,strlen(p)+1); + end; + stab.ntype:=nidx; + stab.ndesc:=line; + stab.nother:=nother; + stab.nvalue:=0; + stabssec.write(stab,sizeof(stab)); + { when the offset is not 0 then write a relocation, take also the + hdrstab into account with the offset } + if reloc then + stabssec.addsymreloc(stabssec.datasize-4,ps,RELOC_ABSOLUTE); end; @@ -468,7 +490,7 @@ implementation { create stabs sections if debugging } if (cs_debuginfo in aktmoduleswitches) then begin - writestab(0,nil,0,0,0,nil); + writestabs(0,nil,0,0,0,false); { write zero pchar and name together (PM) } s:=#0+SplitFileName(current_module.mainsource^)+#0; stabstrsec.write(s[1],length(s)); @@ -603,9 +625,7 @@ implementation AB_GLOBAL : elfsym.st_info:=STB_GLOBAL shl 4; end; - if (sym.currbind<>AB_EXTERNAL) and - not(assigned(sym.section) and - (sym.section.sectype=sec_bss)) then + if sym.currbind<>AB_EXTERNAL then begin case sym.typ of AT_FUNCTION : @@ -875,7 +895,8 @@ implementation asmbin : ''; asmcmd : ''; supported_target : system_any; //target_i386_linux; - flags : [af_outputbinary,af_smartlink_sections]; +// flags : [af_outputbinary,af_smartlink_sections]; + flags : [af_outputbinary]; labelprefix : '.L'; comment : ''; ); diff --git a/compiler/optcse.pas b/compiler/optcse.pas deleted file mode 100644 index 9eaecd8290..0000000000 --- a/compiler/optcse.pas +++ /dev/null @@ -1,79 +0,0 @@ -{ - Common subexpression elimination on base blocks - - Copyright (c) 2005 by Florian Klaempfl - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit optcse; - -{$i fpcdefs.inc} - - interface - - procedure docse(rootnode : tnode); - - implementation - - procedure docse(rootnode : tnode); - begin - { create a linear list of nodes } - - { create hash values } - - { sort by hash values, taking care of nf_csebarrier and keeping the - original order of the nodes } - - { compare nodes with equal hash values } - - { search barrier } - for i:=0 to nodelist.length-1 do - begin - { and then search backward so we get always the largest equal trees } - j:=i+1; - { collect equal nodes } - while (j<=nodelist.length-1) and - nodelist[i].docompare(nodelist[j]) do - inc(j); - dec(j); - if j>i then - begin - { cse found } - - { create temp. location } - - { replace first node by - - temp. creation - - expression calculation - - assignment of expression to temp. } - tempnode:=ctempcreatenode.create(nodelist[i].resulttype,nodelist[i].resulttype.def.size,tt_persistent, - nodelist[i].resulttype.def.is_intregable or nodelist[i].resulttype.def.is_fpuregable); - addstatement(createstatement,tempnode); - addstatement(createstatement,cassignmentnode.create(ctemprefnode.create(tempnode), - caddrnode.create_internal(para.left))); - para.left := ctypeconvnode.create_internal(cderefnode.create(ctemprefnode.create(tempnode)),para.left.resulttype); - addstatement(deletestatement,ctempdeletenode.create(tempnode)); - - { replace next nodes by loading the temp. reference } - - { replace last node by loading the temp. reference and - delete the temp. } - end; - end; - end; - -end. diff --git a/compiler/options.pas b/compiler/options.pas index e98a515b0f..2e630aa29e 100644 --- a/compiler/options.pas +++ b/compiler/options.pas @@ -90,7 +90,9 @@ const var option : toption; read_configfile, { read config file, set when a cfgfile is found } - disable_configfile : boolean; + disable_configfile, + target_is_set : boolean; { do not allow contradictory target settings } + asm_is_set : boolean; { -T also change initoutputformat if not set idrectly } fpcdir, ppccfg, ppcaltcfg, @@ -277,7 +279,9 @@ begin if show then begin case s[2] of +{$ifdef GDB} 'g', +{$endif} {$ifdef Unix} 'L', {$endif} @@ -384,6 +388,7 @@ var d : DirStr; e : ExtStr; s : string; + forceasm : tasm; begin if opt='' then exit; @@ -448,9 +453,10 @@ begin 'A' : begin - paratargetasm:=find_asm_by_string(More); - if paratargetasm=as_none then - IllegalPara(opt); + if set_target_asm_by_string(More) then + asm_is_set:=true + else + IllegalPara(opt); end; 'b' : @@ -743,48 +749,62 @@ begin if UnsetBool(More, 0) then begin exclude(initmoduleswitches,cs_debuginfo); - exclude(initglobalswitches,cs_use_heaptrc); - exclude(initglobalswitches,cs_use_lineinfo); + exclude(initglobalswitches,cs_gdb_dbx); + exclude(initglobalswitches,cs_gdb_gsym); + exclude(initglobalswitches,cs_gdb_heaptrc); + exclude(initglobalswitches,cs_gdb_lineinfo); exclude(initlocalswitches,cs_checkpointer); end else begin +{$ifdef GDB} include(initmoduleswitches,cs_debuginfo); +{$else GDB} + Message(option_no_debug_support); + Message(option_no_debug_support_recompile_fpc); +{$endif GDB} end; +{$ifdef GDB} if not RelocSectionSetExplicitly then RelocSection:=false; j:=1; while j<=length(more) do begin case more[j] of - 'c' : + 'd' : begin if UnsetBool(More, j) then - exclude(initlocalswitches,cs_checkpointer) + exclude(initglobalswitches,cs_gdb_dbx) else - include(initlocalswitches,cs_checkpointer); + include(initglobalswitches,cs_gdb_dbx); end; - 'd' : + 'g' : begin - paratargetdbg:=dbg_dwarf; + if UnsetBool(More, j) then + exclude(initglobalswitches,cs_gdb_gsym) + else + include(initglobalswitches,cs_gdb_gsym); end; 'h' : begin if UnsetBool(More, j) then - exclude(initglobalswitches,cs_use_heaptrc) + exclude(initglobalswitches,cs_gdb_heaptrc) else - include(initglobalswitches,cs_use_heaptrc); + include(initglobalswitches,cs_gdb_heaptrc); end; 'l' : begin if UnsetBool(More, j) then - exclude(initglobalswitches,cs_use_lineinfo) + exclude(initglobalswitches,cs_gdb_lineinfo) else - include(initglobalswitches,cs_use_lineinfo); + include(initglobalswitches,cs_gdb_lineinfo); end; - 's' : + 'c' : begin - paratargetdbg:=dbg_stabs; + if UnsetBool(More, j) then + exclude(initlocalswitches,cs_checkpointer) + else + include(initlocalswitches,cs_checkpointer); end; 'v' : begin @@ -793,11 +813,19 @@ begin else include(initglobalswitches,cs_gdb_valgrind); end; + 'w' : + begin + if UnsetBool(More, j) then + exclude(initglobalswitches,cs_gdb_dwarf) + else + include(initglobalswitches,cs_gdb_dwarf); + end; else IllegalPara(opt); end; inc(j); end; +{$endif GDB} end; 'h' : @@ -852,21 +880,6 @@ begin IllegalPara(opt); end; - 'N' : - begin - j:=1; - while j<=length(more) do - begin - case more[j] of - 'u' : - initglobalswitches:=initglobalswitches+[cs_loopunroll]; - else - IllegalPara(opt); - end; - inc(j); - end; - end; - 'o' : begin if More<>'' then @@ -1003,18 +1016,22 @@ begin 'T' : begin more:=Upper(More); - if paratarget=system_none then + if not target_is_set then begin { remove old target define } TargetDefines(false); + { Save assembler if set } + if asm_is_set then + forceasm:=target_asm.id; { load new target } - paratarget:=find_system_by_string(More); - if paratarget<>system_none then - set_target(paratarget) - else + if not(set_target_by_string(More)) then IllegalPara(opt); + { also initialize assembler if not explicitly set } + if asm_is_set then + set_target_asm(forceasm); { set new define } TargetDefines(true); + target_is_set:=true; end else if More<>upper(target_info.shortname) then @@ -1074,13 +1091,6 @@ begin while j<=length(More) do begin case More[j] of - 'A': - begin - if UnsetBool(More, j) then - apptype:=app_native - else - apptype:=app_cui; - end; 'B': begin { -WB200000 means set trefered base address @@ -1766,10 +1776,6 @@ begin end; option.firstpass:=false; -{ target is set here, for wince the default app type is gui } - if target_info.system in system_wince then - apptype:=app_gui; - { default defines } def_system_macro(target_info.shortname); def_system_macro('FPC'); @@ -1778,9 +1784,9 @@ begin def_system_macro('VER'+version_nr+'_'+release_nr+'_'+patch_nr); { Temporary defines, until things settle down } + def_system_macro('COMPPROCINLINEFIXED'); { "main" symbol is generated in the main program, and left out of the system unit } def_system_macro('FPC_DARWIN_PASCALMAIN'); - def_system_macro('COMPPROCINLINEFIXED'); if pocall_default = pocall_register then def_system_macro('REGCALL'); @@ -1825,17 +1831,6 @@ begin def_system_macro('FPC_CURRENCY_IS_INT64'); def_system_macro('FPC_COMP_IS_INT64'); {$endif} -{$ifdef POWERPC64} - def_system_macro('CPUPOWERPC'); - def_system_macro('CPUPOWERPC64'); - def_system_macro('CPU64'); - def_system_macro('FPC_HAS_TYPE_DOUBLE'); - def_system_macro('FPC_HAS_TYPE_SINGLE'); - def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE'); - def_system_macro('FPC_CURRENCY_IS_INT64'); - def_system_macro('FPC_COMP_IS_INT64'); - def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT'); -{$endif} {$ifdef iA64} def_system_macro('CPUIA64'); def_system_macro('CPU64'); @@ -1846,17 +1841,7 @@ begin def_system_macro('CPU64'); { not supported for now, afaik (FK) def_system_macro('FPC_HAS_TYPE_FLOAT128'); } - - { win64 doesn't support the legacy fpu } - if target_info.system<>system_x86_64_win64 then - def_system_macro('FPC_HAS_TYPE_EXTENDED') - else - begin - def_system_macro('FPC_CURRENCY_IS_INT64'); - def_system_macro('FPC_COMP_IS_INT64'); - undef_system_macro('FPC_HAS_TYPE_EXTENDED'); - end; - + def_system_macro('FPC_HAS_TYPE_EXTENDED'); def_system_macro('FPC_HAS_TYPE_DOUBLE'); def_system_macro('FPC_HAS_TYPE_SINGLE'); {$endif} @@ -1907,6 +1892,8 @@ begin read_configfile := false; { Read commandline and configfile } + target_is_set:=false; + asm_is_set:=false; param_file:=''; { read configfile } @@ -2069,14 +2056,6 @@ begin objectsearchpath.AddList(unitsearchpath,false); librarysearchpath.AddList(unitsearchpath,false); - { maybe override debug info format } - if (paratargetdbg<>dbg_none) then - set_target_dbg(paratargetdbg); - - { maybe override assembler } - if (paratargetasm<>as_none) then - set_target_asm(paratargetasm); - { switch assembler if it's binary and we got -a on the cmdline } if (cs_asm_leave in initglobalswitches) and (af_outputbinary in target_asm.flags) then @@ -2098,10 +2077,6 @@ begin (cs_profile in initmoduleswitches) then exclude(initglobalswitches,cs_link_strip); - { force fpu emulation on arm/wince } - if target_info.system=system_arm_wince then - include(initmoduleswitches,cs_fp_emulation); - {$ifdef x86_64} {$warning HACK: turn off smartlinking} exclude(initmoduleswitches,cs_create_smart); @@ -2121,7 +2096,6 @@ begin initalignment.jumpalign:=1; initalignment.loopalign:=1; end; - UpdateAlignment(initalignment,option.paraalignment); set_system_macro('FPC_VERSION',version_nr); diff --git a/compiler/optunrol.pas b/compiler/optunrol.pas deleted file mode 100644 index 0b69d121c2..0000000000 --- a/compiler/optunrol.pas +++ /dev/null @@ -1,170 +0,0 @@ -{ - Loop unrolling - - Copyright (c) 2005 by Florian Klaempfl - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit optunrol; - -{$i fpcdefs.inc} - - interface - - uses - node; - - function unroll_loop(node : tnode) : tnode; - - implementation - - uses - globtype,globals, - cpuinfo, - nutils, - nbas,nflw,ncon,ninl,ncal; - - var - nodecount : aint; - - function donodecount(var n: tnode; arg: pointer): foreachnoderesult; - begin - inc(nodecount); - result:=fen_false; - end; - - - { rough estimation how large the tree "node" is } - function countnodes(node : tnode) : aint; - begin - nodecount:=0; - foreachnodestatic(node,@donodecount,nil); - result:=nodecount; - end; - - - function number_unrolls(node : tnode) : integer; - begin -{$ifdef i386} - { multiply by 2 for CPUs with a long pipeline } - if aktoptprocessor in [ClassPentium4] then - number_unrolls:=60 div countnodes(node) - else -{$endif i386} - number_unrolls:=30 div countnodes(node); - - if number_unrolls=0 then - number_unrolls:=1; - end; - - - function unroll_loop(node : tnode) : tnode; - var - unrolls,i : integer; - counts : qword; - unrollstatement : tstatementnode; - unrollblock : tblocknode; - entrylabel : tlabelnode; - begin - result:=nil; - if (cs_littlesize in aktglobalswitches) then - exit; - if not(node.nodetype in [forn]) then - exit; - unrolls:=number_unrolls(tfornode(node).t2); - if unrolls>1 then - begin - { number of executions known? } - if (tfornode(node).right.nodetype=ordconstn) and (tfornode(node).t1.nodetype=ordconstn) then - begin - if lnf_backward in tfornode(node).loopflags then - counts:=tordconstnode(tfornode(node).right).value-tordconstnode(tfornode(node).t1).value+1 - else - counts:=tordconstnode(tfornode(node).t1).value-tordconstnode(tfornode(node).right).value+1; - - { don't unroll more than we need } - if unrolls>counts then - unrolls:=counts; - - { create block statement } - unrollblock:=internalstatements(unrollstatement); - - { let's unroll (and rock of course) } - for i:=1 to unrolls do - begin - { create and insert copy of the statement block } - addstatement(unrollstatement,tfornode(tfornode(node).t2).getcopy); - - { set and insert entry label? } - if (counts mod unrolls<>0) and - ((counts mod unrolls)=unrolls-i) then - begin - tfornode(node).entrylabel:=clabelnode.create(cnothingnode.create); - addstatement(unrollstatement,tfornode(node).entrylabel); - end; - - { for itself increases at the last iteration } - if i<unrolls then - begin - { insert incrementation of counter var } - addstatement(unrollstatement, - geninlinenode(in_inc_x,false,ccallparanode.create(tfornode(node).left.getcopy,nil))); - end; - end; - { can we get rid of the for statement? } - if unrolls=counts then - result:=unrollblock; - end - else - begin - { unrolling is a little bit more tricky if we don't know the - loop count at compile time, but the solution is to use a jump table - which is indexed by "loop count mod unrolls" at run time and which - jumps then at the appropriate place inside the loop. Because - a module division is expensive, we can use only unroll counts dividable - by 2 } - case unrolls of - 1..2: - ; - 3: - unrolls:=2; - 4..7: - unrolls:=4; - { unrolls>4 already make no sense imo, but who knows (FK) } - 8..15: - unrolls:=8; - 16..31: - unrolls:=16; - 32..63: - unrolls:=32; - 64..$7fff: - unrolls:=64; - else - exit; - end; - { we don't handle this yet } - exit; - end; - if not(assigned(result)) then - begin - tfornode(node).t2.free; - tfornode(node).t2:=unrollblock; - end; - end; - end; - -end. diff --git a/compiler/parser.pas b/compiler/parser.pas index 8d5a6d06fb..6563f2b9fc 100644 --- a/compiler/parser.pas +++ b/compiler/parser.pas @@ -51,6 +51,9 @@ implementation {$ifdef BrowserLog} browlog, {$endif BrowserLog} +{$ifdef GDB} + gdb, +{$endif GDB} comphook, scanner,scandir, pbase,ptype,psystem,pmodules,psub, @@ -244,45 +247,61 @@ implementation *****************************************************************************} procedure init_module; - var - i : Tasmlist; begin + { Create assembler output lists for CG } exprasmlist:=taasmoutput.create; - for i:=low(Tasmlist) to high(Tasmlist) do - asmlist[i]:=Taasmoutput.create; - - { PIC data } -{$ifdef powerpc} + datasegment:=taasmoutput.create; + codesegment:=taasmoutput.create; + bsssegment:=taasmoutput.create; + debuglist:=taasmoutput.create; + withdebuglist:=taasmoutput.create; + consts:=taasmoutput.create; + rttilist:=taasmoutput.create; + picdata:=taasmoutput.create; if target_info.system=system_powerpc_darwin then - asmlist[al_picdata].concat(tai_directive.create(asd_non_lazy_symbol_pointer,'')); -{$endif powerpc} - + picdata.concat(tai_simple.create(ait_non_lazy_symbol_pointer)); + ResourceStringList:=Nil; + importssection:=nil; + exportssection:=nil; + resourcesection:=nil; { Resource strings } - cresstr.resourcestrings:=Tresourcestrings.Create; - + ResourceStrings:=TResourceStrings.Create; { use the librarydata from current_module } objectlibrary:=current_module.librarydata; end; procedure done_module; - var {$ifdef MEMDEBUG} + var d : tmemdebug; {$endif} - i:Tasmlist; begin {$ifdef MEMDEBUG} d:=tmemdebug.create(current_module.modulename^+' - asmlists'); {$endif} - for i:=low(Tasmlist) to high(Tasmlist) do - if asmlist[i]<>nil then - asmlist[i].free; + exprasmlist.free; + codesegment.free; + bsssegment.free; + datasegment.free; + debuglist.free; + withdebuglist.free; + consts.free; + rttilist.free; + picdata.free; + if assigned(ResourceStringList) then + ResourceStringList.free; + if assigned(importssection) then + importssection.free; + if assigned(exportssection) then + exportssection.free; + if assigned(resourcesection) then + resourcesection.free; {$ifdef MEMDEBUG} d.free; {$endif} { resource strings } - cresstr.resourcestrings.free; + ResourceStrings.free; objectlibrary:=nil; end; @@ -313,11 +332,22 @@ implementation { cg } oldparse_only : boolean; { asmlists } - oldexprasmlist:Taasmoutput; - oldasmlist:array[Tasmlist] of Taasmoutput; + oldimports, + oldexports, + oldresource, + oldrttilist, + oldpicdata, + oldresourcestringlist, + oldbsssegment, + olddatasegment, + oldcodesegment, + oldexprasmlist, + olddebuglist, + oldwithdebuglist, + oldconsts : taasmoutput; oldobjectlibrary : tasmlibrarydata; - { al_resourcestrings } - Oldresourcestrings : tresourcestrings; + { resourcestrings } + OldResourceStrings : tResourceStrings; { akt.. things } oldaktlocalswitches : tlocalswitches; oldaktmoduleswitches : tmoduleswitches; @@ -326,6 +356,7 @@ implementation oldaktpackenum : shortint; oldaktmaxfpuregisters : longint; oldaktalignment : talignmentinfo; + oldaktoutputformat : tasm; oldaktspecificoptprocessor, oldaktoptprocessor : tprocessors; oldaktfputype : tfputype; @@ -336,6 +367,9 @@ implementation oldcurrent_procinfo : tprocinfo; oldaktdefproccall : tproccalloption; oldsourcecodepage : tcodepagestring; +{$ifdef GDB} + store_dbx : plongint; +{$endif GDB} end; var @@ -370,10 +404,21 @@ implementation { save cg } oldparse_only:=parse_only; { save assembler lists } - oldasmlist:=asmlist; + olddatasegment:=datasegment; + oldbsssegment:=bsssegment; + oldcodesegment:=codesegment; + olddebuglist:=debuglist; + oldwithdebuglist:=withdebuglist; + oldconsts:=consts; + oldrttilist:=rttilist; + oldpicdata:=picdata; oldexprasmlist:=exprasmlist; + oldimports:=importssection; + oldexports:=exportssection; + oldresource:=resourcesection; + oldresourcestringlist:=resourcestringlist; oldobjectlibrary:=objectlibrary; - Oldresourcestrings:=resourcestrings; + OldResourceStrings:=ResourceStrings; { save akt... state } { handle the postponed case first } if localswitcheschanged then @@ -388,12 +433,17 @@ implementation oldaktpackrecords:=aktpackrecords; oldaktfputype:=aktfputype; oldaktmaxfpuregisters:=aktmaxfpuregisters; + oldaktoutputformat:=aktoutputformat; oldaktoptprocessor:=aktoptprocessor; oldaktspecificoptprocessor:=aktspecificoptprocessor; oldaktasmmode:=aktasmmode; oldaktinterfacetype:=aktinterfacetype; oldaktfilepos:=aktfilepos; oldaktmodeswitches:=aktmodeswitches; +{$ifdef GDB} + store_dbx:=dbx_counter; + dbx_counter:=nil; +{$endif GDB} end; { show info } Message1(parser_i_compiling,filename); @@ -441,6 +491,8 @@ implementation aktfputype:=initfputype; aktpackenum:=initpackenum; aktpackrecords:=0; + aktoutputformat:=initoutputformat; + set_target_asm(aktoutputformat); aktoptprocessor:=initoptprocessor; aktspecificoptprocessor:=initspecificoptprocessor; aktasmmode:=initasmmode; @@ -527,9 +579,20 @@ implementation parse_only:=oldparse_only; { restore asmlists } exprasmlist:=oldexprasmlist; - asmlist:=oldasmlist; + datasegment:=olddatasegment; + bsssegment:=oldbsssegment; + codesegment:=oldcodesegment; + consts:=oldconsts; + debuglist:=olddebuglist; + withdebuglist:=oldwithdebuglist; + importssection:=oldimports; + exportssection:=oldexports; + resourcesection:=oldresource; + rttilist:=oldrttilist; + picdata:=oldpicdata; + resourcestringlist:=oldresourcestringlist; { object data } - resourcestrings:=oldresourcestrings; + ResourceStrings:=OldResourceStrings; objectlibrary:=oldobjectlibrary; { restore previous scanner } if assigned(old_compiled_module) then @@ -553,6 +616,8 @@ implementation aktpackenum:=oldaktpackenum; aktpackrecords:=oldaktpackrecords; aktmaxfpuregisters:=oldaktmaxfpuregisters; + aktoutputformat:=oldaktoutputformat; + set_target_asm(aktoutputformat); aktoptprocessor:=oldaktoptprocessor; aktspecificoptprocessor:=oldaktspecificoptprocessor; aktfputype:=oldaktfputype; @@ -562,6 +627,9 @@ implementation aktmodeswitches:=oldaktmodeswitches; aktexceptblock:=0; exceptblockcounter:=0; + {$ifdef GDB} + dbx_counter:=store_dbx; + {$endif GDB} end; end else diff --git a/compiler/pdecl.pas b/compiler/pdecl.pas index 476d25d257..7917291c44 100644 --- a/compiler/pdecl.pas +++ b/compiler/pdecl.pas @@ -279,6 +279,9 @@ implementation again : boolean; srsym : tsym; srsymtable : tsymtable; + {$ifdef gdb_notused} + stab_str:Pchar; + {$endif gdb_notused} begin { Check only typesyms or record/object fields } @@ -329,6 +332,27 @@ implementation tpointerdef(pd).pointertype.setsym(srsym); { avoid wrong unused warnings web bug 801 PM } inc(ttypesym(srsym).refs); +{$ifdef GDB_UNUSED} + if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist) and + (tsym(p).owner.symtabletype in [globalsymtable,staticsymtable]) then + begin + ttypesym(p).isusedinstab:=true; +{ ttypesym(p).concatstabto(debuglist);} + {not stabs for forward defs } + if not Ttypesym(p).isstabwritten then + begin + if Ttypesym(p).restype.def.typesym=p then + Tstoreddef(Ttypesym(p).restype.def).concatstabto(debuglist) + else + begin + stab_str:=Ttypesym(p).stabstring; + if assigned(stab_str) then + debuglist.concat(Tai_stabs.create(stab_str)); + Ttypesym(p).isstabwritten:=true; + end; + end; + end; +{$endif GDB_UNUSED} { we need a class type for classrefdef } if (pd.deftype=classrefdef) and not(is_class(ttypesym(srsym).restype.def)) then @@ -556,7 +580,7 @@ implementation { the top symbol table of symtablestack } begin consume(_VAR); - read_var_decs([]); + read_var_decs(false,false,false); end; @@ -584,7 +608,7 @@ implementation consume(_THREADVAR); if not(symtablestack.symtabletype in [staticsymtable,globalsymtable]) then message(parser_e_threadvars_only_sg); - read_var_decs([vd_threadvar]); + read_var_decs(false,false,true); end; diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas index 474ed8726a..ecc608e420 100644 --- a/compiler/pdecobj.pas +++ b/compiler/pdecobj.pas @@ -226,28 +226,6 @@ implementation classtype:=odt_cppclass; consume(_CPPCLASS); end; - _DISPINTERFACE: - begin - { need extra check here since interface is a keyword - in all pascal modes } - if not(m_class in aktmodeswitches) then - Message(parser_f_need_objfpc_or_delphi_mode); - classtype:=odt_dispinterface; - consume(_DISPINTERFACE); - { no forward declaration } - if not(assigned(fd)) and (token=_SEMICOLON) then - begin - { also anonym objects aren't allow (o : object a : longint; end;) } - if n='' then - Message(parser_f_no_anonym_objects); - aktclass:=tobjectdef.create(classtype,n,nil); - include(aktclass.objectoptions,oo_is_forward); - object_dec:=aktclass; - typecanbeforward:=storetypecanbeforward; - readobjecttype:=false; - exit; - end; - end; _INTERFACE: begin { need extra check here since interface is a keyword @@ -446,8 +424,6 @@ implementation odt_object: if not(is_object(childof)) then Message(parser_e_mix_of_classes_and_objects); - odt_dispinterface: - Message(parser_e_dispinterface_cant_have_parent); end; { the forward of the child must be resolved to get correct field addresses } @@ -479,14 +455,12 @@ implementation else aktclass:=tobjectdef.create(classtype,n,nil); { read GUID } - if (classtype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface]) and + if (classtype in [odt_interfacecom,odt_interfacecorba]) and try_to_consume(_LECKKLAMMER) then begin readinterfaceiid; consume(_RECKKLAMMER); - end - else if (classtype=odt_dispinterface) then - message(parser_e_dispinterface_needs_a_guid); + end; end; procedure chkcpp(pd:tprocdef); @@ -618,7 +592,7 @@ implementation not(oo_can_have_published in aktclass.objectoptions) then Message(parser_e_cant_have_published); - read_var_decs([vd_object]); + read_var_decs(false,true,false); end; end; end; diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index 8f7cb5e9c5..915b3e8fde 100644 --- a/compiler/pdecsub.pas +++ b/compiler/pdecsub.pas @@ -1923,7 +1923,7 @@ const if not( assigned(pd.import_dll) and (target_info.system in [system_i386_win32,system_i386_wdosx, - system_i386_emx,system_i386_os2,system_arm_wince,system_i386_wince]) + system_i386_emx,system_i386_os2]) ) then begin if not(pd.proccalloption in [pocall_cdecl,pocall_cppdecl]) then diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas index 0540bdf91b..8f42d13bff 100644 --- a/compiler/pdecvar.pas +++ b/compiler/pdecvar.pas @@ -29,12 +29,9 @@ interface uses symsym,symdef; - type Tvar_dec_option=(vd_record,vd_object,vd_threadvar); - Tvar_dec_options=set of Tvar_dec_option; - function read_property_dec(aclass:tobjectdef):tpropertysym; - procedure read_var_decs(options:Tvar_dec_options); + procedure read_var_decs(is_record,is_object,is_threadvar:boolean); implementation @@ -585,7 +582,7 @@ implementation const variantrecordlevel : longint = 0; - procedure read_var_decs(options:Tvar_dec_options); + procedure read_var_decs(is_record,is_object,is_threadvar:boolean); { reads the filed of a record into a } { symtablestack, if record=false } { variants are forbidden, so this procedure } @@ -711,7 +708,7 @@ implementation {$endif powerpc} old_current_object_option:=current_object_option; { all variables are public if not in a object declaration } - if not(vd_object in options) then + if not is_object then current_object_option:=[sp_public]; old_block_type:=block_type; block_type:=bt_type; @@ -722,8 +719,7 @@ implementation { read vars } sc:=tsinglelist.create; while (token=_ID) and - not((vd_object in options) and - (idtoken in [_PUBLIC,_PRIVATE,_PUBLISHED,_PROTECTED,_STRICT])) do + not(is_object and (idtoken in [_PUBLIC,_PRIVATE,_PUBLISHED,_PROTECTED,_STRICT])) do begin sorg:=orgpattern; semicoloneaten:=false; @@ -751,7 +747,8 @@ implementation consume(_ID); until not try_to_consume(_COMMA); consume(_COLON); - if (m_gpc in aktmodeswitches) and (options=[]) and + if (m_gpc in aktmodeswitches) and + not(is_record or is_object or is_threadvar) and (token=_ID) and (orgpattern='__asmname__') then begin consume(_ID); @@ -761,7 +758,7 @@ implementation { this is needed for Delphi mode at least but should be OK for all modes !! (PM) } ignore_equal:=true; - if options*[vd_record,vd_object]<>[] then + if is_record or is_object then begin { for records, don't search the recordsymtable for the symbols of the types } @@ -798,7 +795,7 @@ implementation the alignment of the first field. */ } if (target_info.system in [system_powerpc_darwin, system_powerpc_macos]) and - (vd_record in options) and + is_record and is_first_field and (trecordsymtable(symtablestack).usefieldalignment = -1) then begin @@ -841,7 +838,8 @@ implementation end; { check for absolute } - if not symdone and (idtoken=_ABSOLUTE) and (options=[]) then + if not symdone and + (idtoken=_ABSOLUTE) and not(is_record or is_object or is_threadvar) then begin consume(_ABSOLUTE); abssym:=nil; @@ -871,7 +869,7 @@ implementation { address } else if is_constintnode(pt) and ((target_info.system in [system_i386_go32v2,system_i386_watcom, - system_i386_wdosx,system_i386_win32,system_arm_wince,system_i386_wince]) or + system_i386_wdosx,system_i386_win32]) or (m_objfpc in aktmodeswitches) or (m_delphi in aktmodeswitches)) then begin @@ -949,7 +947,7 @@ implementation try_consume_hintdirective(dummysymoptions); { Records and objects can't have default values } - if options*[vd_record,vd_object]<>[] then + if is_record or is_object then begin { for a record there doesn't need to be a ; before the END or ) } if not(token in [_END,_RKLAMMER]) and @@ -966,7 +964,7 @@ implementation if (tt.def.deftype=procvardef) and (tt.def.typesym=nil) then handle_calling_convention(tprocvardef(tt.def)); - read_default_value(sc,tt,vd_threadvar in options); + read_default_value(sc,tt,is_threadvar); consume(_SEMICOLON); { for locals we've created typedconstsym with a different name } if symtablestack.symtabletype<>localsymtable then @@ -996,11 +994,12 @@ implementation { Add calling convention for procvar } handle_calling_convention(tprocvardef(tt.def)); { Handling of Delphi typed const = initialized vars } - if (token=_EQUAL) and (options*[vd_record,vd_object]=[]) and + if (token=_EQUAL) and + not(is_record or is_object) and not(m_tp7 in aktmodeswitches) and (symtablestack.symtabletype<>parasymtable) then begin - read_default_value(sc,tt,vd_threadvar in options); + read_default_value(sc,tt,is_threadvar); consume(_SEMICOLON); symdone:=true; hasdefaultvalue:=true; @@ -1008,7 +1007,7 @@ implementation end; { Check for EXTERNAL etc directives or, in macpas, if cs_external_var is set} - if not symdone and (options=[]) then + if not symdone and not(is_record or is_object or is_threadvar) then begin if ( (token=_ID) and @@ -1117,7 +1116,7 @@ implementation if vs.typ=globalvarsym then begin tglobalvarsym(vs).set_mangledname(C_Name); - { insert in the al_globals when it is not external } + { insert in the datasegment when it is not external } if (not extern_var) then insertbssdata(tglobalvarsym(vs)); { now we can insert it in the import lib if its a dll, or @@ -1146,7 +1145,7 @@ implementation end; { Check for STATIC directive } - if not symdone and (vd_object in options) and + if not symdone and (is_object) and (cs_static_keyword in aktmoduleswitches) and (idtoken=_STATIC) then begin include(current_object_option,sp_static); @@ -1182,14 +1181,14 @@ implementation Message(parser_e_only_publishable_classes_can__be_published); exclude(current_object_option,sp_published); end; - insert_syms(sc,tt,vd_threadvar in options,dummysymoptions); + insert_syms(sc,tt,is_threadvar,dummysymoptions); current_object_option:=old_current_object_option; end; end; { Check for Case } - if (vd_record in options) and (token=_CASE) then + if is_record and (token=_CASE) then begin maxsize:=0; maxalignment:=0; @@ -1256,7 +1255,7 @@ implementation consume(_LKLAMMER); inc(variantrecordlevel); if token<>_RKLAMMER then - read_var_decs([vd_record]); + read_var_decs(true,false,false); dec(variantrecordlevel); consume(_RKLAMMER); { calculates maximal variant size } diff --git a/compiler/pexports.pas b/compiler/pexports.pas index 02909f8bc6..b928e754eb 100644 --- a/compiler/pexports.pas +++ b/compiler/pexports.pas @@ -113,7 +113,7 @@ implementation an underline } if InternalProcName[1]='_' then delete(InternalProcName,1,1) - else if (target_info.system in [system_i386_win32,system_i386_wdosx,system_arm_wince,system_i386_wince]) and UseDeffileForExports then + else if (target_info.system in [system_i386_win32,system_i386_wdosx]) and UseDeffileForExports then begin Message(parser_e_dlltool_unit_var_problem); Message(parser_e_dlltool_unit_var_problem2); @@ -134,7 +134,7 @@ implementation end; hp.options:=hp.options or eo_index; pt.free; - if target_info.system in [system_i386_win32,system_i386_wdosx,system_arm_wince,system_i386_wince] then + if target_info.system in [system_i386_win32,system_i386_wdosx] then DefString:=srsym.realname+'='+InternalProcName+' @ '+tostr(hp.index) else DefString:=srsym.realname+'='+InternalProcName; {Index ignored!} diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 9311a0035b..fa324aaf69 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -813,7 +813,7 @@ implementation else begin { then insert an empty string } - p2:=cstringconstnode.createstr('',st_conststring); + p2:=cstringconstnode.createstr('',st_default); end; statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil))); consume(_RKLAMMER); @@ -1428,7 +1428,7 @@ implementation getmem(pc,len+1); move(pchar(tconstsym(srsym).value.valueptr)^,pc^,len); pc[len]:=#0; - p1:=cstringconstnode.createpchar(pc,len,st_conststring); + p1:=cstringconstnode.createpchar(pc,len); end; constwstring : p1:=cstringconstnode.createwstr(pcompilerwidestring(tconstsym(srsym).value.valueptr)); @@ -2265,7 +2265,7 @@ implementation _CSTRING : begin - p1:=cstringconstnode.createstr(pattern,st_conststring); + p1:=cstringconstnode.createstr(pattern,st_default); consume(_CSTRING); end; diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index 5128a68646..7c98992794 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -39,11 +39,23 @@ implementation aasmtai,aasmcpu,aasmbase, cgbase,cgobj, nbas,ncgutil, - link,assemble,import,export,gendef,ppu,comprsrc,dbgbase, + link,assemble,import,export,gendef,ppu,comprsrc, cresstr,procinfo, dwarf,pexports, +{$ifdef GDB} + gdb, +{$endif GDB} scanner,pbase,pexpr,psystem,psub,pdecsub; + procedure fixseg(p:TAAsmoutput; sec:TAsmSectionType; secname: string); + begin + maybe_new_object_file(p); + if target_info.system <> system_powerpc_macos then + p.insert(Tai_section.Create(sec,'',0)) + else + p.insert(Tai_section.Create(sec,secname,0)); + end; + procedure create_objectfile; var @@ -72,10 +84,10 @@ implementation { Recreate import section } if (target_info.system in [system_i386_win32,system_i386_wdosx]) then begin - if assigned(asmlist[al_imports]) then - asmlist[al_imports].clear + if assigned(importssection)then + importssection.clear else - asmlist[al_imports]:=taasmoutput.Create; + importssection:=taasmoutput.Create; importlib.generatelib; end; { Readd the not processed files } @@ -87,24 +99,17 @@ implementation KeepShared.Free; end; - { Start and end module debuginfo, at least required for stabs - to insert n_sourcefile lines } - if (cs_debuginfo in aktmoduleswitches) or - (cs_use_lineinfo in aktglobalswitches) then - debuginfo.insertmoduleinfo; - { create the .s file and assemble it } GenerateAsm(false); { Also create a smartlinked version ? } - if (cs_create_smart in aktmoduleswitches) and - not(af_smartlink_sections in target_asm.flags) then + if (cs_create_smart in aktmoduleswitches) then begin { regenerate the importssection for win32 } - if assigned(asmlist[al_imports]) and - (target_info.system in [system_i386_win32,system_i386_wdosx, system_arm_wince,system_i386_wince]) then + if assigned(importssection) and + (target_info.system in [system_i386_win32,system_i386_wdosx]) then begin - asmlist[al_imports].clear; + importsSection.clear; importlib.generatesmartlib; end; @@ -124,8 +129,7 @@ implementation current_module.linkunitofiles.add(current_module.objfilename^,link_static); current_module.flags:=current_module.flags or uf_static_linked; - if (cs_create_smart in aktmoduleswitches) and - not(af_smartlink_sections in target_asm.flags) then + if (cs_create_smart in aktmoduleswitches) then begin current_module.linkunitstaticlibs.add(current_module.staticlibfilename^,link_smart); current_module.flags:=current_module.flags or uf_smart_linked; @@ -135,15 +139,58 @@ implementation procedure create_dwarf; begin - asmlist[al_dwarf]:=taasmoutput.create; + dwarflist:=taasmoutput.create; { Call frame information } if (tf_needs_dwarf_cfi in target_info.flags) and (af_supports_dwarf in target_asm.flags) then - dwarfcfi.generate_code(asmlist[al_dwarf]); + dwarfcfi.generate_code(dwarflist); + end; + + + procedure insertsegment; + var + oldaktfilepos : tfileposinfo; + {Note: Sections get names in macos only.} + begin + { Insert Ident of the compiler } + if (not (cs_create_smart in aktmoduleswitches)) +{$ifndef EXTDEBUG} + and (not current_module.is_unit) +{$endif} + then + begin + { align the first data } + dataSegment.insert(Tai_align.Create(const_align(32))); + dataSegment.insert(Tai_string.Create('FPC '+full_version_string+ + ' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname)); + end; + { align code segment } + codeSegment.concat(Tai_align.Create(aktalignment.procalign)); + { Insert start and end of sections } + fixseg(codesegment,sec_code,'____seg_code'); + fixseg(datasegment,sec_data,'____seg_data'); + fixseg(bsssegment,sec_bss,'____seg_bss'); + { we should use .rdata section for these two no ? + .rdata is a read only data section (PM) } + fixseg(rttilist,sec_data,'____seg_rtti'); + fixseg(consts,sec_data,'____seg_consts'); + fixseg(picdata,sec_data,'____seg_picdata'); + if assigned(resourcestringlist) then + fixseg(resourcestringlist,sec_data,'____seg_resstrings'); +{$ifdef GDB} + if assigned(debuglist) then + begin + oldaktfilepos:=aktfilepos; + aktfilepos.line:=0; + debugList.insert(Tai_symbol.Createname('gcc2_compiled',AT_DATA,0)); + debugList.insert(Tai_symbol.Createname('fpc_compiled',AT_DATA,0)); + fixseg(debuglist,sec_code,'____seg_debug'); + aktfilepos:=oldaktfilepos; + end; +{$endif GDB} end; -{$ifndef segment_threadvars} procedure InsertThreadvarTablesTable; var hp : tused_unit; @@ -168,17 +215,18 @@ implementation ltvTables.concat(Tai_const.Createname(make_mangledname('THREADVARLIST',current_module.localsymtable,''),AT_DATA,0)); inc(count); end; - { Insert TableCount at start } + { TableCount } ltvTables.insert(Tai_const.Create_32bit(count)); + ltvTables.insert(Tai_symbol.Createname_global('FPC_THREADVARTABLES',AT_DATA,0)); + ltvTables.insert(Tai_align.Create(const_align(sizeof(aint)))); + ltvTables.concat(Tai_symbol_end.Createname('FPC_THREADVARTABLES')); { insert in data segment } - maybe_new_object_file(asmlist[al_globals]); - new_section(asmlist[al_globals],sec_data,'FPC_THREADVARTABLES',sizeof(aint)); - asmlist[al_globals].concat(Tai_symbol.Createname_global('FPC_THREADVARTABLES',AT_DATA,0)); - asmlist[al_globals].concatlist(ltvTables); - asmlist[al_globals].concat(Tai_symbol_end.Createname('FPC_THREADVARTABLES')); + maybe_new_object_file(dataSegment); + dataSegment.concatlist(ltvTables); ltvTables.free; end; + procedure AddToThreadvarList(p:tnamedindexitem;arg:pointer); var ltvTable : taasmoutput; @@ -207,28 +255,26 @@ implementation if ltvTable.first<>nil then begin s:=make_mangledname('THREADVARLIST',current_module.localsymtable,''); - { end of the list marker } - ltvTable.concat(tai_const.create_sym(nil)); - { add to datasegment } - maybe_new_object_file(asmlist[al_globals]); - new_section(asmlist[al_globals],sec_data,s,sizeof(aint)); - asmlist[al_globals].concat(Tai_symbol.Createname_global(s,AT_DATA,0)); - asmlist[al_globals].concatlist(ltvTable); - asmlist[al_globals].concat(Tai_symbol_end.Createname(s)); + { add begin and end of the list } + ltvTable.insert(tai_symbol.Createname_global(s,AT_DATA,0)); + ltvTable.insert(Tai_align.Create(const_align(32))); + ltvTable.concat(tai_const.create_sym(nil)); { end of list marker } + ltvTable.concat(tai_symbol_end.createname(s)); + maybe_new_object_file(dataSegment); + dataSegment.concatlist(ltvTable); current_module.flags:=current_module.flags or uf_threadvars; end; ltvTable.Free; end; -{$endif} Procedure InsertResourceInfo; - + var hp : tused_unit; found : Boolean; I : Integer; ResourceInfo : taasmoutput; - + begin if target_res.id=res_elf then begin @@ -252,7 +298,7 @@ implementation {$else EXTERNALRESPTRS} new_section(ResourceInfo,sec_fpc,'resptrs',4); ResourceInfo.concat(Tai_symbol.Createname_global('FPC_RESSYMBOL',AT_DATA,0)); - For I:=1 to 32 do + For I:=1 to 32 do ResourceInfo.Concat(Tai_const.Create_32bit(0)); {$endif EXTERNALRESPTRS} end @@ -262,8 +308,8 @@ implementation ResourceInfo.concat(Tai_symbol.Createname_global('FPC_RESLOCATION',AT_DATA,0)); ResourceInfo.Concat(Tai_const.Create_32bit(0)); end; - maybe_new_object_file(asmlist[al_globals]); - asmlist[al_globals].concatlist(ResourceInfo); + maybe_new_object_file(DataSegment); + DataSegment.concatlist(ResourceInfo); ResourceInfo.free; end; end; @@ -287,19 +333,19 @@ implementation hp:=tused_unit(hp.next); end; { Add program resources, if any } - If resourcestrings.ResStrCount>0 then + If ResourceStringList<>Nil then begin ResourceStringTables.concat(Tai_const.Createname(make_mangledname('RESOURCESTRINGLIST',current_module.localsymtable,''),AT_DATA,0)); Inc(Count); end; - { Insert TableCount at start } + { TableCount } ResourceStringTables.insert(Tai_const.Create_32bit(count)); - { Add to data segment } - maybe_new_object_file(asmlist[al_globals]); - new_section(asmlist[al_globals],sec_data,'FPC_RESOURCESTRINGTABLES',sizeof(aint)); - asmlist[al_globals].concat(Tai_symbol.Createname_global('FPC_RESOURCESTRINGTABLES',AT_DATA,0)); - asmlist[al_globals].concatlist(ResourceStringTables); - asmlist[al_globals].concat(Tai_symbol_end.Createname('FPC_RESOURCESTRINGTABLES')); + ResourceStringTables.insert(Tai_symbol.Createname_global('FPC_RESOURCESTRINGTABLES',AT_DATA,0)); + ResourceStringTables.insert(Tai_align.Create(const_align(4))); + ResourceStringTables.concat(Tai_symbol_end.Createname('FPC_RESOURCESTRINGTABLES')); + { insert in data segment } + maybe_new_object_file(dataSegment); + dataSegment.concatlist(ResourceStringTables); ResourceStringTables.free; end; @@ -343,15 +389,15 @@ implementation unitinits.concat(Tai_const.Create_sym(nil)); inc(count); end; - { Insert TableCount,InitCount at start } + { TableCount,InitCount } unitinits.insert(Tai_const.Create_32bit(0)); unitinits.insert(Tai_const.Create_32bit(count)); - { Add to data segment } - maybe_new_object_file(asmlist[al_globals]); - new_section(asmlist[al_globals],sec_data,'INITFINAL',sizeof(aint)); - asmlist[al_globals].concat(Tai_symbol.Createname_global('INITFINAL',AT_DATA,0)); - asmlist[al_globals].concatlist(unitinits); - asmlist[al_globals].concat(Tai_symbol_end.Createname('INITFINAL')); + unitinits.insert(Tai_symbol.Createname_global('INITFINAL',AT_DATA,0)); + unitinits.insert(Tai_align.Create(const_align(4))); + unitinits.concat(Tai_symbol_end.Createname('INITFINAL')); + { insert in data segment } + maybe_new_object_file(dataSegment); + dataSegment.concatlist(unitinits); unitinits.free; end; @@ -359,15 +405,11 @@ implementation procedure insertmemorysizes; begin { stacksize can be specified and is now simulated } - maybe_new_object_file(asmlist[al_globals]); - new_section(asmlist[al_globals],sec_data,'__stklen',4); - asmlist[al_globals].concat(Tai_symbol.Createname_global('__stklen',AT_DATA,4)); - asmlist[al_globals].concat(Tai_const.Create_32bit(stacksize)); - { Initial heapsize } - maybe_new_object_file(asmlist[al_globals]); - new_section(asmlist[al_globals],sec_data,'__heapsize',4); - asmlist[al_globals].concat(Tai_symbol.Createname_global('__heapsize',AT_DATA,4)); - asmlist[al_globals].concat(Tai_const.Create_32bit(heapsize)); + dataSegment.concat(Tai_align.Create(const_align(4))); + dataSegment.concat(Tai_symbol.Createname_global('__stklen',AT_DATA,4)); + dataSegment.concat(Tai_const.Create_32bit(stacksize)); + dataSegment.concat(Tai_symbol.Createname_global('__heapsize',AT_DATA,4)); + dataSegment.concat(Tai_const.Create_32bit(heapsize)); end; @@ -444,24 +486,24 @@ implementation prevent crashes when accessing .owner } generrorsym.owner:=systemunit; generrortype.def.owner:=systemunit; +{$ifdef cpufpemu} + { Floating point emulation unit? } + if (cs_fp_emulation in aktmoduleswitches) then + AddUnit('SoftFpu'); +{$endif cpufpemu} { Units only required for main module } { load heaptrace before any other units especially objpas } if not(current_module.is_unit) then begin { Heaptrc unit } - if (cs_use_heaptrc in aktglobalswitches) then + if (cs_gdb_heaptrc in aktglobalswitches) then AddUnit('HeapTrc'); { Lineinfo unit } - if (cs_use_lineinfo in aktglobalswitches) then + if (cs_gdb_lineinfo in aktglobalswitches) then AddUnit('LineInfo'); { Lineinfo unit } if (cs_gdb_valgrind in aktglobalswitches) then AddUnit('CMem'); -{$ifdef cpufpemu} - { Floating point emulation unit? } - if (cs_fp_emulation in aktmoduleswitches) and not(target_info.system in system_wince) then - AddUnit('SoftFpu'); -{$endif cpufpemu} end; { Objpas unit? } if m_objpas in aktmodeswitches then @@ -636,6 +678,98 @@ implementation end; +{$IfDef GDB} + procedure write_gdb_info; + + procedure reset_unit_type_info; + var + hp : tmodule; + begin + hp:=tmodule(loaded_units.first); + while assigned(hp) do + begin + hp.is_stab_written:=false; + hp:=tmodule(hp.next); + end; + end; + + procedure write_used_unit_type_info(hp:tmodule); + var + pu : tused_unit; + begin + pu:=tused_unit(hp.used_units.first); + while assigned(pu) do + begin + if not pu.u.is_stab_written then + begin + { prevent infinte loop for circular dependencies } + pu.u.is_stab_written:=true; + { write type info from used units, use a depth first + strategy to reduce the recursion in writing all + dependent stabs } + write_used_unit_type_info(pu.u); + if assigned(pu.u.globalsymtable) then + tglobalsymtable(pu.u.globalsymtable).concattypestabto(debuglist); + end; + pu:=tused_unit(pu.next); + end; + end; + + var + vardebuglist : taasmoutput; + storefilepos : tfileposinfo; + begin + if not (cs_debuginfo in aktmoduleswitches) then + exit; + storefilepos:=aktfilepos; + aktfilepos:=current_module.mainfilepos; + { include symbol that will be referenced from the program to be sure to + include this debuginfo .o file } + if current_module.is_unit then + begin + current_module.flags:=current_module.flags or uf_has_debuginfo; + debugList.concat(tai_symbol.Createname_global(make_mangledname('DEBUGINFO',current_module.globalsymtable,''),AT_DATA,0)); + end + else + debugList.concat(tai_symbol.Createname_global(make_mangledname('DEBUGINFO',current_module.localsymtable,''),AT_DATA,0)); + { first write all global/local symbols again to a temp list. This will flag + all required tdefs. After that the temp list can be removed since the debuginfo is already + written to the stabs when the variables/consts were written } +{$warning Hack to get all needed types} + vardebuglist:=taasmoutput.create; + new_section(vardebuglist,sec_data,'',0); + if assigned(current_module.globalsymtable) then + tglobalsymtable(current_module.globalsymtable).concatstabto(vardebuglist); + if assigned(current_module.localsymtable) then + tstaticsymtable(current_module.localsymtable).concatstabto(vardebuglist); + vardebuglist.free; + { reset unit type info flag } + reset_unit_type_info; + { write used types from the used units } + write_used_unit_type_info(current_module); + { last write the types from this unit } + if assigned(current_module.globalsymtable) then + tglobalsymtable(current_module.globalsymtable).concattypestabto(debuglist); + if assigned(current_module.localsymtable) then + tstaticsymtable(current_module.localsymtable).concattypestabto(debuglist); + { include files } + if (cs_gdb_dbx in aktglobalswitches) then + begin + debugList.concat(tai_comment.Create(strpnew('EINCL of global '+ + tglobalsymtable(current_module.globalsymtable).name^+' has index '+ + tostr(tglobalsymtable(current_module.globalsymtable).moduleid)))); + debugList.concat(Tai_stabs.Create(strpnew('"'+ + tglobalsymtable(current_module.globalsymtable).name^+'",'+ + tostr(N_EINCL)+',0,0,0'))); + tglobalsymtable(current_module.globalsymtable).dbx_count_ok:={true}false; + dbx_counter:=tglobalsymtable(current_module.globalsymtable).prev_dbx_counter; + do_count_dbx:=false; + end; + aktfilepos:=storefilepos; + end; +{$EndIf GDB} + + procedure reset_all_defs; procedure reset_used_unit_defs(hp:tmodule); @@ -823,19 +957,16 @@ implementation procedure proc_unit; function is_assembler_generated:boolean; - var - hal : tasmlist; begin - result:=false; - if Errorcount=0 then - begin - for hal:=low(Tasmlist) to high(Tasmlist) do - if not asmlist[hal].empty then - begin - result:=true; - exit; - end; - end; + is_assembler_generated:=(Errorcount=0) and + not( + codeSegment.empty and + dataSegment.empty and + bssSegment.empty and + ((importssection=nil) or importsSection.empty) and + ((resourcesection=nil) or resourceSection.empty) and + ((resourcestringlist=nil) or resourcestringList.empty) + ); end; var @@ -850,7 +981,7 @@ implementation force_init_final : boolean; pd : tprocdef; unitname8 : string[8]; - has_impl,ag: boolean; + has_impl: boolean; begin if m_mac in aktmodeswitches then begin @@ -1121,13 +1252,13 @@ implementation consume(_POINT); { Generate resoucestrings } - If resourcestrings.ResStrCount>0 then + If ResourceStrings.ResStrCount>0 then begin - resourcestrings.CreateResourceStringList; + ResourceStrings.CreateResourceStringList; current_module.flags:=current_module.flags or uf_has_resources; { only write if no errors found } if (Errorcount=0) then - resourcestrings.WriteResourceFile(ForceExtension(current_module.ppufilename^,'.rst')); + ResourceStrings.WriteResourceFile(ForceExtension(current_module.ppufilename^,'.rst')); end; if (Errorcount=0) then @@ -1162,17 +1293,16 @@ implementation maybeloadvariantsunit; { generate debuginfo } - if (cs_debuginfo in aktmoduleswitches) then - debuginfo.inserttypeinfo; +{$ifdef GDB} + write_gdb_info; +{$endif GDB} { generate wrappers for interfaces } - gen_intf_wrappers(asmlist[al_procedures],current_module.globalsymtable); - gen_intf_wrappers(asmlist[al_procedures],current_module.localsymtable); + gen_intf_wrappers(codesegment,current_module.globalsymtable); + gen_intf_wrappers(codesegment,current_module.localsymtable); { generate a list of threadvars } -{$ifndef segment_threadvars} InsertThreadvars; -{$endif} { generate imports } if current_module.uses_imports then @@ -1180,24 +1310,20 @@ implementation { insert own objectfile, or say that it's in a library (no check for an .o when loading) } - ag:=is_assembler_generated; - if ag then + if is_assembler_generated then insertobjectfile else - begin - current_module.flags:=current_module.flags or uf_no_link; - current_module.flags:=current_module.flags and not uf_has_debuginfo; - end; + current_module.flags:=current_module.flags or uf_no_link; if cs_local_browser in aktmoduleswitches then current_module.localsymtable:=refsymtable; - if ag then + if is_assembler_generated then begin { create dwarf debuginfo } create_dwarf; { finish asmlist by adding segment starts } -// insertsegment; + insertsegment; { assemble } create_objectfile; end; @@ -1380,7 +1506,7 @@ implementation { The program intialization needs an alias, so it can be called from the bootstrap code.} - + if islibrary then begin pd:=create_main_proc(make_mangledname('',current_module.localsymtable,mainaliasname),potype_proginit,st); @@ -1393,7 +1519,7 @@ implementation begin pd:=create_main_proc('PASCALMAIN',potype_proginit,st); { main is need by the netware rtl } end - else + else begin pd:=create_main_proc(mainaliasname,potype_proginit,st); pd.aliasnames.insert('PASCALMAIN'); @@ -1419,14 +1545,14 @@ implementation if assigned(exportlib) and (target_info.system in [system_i386_win32,system_i386_wdosx]) and BinaryContainsExports then - asmlist[al_procedures].concat(tai_const.create_sym(exportlib.edatalabel)); + codesegment.concat(tai_const.create_sym(exportlib.edatalabel)); - If resourcestrings.ResStrCount>0 then + If ResourceStrings.ResStrCount>0 then begin - resourcestrings.CreateResourceStringList; + ResourceStrings.CreateResourceStringList; { only write if no errors found } if (Errorcount=0) then - resourcestrings.WriteResourceFile(ForceExtension(current_module.ppufilename^,'.rst')); + ResourceStrings.WriteResourceFile(ForceExtension(current_module.ppufilename^,'.rst')); end; { finalize? } @@ -1482,16 +1608,15 @@ implementation maybeloadvariantsunit; { generate debuginfo } - if (cs_debuginfo in aktmoduleswitches) then - debuginfo.inserttypeinfo; +{$ifdef GDB} + write_gdb_info; +{$endif GDB} { generate wrappers for interfaces } - gen_intf_wrappers(asmlist[al_procedures],current_module.localsymtable); + gen_intf_wrappers(codesegment,current_module.localsymtable); -{$ifndef segment_threadvars} { generate a list of threadvars } InsertThreadvars; -{$endif} { generate imports } if current_module.uses_imports then @@ -1503,21 +1628,19 @@ implementation exportlib.generatelib; { insert Tables and StackLength } -{$ifndef segment_threadvars} insertThreadVarTablesTable; -{$endif} insertResourceTablesTable; insertinitfinaltable; insertmemorysizes; { Insert symbol to resource info } - + InsertResourceInfo; { create dwarf debuginfo } create_dwarf; { finish asmlist by adding segment starts } -// insertsegment; + insertsegment; { insert own objectfile } insertobjectfile; diff --git a/compiler/powerpc/aasmcpu.pas b/compiler/powerpc/aasmcpu.pas index 341d5b1580..3e4fa99b63 100644 --- a/compiler/powerpc/aasmcpu.pas +++ b/compiler/powerpc/aasmcpu.pas @@ -475,7 +475,7 @@ uses cutils, cclasses; (ptruint(abs(ptrint(labelpositions[tasmlabel(taicpu(p).oper[0]^.ref^.symbol).labelnr]-instrpos)) - (low(smallint) div 4)) > ptruint((high(smallint) - low(smallint)) div 4)) then begin // add a new label after this jump - objectlibrary.getjumplabel(l); + objectlibrary.getlabel(l); list.insertafter(tai_label.create(l),p); // add a new unconditional jump between this jump and the label newjmp := taicpu.op_sym(A_B,taicpu(p).oper[0]^.ref^.symbol); diff --git a/compiler/powerpc/agppcmpw.pas b/compiler/powerpc/agppcmpw.pas index 6ec390d346..a2080b2512 100644 --- a/compiler/powerpc/agppcmpw.pas +++ b/compiler/powerpc/agppcmpw.pas @@ -39,6 +39,10 @@ interface procedure WriteAsmList;override; Function DoAssemble:boolean;override; procedure WriteExternals; +{$ifdef GDB} + procedure WriteFileLineInfo(var fileinfo : tfileposinfo); + procedure WriteFileEndInfo; +{$endif} procedure WriteAsmFileHeader; private procedure WriteInstruction(hp : tai); @@ -72,10 +76,21 @@ interface 'csect', {code} 'csect', {data} 'csect', {read only data} - 'csect', {bss} 'csect', - 'csect','csect','csect','csect','','','','','','','','','','' + 'csect', {bss} + 'csect','csect','csect','csect','','','','','','','','','' ); +{$ifdef GDB} +var + n_line : byte; { different types of source lines } + linecount, + includecount : longint; + funcname : pchar; + stabslastfileinfo : tfileposinfo; + isInFunction: Boolean; + firstLineInFunction: longint; +{$endif} + type t64bitarray = array[0..7] of byte; t32bitarray = array[0..3] of byte; @@ -544,7 +559,7 @@ interface GetAdjacentTaiSymbol:= true; Break; end; - ait_function_name: + ait_stab_function_name: hp:=tai(hp.next); else begin @@ -595,6 +610,16 @@ interface AsmWrite(s); AsmWriteLn('[PR]'); + {$ifdef GDB} + if ((cs_debuginfo in aktmoduleswitches) or + (cs_gdb_lineinfo in aktglobalswitches)) then + begin + //info for debuggers: + firstLineInFunction:= stabslastfileinfo.line; + AsmWriteLn(#9'beginf ' + tostr(firstLineInFunction)); + isInFunction:= true; + end; + {$endif} {Write all labels: } hp:= first; repeat @@ -672,6 +697,85 @@ interface (#9'dc.l'#9,#9'dc.w'#9,#9'dc.b'#9); +{$ifdef GDB} + procedure TPPCMPWAssembler.WriteFileLineInfo(var fileinfo : tfileposinfo); + var + curr_n : byte; + begin + if not ((cs_debuginfo in aktmoduleswitches) or + (cs_gdb_lineinfo in aktglobalswitches)) then + exit; + { file changed ? (must be before line info) } + if (fileinfo.fileindex<>0) and + (stabslastfileinfo.fileindex<>fileinfo.fileindex) then + begin + infile:=current_module.sourcefiles.get_file(fileinfo.fileindex); + if assigned(infile) then + begin + (* + if includecount=0 then + curr_n:=n_sourcefile + else + curr_n:=n_includefile; + if (infile.path^<>'') then + begin + AsmWriteLn(#9'.stabs "'+lower(BsToSlash(FixPath(infile.path^,false)))+'",'+ + tostr(curr_n)+',0,0,'+target_asm.labelprefix+'text'+ToStr(IncludeCount)); + end; + + AsmWriteLn(#9'.stabs "'+lower(FixFileName(infile.name^))+'",'+ + tostr(curr_n)+',0,0,'+target_asm.labelprefix+'text'+ToStr(IncludeCount)); + *) + AsmWriteLn(#9'file '''+lower(FixFileName(infile.name^))+''''); + + (* + AsmWriteLn(target_asm.labelprefix+'text'+ToStr(IncludeCount)+':'); + *) + + inc(includecount); + { force new line info } + stabslastfileinfo.line:=-1; + end; + end; + { line changed ? } + if (stabslastfileinfo.line<>fileinfo.line) and (fileinfo.line<>0) then + begin + (* + if (n_line=n_textline) and assigned(funcname) and + (target_info.use_function_relative_addresses) then + begin + AsmWriteLn(target_asm.labelprefix+'l'+tostr(linecount)+':'); + AsmWrite(#9'.stabn '+tostr(n_line)+',0,'+tostr(fileinfo.line)+','+ + target_asm.labelprefix+'l'+tostr(linecount)+' - '); + AsmWritePChar(FuncName); + AsmLn; + inc(linecount); + end + else + AsmWriteLn(#9'.stabd'#9+tostr(n_line)+',0,'+tostr(fileinfo.line)); + *) + if isInFunction then + AsmWriteln(#9'line '+ tostr(fileinfo.line - firstLineInFunction + 1)); + end; + stabslastfileinfo:=fileinfo; + end; + + procedure TPPCMPWAssembler.WriteFileEndInfo; + + begin + if not ((cs_debuginfo in aktmoduleswitches) or + (cs_gdb_lineinfo in aktglobalswitches)) then + exit; + AsmLn; + (* + AsmWriteLn(ait_section2str(sec_code)); + AsmWriteLn(#9'.stabs "",'+tostr(n_sourcefile)+',0,0,'+target_asm.labelprefix+'etext'); + AsmWriteLn(target_asm.labelprefix+'etext:'); + *) + end; + +{$endif} + procedure TPPCMPWAssembler.WriteTree(p:TAAsmoutput); var s, @@ -696,10 +800,10 @@ interface if not assigned(p) then exit; InlineLevel:=0; - { lineinfo is only needed for al_procedures (PFV) } + { lineinfo is only needed for codesegment (PFV) } do_line:=((cs_asm_source in aktglobalswitches) or (cs_lineinfo in aktmoduleswitches)) - and (p=asmlist[al_procedures]); + and (p=codesegment); DoNotSplitLine:=false; hp:=tai(p.first); while assigned(hp) do @@ -709,6 +813,13 @@ interface begin hp1 := hp as tailineinfo; +{$ifdef GDB} + { write debug info } + if (cs_debuginfo in aktmoduleswitches) or + (cs_gdb_lineinfo in aktglobalswitches) then + WriteFileLineInfo(hp1.fileinfo); +{$endif GDB} + if do_line then begin { load infile } @@ -788,6 +899,9 @@ interface AsmLn; AsmWriteLn(#9+secnames[tai_section(hp).sectype]+' '+cur_CSECT_name+cur_CSECT_class); +{$ifdef GDB} + lastfileinfo.line:=-1; +{$endif GDB} end; LasTSec:=tai_section(hp).sectype; end; @@ -1071,6 +1185,11 @@ interface end; end; end; + ait_direct: + begin + AsmWritePChar(tai_direct(hp).str); + AsmLn; + end; ait_symbol: begin if tai_symbol(hp).sym.typ=AT_FUNCTION then @@ -1089,12 +1208,28 @@ interface InternalError(2003071301); end; ait_symbol_end: +{$ifdef GDB} + if isInFunction then + if ((cs_debuginfo in aktmoduleswitches) or + (cs_gdb_lineinfo in aktglobalswitches)) then + begin + //info for debuggers: + AsmWriteLn(#9'endf ' + tostr(stabslastfileinfo.line)); + isInFunction:= false; + end +{$endif GDB} ; ait_instruction: WriteInstruction(hp); - ait_stab, - ait_force_line, - ait_function_name : ; +{$ifdef GDB} + ait_stabn: ; + ait_stabs: ; + + ait_force_line : + stabslastfileinfo.line:=0; + + ait_stab_function_name: ; +{$endif GDB} ait_cutobject : begin InternalError(2004101101); {Smart linking is done transparently by the MPW linker.} @@ -1207,7 +1342,7 @@ interface DoAssemble:=Inherited DoAssemble; (* { masm does not seem to recognize specific extensions and uses .obj allways PM } - if (target_asm.id = as_i386_masm) then + if (aktoutputformat = as_i386_masm) then begin if not(cs_asm_extern in aktglobalswitches) then begin @@ -1230,7 +1365,7 @@ interface (* AsmWriteLn(#9'.386p'); { masm 6.11 does not seem to like LOCALS PM } - if (target_asm.id = as_i386_tasm) then + if (aktoutputformat = as_i386_tasm) then begin AsmWriteLn(#9'LOCALS '+target_asm.labelprefix); end; @@ -1245,24 +1380,55 @@ interface end; procedure TPPCMPWAssembler.WriteAsmList; + + +{$ifdef GDB} var - hal : tasmlist; + fileinfo : tfileposinfo; +{$endif GDB} + begin {$ifdef EXTDEBUG} if assigned(current_module.mainsource) then comment(v_info,'Start writing MPW-styled assembler output for '+current_module.mainsource^); {$endif} LasTSec:=sec_none; +{$ifdef GDB} + FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0); +{$endif GDB} +{$ifdef GDB} + //n_line:=n_bssline; + funcname:=nil; + linecount:=1; + includecount:=0; + fileinfo.fileindex:=1; + fileinfo.line:=1; + + isInFunction:= false; + firstLineInFunction:= 0; + + { Write main file } + WriteFileLineInfo(fileinfo); + +{$endif GDB} WriteAsmFileHeader; WriteExternals; - for hal:=low(Tasmlist) to high(Tasmlist) do - begin - AsmWriteLn(target_asm.comment+'Begin asmlist '+TasmlistStr[hal]); - writetree(asmlist[hal]); - AsmWriteLn(target_asm.comment+'End asmlist '+TasmlistStr[hal]); - end; + { PowerPC MPW ASM doesn't support stabs, at the moment:} +(* + If (cs_debuginfo in aktmoduleswitches) then + WriteTree(debuglist); +*) + WriteTree(codesegment); + WriteTree(datasegment); + WriteTree(consts); + WriteTree(rttilist); + WriteTree(resourcestringlist); + WriteTree(bsssegment); + {$ifdef GDB} + WriteFileEndInfo; + {$ENDIF} AsmWriteLn(#9'end'); AsmLn; diff --git a/compiler/powerpc/aoptcpu.pas b/compiler/powerpc/aoptcpu.pas index a6e38a5c3f..3a46494b69 100644 --- a/compiler/powerpc/aoptcpu.pas +++ b/compiler/powerpc/aoptcpu.pas @@ -28,424 +28,15 @@ Interface {$i fpcdefs.inc} -uses cpubase, aoptobj, aoptcpub, aopt, aasmtai, aasmcpu; +uses cpubase, aoptobj, aoptcpub, aopt; Type TCpuAsmOptimizer = class(TAsmOptimizer) { uses the same constructor as TAopObj } - function PeepHoleOptPass1Cpu(var p: tai): boolean; override; - - function PostPeepHoleOptsCpu(var p: tai): boolean; override; - - private - function cmpi_mfcr_opt(p, next1, next2: taicpu): boolean; End; Implementation - uses - cutils, cgbase; - -const - calculation_target_op0: array[tasmop] of tasmop = (a_none, - a_add, a_add_, a_addo, a_addo_, a_addc, a_addc_, a_addco, a_addco_, - a_adde, a_adde_, a_addeo, a_addeo_, a_addi, a_addic, a_addic_, a_addis, - a_addme, a_addme_, a_addmeo, a_addmeo_, a_addze, a_addze_, a_addzeo, - a_addzeo_, a_and, a_and_, a_andc, a_andc_, a_andi_, a_andis_, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_cntlzw, a_cntlzw_, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_divw, a_divw_, a_divwo, a_divwo_, - a_divwu, a_divwu_, a_divwuo, a_divwuo_, a_none, a_none, a_none, a_eqv, - a_eqv_, a_extsb, a_extsb_, a_extsh, a_extsh_, a_fabs, a_fabs_, a_fadd, - a_fadd_, a_fadds, a_fadds_, a_none, a_none, a_none, a_none, a_none, - a_none, a_fdiv, a_fdiv_, a_fdivs, a_fdivs_, a_fmadd, a_fmadd_, a_fmadds, - a_fmadds_, a_none, a_fmsub, a_fmsub_, a_fmsubs, a_fmsubs_, a_fmul, a_fmul_, - a_fmuls, a_fmuls_, a_fnabs, a_fnabs_, a_fneg, a_fneg_, a_fnmadd, - a_fnmadd_, a_fnmadds, a_fnmadds_, a_fnmsub, a_fnmsub_, a_fnmsubs, - a_fnmsubs_, a_fres, a_fres_, a_frsp, a_frsp_, a_frsqrte, a_frsqrte_, - a_none, a_none, a_fsqrt, a_fsqrt_, a_fsqrts, a_fsqrts_, a_fsub, a_fsub_, - a_fsubs, a_fsubs_, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_mulhw, - a_mulhw_, a_mulhwu, a_mulhwu_, a_mulli, a_mullw, a_mullw_, a_mullwo, - a_mullwo_, a_nand, a_nand_, a_neg, a_neg_, a_nego, a_nego_, a_nor, a_nor_, - a_or, a_or_, a_orc, a_orc_, a_ori, a_oris, a_rfi, a_rlwimi, a_rlwimi_, - a_rlwinm, a_rlwinm_, a_rlwnm, a_rlwnm_, a_none, a_slw, a_slw_, a_sraw, a_sraw_, - a_srawi, a_srawi_,a_srw, a_srw_, a_stb, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_subf, a_subf_, a_subfo, - a_subfo_, a_subfc, a_subfc_, a_subfco, a_subfco_, a_subfe, a_subfe_, - a_subfeo, a_subfeo_, a_subfic, a_subfme, a_subfme_, a_subfmeo, a_subfmeo_, - a_subfze, a_subfze_, a_subfzeo, a_subfzeo_, a_none, a_none, a_none, - a_none, a_none, a_none, a_xor, a_xor_, a_xori, a_xoris, - { simplified mnemonics } - a_subi, a_subis, a_subic, a_subic_, a_sub, a_sub_, a_subo, a_subo_, - a_subc, a_subc_, a_subco, a_subco_, a_none, a_none, a_none, a_none, - a_extlwi, a_extlwi_, a_extrwi, a_extrwi_, a_inslwi, a_inslwi_, a_insrwi, - a_insrwi_, a_rotlwi, a_rotlwi_, a_rotlw, a_rotlw_, a_slwi, a_slwi_, - a_srwi, a_srwi_, a_clrlwi, a_clrlwi_, a_clrrwi, a_clrrwi_, a_clrslwi, - a_clrslwi_, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none {move to special prupose reg}, a_none {move from special purpose reg}, - a_none, a_none, a_none, a_none, a_none, a_none, a_not, a_not_, a_none, a_none, a_none, - a_none, a_none, a_none); - - function TCpuAsmOptimizer.cmpi_mfcr_opt(p, next1, next2: taicpu): boolean; - var - next3: tai; - inverse: boolean; - begin - result := true; - inverse := - getnextinstruction(next2,next3) and - (next3.typ = ait_instruction) and - (taicpu(next3).opcode = A_XORI) and - (taicpu(next3).oper[0]^.reg = taicpu(next3).oper[1]^.reg) and - (taicpu(next3).oper[0]^.reg = taicpu(next2).oper[0]^.reg); - case taicpu(next2).oper[2]^.val of - 1: - begin - // less than zero or greater/equal than zero (the xori remains in - // in the latter case). Doesn't make sense for unsigned comparisons. - if (p.opcode = A_CMPWI) then - begin - p.opcode := A_SRWI; - p.ops := 3; - p.loadreg(1,p.oper[0]^.reg); - p.loadreg(0,next1.oper[0]^.reg); - p.loadconst(2,31); - asml.remove(next1); - next1.free; - asml.remove(next2); - next2.free; - end - else - result := false; - end; -{ - needs two registers to work with - 2: - begin - // greater or less/equal to zero - end; -} - 3: - begin - // equal/not equal to zero (the xori remains in the latter case; - // there's a more optimal sequence without it, but needs extra - // register) - p.opcode := A_CNTLZW; - p.loadreg(1,p.oper[0]^.reg); - p.loadreg(0,next1.oper[0]^.reg); - next1.ops := 3; - next1.opcode := A_SRWI; - next1.loadreg(1,next1.oper[0]^.reg); - next1.loadconst(2,5); - asml.remove(next2); - next2.free; - end; - else - result := false; - end; - end; - - - function TCpuAsmOptimizer.PeepHoleOptPass1Cpu(var p: tai): boolean; - var - next1, next2: tai; - l1, l2: longint; - begin - result := false; - case p.typ of - ait_instruction: - begin - case taicpu(p).opcode of - A_CMPWI, - A_CMPLWI: - begin - if (taicpu(p).oper[1]^.typ = top_const) and - (taicpu(p).oper[1]^.val = 0) and - getnextinstruction(p,next1) and - (next1.typ = ait_instruction) and - (taicpu(next1).opcode = A_MFCR) and - getnextinstruction(next1,next2) and - (taicpu(next2).opcode = A_RLWINM) and - (taicpu(next2).oper[0]^.reg = taicpu(next2).oper[1]^.reg) and - (taicpu(next2).oper[0]^.reg = taicpu(next1).oper[0]^.reg) and - (taicpu(next2).oper[3]^.val = 31) and - (taicpu(next2).oper[4]^.val = 31) and - cmpi_mfcr_opt(taicpu(p),taicpu(next1),taicpu(next2)) then - result := true; - end; -{ seems the register allocator doesn't generate superfluous fmr's } -{ A_FMR, } - A_MR: - begin - if getnextinstruction(p,next1) and - (next1.typ = ait_instruction) and - (calculation_target_op0[taicpu(next1).opcode] <> a_none) and - (taicpu(next1).oper[0]^.reg = taicpu(p).oper[0]^.reg) then - begin - for l1 := 1 to taicpu(next1).ops - 1 do - if (taicpu(next1).oper[l1]^.typ = top_reg) and - (taicpu(next1).oper[l1]^.reg = taicpu(p).oper[0]^.reg) then - taicpu(next1).loadreg(l1,taicpu(p).oper[1]^.reg); - asml.remove(p); - p.free; - p := next1; - result := true; - end; - end; - A_SLWI: - begin - if getnextinstruction(p,next1) and - (next1.typ = ait_instruction) and - (taicpu(next1).opcode = A_RLWINM) and - (taicpu(next1).oper[0]^.reg = taicpu(p).oper[0]^.reg) and - (taicpu(next1).oper[1]^.reg = taicpu(p).oper[0]^.reg) then - begin - if (taicpu(next1).oper[2]^.val = 0) then - begin - { convert slwi to rlwinm and see if the rlwinm } - { optimization can do something with it } - taicpu(p).opcode := A_RLWINM; - taicpu(p).ops := 5; - taicpu(p).loadconst(2,taicpu(p).oper[2]^.val); - taicpu(p).loadconst(3,0); - taicpu(p).loadconst(4,31-taicpu(p).oper[2]^.val); - result := true; - end; - end; - end; - A_SRWI: - begin - if getnextinstruction(p,next1) and - (next1.typ = ait_instruction) and - ((taicpu(next1).opcode = A_SLWI) or - (taicpu(next1).opcode = A_RLWINM)) and - (taicpu(next1).oper[0]^.reg = taicpu(p).oper[0]^.reg) and - (taicpu(next1).oper[1]^.reg = taicpu(p).oper[0]^.reg) then - case taicpu(next1).opcode of - A_SLWI: - begin - taicpu(p).opcode := A_RLWINM; - taicpu(p).ops := 5; - taicpu(p).loadconst(2,taicpu(next1).oper[2]^.val-taicpu(p).oper[2]^.val); - if (taicpu(p).oper[2]^.val < 0) then - begin - taicpu(p).loadconst(3,-taicpu(p).oper[2]^.val); - taicpu(p).loadconst(4,31-taicpu(next1).oper[2]^.val); - inc(taicpu(p).oper[2]^.val,32); - end - else - begin - taicpu(p).loadconst(3,0); - taicpu(p).loadconst(4,31-taicpu(next1).oper[2]^.val); - end; - asml.remove(next1); - next1.free; - result := true; - end; - A_RLWINM: - begin - if (taicpu(next1).oper[2]^.val = 0) then - begin - { convert srwi to rlwinm and see if the rlwinm } - { optimization can do something with it } - taicpu(p).opcode := A_RLWINM; - taicpu(p).ops := 5; - taicpu(p).loadconst(3,taicpu(p).oper[2]^.val); - taicpu(p).loadconst(4,31); - taicpu(p).loadconst(2,(32-taicpu(p).oper[2]^.val) and 31); - result := true; - end; - end; - end; - end; - A_RLWINM: - begin - if getnextinstruction(p,next1) and - (next1.typ = ait_instruction) and - (taicpu(next1).opcode = A_RLWINM) and - (taicpu(next1).oper[0]^.reg = taicpu(p).oper[0]^.reg) and - // both source and target of next1 must equal target of p - (taicpu(next1).oper[1]^.reg = taicpu(p).oper[0]^.reg) and - (taicpu(next1).oper[2]^.val = 0) then - begin - l1 := taicpu(p).oper[4]^.val; - if (l1 < taicpu(p).oper[3]^.val) then - inc(l1,32); - l2 := taicpu(next1).oper[4]^.val; - if (l2 < taicpu(next1).oper[3]^.val) then - inc(l2,32); - - if (taicpu(p).oper[3]^.val > l2) or - (taicpu(next1).oper[3]^.val > l1) then - begin - // masks have no bits in common - taicpu(p).opcode := A_LI; - taicpu(p).loadconst(1,0); - taicpu(p).clearop(2); - taicpu(p).clearop(3); - taicpu(p).clearop(4); - taicpu(p).ops := 2; - taicpu(p).opercnt := 2; - asml.remove(next1); - next1.free; - end - else - // some of the cases with l1>32 or l2>32 can be - // optimized, but others can't (like 19,17 and 25,23) - if (l1 < 32) and - (l2 < 32) then - begin - taicpu(p).oper[3]^.val := max(taicpu(p).oper[3]^.val,taicpu(next1).oper[3]^.val); - taicpu(p).oper[4]^.val := min(taicpu(p).oper[4]^.val,taicpu(next1).oper[4]^.val); - asml.remove(next1); - next1.free; - result := true; - end; - end; - end; - end; - end; - end; - end; - - - const - modifyflags: array[tasmop] of tasmop = - (a_none, a_add_, a_add_, a_addo_, a_addo_, a_addc_, a_addc_, a_addco_, a_addco_, - a_adde_, a_adde_, a_addeo_, a_addeo_, {a_addi could be addic_ if sure doesn't disturb carry} a_none, a_addic_, a_addic_, a_none, - a_addme_, a_addme_, a_addmeo_, a_addmeo_, a_addze_, a_addze_, a_addzeo_, - a_addzeo_, a_and_, a_and_, a_andc_, a_andc_, a_andi_, a_andis_, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_cntlzw_, a_cntlzw_, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_divw_, a_divw_, a_divwo_, a_divwo_, - a_divwu_, a_divwu_, a_divwuo_, a_divwuo_, a_none, a_none, a_none, a_eqv_, - a_eqv_, a_extsb_, a_extsb_, a_extsh_, a_extsh_, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_mffs, a_mffs_, a_mfmsr, a_mfspr, a_mfsr, - a_mfsrin, a_mftb, a_mtcrf, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_mulhw_, - a_mulhw_, a_mulhwu_, a_mulhwu_, a_none, a_mullw_, a_mullw_, a_mullwo_, - a_mullwo_, a_nand_, a_nand_, a_neg_, a_neg_, a_nego_, a_nego_, a_nor_, a_nor_, - a_or_, a_or_, a_orc_, a_orc_, a_none, a_none, a_none, a_rlwimi_, a_rlwimi_, - a_rlwinm_, a_rlwinm_, a_rlwnm_, a_rlwnm_, a_none, a_slw_, a_slw_, a_sraw_, a_sraw_, - a_srawi_, a_srawi_,a_srw_, a_srw_, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none, a_none, a_none, a_none, a_subf_, a_subf_, a_subfo_, - a_subfo_, a_subfc_, a_subfc_, a_subfco_, a_subfco_, a_subfe_, a_subfe_, - a_subfeo_, a_subfeo_, a_none, a_subfme_, a_subfme_, a_subfmeo_, a_subfmeo_, - a_subfze_, a_subfze_, a_subfzeo_, a_subfzeo_, a_none, a_none, a_none, - a_none, a_none, a_none, a_xor_, a_xor_, a_none, a_none, - { simplified mnemonics } - a_none, a_none, a_subic_, a_subic_, a_sub_, a_sub_, a_subo_, a_subo_, - a_subc_, a_subc_, a_subco_, a_subco_, a_none, a_none, a_none, a_none, - a_extlwi_, a_extlwi_, a_extrwi_, a_extrwi_, a_inslwi_, a_inslwi_, a_insrwi_, - a_insrwi_, a_rotlwi_, a_rotlwi_, a_rotlw_, a_rotlw_, a_slwi_, a_slwi_, - a_srwi_, a_srwi_, a_clrlwi_, a_clrlwi_, a_clrrwi_, a_clrrwi_, a_clrslwi_, - a_clrslwi_, a_none, a_none, a_none, a_none, a_none, a_none, a_none, - a_none, a_none {move to special prupose reg}, a_none {move from special purpose reg}, - a_none, a_none, a_none, a_none, a_mr_, a_mr_, a_not_, a_not_, a_none, a_none, a_none, - a_none, a_none, a_none); - - function changetomodifyflags(p: taicpu): boolean; - begin - result := false; - if (modifyflags[p.opcode] <> a_none) then - begin - p.opcode := modifyflags[p.opcode]; - result := true; - end; - end; - - function TCpuAsmOptimizer.PostPeepHoleOptsCpu(var p: tai): boolean; - var - next1: tai; - begin - result := false; - case p.typ of - ait_instruction: - begin - case taicpu(p).opcode of - A_RLWINM_: - begin - // rlwinm_ is cracked on the G5, andi_/andis_ aren't - if (taicpu(p).oper[2]^.val = 0) then - if (taicpu(p).oper[3]^.val < 16) and - (taicpu(p).oper[4]^.val < 16) then - begin - taicpu(p).opcode := A_ANDIS_; - taicpu(p).oper[2]^.val := - ((1 shl (16-taicpu(p).oper[3]^.val)) - 1) and - not((1 shl (15-taicpu(p).oper[4]^.val)) - 1); - taicpu(p).clearop(3); - taicpu(p).clearop(4); - taicpu(p).ops := 3; - taicpu(p).opercnt := 2; - end - else if (taicpu(p).oper[3]^.val >= 16) and - (taicpu(p).oper[4]^.val >= 16) then - begin - taicpu(p).opcode := A_ANDI_; - taicpu(p).oper[2]^.val := - ((1 shl (32-taicpu(p).oper[3]^.val)) - 1) and - not((1 shl (31-taicpu(p).oper[4]^.val)) - 1); - taicpu(p).clearop(3); - taicpu(p).clearop(4); - taicpu(p).ops := 3; - taicpu(p).opercnt := 2; - end; - end; - end; - - // change "integer operation with destination reg" followed by a - // comparison to zero of that reg, with a variant of that integer - // operation which sets the flags (if it exists) - if not(result) and - (taicpu(p).ops >= 2) and - (taicpu(p).oper[0]^.typ = top_reg) and - (taicpu(p).oper[1]^.typ = top_reg) and - getnextinstruction(p,next1) and - (next1.typ = ait_instruction) and - (taicpu(next1).opcode = A_CMPWI) and - // make sure it the result goes to cr0 - (((taicpu(next1).ops = 2) and - (taicpu(next1).oper[1]^.val = 0) and - (taicpu(next1).oper[0]^.reg = taicpu(p).oper[0]^.reg)) or - ((taicpu(next1).ops = 3) and - (taicpu(next1).oper[2]^.val = 0) and - (taicpu(next1).oper[0]^.typ = top_reg) and - (getsupreg(taicpu(next1).oper[0]^.reg) = RS_CR0) and - (taicpu(next1).oper[1]^.reg = taicpu(p).oper[0]^.reg))) and - changetomodifyflags(taicpu(p)) then - begin - asml.remove(next1); - next1.free; - result := true; - end; - end; - end; - end; - begin casmoptimizer:=TCpuAsmOptimizer; End. diff --git a/compiler/powerpc/cgcpu.pas b/compiler/powerpc/cgcpu.pas index 9c49618cdb..812f83fc11 100644 --- a/compiler/powerpc/cgcpu.pas +++ b/compiler/powerpc/cgcpu.pas @@ -365,29 +365,33 @@ const if assigned(result) then exit; - if asmlist[al_imports]=nil then - asmlist[al_imports]:=TAAsmoutput.create; + if not(assigned(importssection)) then + importssection:=TAAsmoutput.create; - asmlist[al_imports].concat(Tai_section.Create(sec_data,'',0)); - asmlist[al_imports].concat(Tai_section.create(sec_stub,'',0)); - asmlist[al_imports].concat(Tai_align.Create(4)); + importsSection.concat(Tai_section.Create(sec_data,'',0)); + importsSection.concat(Tai_direct.create(strpnew('.section __TEXT,__symbol_stub1,symbol_stubs,pure_instructions,16'))); + importsSection.concat(Tai_align.Create(4)); result := objectlibrary.newasmsymbol(stubname,AB_EXTERNAL,AT_FUNCTION); - asmlist[al_imports].concat(Tai_symbol.Create(result,0)); - asmlist[al_imports].concat(tai_directive.create(asd_indirect_symbol,s)); + importsSection.concat(Tai_symbol.Create(result,0)); + importsSection.concat(Tai_direct.create(strpnew((#9+'.indirect_symbol ')+s))); l1 := objectlibrary.newasmsymbol('L'+s+'$lazy_ptr',AB_EXTERNAL,AT_FUNCTION); reference_reset_symbol(href,l1,0); +{$ifdef powerpc} href.refaddr := addr_hi; - asmlist[al_imports].concat(taicpu.op_reg_ref(A_LIS,NR_R11,href)); + importsSection.concat(taicpu.op_reg_ref(A_LIS,NR_R11,href)); href.refaddr := addr_lo; href.base := NR_R11; - asmlist[al_imports].concat(taicpu.op_reg_ref(A_LWZU,NR_R12,href)); - asmlist[al_imports].concat(taicpu.op_reg(A_MTCTR,NR_R12)); - asmlist[al_imports].concat(taicpu.op_none(A_BCTR)); - asmlist[al_imports].concat(Tai_section.Create(sec_data,'',0)); - asmlist[al_imports].concat(tai_directive.create(asd_lazy_symbol_pointer,'')); - asmlist[al_imports].concat(Tai_symbol.Create(l1,0)); - asmlist[al_imports].concat(tai_directive.create(asd_indirect_symbol,s)); - asmlist[al_imports].concat(tai_const.createname(strpnew('dyld_stub_binding_helper'),AT_FUNCTION,0)); + importsSection.concat(taicpu.op_reg_ref(A_LWZU,NR_R12,href)); + importsSection.concat(taicpu.op_reg(A_MTCTR,NR_R12)); + importsSection.concat(taicpu.op_none(A_BCTR)); +{$else powerpc} + internalerror(2004010502); +{$endif powerpc} + importsSection.concat(Tai_section.Create(sec_data,'',0)); + importsSection.concat(Tai_direct.create(strpnew('.lazy_symbol_pointer'))); + importsSection.concat(Tai_symbol.Create(l1,0)); + importsSection.concat(Tai_direct.create(strpnew((#9+'.indirect_symbol ')+s))); + importsSection.concat(tai_const.createname(strpnew('dyld_stub_binding_helper'),AT_FUNCTION,0)); end; @@ -404,7 +408,9 @@ const list.concat(taicpu.op_none(A_NOP)); end else - list.concat(taicpu.op_sym(A_BL,get_darwin_call_stub(s))); + begin + list.concat(taicpu.op_sym(A_BL,get_darwin_call_stub(s))); + end; { the compiler does not properly set this flag anymore in pass 1, and for now we only need it after pass 2 (I hope) (JM) @@ -1879,7 +1885,7 @@ const { explicitely allocate R_0 since it can be used safely here } { (for holding date that's being copied) } a_reg_alloc(list,NR_F0); - objectlibrary.getjumplabel(lab); + objectlibrary.getlabel(lab); a_label(list, lab); list.concat(taicpu.op_reg_reg_const(A_SUBIC_,countreg,countreg,1)); list.concat(taicpu.op_reg_ref(A_LFDU,NR_F0,src)); @@ -1931,7 +1937,7 @@ const { explicitely allocate R_0 since it can be used safely here } { (for holding date that's being copied) } a_reg_alloc(list,NR_R0); - objectlibrary.getjumplabel(lab); + objectlibrary.getlabel(lab); a_label(list, lab); list.concat(taicpu.op_reg_reg_const(A_SUBIC_,countreg,countreg,1)); list.concat(taicpu.op_reg_ref(A_LWZU,NR_R0,src)); @@ -1983,7 +1989,7 @@ const begin if not(cs_check_overflow in aktlocalswitches) then exit; - objectlibrary.getjumplabel(hl); + objectlibrary.getlabel(hl); if not ((def.deftype=pointerdef) or ((def.deftype=orddef) and (torddef(def).typ in [u64bit,u16bit,u32bit,u8bit,uchar, diff --git a/compiler/powerpc/cpubase.pas b/compiler/powerpc/cpubase.pas index b09e1ccaf7..dd94e6271c 100644 --- a/compiler/powerpc/cpubase.pas +++ b/compiler/powerpc/cpubase.pas @@ -84,7 +84,7 @@ uses a_clrslwi_, a_blr, a_bctr, a_blrl, a_bctrl, a_crset, a_crclr, a_crmove, a_crnot, a_mt {move to special prupose reg}, a_mf {move from special purpose reg}, a_nop, a_li, a_lis, a_la, a_mr, a_mr_, a_not, a_not_, a_mtcr, a_mtlr, a_mflr, - a_mtctr, a_mfctr, a_mftbu); + a_mtctr, a_mfctr); {# This should define the array of instructions as string } op2strtable=array[tasmop] of string[8]; diff --git a/compiler/powerpc/cputarg.pas b/compiler/powerpc/cputarg.pas index f3bc579da7..3ba07c70c3 100644 --- a/compiler/powerpc/cputarg.pas +++ b/compiler/powerpc/cputarg.pas @@ -58,26 +58,8 @@ implementation {$ifndef NOAGPPPCMPW} ,agppcmpw {$endif} - -{************************************** - Assembler Readers -**************************************} - - {$ifndef NoRaPPCGas} - ,rappcgas - {$endif NoRaPPCGas} - -{************************************** - Debuginfo -**************************************} - - {$ifndef NoDbgStabs} - ,dbgstabs - {$endif NoDbgStabs} - {$ifndef NoDbgDwarf} - ,dbgdwarf - {$endif NoDbgDwarf} - + + {************************************** Optimizer **************************************} diff --git a/compiler/powerpc/itcpugas.pas b/compiler/powerpc/itcpugas.pas index 49d4a9156b..98364680b7 100644 --- a/compiler/powerpc/itcpugas.pas +++ b/compiler/powerpc/itcpugas.pas @@ -74,7 +74,7 @@ interface 'srwi', 'srwi.', 'clrlwi', 'clrlwi.', 'clrrwi', 'clrrwi.', 'clrslwi', 'clrslwi.', 'blr', 'bctr', 'blrl', 'bctrl', 'crset', 'crclr', 'crmove', 'crnot', 'mt', 'mf','nop', 'li', 'lis', 'la', 'mr','mr.','not', 'not.', - 'mtcr', 'mtlr', 'mflr','mtctr', 'mfctr', 'mftbu'); + 'mtcr', 'mtlr', 'mflr','mtctr', 'mfctr'); function gas_regnum_search(const s:string):Tregister; function gas_regname(r:Tregister):string; diff --git a/compiler/powerpc/nppcadd.pas b/compiler/powerpc/nppcadd.pas index 754404f99b..965311477e 100644 --- a/compiler/powerpc/nppcadd.pas +++ b/compiler/powerpc/nppcadd.pas @@ -281,9 +281,9 @@ interface if isjump then begin otl:=truelabel; - objectlibrary.getjumplabel(truelabel); + objectlibrary.getlabel(truelabel); ofl:=falselabel; - objectlibrary.getjumplabel(falselabel); + objectlibrary.getlabel(falselabel); end; secondpass(left); if left.location.loc in [LOC_FLAGS,LOC_JUMP] then @@ -300,9 +300,9 @@ interface if isjump then begin otl:=truelabel; - objectlibrary.getjumplabel(truelabel); + objectlibrary.getlabel(truelabel); ofl:=falselabel; - objectlibrary.getjumplabel(falselabel); + objectlibrary.getlabel(falselabel); end; secondpass(right); if right.location.loc in [LOC_FLAGS,LOC_JUMP] then @@ -378,7 +378,7 @@ interface andn : begin otl:=truelabel; - objectlibrary.getjumplabel(truelabel); + objectlibrary.getlabel(truelabel); secondpass(left); maketojumpbool(exprasmlist,left,lr_load_regvars); cg.a_label(exprasmlist,truelabel); @@ -387,7 +387,7 @@ interface orn : begin ofl:=falselabel; - objectlibrary.getjumplabel(falselabel); + objectlibrary.getlabel(falselabel); secondpass(left); maketojumpbool(exprasmlist,left,lr_load_regvars); cg.a_label(exprasmlist,falselabel); @@ -1447,7 +1447,7 @@ interface exprasmlist.concat(taicpu.op_reg_reg_reg(A_MULLW,location.register, left.location.register,right.location.register)); { g_overflowcheck generates a OC_AE instead of OC_EQ :/ } - objectlibrary.getjumplabel(hl); + objectlibrary.getlabel(hl); tcgppc(cg).a_jmp_cond(exprasmlist,OC_EQ,hl); cg.a_call_name(exprasmlist,'FPC_OVERFLOW'); cg.a_label(exprasmlist,hl); diff --git a/compiler/powerpc/nppccal.pas b/compiler/powerpc/nppccal.pas index 264896f900..26b180bf83 100644 --- a/compiler/powerpc/nppccal.pas +++ b/compiler/powerpc/nppccal.pas @@ -41,6 +41,10 @@ implementation globtype,systems, cutils,verbose,globals, symconst,symbase,symsym,symtable,defutil,paramgr,parabase, +{$ifdef GDB} + strings, + gdb, +{$endif GDB} cgbase,pass_2, cpuinfo,cpubase,aasmbase,aasmtai,aasmcpu, nmem,nld,ncnv, diff --git a/compiler/powerpc/nppccnv.pas b/compiler/powerpc/nppccnv.pas index 4dca8d53d3..ba60b7c372 100644 --- a/compiler/powerpc/nppccnv.pas +++ b/compiler/powerpc/nppccnv.pas @@ -251,8 +251,8 @@ implementation begin oldtruelabel:=truelabel; oldfalselabel:=falselabel; - objectlibrary.getjumplabel(truelabel); - objectlibrary.getjumplabel(falselabel); + objectlibrary.getlabel(truelabel); + objectlibrary.getlabel(falselabel); secondpass(left); if codegenerror then exit; @@ -312,7 +312,7 @@ implementation LOC_JUMP : begin hreg1:=cg.getintregister(exprasmlist,OS_INT); - objectlibrary.getjumplabel(hlabel); + objectlibrary.getlabel(hlabel); cg.a_label(exprasmlist,truelabel); cg.a_load_const_reg(exprasmlist,OS_INT,1,hreg1); cg.a_jmp_always(exprasmlist,hlabel); diff --git a/compiler/powerpc/nppcld.pas b/compiler/powerpc/nppcld.pas index a847b6fc7f..41bf789da3 100644 --- a/compiler/powerpc/nppcld.pas +++ b/compiler/powerpc/nppcld.pas @@ -68,9 +68,9 @@ unit nppcld; if not(assigned(l)) then begin l:=objectlibrary.newasmsymbol('L'+tprocsym(symtableentry).procdef[1].mangledname+'$non_lazy_ptr',AB_COMMON,AT_DATA); - asmlist[al_picdata].concat(tai_symbol.create(l,0)); - asmlist[al_picdata].concat(tai_const.create_indirect_sym(objectlibrary.newasmsymbol(tprocsym(symtableentry).procdef[1].mangledname,AB_EXTERNAL,AT_DATA))); - asmlist[al_picdata].concat(tai_const.create_32bit(0)); + picdata.concat(tai_symbol.create(l,0)); + picdata.concat(tai_const.create_indirect_sym(objectlibrary.newasmsymbol(tprocsym(symtableentry).procdef[1].mangledname,AB_EXTERNAL,AT_DATA))); + picdata.concat(tai_const.create_32bit(0)); end; reference_reset_symbol(ref,l,0); reference_reset_base(location.reference,cg.getaddressregister(exprasmlist),0); @@ -101,9 +101,9 @@ unit nppcld; if not(assigned(l)) then begin l:=objectlibrary.newasmsymbol('L'+tglobalvarsym(symtableentry).mangledname+'$non_lazy_ptr',AB_COMMON,AT_DATA); - asmlist[al_picdata].concat(tai_symbol.create(l,0)); - asmlist[al_picdata].concat(tai_const.create_indirect_sym(objectlibrary.newasmsymbol(tglobalvarsym(symtableentry).mangledname,AB_EXTERNAL,AT_DATA))); - asmlist[al_picdata].concat(tai_const.create_32bit(0)); + picdata.concat(tai_symbol.create(l,0)); + picdata.concat(tai_const.create_indirect_sym(objectlibrary.newasmsymbol(tglobalvarsym(symtableentry).mangledname,AB_EXTERNAL,AT_DATA))); + picdata.concat(tai_const.create_32bit(0)); end; reference_reset_symbol(ref,l,0); diff --git a/compiler/powerpc/nppcmat.pas b/compiler/powerpc/nppcmat.pas index 247179a7c8..e720534292 100644 --- a/compiler/powerpc/nppcmat.pas +++ b/compiler/powerpc/nppcmat.pas @@ -53,96 +53,13 @@ implementation uses globtype,systems, cutils,verbose,globals, - symconst, + symconst,symdef, aasmbase,aasmcpu,aasmtai, defutil, - cgbase,cgutils,cgobj,pass_2, + cgbase,cgutils,cgobj,pass_1,pass_2, ncon,procinfo, - cpubase, - ncgutil,cgcpu; - -{ helper functions } -procedure getmagic_unsigned32(d : dword; out magic_m : dword; out magic_add : boolean; out magic_shift : dword); -var - p : longint; - nc, delta, q1, r1, q2, r2 : dword; - -begin - assert(d > 0); - - magic_add := false; - nc := - 1 - (-d) mod d; - p := 31; { initialize p } - q1 := $80000000 div nc; { initialize q1 = 2p/nc } - r1 := $80000000 - q1*nc; { initialize r1 = rem(2p,nc) } - q2 := $7FFFFFFF div d; { initialize q2 = (2p-1)/d } - r2 := $7FFFFFFF - q2*d; { initialize r2 = rem((2p-1),d) } - repeat - inc(p); - if (r1 >= (nc - r1)) then begin - q1 := 2 * q1 + 1; { update q1 } - r1 := 2*r1 - nc; { update r1 } - end else begin - q1 := 2*q1; { update q1 } - r1 := 2*r1; { update r1 } - end; - if ((r2 + 1) >= (d - r2)) then begin - if (q2 >= $7FFFFFFF) then - magic_add := true; - q2 := 2*q2 + 1; { update q2 } - r2 := 2*r2 + 1 - d; { update r2 } - end else begin - if (q2 >= $80000000) then - magic_add := true; - q2 := 2*q2; { update q2 } - r2 := 2*r2 + 1; { update r2 } - end; - delta := d - 1 - r2; - until not ((p < 64) and ((q1 < delta) or ((q1 = delta) and (r1 = 0)))); - magic_m := q2 + 1; { resulting magic number } - magic_shift := p - 32; { resulting shift } -end; - -procedure getmagic_signed32(d : longint; out magic_m : longint; out magic_s : longint); -const - two_31 : DWord = high(longint)+1; -var - p : Longint; - ad, anc, delta, q1, r1, q2, r2, t : DWord; - -begin - assert((d < -1) or (d > 1)); - - ad := abs(d); - t := two_31 + (DWord(d) shr 31); - anc := t - 1 - t mod ad; { absolute value of nc } - p := 31; { initialize p } - q1 := two_31 div anc; { initialize q1 = 2p/abs(nc) } - r1 := two_31 - q1*anc; { initialize r1 = rem(2p,abs(nc)) } - q2 := two_31 div ad; { initialize q2 = 2p/abs(d) } - r2 := two_31 - q2*ad; { initialize r2 = rem(2p,abs(d)) } - repeat - inc(p); - q1 := 2*q1; { update q1 = 2p/abs(nc) } - r1 := 2*r1; { update r1 = rem(2p/abs(nc)) } - if (r1 >= anc) then begin { must be unsigned comparison } - inc(q1); - dec(r1, anc); - end; - q2 := 2*q2; { update q2 = 2p/abs(d) } - r2 := 2*r2; { update r2 = rem(2p/abs(d)) } - if (r2 >= ad) then begin { must be unsigned comparison } - inc(q2); - dec(r2, ad); - end; - delta := ad - r2; - until not ((q1 < delta) or ((q1 = delta) and (r1 = 0))); - magic_m := q2 + 1; - if (d < 0) then begin - magic_m := -magic_m; { resulting magic number } - end; - magic_s := p - 32; { resulting shift } -end; + cpubase,cpuinfo, + ncgutil,cgcpu,cg64f32,rgobj; {***************************************************************************** TPPCMODDIVNODE @@ -171,112 +88,6 @@ end; size : Tcgsize; hl : tasmlabel; done: boolean; - - procedure genOrdConstNodeDiv; - const - negops : array[boolean] of tasmop = (A_NEG, A_NEGO); - var - magic, shift : longint; - u_magic, u_shift : dword; - u_add : boolean; - - divreg : tregister; - begin - if (tordconstnode(right).value = 0) then begin - internalerror(2005061701); - end else if (tordconstnode(right).value = 1) then begin - cg.a_load_reg_reg(exprasmlist, OS_INT, OS_INT, numerator, resultreg); - end else if (tordconstnode(right).value = -1) then begin - // note: only in the signed case possible..., may overflow - exprasmlist.concat(taicpu.op_reg_reg(negops[cs_check_overflow in aktlocalswitches], resultreg, numerator)); - end else if (ispowerof2(tordconstnode(right).value, power)) then begin - if (is_signed(right.resulttype.def)) then begin - { From "The PowerPC Compiler Writer's Guide", pg. 52ff } - cg.a_op_const_reg_reg(exprasmlist, OP_SAR, OS_INT, power, - numerator, resultreg); - exprasmlist.concat(taicpu.op_reg_reg(A_ADDZE, resultreg, resultreg)); - end else begin - cg.a_op_const_reg_reg(exprasmlist, OP_SHR, OS_INT, power, numerator, resultreg) - end; - end else begin - { replace division by multiplication, both implementations } - { from "The PowerPC Compiler Writer's Guide" pg. 53ff } - divreg := cg.getintregister(exprasmlist, OS_INT); - if (is_signed(right.resulttype.def)) then begin - getmagic_signed32(tordconstnode(right).value, magic, shift); - // load magic value - cg.a_load_const_reg(exprasmlist, OS_INT, magic, divreg); - // multiply - exprasmlist.concat(taicpu.op_reg_reg_reg(A_MULHW, resultreg, numerator, divreg)); - // add/subtract numerator - if (tordconstnode(right).value > 0) and (magic < 0) then begin - cg.a_op_reg_reg_reg(exprasmlist, OP_ADD, OS_INT, numerator, resultreg, resultreg); - end else if (tordconstnode(right).value < 0) and (magic > 0) then begin - cg.a_op_reg_reg_reg(exprasmlist, OP_SUB, OS_INT, numerator, resultreg, resultreg); - end; - // shift shift places to the right (arithmetic) - cg.a_op_const_reg_reg(exprasmlist, OP_SAR, OS_INT, shift, resultreg, resultreg); - // extract and add sign bit - if (tordconstnode(right).value >= 0) then begin - cg.a_op_const_reg_reg(exprasmlist, OP_SHR, OS_INT, 31, numerator, divreg); - end else begin - cg.a_op_const_reg_reg(exprasmlist, OP_SHR, OS_INT, 31, resultreg, divreg); - end; - cg.a_op_reg_reg_reg(exprasmlist, OP_ADD, OS_INT, resultreg, divreg, resultreg); - end else begin - getmagic_unsigned32(tordconstnode(right).value, u_magic, u_add, u_shift); - // load magic in divreg - cg.a_load_const_reg(exprasmlist, OS_INT, u_magic, divreg); - exprasmlist.concat(taicpu.op_reg_reg_reg(A_MULHWU, resultreg, numerator, divreg)); - if (u_add) then begin - cg.a_op_reg_reg_reg(exprasmlist, OP_SUB, OS_INT, resultreg, numerator, divreg); - cg.a_op_const_reg_reg(exprasmlist, OP_SHR, OS_INT, 1, divreg, divreg); - cg.a_op_reg_reg_reg(exprasmlist, OP_ADD, OS_INT, divreg, resultreg, divreg); - cg.a_op_const_reg_reg(exprasmlist, OP_SHR, OS_INT, u_shift-1, divreg, resultreg); - end else begin - cg.a_op_const_reg_reg(exprasmlist, OP_SHR, OS_INT, u_shift, resultreg, resultreg); - end; - end; - end; - done := true; - end; - - procedure genOrdConstNodeMod; - var - modreg, maskreg, tempreg : tregister; - begin - if (tordconstnode(right).value = 0) then begin - internalerror(2005061702); - end else if (abs(tordconstnode(right).value) = 1) then begin - // x mod +/-1 is always zero - cg.a_load_const_reg(exprasmlist, OS_INT, 0, resultreg); - end else if (ispowerof2(tordconstnode(right).value, power)) then begin - if (is_signed(right.resulttype.def)) then begin - - tempreg := cg.getintregister(exprasmlist, OS_INT); - maskreg := cg.getintregister(exprasmlist, OS_INT); - modreg := cg.getintregister(exprasmlist, OS_INT); - - cg.a_load_const_reg(exprasmlist, OS_INT, abs(tordconstnode(right).value)-1, modreg); - cg.a_op_const_reg_reg(exprasmlist, OP_SAR, OS_INT, 31, numerator, maskreg); - cg.a_op_reg_reg_reg(exprasmlist, OP_AND, OS_INT, numerator, modreg, tempreg); - - exprasmlist.concat(taicpu.op_reg_reg_reg(A_ANDC, maskreg, maskreg, modreg)); - exprasmlist.concat(taicpu.op_reg_reg_const(A_SUBFIC, modreg, tempreg, 0)); - exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBFE, modreg, modreg, modreg)); - cg.a_op_reg_reg_reg(exprasmlist, OP_AND, OS_INT, modreg, maskreg, maskreg); - cg.a_op_reg_reg_reg(exprasmlist, OP_OR, OS_INT, maskreg, tempreg, resultreg); - end else begin - cg.a_op_const_reg_reg(exprasmlist, OP_AND, OS_INT, tordconstnode(right).value-1, numerator, resultreg); - end; - end else begin - genOrdConstNodeDiv(); - cg.a_op_const_reg_reg(exprasmlist, OP_MUL, OS_INT, tordconstnode(right).value, resultreg, resultreg); - cg.a_op_reg_reg_reg(exprasmlist, OP_SUB, OS_INT, resultreg, numerator, resultreg); - end; - end; - - begin secondpass(left); secondpass(right); @@ -289,26 +100,50 @@ end; location_copy(location,left.location); numerator := location.register; resultreg := location.register; - if (location.loc = LOC_CREGISTER) then begin - location.loc := LOC_REGISTER; - location.register := cg.getintregister(exprasmlist,size); - resultreg := location.register; - end else if (nodetype = modn) or (right.nodetype = ordconstn) then begin - // for a modulus op, and for const nodes we need the result register - // to be an extra register - resultreg := cg.getintregister(exprasmlist,size); - end; + if (location.loc = LOC_CREGISTER) then + begin + location.loc := LOC_REGISTER; + location.register := cg.getintregister(exprasmlist,size); + resultreg := location.register; + end; + if (nodetype = modn) then + begin + resultreg := cg.getintregister(exprasmlist,size); + end; done := false; - if (right.nodetype = ordconstn) then begin - if (nodetype = divn) then - genOrdConstNodeDiv + if (right.nodetype = ordconstn) and + ispowerof2(tordconstnode(right).value,power) then + if is_signed(right.resulttype.def) then + begin + if (nodetype = divn) then + begin + { From "The PowerPC Compiler Writer's Guide": } + { This code uses the fact that, in the PowerPC architecture, } + { the shift right algebraic instructions set the Carry bit if } + { the source register contains a negative number and one or } + { more 1-bits are shifted out. Otherwise, the carry bit is } + { cleared. The addze instruction corrects the quotient, if } + { necessary, when the dividend is negative. For example, if } + { n = -13, (0xFFFF_FFF3), and k = 2, after executing the srawi } + { instruction, q = -4 (0xFFFF_FFFC) and CA = 1. After executing } + { the addze instruction, q = -3, the correct quotient. } + cg.a_op_const_reg_reg(exprasmlist,OP_SAR,OS_INT,power, + numerator,resultreg); + exprasmlist.concat(taicpu.op_reg_reg(A_ADDZE,resultreg,resultreg)); + done := true; + end + end else - genOrdConstNodeMod; - done := true; - end; - - if (not done) then begin + begin + if (nodetype = divn) then + cg.a_op_const_reg_reg(exprasmlist,OP_SHR,OS_INT,power,numerator,resultreg) + else + cg.a_op_const_reg_reg(exprasmlist,OP_AND,OS_INT,tordconstnode(right).value-1,numerator,resultreg); + done := true; + end; + if not done then + begin { load divider in a register if necessary } location_force_reg(exprasmlist,right.location, def_cgsize(right.resulttype.def),true); @@ -337,7 +172,7 @@ end; location.register:=resultreg; if right.nodetype <> ordconstn then begin - objectlibrary.getjumplabel(hl); + objectlibrary.getlabel(hl); exprasmlist.concat(taicpu.op_cond_sym(A_BC,zerocond,hl)); cg.a_call_name(exprasmlist,'FPC_DIVBYZERO'); cg.a_label(exprasmlist,hl); diff --git a/compiler/powerpc/nppcset.pas b/compiler/powerpc/nppcset.pas index 9bf937f1eb..5a517e4a26 100644 --- a/compiler/powerpc/nppcset.pas +++ b/compiler/powerpc/nppcset.pas @@ -26,13 +26,12 @@ unit nppcset; interface uses - node,nset,ncgset,cpubase,cgbase,cgobj,aasmbase,aasmtai,globtype; + node,nset,ncgset,cpubase,cgbase,cgobj,aasmbase,aasmtai; type + tppccasenode = class(tcgcasenode) protected - function has_jumptable : boolean;override; - procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override; procedure genlinearlist(hp : pcaselabel); override; end; @@ -40,83 +39,22 @@ interface implementation uses - systems, + globtype,systems, verbose,globals, symconst,symdef,defutil, paramgr, cpuinfo, pass_2,cgcpu, ncon, - tgobj,ncgutil,regvars,rgobj,aasmcpu, - procinfo, - cgutils; + tgobj,ncgutil,regvars,rgobj,aasmcpu; + + {***************************************************************************** TCGCASENODE *****************************************************************************} - function tppccasenode.has_jumptable : boolean; - begin - has_jumptable:=true; - end; - - - procedure tppccasenode.genjumptable(hp : pcaselabel;min_,max_ : aint); - var - table : tasmlabel; - last : TConstExprInt; - indexreg : tregister; - href : treference; - - procedure genitem(list:taasmoutput;t : pcaselabel); - var - i : aint; - begin - if assigned(t^.less) then - genitem(list,t^.less); - { fill possible hole } - for i:=last+1 to t^._low-1 do - list.concat(Tai_const.Create_sym(elselabel)); - for i:=t^._low to t^._high do - list.concat(Tai_const.Create_sym(blocklabel(t^.blockid))); - last:=t^._high; - if assigned(t^.greater) then - genitem(list,t^.greater); - end; - - begin - if not(jumptable_no_range) then - begin - { case expr less than min_ => goto elselabel } - cg.a_cmp_const_reg_label(exprasmlist,opsize,jmp_lt,aint(min_),hregister,elselabel); - { case expr greater than max_ => goto elselabel } - cg.a_cmp_const_reg_label(exprasmlist,opsize,jmp_gt,aint(max_),hregister,elselabel); - end; - objectlibrary.getjumplabel(table); - { make it a 32bit register } - // allocate base and index registers register - indexreg:= cg.makeregsize(exprasmlist, hregister, OS_INT); - { indexreg := hregister; } - cg.a_load_reg_reg(exprasmlist, opsize, OS_INT, hregister, indexreg); - { create reference, indexreg := indexreg * sizeof(OS_ADDR) } - cg.a_op_const_reg(exprasmlist, OP_MUL, OS_INT, tcgsize2size[OS_ADDR], indexreg); - reference_reset_symbol(href, table, (-aint(min_)) * tcgsize2size[OS_ADDR]); - href.index := indexreg; - - cg.a_load_ref_reg(exprasmlist, OS_INT, OS_INT, href, indexreg); - - exprasmlist.concat(taicpu.op_reg(A_MTCTR, indexreg)); - exprasmlist.concat(taicpu.op_none(A_BCTR)); - - { generate jump table } - new_section(current_procinfo.aktlocaldata,sec_data,current_procinfo.procdef.mangledname,sizeof(aint)); - current_procinfo.aktlocaldata.concat(Tai_label.Create(table)); - last:=min_; - genitem(current_procinfo.aktlocaldata,hp); - end; - - procedure tppccasenode.genlinearlist(hp : pcaselabel); var diff --git a/compiler/powerpc64/aasmcpu.pas b/compiler/powerpc64/aasmcpu.pas deleted file mode 100644 index 306060e1ac..0000000000 --- a/compiler/powerpc64/aasmcpu.pas +++ /dev/null @@ -1,537 +0,0 @@ -{ - Copyright (c) 1999-2002 by Jonas Maebe - - Contains the assembler object for the PowerPC64. Heavily based on code - from the PowerPC platform - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit aasmcpu; - -{$I fpcdefs.inc} - -interface - -uses - globtype, verbose, - aasmbase, aasmtai, - cpubase, cgbase, cgutils; - -const - { "mov reg,reg" source operand number } - O_MOV_SOURCE = 1; - { "mov reg,reg" source operand number } - O_MOV_DEST = 0; - -type - taicpu = class(tai_cpu_abstract) - constructor op_none(op: tasmop); - - constructor op_reg(op: tasmop; _op1: tregister); - constructor op_const(op: tasmop; _op1: aint); - - constructor op_reg_reg(op: tasmop; _op1, _op2: tregister); - constructor op_reg_ref(op: tasmop; _op1: tregister; const _op2: treference); - constructor op_reg_const(op: tasmop; _op1: tregister; _op2: aint); - constructor op_const_reg(op: tasmop; _op1: aint; _op2: tregister); - - constructor op_const_const(op: tasmop; _op1, _op2: aint); - - constructor op_reg_reg_const_const(op: tasmop; _op1, _op2: tregister; _op3, - _op4: aint); - - constructor op_reg_reg_reg(op: tasmop; _op1, _op2, _op3: tregister); - constructor op_reg_reg_const(op: tasmop; _op1, _op2: tregister; _op3: aint); - constructor op_reg_reg_sym_ofs(op: tasmop; _op1, _op2: tregister; _op3: - tasmsymbol; _op3ofs: aint); - constructor op_reg_reg_ref(op: tasmop; _op1, _op2: tregister; const _op3: - treference); - constructor op_const_reg_reg(op: tasmop; _op1: aint; _op2, _op3: tregister); - constructor op_const_reg_const(op: tasmop; _op1: aint; _op2: tregister; - _op3: aint); - constructor op_const_const_const(op: tasmop; _op1: aint; _op2: aint; _op3: - aint); - - constructor op_reg_reg_reg_reg(op: tasmop; _op1, _op2, _op3, _op4: - tregister); - constructor op_reg_bool_reg_reg(op: tasmop; _op1: tregister; _op2: boolean; - _op3, _op4: tregister); - constructor op_reg_bool_reg_const(op: tasmop; _op1: tregister; _op2: - boolean; _op3: tregister; _op4: aint); - - constructor op_reg_reg_reg_const_const(op: tasmop; _op1, _op2, _op3: - tregister; _op4, _op5: aint); - constructor op_reg_reg_const_const_const(op: tasmop; _op1, _op2: tregister; - _op3, _op4, _op5: aint); - - { this is for Jmp instructions } - constructor op_cond_sym(op: tasmop; cond: TAsmCond; _op1: tasmsymbol); - constructor op_const_const_sym(op: tasmop; _op1, _op2: aint; _op3: - tasmsymbol); - - constructor op_sym(op: tasmop; _op1: tasmsymbol); - constructor op_sym_ofs(op: tasmop; _op1: tasmsymbol; _op1ofs: aint); - constructor op_reg_sym_ofs(op: tasmop; _op1: tregister; _op2: tasmsymbol; - _op2ofs: aint); - constructor op_sym_ofs_ref(op: tasmop; _op1: tasmsymbol; _op1ofs: aint; const - _op2: treference); - - procedure loadbool(opidx: aint; _b: boolean); - - function is_same_reg_move(regtype: Tregistertype): boolean; override; - - { register spilling code } - function spilling_get_operation_type(opnr: longint): topertype;override; - function spilling_get_operation_type_ref(opnr: longint; reg: tregister): topertype;override; - end; - - tai_align = class(tai_align_abstract) - { nothing to add } - end; - -procedure InitAsm; -procedure DoneAsm; - -function spilling_create_load(const ref: treference; r: tregister): tai; -function spilling_create_store(r: tregister; const ref: treference): tai; - -procedure fixup_jmps(list: taasmoutput); - -implementation - -uses cutils, cclasses; - -{***************************************************************************** - taicpu Constructors -*****************************************************************************} - -procedure taicpu.loadbool(opidx: aint; _b: boolean); -begin - if opidx >= ops then - ops := opidx + 1; - with oper[opidx]^ do - begin - if typ = top_ref then - dispose(ref); - b := _b; - typ := top_bool; - end; -end; - -constructor taicpu.op_none(op: tasmop); -begin - inherited create(op); -end; - -constructor taicpu.op_reg(op: tasmop; _op1: tregister); -begin - inherited create(op); - ops := 1; - loadreg(0, _op1); -end; - -constructor taicpu.op_const(op: tasmop; _op1: aint); -begin - inherited create(op); - ops := 1; - loadconst(0, _op1); -end; - -constructor taicpu.op_reg_reg_const_const(op: tasmop; _op1, _op2: tregister; - _op3, _op4: aint); -begin - inherited create(op); - ops := 4; - loadreg(0, _op1); - loadreg(1, _op2); - loadconst(2, _op3); - loadconst(3, _op4); -end; - -constructor taicpu.op_reg_reg(op: tasmop; _op1, _op2: tregister); -begin - inherited create(op); - ops := 2; - loadreg(0, _op1); - loadreg(1, _op2); -end; - -constructor taicpu.op_reg_const(op: tasmop; _op1: tregister; _op2: aint); -begin - inherited create(op); - ops := 2; - loadreg(0, _op1); - loadconst(1, _op2); -end; - -constructor taicpu.op_const_reg(op: tasmop; _op1: aint; _op2: tregister); -begin - inherited create(op); - ops := 2; - loadconst(0, _op1); - loadreg(1, _op2); -end; - -constructor taicpu.op_reg_ref(op: tasmop; _op1: tregister; const _op2: - treference); -begin - inherited create(op); - ops := 2; - loadreg(0, _op1); - loadref(1, _op2); -end; - -constructor taicpu.op_const_const(op: tasmop; _op1, _op2: aint); -begin - inherited create(op); - ops := 2; - loadconst(0, _op1); - loadconst(1, _op2); -end; - -constructor taicpu.op_reg_reg_reg(op: tasmop; _op1, _op2, _op3: tregister); -begin - inherited create(op); - ops := 3; - loadreg(0, _op1); - loadreg(1, _op2); - loadreg(2, _op3); -end; - -constructor taicpu.op_reg_reg_const(op: tasmop; _op1, _op2: tregister; _op3: - aint); -begin - inherited create(op); - ops := 3; - loadreg(0, _op1); - loadreg(1, _op2); - loadconst(2, _op3); -end; - -constructor taicpu.op_reg_reg_sym_ofs(op: tasmop; _op1, _op2: tregister; _op3: - tasmsymbol; _op3ofs: aint); -begin - inherited create(op); - ops := 3; - loadreg(0, _op1); - loadreg(1, _op2); - loadsymbol(0, _op3, _op3ofs); -end; - -constructor taicpu.op_reg_reg_ref(op: tasmop; _op1, _op2: tregister; const _op3: - treference); -begin - inherited create(op); - ops := 3; - loadreg(0, _op1); - loadreg(1, _op2); - loadref(2, _op3); -end; - -constructor taicpu.op_const_reg_reg(op: tasmop; _op1: aint; _op2, _op3: - tregister); -begin - inherited create(op); - ops := 3; - loadconst(0, _op1); - loadreg(1, _op2); - loadreg(2, _op3); -end; - -constructor taicpu.op_const_reg_const(op: tasmop; _op1: aint; _op2: tregister; - _op3: aint); -begin - inherited create(op); - ops := 3; - loadconst(0, _op1); - loadreg(1, _op2); - loadconst(2, _op3); -end; - -constructor taicpu.op_const_const_const(op: tasmop; _op1: aint; _op2: aint; - _op3: aint); -begin - inherited create(op); - ops := 3; - loadconst(0, _op1); - loadconst(1, _op2); - loadconst(2, _op3); -end; - -constructor taicpu.op_reg_reg_reg_reg(op: tasmop; _op1, _op2, _op3, _op4: - tregister); -begin - inherited create(op); - ops := 4; - loadreg(0, _op1); - loadreg(1, _op2); - loadreg(2, _op3); - loadreg(3, _op4); -end; - -constructor taicpu.op_reg_bool_reg_reg(op: tasmop; _op1: tregister; _op2: - boolean; _op3, _op4: tregister); -begin - inherited create(op); - ops := 4; - loadreg(0, _op1); - loadbool(1, _op2); - loadreg(2, _op3); - loadreg(3, _op4); -end; - -constructor taicpu.op_reg_bool_reg_const(op: tasmop; _op1: tregister; _op2: - boolean; _op3: tregister; _op4: aint); -begin - inherited create(op); - ops := 4; - loadreg(0, _op1); - loadbool(0, _op2); - loadreg(0, _op3); - loadconst(0, cardinal(_op4)); -end; - -constructor taicpu.op_reg_reg_reg_const_const(op: tasmop; _op1, _op2, _op3: - tregister; _op4, _op5: aint); -begin - inherited create(op); - ops := 5; - loadreg(0, _op1); - loadreg(1, _op2); - loadreg(2, _op3); - loadconst(3, cardinal(_op4)); - loadconst(4, cardinal(_op5)); -end; - -constructor taicpu.op_reg_reg_const_const_const(op: tasmop; _op1, _op2: - tregister; _op3, _op4, _op5: aint); -begin - inherited create(op); - ops := 5; - loadreg(0, _op1); - loadreg(1, _op2); - loadconst(2, _op3); - loadconst(3, _op4); - loadconst(4, _op5); -end; - -constructor taicpu.op_cond_sym(op: tasmop; cond: TAsmCond; _op1: tasmsymbol); -begin - inherited create(op); - condition := cond; - ops := 1; - loadsymbol(0, _op1, 0); -end; - -constructor taicpu.op_const_const_sym(op: tasmop; _op1, _op2: aint; _op3: - tasmsymbol); -begin - inherited create(op); - ops := 3; - loadconst(0, _op1); - loadconst(1, _op2); - loadsymbol(2, _op3, 0); -end; - -constructor taicpu.op_sym(op: tasmop; _op1: tasmsymbol); -begin - inherited create(op); - ops := 1; - loadsymbol(0, _op1, 0); -end; - -constructor taicpu.op_sym_ofs(op: tasmop; _op1: tasmsymbol; _op1ofs: aint); -begin - inherited create(op); - ops := 1; - loadsymbol(0, _op1, _op1ofs); -end; - -constructor taicpu.op_reg_sym_ofs(op: tasmop; _op1: tregister; _op2: tasmsymbol; - _op2ofs: aint); -begin - inherited create(op); - ops := 2; - loadreg(0, _op1); - loadsymbol(1, _op2, _op2ofs); -end; - -constructor taicpu.op_sym_ofs_ref(op: tasmop; _op1: tasmsymbol; _op1ofs: aint; - const _op2: treference); -begin - inherited create(op); - ops := 2; - loadsymbol(0, _op1, _op1ofs); - loadref(1, _op2); -end; - -{ ****************************** newra stuff *************************** } - -function taicpu.is_same_reg_move(regtype: Tregistertype):boolean; -begin - result := - (((opcode=A_MR) and - (regtype = R_INTREGISTER)) or - ((opcode = A_FMR) and - (regtype = R_FPUREGISTER))) and - { these opcodes can only have registers as operands } - (oper[0]^.reg=oper[1]^.reg); -end; - - -function taicpu.spilling_get_operation_type(opnr: longint): topertype; -begin - result := operand_read; - case opcode of - A_STMW,A_LMW: - internalerror(2005021805); - - A_STBU, A_STBUX, A_STHU, A_STHUX, - A_STWU, A_STWUX, A_STDU, A_STDUX, - A_STFSU, A_STFSUX, A_STFDU, A_STFDUX, - A_STB, A_STBX, A_STH, A_STHX, - A_STW, A_STWX, A_STD, A_STDX, - A_STFS, A_STFSX, A_STFD, A_STFDX, A_STFIWX, A_STHBRX, A_STWBRX, A_STWCX_, A_STDCX_, - A_CMP, A_CMPI, A_CMPL, A_CMPLI, A_CMPD, A_CMPDI, A_CMPLD, A_CMPLDI, - A_DCBA, A_DCBI, A_DCBST, A_DCBT, A_DCBTST, A_DCBZ, - A_ECOWX, A_FCMPO, A_FCMPU, A_MTMSR, A_TLBIE, A_TW, A_TWI, A_MFXER, - A_CMPWI, A_CMPW, A_CMPLWI, A_CMPLW, A_MT, A_MTLR, A_MTCTR:; - else - if opnr = 0 then - result := operand_write; - end; -end; - -function taicpu.spilling_get_operation_type_ref(opnr: longint; reg: tregister): topertype; -begin - result := operand_read; - case opcode of - A_STBU, A_STBUX, A_STHU, A_STHUX, A_STWU, A_STWUX, A_STDU, A_STDUX, - A_STFSU, A_STFSUX, A_STFDU, A_STFDUX: - if (oper[opnr]^.ref^.base = reg) then - result := operand_readwrite; - end; -end; - - -function spilling_create_load(const ref: treference; r: tregister): tai; -begin - result := taicpu.op_reg_ref(A_LD, r, ref); -end; - -function spilling_create_store(r: tregister; const ref: treference): tai; -begin - result := taicpu.op_reg_ref(A_STD, r, ref); -end; - -procedure InitAsm; -begin -end; - -procedure DoneAsm; -begin -end; - -procedure fixup_jmps(list: taasmoutput); -var - p: tai; - newjmp: taicpu; - labelpositions: tlist; - instrpos: ptrint; - l: tasmlabel; - inserted_something: boolean; -begin - // if certainly not enough instructions to cause an overflow, don't bother - if (list.count <= (high(smallint) div 4)) then - exit; - labelpositions := tlist.create; - p := tai(list.first); - instrpos := 1; - // record label positions - while assigned(p) do - begin - if p.typ = ait_label then - begin - if (tai_label(p).l.labelnr > labelpositions.count) then - labelpositions.count := tai_label(p).l.labelnr * 2; - labelpositions[tai_label(p).l.labelnr] := pointer(instrpos); - end; - if p.typ = ait_instruction then - inc(instrpos); - p := tai(p.next); - end; - - // check and fix distances - repeat - inserted_something := false; - p := tai(list.first); - instrpos := 1; - while assigned(p) do - begin - case p.typ of - ait_label: - // update labelposition in case it changed due to insertion - // of jumps - begin - // can happen because of newly inserted labels - if (tai_label(p).l.labelnr > labelpositions.count) then - labelpositions.count := tai_label(p).l.labelnr * 2; - labelpositions[tai_label(p).l.labelnr] := pointer(instrpos); - end; - ait_instruction: - begin - inc(instrpos); - case taicpu(p).opcode of - A_BC: - if (taicpu(p).oper[0]^.typ = top_ref) and - assigned(taicpu(p).oper[0]^.ref^.symbol) and - (taicpu(p).oper[0]^.ref^.symbol is tasmlabel) and - (labelpositions[tasmlabel(taicpu(p).oper[0]^.ref^.symbol).labelnr] <> NIL) and - (ptruint(abs(ptrint(labelpositions[tasmlabel(taicpu(p).oper[0]^.ref^.symbol).labelnr]-instrpos)) - (low(smallint) div 4)) > ptruint((high(smallint) - low(smallint)) div 4)) then - begin - // add a new label after this jump - objectlibrary.getjumplabel(l); - list.insertafter(tai_label.create(l),p); - // add a new unconditional jump between this jump and the label - newjmp := taicpu.op_sym(A_B,taicpu(p).oper[0]^.ref^.symbol); - newjmp.is_jmp := true; - newjmp.fileinfo := taicpu(p).fileinfo; - list.insertafter(newjmp,p); - inc(instrpos); - // change the conditional jump to point to the newly inserted label - tasmlabel(taicpu(p).oper[0]^.ref^.symbol).decrefs; - taicpu(p).oper[0]^.ref^.symbol := l; - l.increfs; - // and invert its condition code - taicpu(p).condition := inverse_cond(taicpu(p).condition); - // we inserted an instruction, so will have to check everything again - inserted_something := true; - end; - end; - end; - end; - p := tai(p.next); - end; - until not inserted_something; - labelpositions.free; -end; - -begin - cai_align := tai_align; - cai_cpu := taicpu; -end. - diff --git a/compiler/powerpc64/agppcgas.pas b/compiler/powerpc64/agppcgas.pas deleted file mode 100644 index 44dae97e39..0000000000 --- a/compiler/powerpc64/agppcgas.pas +++ /dev/null @@ -1,343 +0,0 @@ -{ - Copyright (c) 1998-2002 by Florian Klaempfl - - This unit implements an asm for the PowerPC64. Heavily based on the one - from the PowerPC architecture. - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -{ This unit implements the GNU Assembler writer for the PowerPC -} - -unit agppcgas; - -{$I fpcdefs.inc} - -interface - -uses - aasmtai, - aggas, - cpubase; - -type - PPPCGNUAssembler = ^TPPCGNUAssembler; - TPPCGNUAssembler = class(TGNUassembler) - public - procedure WriteExtraHeader; override; - procedure WriteInstruction(hp: tai); override; - end; - -implementation - -uses - cutils, globals, verbose, - cgbase, cgutils, systems, - assemble, globtype, fmodule, - itcpugas, finput, - aasmcpu; - - -procedure TPPCGNUAssembler.WriteExtraHeader; -var - i: longint; -begin - for i := 0 to 31 do - AsmWriteln(#9'.set'#9'r' + tostr(i) + ',' + tostr(i)); - for i := 0 to 31 do - AsmWriteln(#9'.set'#9'f' + tostr(i) + ',' + tostr(i)); -end; - -const - as_ppc_gas_info: tasminfo = - ( - id: as_gas; - - idtxt: 'AS'; - asmbin: 'as'; - asmcmd: '-a64 -o $OBJ $ASM'; - supported_target: system_any; - flags: [af_allowdirect, af_needar, af_smartlink_sections]; - labelprefix: '.L'; - comment: '# '; - ); - - refaddr2str: array[trefaddr] of string[9] = ('', '', '', '@l', '@h', '@higher', '@highest', '@ha', '@highera', '@highesta'); - -function getreferencestring(var ref: treference): string; -var - s: string; -begin - with ref do - begin - if ((offset < -32768) or (offset > 32767)) and - (refaddr = addr_no) then - ; //internalerror(19991); - if (refaddr = addr_no) then - s := '' - else - begin - s := '('; - if assigned(symbol) then - begin - s := s + symbol.name; - if assigned(relsymbol) then - s := s + '-' + relsymbol.name; - end; - end; - if offset < 0 then - s := s + tostr(offset) - else if (offset > 0) then - begin - if assigned(symbol) then - s := s + '+' + tostr(offset) - else - s := s + tostr(offset); - end; - - if (refaddr in [addr_low, addr_high, addr_higher, addr_highest, addr_higha, addr_highera, addr_highesta]) then - begin - s := s + ')'; - if (target_info.system <> system_powerpc_darwin) then - s := s + refaddr2str[refaddr]; - end; - - if (index = NR_NO) and (base <> NR_NO) then - begin - if offset = 0 then - begin - if assigned(symbol) then - begin - if target_info.system <> system_powerpc_darwin then - s := s + '+0' - end - else - s := s + '0'; - end; - s := s + '(' + gas_regname(base) + ')'; - end - else if (index <> NR_NO) and (base <> NR_NO) then - begin - if (offset = 0) then - s := s + gas_regname(base) + ',' + gas_regname(index) - else - internalerror(19992); - end; - end; - getreferencestring := s; -end; - -function getopstr_jmp(const o: toper): string; -var - hs: string; -begin - case o.typ of - top_reg: - getopstr_jmp := gas_regname(o.reg); - { no top_ref jumping for powerpc } - top_const: - getopstr_jmp := tostr(o.val); - top_ref: - begin - if o.ref^.refaddr <> addr_full then - internalerror(200402262); - hs := o.ref^.symbol.name; - if o.ref^.offset > 0 then - hs := hs + '+' + tostr(o.ref^.offset) - else if o.ref^.offset < 0 then - hs := hs + tostr(o.ref^.offset); - getopstr_jmp := hs; - end; - top_none: - getopstr_jmp := ''; - else - internalerror(2002070603); - end; -end; - -function getopstr(const o: toper): string; -var - hs: string; -begin - case o.typ of - top_reg: - getopstr := gas_regname(o.reg); - top_const: - getopstr := tostr(longint(o.val)); - top_ref: - if o.ref^.refaddr = addr_full then - begin - hs := o.ref^.symbol.name; - if o.ref^.offset > 0 then - hs := hs + '+' + tostr(o.ref^.offset) - else if o.ref^.offset < 0 then - hs := hs + tostr(o.ref^.offset); - getopstr := hs; - end - else - getopstr := getreferencestring(o.ref^); - else - internalerror(2002070604); - end; -end; - -function branchmode(o: tasmop): string[4]; -var - tempstr: string[4]; -begin - tempstr := ''; - case o of - A_BCCTR, A_BCCTRL: tempstr := 'ctr'; - A_BCLR, A_BCLRL: tempstr := 'lr'; - end; - case o of - A_BL, A_BLA, A_BCL, A_BCLA, A_BCCTRL, A_BCLRL: tempstr := tempstr + 'l'; - end; - case o of - A_BA, A_BLA, A_BCA, A_BCLA: tempstr := tempstr + 'a'; - end; - branchmode := tempstr; -end; - -function cond2str(op: tasmop; c: tasmcond): string; -{ note: no checking is performed whether the given combination of } -{ conditions is valid } -var - tempstr: string; -begin - tempstr := #9; - case c.simple of - false: - begin - cond2str := tempstr + gas_op2str[op]; - case c.dirhint of - DH_None: ; - DH_Minus: - cond2str := cond2str + '-'; - DH_Plus: - cond2str := cond2str + '+'; - else - internalerror(2003112901); - end; - cond2str := cond2str + #9 + tostr(c.bo) + ',' + tostr(c.bi); - end; - true: - if (op >= A_B) and (op <= A_BCLRL) then - case c.cond of - { unconditional branch } - C_NONE: - cond2str := tempstr + gas_op2str[op]; - { bdnzt etc } - else - begin - tempstr := tempstr + 'b' + asmcondflag2str[c.cond] + - branchmode(op); - case c.dirhint of - DH_None: - tempstr := tempstr + #9; - DH_Minus: - tempstr := tempstr + ('-' + #9); - DH_Plus: - tempstr := tempstr + ('+' + #9); - else - internalerror(2003112901); - end; - case c.cond of - C_LT..C_NU: - cond2str := tempstr + gas_regname(newreg(R_SPECIALREGISTER, - c.cr, R_SUBWHOLE)); - C_T, C_F, C_DNZT, C_DNZF, C_DZT, C_DZF: - cond2str := tempstr + tostr(c.crbit); - else - cond2str := tempstr; - end; - end; - end - { we have a trap instruction } - else - begin - internalerror(2002070601); - { not yet implemented !!!!!!!!!!!!!!!!!!!!! } - { case tempstr := 'tw';} - end; - end; -end; - -procedure TPPCGNUAssembler.WriteInstruction(hp: tai); -var - op: TAsmOp; - s: string; - i: byte; - sep: string[3]; -begin - op := taicpu(hp).opcode; - if is_calljmp(op) then - begin - { direct BO/BI in op[0] and op[1] not supported, put them in condition! } - case op of - A_BL : - s := #9 + gas_op2str[op] + #9; - A_B, A_BA, A_BLA: - s := #9 + gas_op2str[op] + #9; - A_BCTR, A_BCTRL, A_BLR, A_BLRL: - s := #9 + gas_op2str[op] - else - begin - s := cond2str(op, taicpu(hp).condition); - if (s[length(s)] <> #9) and - (taicpu(hp).ops > 0) then - s := s + ','; - end; - end; - - if (taicpu(hp).ops > 0) and (taicpu(hp).oper[0]^.typ <> top_none) then - begin - { first write the current contents of s, because the symbol } - { may be 255 characters } - asmwrite(s); - s := getopstr_jmp(taicpu(hp).oper[0]^); - end; - end - else - { process operands } - begin - s := #9 + gas_op2str[op]; - if taicpu(hp).ops <> 0 then - begin - { - if not is_calljmp(op) then - sep:=',' - else - } - sep := #9; - for i := 0 to taicpu(hp).ops - 1 do - begin - // debug code - // writeln(s); - // writeln(taicpu(hp).fileinfo.line); - s := s + sep + getopstr(taicpu(hp).oper[i]^); - sep := ','; - end; - end; - end; - AsmWriteLn(s); -end; - - -begin - RegisterAssembler(as_ppc_gas_info, TPPCGNUAssembler); -end. diff --git a/compiler/powerpc64/aoptcpu.pas b/compiler/powerpc64/aoptcpu.pas deleted file mode 100644 index bd96f25524..0000000000 --- a/compiler/powerpc64/aoptcpu.pas +++ /dev/null @@ -1,41 +0,0 @@ -{ - Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal - Development Team - - This unit implements the PowerPC optimizer object - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} - -unit aoptcpu; - -interface - -{$I fpcdefs.inc} - -uses cpubase, aoptobj, aoptcpub, aopt; - -type - TCpuAsmOptimizer = class(TAsmOptimizer) - { uses the same constructor as TAopObj } - end; - -implementation - -begin - casmoptimizer := TCpuAsmOptimizer; -end. diff --git a/compiler/powerpc64/aoptcpub.pas b/compiler/powerpc64/aoptcpub.pas deleted file mode 100644 index b2e82450c5..0000000000 --- a/compiler/powerpc64/aoptcpub.pas +++ /dev/null @@ -1,123 +0,0 @@ -{ - Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal - Development Team - - This unit contains several types and constants necessary for the - optimizer to work on the PowerPC64 architecture - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -**************************************************************************** -} -unit aoptcpub; { Assembler OPTimizer CPU specific Base } - -{$I fpcdefs.inc} - -{ enable the following define if memory references can have both a base and } -{ index register in 1 operand } - -{$DEFINE RefsHaveIndexReg} - -{ enable the following define if memory references can have a scaled index } - -{ define RefsHaveScale} - -{ enable the following define if memory references can have a segment } -{ override } - -{ define RefsHaveSegment} - -interface - -uses - aasmcpu, AOptBase, cpubase; - -type - - { type of a normal instruction } - TInstr = Taicpu; - PInstr = ^TInstr; - - { ************************************************************************* } - { **************************** TCondRegs ********************************** } - { ************************************************************************* } - { Info about the conditional registers } - TCondRegs = object - constructor Init; - destructor Done; - end; - - { ************************************************************************* } - { **************************** TAoptBaseCpu ******************************* } - { ************************************************************************* } - - TAoptBaseCpu = class(TAoptBase) - end; - - { ************************************************************************* } - { ******************************* Constants ******************************* } - { ************************************************************************* } -const - - { the maximum number of things (registers, memory, ...) a single instruction } - { changes } - - MaxCh = 3; - - { the maximum number of operands an instruction has } - - MaxOps = 5; - - {Oper index of operand that contains the source (reference) with a load } - {instruction } - - LoadSrc = 1; - - {Oper index of operand that contains the destination (register) with a load } - {instruction } - - LoadDst = 0; - - {Oper index of operand that contains the source (register) with a store } - {instruction } - - StoreSrc = 0; - - {Oper index of operand that contains the destination (reference) with a load } - {instruction } - - StoreDst = 1; - - aopt_uncondjmp = A_B; - aopt_condjmp = A_BC; - -implementation - -{ ************************************************************************* } -{ **************************** TCondRegs ********************************** } -{ ************************************************************************* } - -constructor TCondRegs.init; -begin -end; - -destructor TCondRegs.Done; -{$IFDEF inl}inline; -{$ENDIF inl} -begin -end; - -end. - diff --git a/compiler/powerpc64/aoptcpuc.pas b/compiler/powerpc64/aoptcpuc.pas deleted file mode 100644 index e002fedb21..0000000000 --- a/compiler/powerpc64/aoptcpuc.pas +++ /dev/null @@ -1,40 +0,0 @@ -{ - Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal - Development Team - - This unit contains the processor specific implementation of the - assembler optimizer common subexpression elimination object. - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -**************************************************************************** -} -unit aoptcpuc; - -interface - -{$I fpcdefs.inc} - -uses - AOptCs; - -type - TRegInfoCpu = object(TRegInfo) - end; - -implementation - -end. - diff --git a/compiler/powerpc64/aoptcpud.pas b/compiler/powerpc64/aoptcpud.pas deleted file mode 100644 index 5e6e7fc308..0000000000 --- a/compiler/powerpc64/aoptcpud.pas +++ /dev/null @@ -1,40 +0,0 @@ -{ - Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal - Development Team - - This unit contains the processor specific implementation of the - assembler optimizer data flow analyzer. - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit aoptcpud; - -{$I fpcdefs.inc} - -interface - -uses - AOptDA; - -type - TAOptDFACpu = class(TAOptDFA) - end; - -implementation - -end. - diff --git a/compiler/powerpc64/cgcpu.pas b/compiler/powerpc64/cgcpu.pas deleted file mode 100644 index c6c10243ea..0000000000 --- a/compiler/powerpc64/cgcpu.pas +++ /dev/null @@ -1,1900 +0,0 @@ -{ - Copyright (c) 1998-2002 by Florian Klaempfl - - This unit implements the code generator for the PowerPC - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit cgcpu; - -{$I fpcdefs.inc} - -interface - -uses - globtype, symtype, symdef, - cgbase, cgobj, - aasmbase, aasmcpu, aasmtai, - cpubase, cpuinfo, cgutils, rgcpu, - parabase; - -type - tcgppc = class(tcg) - procedure init_register_allocators; override; - procedure done_register_allocators; override; - - { passing parameters, per default the parameter is pushed } - { nr gives the number of the parameter (enumerated from } - { left to right), this allows to move the parameter to } - { register, if the cpu supports register calling } - { conventions } - procedure a_param_const(list: taasmoutput; size: tcgsize; a: aint; const - paraloc: tcgpara); override; - procedure a_param_ref(list: taasmoutput; size: tcgsize; const r: treference; - const paraloc: tcgpara); override; - procedure a_paramaddr_ref(list: taasmoutput; const r: treference; const - paraloc: tcgpara); override; - - procedure a_call_name(list: taasmoutput; const s: string); override; - procedure a_call_reg(list: taasmoutput; reg: tregister); override; - - procedure a_op_const_reg(list: taasmoutput; Op: TOpCG; size: TCGSize; a: - aint; reg: TRegister); override; - procedure a_op_reg_reg(list: taasmoutput; Op: TOpCG; size: TCGSize; src, - dst: TRegister); override; - - procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg; - size: tcgsize; a: aint; src, dst: tregister); override; - procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg; - size: tcgsize; src1, src2, dst: tregister); override; - - { move instructions } - procedure a_load_const_reg(list: taasmoutput; size: tcgsize; a: aint; reg: - tregister); override; - { stores the contents of register reg to the memory location described by - ref } - procedure a_load_reg_ref(list: taasmoutput; fromsize, tosize: tcgsize; reg: - tregister; const ref: treference); override; - { loads the memory pointed to by ref into register reg } - procedure a_load_ref_reg(list: taasmoutput; fromsize, tosize: tcgsize; const - Ref: treference; reg: tregister); override; - procedure a_load_reg_reg(list: taasmoutput; fromsize, tosize: tcgsize; reg1, - reg2: tregister); override; - - { fpu move instructions } - procedure a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2: - tregister); override; - - procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: - treference; reg: tregister); override; - procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: - tregister; const ref: treference); override; - - { comparison operations } - procedure a_cmp_const_reg_label(list: taasmoutput; size: tcgsize; cmp_op: - topcmp; a: aint; reg: tregister; - l: tasmlabel); override; - procedure a_cmp_reg_reg_label(list: taasmoutput; size: tcgsize; cmp_op: - topcmp; reg1, reg2: tregister; l: tasmlabel); override; - - procedure a_jmp_name(list: taasmoutput; const s: string); override; - procedure a_jmp_always(list: taasmoutput; l: tasmlabel); override; - procedure a_jmp_flags(list: taasmoutput; const f: TResFlags; l: tasmlabel); - override; - - procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: TResFlags; - reg: TRegister); override; - - procedure g_proc_entry(list: taasmoutput; localsize: longint; nostackframe: - boolean); override; - procedure g_proc_exit(list: taasmoutput; parasize: longint; nostackframe: - boolean); override; - procedure g_save_standard_registers(list: Taasmoutput); override; - procedure g_restore_standard_registers(list: Taasmoutput); override; - - procedure a_loadaddr_ref_reg(list: taasmoutput; const ref: treference; r: - tregister); override; - - procedure g_concatcopy(list: taasmoutput; const source, dest: treference; - len: aint); override; - - procedure g_overflowcheck(list: taasmoutput; const l: tlocation; def: tdef); - override; - procedure a_jmp_cond(list: taasmoutput; cond: TOpCmp; l: tasmlabel); - - procedure g_intf_wrapper(list: TAAsmoutput; procdef: tprocdef; const - labelname: string; ioffset: longint); override; - - private - - { Make sure ref is a valid reference for the PowerPC and sets the } - { base to the value of the index if (base = R_NO). } - { Returns true if the reference contained a base, index and an } - { offset or symbol, in which case the base will have been changed } - { to a tempreg (which has to be freed by the caller) containing } - { the sum of part of the original reference } - function fixref(list: taasmoutput; var ref: treference; const size : TCgsize): boolean; - - { returns whether a reference can be used immediately in a powerpc } - { instruction } - function issimpleref(const ref: treference): boolean; - - { contains the common code of a_load_reg_ref and a_load_ref_reg } - procedure a_load_store(list: taasmoutput; op: tasmop; reg: tregister; - ref: treference); - - { creates the correct branch instruction for a given combination } - { of asmcondflags and destination addressing mode } - procedure a_jmp(list: taasmoutput; op: tasmop; - c: tasmcondflag; crval: longint; l: tasmlabel); - - { returns the lowest numbered FP register in use, and the number of used FP registers - for the current procedure } - procedure calcFirstUsedFPR(out firstfpr : TSuperRegister; out fprcount : aint); - { returns the lowest numbered GP register in use, and the number of used GP registers - for the current procedure } - procedure calcFirstUsedGPR(out firstgpr : TSuperRegister; out gprcount : aint); - - { returns true if the offset of the given reference can not be represented by a 16 bit - immediate as required by some PowerPC instructions } - function hasLargeOffset(const ref : TReference) : Boolean; inline; - - procedure a_call_name_direct(list: taasmoutput; s: string; prependDot : boolean; addNOP : boolean); - end; - -const - TShiftOpCG2AsmOpConst : array[boolean, OP_SAR..OP_SHR] of TAsmOp = ( - (A_SRAWI, A_SLWI, A_SRWI), (A_SRADI, A_SLDI, A_SRDI) - ); - - TOpCmp2AsmCond: array[topcmp] of TAsmCondFlag = (C_NONE, C_EQ, C_GT, - C_LT, C_GE, C_LE, C_NE, C_LE, C_LT, C_GE, C_GT); - -implementation - -uses - sysutils, - globals, verbose, systems, cutils, - symconst, symsym, fmodule, - rgobj, tgobj, cpupi, procinfo, paramgr; - -{ helper function which calculate "magic" values for replacement of unsigned - division by constant operation by multiplication. See the PowerPC compiler - developer manual for more information } -procedure getmagic_unsignedN(const N : byte; const d : aWord; - out magic_m : aWord; out magic_add : boolean; out magic_shift : byte); -var - p : aInt; - nc, delta, q1, r1, q2, r2, two_N_minus_1 : aWord; -begin - assert(d > 0); - - two_N_minus_1 := aWord(1) shl (N-1); - - magic_add := false; - nc := - 1 - (-d) mod d; - p := N-1; { initialize p } - q1 := two_N_minus_1 div nc; { initialize q1 = 2p/nc } - r1 := two_N_minus_1 - q1*nc; { initialize r1 = rem(2p,nc) } - q2 := (two_N_minus_1-1) div d; { initialize q2 = (2p-1)/d } - r2 := (two_N_minus_1-1) - q2*d; { initialize r2 = rem((2p-1),d) } - repeat - inc(p); - if (r1 >= (nc - r1)) then begin - q1 := 2 * q1 + 1; { update q1 } - r1 := 2*r1 - nc; { update r1 } - end else begin - q1 := 2*q1; { update q1 } - r1 := 2*r1; { update r1 } - end; - if ((r2 + 1) >= (d - r2)) then begin - if (q2 >= (two_N_minus_1-1)) then - magic_add := true; - q2 := 2*q2 + 1; { update q2 } - r2 := 2*r2 + 1 - d; { update r2 } - end else begin - if (q2 >= two_N_minus_1) then - magic_add := true; - q2 := 2*q2; { update q2 } - r2 := 2*r2 + 1; { update r2 } - end; - delta := d - 1 - r2; - until not ((p < (2*N)) and ((q1 < delta) or ((q1 = delta) and (r1 = 0)))); - magic_m := q2 + 1; { resulting magic number } - magic_shift := p - N; { resulting shift } -end; - -{ helper function which calculate "magic" values for replacement of signed - division by constant operation by multiplication. See the PowerPC compiler - developer manual for more information } -procedure getmagic_signedN(const N : byte; const d : aInt; - out magic_m : aInt; out magic_s : aInt); -var - p : aInt; - ad, anc, delta, q1, r1, q2, r2, t : aWord; - two_N_minus_1 : aWord; - -begin - assert((d < -1) or (d > 1)); - - two_N_minus_1 := aWord(1) shl (N-1); - - ad := abs(d); - t := two_N_minus_1 + (aWord(d) shr (N-1)); - anc := t - 1 - t mod ad; { absolute value of nc } - p := (N-1); { initialize p } - q1 := two_N_minus_1 div anc; { initialize q1 = 2p/abs(nc) } - r1 := two_N_minus_1 - q1*anc; { initialize r1 = rem(2p,abs(nc)) } - q2 := two_N_minus_1 div ad; { initialize q2 = 2p/abs(d) } - r2 := two_N_minus_1 - q2*ad; { initialize r2 = rem(2p,abs(d)) } - repeat - inc(p); - q1 := 2*q1; { update q1 = 2p/abs(nc) } - r1 := 2*r1; { update r1 = rem(2p/abs(nc)) } - if (r1 >= anc) then begin { must be unsigned comparison } - inc(q1); - dec(r1, anc); - end; - q2 := 2*q2; { update q2 = 2p/abs(d) } - r2 := 2*r2; { update r2 = rem(2p/abs(d)) } - if (r2 >= ad) then begin { must be unsigned comparison } - inc(q2); - dec(r2, ad); - end; - delta := ad - r2; - until not ((q1 < delta) or ((q1 = delta) and (r1 = 0))); - magic_m := q2 + 1; - if (d < 0) then begin - magic_m := -magic_m; { resulting magic number } - end; - magic_s := p - N; { resulting shift } -end; - -{ finds positive and negative powers of two of the given value, returning the - power and whether it's a negative power or not in addition to the actual result - of the function } -function ispowerof2(value : aInt; out power : byte; out neg : boolean) : boolean; -var - i : longint; - hl : aInt; -begin - neg := false; - { also try to find negative power of two's by negating if the - value is negative. low(aInt) is special because it can not be - negated. Simply return the appropriate values for it } - if (value < 0) then begin - neg := true; - if (value = low(aInt)) then begin - power := sizeof(aInt)*8-1; - result := true; - exit; - end; - value := -value; - end; - - if ((value and (value-1)) <> 0) then begin - result := false; - exit; - end; - hl := 1; - for i := 0 to (sizeof(aInt)*8-1) do begin - if (hl = value) then begin - result := true; - power := i; - exit; - end; - hl := hl shl 1; - end; -end; - - -procedure tcgppc.init_register_allocators; -begin - inherited init_register_allocators; - rg[R_INTREGISTER] := trgcpu.create(R_INTREGISTER, R_SUBWHOLE, - [RS_R3, RS_R4, RS_R5, RS_R6, RS_R7, RS_R8, - RS_R9, RS_R10, RS_R11, RS_R12, RS_R31, RS_R30, RS_R29, - RS_R28, RS_R27, RS_R26, RS_R25, RS_R24, RS_R23, RS_R22, - RS_R21, RS_R20, RS_R19, RS_R18, RS_R17, RS_R16, RS_R15, - RS_R14, RS_R13], first_int_imreg, []); - rg[R_FPUREGISTER] := trgcpu.create(R_FPUREGISTER, R_SUBNONE, - [RS_F0, RS_F1, RS_F2, RS_F3, RS_F4, RS_F5, RS_F6, RS_F7, RS_F8, RS_F9, - RS_F10, RS_F11, RS_F12, RS_F13, RS_F31, RS_F30, RS_F29, RS_F28, RS_F27, - RS_F26, RS_F25, RS_F24, RS_F23, RS_F22, RS_F21, RS_F20, RS_F19, RS_F18, - RS_F17, RS_F16, RS_F15, RS_F14], first_fpu_imreg, []); -{$WARNING FIX ME} - rg[R_MMREGISTER] := trgcpu.create(R_MMREGISTER, R_SUBNONE, - [RS_M0, RS_M1, RS_M2], first_mm_imreg, []); -end; - -procedure tcgppc.done_register_allocators; -begin - rg[R_INTREGISTER].free; - rg[R_FPUREGISTER].free; - rg[R_MMREGISTER].free; - inherited done_register_allocators; -end; - -procedure tcgppc.a_param_const(list: taasmoutput; size: tcgsize; a: aint; const - paraloc: tcgpara); -var - ref: treference; -begin - paraloc.check_simple_location; - case paraloc.location^.loc of - LOC_REGISTER, LOC_CREGISTER: - a_load_const_reg(list, size, a, paraloc.location^.register); - LOC_REFERENCE: - begin - reference_reset(ref); - ref.base := paraloc.location^.reference.index; - ref.offset := paraloc.location^.reference.offset; - a_load_const_ref(list, size, a, ref); - end; - else - internalerror(2002081101); - end; -end; - -procedure tcgppc.a_param_ref(list: taasmoutput; size: tcgsize; const r: - treference; const paraloc: tcgpara); - -var - tmpref, ref: treference; - location: pcgparalocation; - sizeleft: aint; - -begin - location := paraloc.location; - tmpref := r; - sizeleft := paraloc.intsize; - while assigned(location) do begin - case location^.loc of - LOC_REGISTER, LOC_CREGISTER: - begin - if (size <> OS_NO) then - a_load_ref_reg(list, size, location^.size, tmpref, - location^.register) - else - { load non-integral sized memory location into register. This - memory location be 1-sizeleft byte sized. - Always assume that this memory area is properly aligned, eg. start - loading the larger quantities for "odd" quantities first } - case sizeleft of - 1,2,4,8 : - a_load_ref_reg(list, int_cgsize(sizeleft), location^.size, tmpref, - location^.register); - 3 : begin - a_reg_alloc(list, NR_R12); - a_load_ref_reg(list, OS_16, location^.size, tmpref, - NR_R12); - inc(tmpref.offset, tcgsize2size[OS_16]); - a_load_ref_reg(list, OS_8, location^.size, tmpref, - location^.register); - list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, location^.register, NR_R12, 8, 40)); - a_reg_dealloc(list, NR_R12); - end; - 5 : begin - a_reg_alloc(list, NR_R12); - a_load_ref_reg(list, OS_32, location^.size, tmpref, NR_R12); - inc(tmpref.offset, tcgsize2size[OS_32]); - a_load_ref_reg(list, OS_8, location^.size, tmpref, location^.register); - list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, location^.register, NR_R12, 8, 24)); - a_reg_dealloc(list, NR_R12); - end; - 6 : begin - a_reg_alloc(list, NR_R12); - a_load_ref_reg(list, OS_32, location^.size, tmpref, NR_R12); - inc(tmpref.offset, tcgsize2size[OS_32]); - a_load_ref_reg(list, OS_16, location^.size, tmpref, location^.register); - list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, location^.register, NR_R12, 16, 16)); - a_reg_dealloc(list, NR_R12); - end; - 7 : begin - a_reg_alloc(list, NR_R12); - a_reg_alloc(list, NR_R0); - a_load_ref_reg(list, OS_32, location^.size, tmpref, NR_R12); - inc(tmpref.offset, tcgsize2size[OS_32]); - a_load_ref_reg(list, OS_16, location^.size, tmpref, NR_R0); - inc(tmpref.offset, tcgsize2size[OS_16]); - a_load_ref_reg(list, OS_8, location^.size, tmpref, location^.register); - list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, NR_R0, NR_R12, 16, 16)); - list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, location^.register, NR_R0, 8, 8)); - a_reg_dealloc(list, NR_R0); - a_reg_dealloc(list, NR_R12); - end; - else - { still > 8 bytes to load, so load data single register now } - a_load_ref_reg(list, location^.size, location^.size, tmpref, - location^.register); - end; - end; - LOC_REFERENCE: - begin - reference_reset_base(ref, location^.reference.index, - location^.reference.offset); - g_concatcopy(list, tmpref, ref, sizeleft); - if assigned(location^.next) then - internalerror(2005010710); - end; - LOC_FPUREGISTER, LOC_CFPUREGISTER: - case location^.size of - OS_F32, OS_F64: - a_loadfpu_ref_reg(list, location^.size, tmpref, location^.register); - else - internalerror(2002072801); - end; - LOC_VOID: - { nothing to do } - ; - else - internalerror(2002081103); - end; - inc(tmpref.offset, tcgsize2size[location^.size]); - dec(sizeleft, tcgsize2size[location^.size]); - location := location^.next; - end; -end; - -procedure tcgppc.a_paramaddr_ref(list: taasmoutput; const r: treference; const - paraloc: tcgpara); -var - ref: treference; - tmpreg: tregister; - -begin - paraloc.check_simple_location; - case paraloc.location^.loc of - LOC_REGISTER, LOC_CREGISTER: - a_loadaddr_ref_reg(list, r, paraloc.location^.register); - LOC_REFERENCE: - begin - reference_reset(ref); - ref.base := paraloc.location^.reference.index; - ref.offset := paraloc.location^.reference.offset; - tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE); - a_loadaddr_ref_reg(list, r, tmpreg); - a_load_reg_ref(list, OS_ADDR, OS_ADDR, tmpreg, ref); - end; - else - internalerror(2002080701); - end; -end; - -{ calling a procedure by name } - -procedure tcgppc.a_call_name(list: taasmoutput; const s: string); -begin - a_call_name_direct(list, s, true, true); -end; - -procedure tcgppc.a_call_name_direct(list: taasmoutput; s: string; prependDot : boolean; addNOP : boolean); -begin - if (prependDot) then - s := '.' + s; - list.concat(taicpu.op_sym(A_BL, objectlibrary.newasmsymbol(s, AB_EXTERNAL, - AT_FUNCTION))); - if (addNOP) then - list.concat(taicpu.op_none(A_NOP)); - { the compiler does not properly set this flag anymore in pass 1, and - for now we only need it after pass 2 (I hope) (JM) } - include(current_procinfo.flags, pi_do_call); -end; - - -{ calling a procedure by address } - -procedure tcgppc.a_call_reg(list: taasmoutput; reg: tregister); -var - tmpref: treference; -begin - if (not (cs_littlesize in aktglobalswitches)) then begin - { load actual function entry (reg contains the reference to the function descriptor) - into R0 } - reference_reset_base(tmpref, reg, 0); - a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, NR_R0); - - { save TOC pointer in stackframe } - reference_reset_base(tmpref, NR_STACK_POINTER_REG, LA_RTOC_ELF); - a_load_reg_ref(list, OS_ADDR, OS_ADDR, NR_RTOC, tmpref); - - { move actual function pointer to CTR register } - list.concat(taicpu.op_reg(A_MTCTR, NR_R0)); - - { load new TOC pointer from function descriptor into RTOC register } - reference_reset_base(tmpref, reg, tcgsize2size[OS_ADDR]); - a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, NR_RTOC); - - { load new environment pointer from function descriptor into R11 register } - reference_reset_base(tmpref, reg, 2*tcgsize2size[OS_ADDR]); - a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, NR_R11); - - { call function } - list.concat(taicpu.op_none(A_BCTRL)); - end else begin - { call ptrgl helper routine which expects the pointer to the function descriptor - in R11 } - a_load_reg_reg(list, OS_ADDR, OS_ADDR, reg, NR_R11); - a_call_name_direct(list, 'ptrgl', true, false); - end; - - { we need to load the old RTOC from stackframe because we changed it} - reference_reset_base(tmpref, NR_STACK_POINTER_REG, LA_RTOC_ELF); - a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, NR_RTOC); - - include(current_procinfo.flags, pi_do_call); -end; - -{********************** load instructions ********************} - -procedure tcgppc.a_load_const_reg(list: taasmoutput; size: TCGSize; a: aint; - reg: TRegister); - - { loads a 32 bit constant into the given register, using an optimal instruction sequence. - This is either LIS, LI or LI+ADDIS. - Returns true if during these operations the upper 32 bits were filled with 1 bits (e.g. - sign extension was performed) } - function load32bitconstant(list : taasmoutput; size : TCGSize; a : longint; - reg : TRegister) : boolean; - var - is_half_signed : byte; - begin - { if the lower 16 bits are zero, do a single LIS } - if (smallint(a) = 0) and ((a shr 16) <> 0) then begin - list.concat(taicpu.op_reg_const(A_LIS, reg, smallint(hi(a)))); - load32bitconstant := longint(a) < 0; - end else begin - is_half_signed := ord(smallint(lo(a)) < 0); - list.concat(taicpu.op_reg_const(A_LI, reg, smallint(a and $ffff))); - if smallint(hi(a) + is_half_signed) <> 0 then begin - list.concat(taicpu.op_reg_reg_const(A_ADDIS, reg, reg, smallint(hi(a) + is_half_signed))); - end; - load32bitconstant := (smallint(a) < 0) or (a < 0); - end; - end; - - { R0-safe version of the above (ADDIS doesn't work the same way with R0 as base), without - the return value. Unused until further testing shows that it is not really necessary; - loading the upper 32 bits of a value is now done using R12, which does not require - special treatment } - procedure load32bitconstantR0(list : taasmoutput; size : TCGSize; a : longint; - reg : TRegister); - begin - { only 16 bit constant? (-2^15 <= a <= +2^15-1) } - if (a >= low(smallint)) and (a <= high(smallint)) then begin - list.concat(taicpu.op_reg_const(A_LI, reg, smallint(a))); - end else begin - { check if we have to start with LI or LIS, load as 32 bit constant } - if ((a and $FFFF) <> 0) then begin - list.concat(taicpu.op_reg_const(A_LIS, reg, smallint(a shr 16))); - list.concat(taicpu.op_reg_reg_const(A_ORI, reg, reg, word(a))); - end else begin - list.concat(taicpu.op_reg_const(A_LIS, reg, smallint(a shr 16))); - end; - end; - end; - -var - extendssign : boolean; - {$IFDEF EXTDEBUG} - astring : string; - {$ENDIF EXTDEBUG} - -begin - {$IFDEF EXTDEBUG} - astring := 'a_load_const reg ' + inttostr(hi(a)) + ' ' + inttostr(lo(a)) + ' ' + inttostr(ord(size)) + ' ' + inttostr(tcgsize2size[size]); - list.concat(tai_comment.create(strpnew(astring))); - {$ENDIF EXTDEBUG} - - if not (size in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32, OS_64, OS_S64]) then - internalerror(2002090902); - if (lo(a) = 0) and (hi(a) <> 0) then begin - { load only upper 32 bits, and shift } - load32bitconstant(list, size, hi(a), reg); - list.concat(taicpu.op_reg_reg_const(A_SLDI, reg, reg, 32)); - end else begin - { load lower 32 bits } - extendssign := load32bitconstant(list, size, lo(a), reg); - if (extendssign) and (hi(a) = 0) then - { if upper 32 bits are zero, but loading the lower 32 bit resulted in automatic - sign extension, clear those bits } - a_load_reg_reg(list, OS_32, OS_64, reg, reg) - else if (not - ((extendssign and (longint(hi(a)) = -1)) or - ((not extendssign) and (hi(a)=0))) - ) then begin - { only load the upper 32 bits, if the automatic sign extension is not okay, - that is, _not_ if - - loading the lower 32 bits resulted in -1 in the upper 32 bits, and the upper - 32 bits should contain -1 - - loading the lower 32 bits resulted in 0 in the upper 32 bits, and the upper - 32 bits should contain 0 } - load32bitconstant(list, size, hi(a), NR_R12); - { combine both registers } - list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, reg, NR_R12, 32, 0)); - end; - end; -end; - -procedure tcgppc.a_load_reg_ref(list: taasmoutput; fromsize, tosize: TCGSize; - reg: tregister; const ref: treference); - -const - StoreInstr: array[OS_8..OS_64, boolean, boolean] of TAsmOp = - { indexed? updating?} - (((A_STB, A_STBU), (A_STBX, A_STBUX)), - ((A_STH, A_STHU), (A_STHX, A_STHUX)), - ((A_STW, A_STWU), (A_STWX, A_STWUX)), - ((A_STD, A_STDU), (A_STDX, A_STDUX)) - ); -var - op: TAsmOp; - ref2: TReference; -begin - ref2 := ref; - fixref(list, ref2, tosize); - if tosize in [OS_S8..OS_S64] then - { storing is the same for signed and unsigned values } - tosize := tcgsize(ord(tosize) - (ord(OS_S8) - ord(OS_8))); - op := storeinstr[tcgsize2unsigned[tosize], ref2.index <> NR_NO, false]; - a_load_store(list, op, reg, ref2); -end; - -procedure tcgppc.a_load_ref_reg(list: taasmoutput; fromsize, tosize: tcgsize; - const ref: treference; reg: tregister); - -const - LoadInstr: array[OS_8..OS_S64, boolean, boolean] of TAsmOp = - { indexed? updating? } - (((A_LBZ, A_LBZU), (A_LBZX, A_LBZUX)), - ((A_LHZ, A_LHZU), (A_LHZX, A_LHZUX)), - ((A_LWZ, A_LWZU), (A_LWZX, A_LWZUX)), - ((A_LD, A_LDU), (A_LDX, A_LDUX)), - { 128bit stuff too } - ((A_NONE, A_NONE), (A_NONE, A_NONE)), - { there's no load-byte-with-sign-extend :( } - ((A_LBZ, A_LBZU), (A_LBZX, A_LBZUX)), - ((A_LHA, A_LHAU), (A_LHAX, A_LHAUX)), - { there's no load-word-arithmetic-indexed with update, simulate it in code :( } - ((A_LWA, A_NOP), (A_LWAX, A_LWAUX)), - ((A_LD, A_LDU), (A_LDX, A_LDUX)) - ); -var - op: tasmop; - ref2: treference; - -begin - if not (fromsize in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32, OS_64, OS_S64]) then - internalerror(2002090902); - ref2 := ref; - fixref(list, ref2, tosize); - { the caller is expected to have adjusted the reference already - in this case } - if (TCGSize2Size[fromsize] >= TCGSize2Size[tosize]) then - fromsize := tosize; - op := loadinstr[fromsize, ref2.index <> NR_NO, false]; - { there is no LWAU instruction, simulate using ADDI and LWA } - if (op = A_NOP) then begin - list.concat(taicpu.op_reg_reg_const(A_ADDI, reg, reg, ref2.offset)); - ref2.offset := 0; - op := A_LWA; - end; - a_load_store(list, op, reg, ref2); - { sign extend shortint if necessary, since there is no - load instruction that does that automatically (JM) } - if fromsize = OS_S8 then - list.concat(taicpu.op_reg_reg(A_EXTSB, reg, reg)); -end; - -procedure tcgppc.a_load_reg_reg(list: taasmoutput; fromsize, tosize: tcgsize; - reg1, reg2: tregister); - -const - movemap : array[OS_8..OS_S128, OS_8..OS_S128] of tasmop = ( -{ to -> OS_8 OS_16 OS_32 OS_64 OS_128 OS_S8 OS_S16 OS_S32 OS_S64 OS_S128 } -{ from } -{ OS_8 } (A_MR, A_RLDICL, A_RLDICL, A_RLDICL, A_NONE, A_RLDICL, A_RLDICL, A_RLDICL, A_RLDICL, A_NOP ), -{ OS_16 } (A_RLDICL, A_MR, A_RLDICL, A_RLDICL, A_NONE, A_RLDICL, A_RLDICL, A_RLDICL, A_RLDICL, A_NOP ), -{ OS_32 } (A_RLDICL, A_RLDICL, A_MR, A_RLDICL, A_NONE, A_RLDICL, A_RLDICL, A_RLDICL, A_RLDICL, A_NOP ), -{ OS_64 } (A_RLDICL, A_RLDICL, A_RLDICL, A_MR, A_NONE, A_RLDICL, A_RLDICL, A_RLDICL, A_RLDICL, A_NOP ), -{ OS_128 } (A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NOP ), -{ OS_S8 } (A_EXTSB, A_EXTSB, A_EXTSB, A_EXTSB, A_NONE, A_MR, A_EXTSB, A_EXTSB, A_EXTSB, A_NOP ), -{ OS_S16 } (A_RLDICL, A_EXTSH, A_EXTSH, A_EXTSH, A_NONE, A_EXTSB, A_MR, A_EXTSH, A_EXTSH, A_NOP ), -{ OS_S32 } (A_RLDICL, A_RLDICL, A_EXTSW, A_EXTSW, A_NONE, A_EXTSB, A_EXTSH, A_MR, A_EXTSW, A_NOP ), -{ OS_S64 } (A_RLDICL, A_RLDICL, A_RLDICL, A_MR, A_NONE, A_EXTSB, A_EXTSH, A_EXTSW, A_MR, A_NOP ), -{ OS_S128 } (A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NOP ) -); - -var - instr: taicpu; - op : tasmop; -begin - op := movemap[fromsize, tosize]; - case op of - A_MR, A_EXTSB, A_EXTSH, A_EXTSW : instr := taicpu.op_reg_reg(op, reg2, reg1); - A_RLDICL : instr := taicpu.op_reg_reg_const_const(A_RLDICL, reg2, reg1, 0, (8-tcgsize2size[fromsize])*8); - else - internalerror(2002090901); - end; - list.concat(instr); - rg[R_INTREGISTER].add_move_instruction(instr); -end; - -procedure tcgppc.a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; - reg1, reg2: tregister); -var - instr: taicpu; -begin - instr := taicpu.op_reg_reg(A_FMR, reg2, reg1); - list.concat(instr); - rg[R_FPUREGISTER].add_move_instruction(instr); -end; - -procedure tcgppc.a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; - const ref: treference; reg: tregister); -const - FpuLoadInstr: array[OS_F32..OS_F64, boolean, boolean] of TAsmOp = - { indexed? updating?} - (((A_LFS, A_LFSU), (A_LFSX, A_LFSUX)), - ((A_LFD, A_LFDU), (A_LFDX, A_LFDUX))); -var - op: tasmop; - ref2: treference; - -begin - { several functions call this procedure with OS_32 or OS_64 - so this makes life easier (FK) } - case size of - OS_32, OS_F32: - size := OS_F32; - OS_64, OS_F64, OS_C64: - size := OS_F64; - else - internalerror(200201121); - end; - ref2 := ref; - fixref(list, ref2, size); - op := fpuloadinstr[size, ref2.index <> NR_NO, false]; - a_load_store(list, op, reg, ref2); -end; - -procedure tcgppc.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: - tregister; const ref: treference); -const - FpuStoreInstr: array[OS_F32..OS_F64, boolean, boolean] of TAsmOp = - { indexed? updating? } - (((A_STFS, A_STFSU), (A_STFSX, A_STFSUX)), - ((A_STFD, A_STFDU), (A_STFDX, A_STFDUX))); -var - op: tasmop; - ref2: treference; - -begin - if not (size in [OS_F32, OS_F64]) then - internalerror(200201122); - ref2 := ref; - fixref(list, ref2, size); - op := fpustoreinstr[size, ref2.index <> NR_NO, false]; - a_load_store(list, op, reg, ref2); -end; - -procedure tcgppc.a_op_const_reg(list: taasmoutput; Op: TOpCG; size: TCGSize; a: - aint; reg: TRegister); -begin - a_op_const_reg_reg(list, op, size, a, reg, reg); -end; - -procedure tcgppc.a_op_reg_reg(list: taasmoutput; Op: TOpCG; size: TCGSize; src, - dst: TRegister); -begin - a_op_reg_reg_reg(list, op, size, src, dst, dst); -end; - -procedure tcgppc.a_op_const_reg_reg(list: taasmoutput; op: TOpCg; - size: tcgsize; a: aint; src, dst: tregister); -var - useReg : boolean; - - procedure do_lo_hi(loOp, hiOp : TAsmOp); - begin - { Optimization for logical ops (excluding AND), trying to do this as efficiently - as possible by only generating code for the affected halfwords. Note that all - the instructions handled here must have "X op 0 = X" for every halfword. } - usereg := false; - if (aword(a) > high(dword)) then begin - usereg := true; - end else begin - if (word(a) <> 0) then begin - list.concat(taicpu.op_reg_reg_const(loOp, dst, src, word(a))); - if (word(a shr 16) <> 0) then - list.concat(taicpu.op_reg_reg_const(hiOp, dst, dst, word(a shr 16))); - end else if (word(a shr 16) <> 0) then - list.concat(taicpu.op_reg_reg_const(hiOp, dst, src, word(a shr 16))); - end; - end; - - procedure do_lo_hi_and; - begin - { optimization logical and with immediate: only use "andi." for 16 bit - ands, otherwise use register method. Doing this for 32 bit constants - would not give any advantage to the register method (via useReg := true), - requiring a scratch register and three instructions. } - usereg := false; - if (aword(a) > high(word)) then - usereg := true - else - list.concat(taicpu.op_reg_reg_const(A_ANDI_, dst, src, word(a))); - end; - - procedure do_constant_div(list : taasmoutput; size : TCgSize; a : aint; src, dst : TRegister; - signed : boolean); - const - negops : array[boolean] of tasmop = (A_NEG, A_NEGO); - var - magic, shift : int64; - u_magic : qword; - u_shift : byte; - u_add : boolean; - power : byte; - isNegPower : boolean; - - divreg : tregister; - begin - if (a = 0) then begin - internalerror(2005061701); - end else if (a = 1) then begin - cg.a_load_reg_reg(exprasmlist, OS_INT, OS_INT, src, dst); - end else if (a = -1) then begin - { note: only in the signed case possible..., may overflow } - exprasmlist.concat(taicpu.op_reg_reg(negops[cs_check_overflow in aktlocalswitches], dst, src)); - end else if (ispowerof2(a, power, isNegPower)) then begin - if (signed) then begin - { From "The PowerPC Compiler Writer's Guide", pg. 52ff } - cg.a_op_const_reg_reg(exprasmlist, OP_SAR, OS_INT, power, - src, dst); - exprasmlist.concat(taicpu.op_reg_reg(A_ADDZE, dst, dst)); - if (isNegPower) then - exprasmlist.concat(taicpu.op_reg_reg(A_NEG, dst, dst)); - end else begin - cg.a_op_const_reg_reg(exprasmlist, OP_SHR, OS_INT, power, src, dst) - end; - end else begin - { replace division by multiplication, both implementations } - { from "The PowerPC Compiler Writer's Guide" pg. 53ff } - divreg := cg.getintregister(exprasmlist, OS_INT); - if (signed) then begin - getmagic_signedN(sizeof(aInt)*8, a, magic, shift); - { load magic value } - cg.a_load_const_reg(exprasmlist, OS_INT, magic, divreg); - { multiply } - exprasmlist.concat(taicpu.op_reg_reg_reg(A_MULHD, dst, src, divreg)); - { add/subtract numerator } - if (a > 0) and (magic < 0) then begin - cg.a_op_reg_reg_reg(exprasmlist, OP_ADD, OS_INT, src, dst, dst); - end else if (a < 0) and (magic > 0) then begin - cg.a_op_reg_reg_reg(exprasmlist, OP_SUB, OS_INT, src, dst, dst); - end; - { shift shift places to the right (arithmetic) } - cg.a_op_const_reg_reg(exprasmlist, OP_SAR, OS_INT, shift, dst, dst); - { extract and add sign bit } - if (a >= 0) then begin - cg.a_op_const_reg_reg(exprasmlist, OP_SHR, OS_INT, 63, src, divreg); - end else begin - cg.a_op_const_reg_reg(exprasmlist, OP_SHR, OS_INT, 63, dst, divreg); - end; - cg.a_op_reg_reg_reg(exprasmlist, OP_ADD, OS_INT, dst, divreg, dst); - end else begin - getmagic_unsignedN(sizeof(aWord)*8, a, u_magic, u_add, u_shift); - { load magic in divreg } - cg.a_load_const_reg(exprasmlist, OS_INT, u_magic, divreg); - exprasmlist.concat(taicpu.op_reg_reg_reg(A_MULHDU, dst, src, divreg)); - if (u_add) then begin - cg.a_op_reg_reg_reg(exprasmlist, OP_SUB, OS_INT, dst, src, divreg); - cg.a_op_const_reg_reg(exprasmlist, OP_SHR, OS_INT, 1, divreg, divreg); - cg.a_op_reg_reg_reg(exprasmlist, OP_ADD, OS_INT, divreg, dst, divreg); - cg.a_op_const_reg_reg(exprasmlist, OP_SHR, OS_INT, u_shift-1, divreg, dst); - end else begin - cg.a_op_const_reg_reg(exprasmlist, OP_SHR, OS_INT, u_shift, dst, dst); - end; - end; - end; - end; - -var - scratchreg: tregister; - shift : byte; - shiftmask : longint; - isneg : boolean; - -begin - { subtraction is the same as addition with negative constant } - if op = OP_SUB then begin - a_op_const_reg_reg(list, OP_ADD, size, -a, src, dst); - exit; - end; - { This case includes some peephole optimizations for the various operations, - (e.g. AND, OR, XOR, ..) - can't this be done at some higher level, - independent of architecture? } - - { assume that we do not need a scratch register for the operation } - useReg := false; - case (op) of - OP_DIV, OP_IDIV: - if (cs_slowoptimize in aktglobalswitches) then - do_constant_div(list, size, a, src, dst, op = OP_IDIV) - else - usereg := true; - OP_IMUL, OP_MUL: - { idea: factorize constant multiplicands and use adds/shifts with few factors; - however, even a 64 bit multiply is already quite fast on PPC64 } - if (a = 0) then - a_load_const_reg(list, size, 0, dst) - else if (a = -1) then - list.concat(taicpu.op_reg_reg(A_NEG, dst, dst)) - else if (a = 1) then - a_load_reg_reg(list, OS_INT, OS_INT, src, dst) - else if ispowerof2(a, shift, isneg) then begin - list.concat(taicpu.op_reg_reg_const(A_SLDI, dst, src, shift)); - if (isneg) then - exprasmlist.concat(taicpu.op_reg_reg(A_NEG, dst, dst)); - end else if (a >= low(smallint)) and (a <= high(smallint)) then - list.concat(taicpu.op_reg_reg_const(A_MULLI, dst, src, - smallint(a))) - else - usereg := true; - OP_ADD: - if (a = 0) then - a_load_reg_reg(list, size, size, src, dst) - else if (a >= low(smallint)) and (a <= high(smallint)) then - list.concat(taicpu.op_reg_reg_const(A_ADDI, dst, src, smallint(a))) - else - useReg := true; - OP_OR: - if (a = 0) then - a_load_reg_reg(list, size, size, src, dst) - else if (a = -1) then - a_load_const_reg(list, size, -1, dst) - else - do_lo_hi(A_ORI, A_ORIS); - OP_AND: - if (a = 0) then - a_load_const_reg(list, size, 0, dst) - else if (a = -1) then - a_load_reg_reg(list, size, size, src, dst) - else - do_lo_hi_and; - OP_XOR: - if (a = 0) then - a_load_reg_reg(list, size, size, src, dst) - else if (a = -1) then - list.concat(taicpu.op_reg_reg(A_NOT, dst, src)) - else - do_lo_hi(A_XORI, A_XORIS); - OP_SHL, OP_SHR, OP_SAR: - begin - if (size in [OS_64, OS_S64]) then - shift := 6 - else - shift := 5; - - shiftmask := (1 shl shift)-1; - if (a and shiftmask) <> 0 then - list.concat(taicpu.op_reg_reg_const( - TShiftOpCG2AsmOpConst[size in [OS_64, OS_S64], op], dst, src, a and shiftmask)) - else - a_load_reg_reg(list, size, size, src, dst); - if ((a shr shift) <> 0) then - internalError(68991); - end - else - internalerror(200109091); - end; - { if all else failed, load the constant in a register and then - perform the operation } - if (useReg) then begin - scratchreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE); - a_load_const_reg(list, size, a, scratchreg); - a_op_reg_reg_reg(list, op, size, scratchreg, src, dst); - end; -end; - -procedure tcgppc.a_op_reg_reg_reg(list: taasmoutput; op: TOpCg; - size: tcgsize; src1, src2, dst: tregister); -const - op_reg_reg_opcg2asmop32: array[TOpCG] of tasmop = - (A_NONE, A_ADD, A_AND, A_DIVWU, A_DIVW, A_MULLW, A_MULLW, A_NEG, A_NOT, A_OR, - A_SRAW, A_SLW, A_SRW, A_SUB, A_XOR); - op_reg_reg_opcg2asmop64: array[TOpCG] of tasmop = - (A_NONE, A_ADD, A_AND, A_DIVDU, A_DIVD, A_MULLD, A_MULLD, A_NEG, A_NOT, A_OR, - A_SRAD, A_SLD, A_SRD, A_SUB, A_XOR); -begin - case op of - OP_NEG, OP_NOT: - begin - list.concat(taicpu.op_reg_reg(op_reg_reg_opcg2asmop64[op], dst, src1)); - if (op = OP_NOT) and not (size in [OS_64, OS_S64]) then - { zero/sign extend result again, fromsize is not important here } - a_load_reg_reg(list, OS_S64, size, dst, dst) - end; - else - if (size in [OS_64, OS_S64]) then begin - list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop64[op], dst, src2, - src1)); - end else begin - list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop32[op], dst, src2, - src1)); - end; - end; -end; - -{*************** compare instructructions ****************} - -procedure tcgppc.a_cmp_const_reg_label(list: taasmoutput; size: tcgsize; - cmp_op: topcmp; a: aint; reg: tregister; l: tasmlabel); -var - scratch_register: TRegister; - signed: boolean; -begin - signed := cmp_op in [OC_GT, OC_LT, OC_GTE, OC_LTE]; - { in the following case, we generate more efficient code when } - { signed is true } - if (cmp_op in [OC_EQ, OC_NE]) and - (aword(a) > $FFFF) then - signed := true; - if signed then - if (a >= low(smallint)) and (a <= high(smallint)) then - list.concat(taicpu.op_reg_reg_const(A_CMPDI, NR_CR0, reg, a)) - else begin - scratch_register := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE); - a_load_const_reg(list, OS_64, a, scratch_register); - list.concat(taicpu.op_reg_reg_reg(A_CMPD, NR_CR0, reg, scratch_register)); - end - else if (aword(a) <= $FFFF) then - list.concat(taicpu.op_reg_reg_const(A_CMPLDI, NR_CR0, reg, aword(a))) - else begin - scratch_register := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE); - a_load_const_reg(list, OS_64, a, scratch_register); - list.concat(taicpu.op_reg_reg_reg(A_CMPLD, NR_CR0, reg, - scratch_register)); - end; - a_jmp(list, A_BC, TOpCmp2AsmCond[cmp_op], 0, l); -end; - -procedure tcgppc.a_cmp_reg_reg_label(list: taasmoutput; size: tcgsize; - cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel); -var - op: tasmop; -begin - if cmp_op in [OC_GT, OC_LT, OC_GTE, OC_LTE] then - if (size in [OS_64, OS_S64]) then - op := A_CMPD - else - op := A_CMPW - else - if (size in [OS_64, OS_S64]) then - op := A_CMPLD - else - op := A_CMPLW; - list.concat(taicpu.op_reg_reg_reg(op, NR_CR0, reg2, reg1)); - a_jmp(list, A_BC, TOpCmp2AsmCond[cmp_op], 0, l); -end; - -procedure tcgppc.a_jmp_cond(list: taasmoutput; cond: TOpCmp; l: tasmlabel); - -begin - a_jmp(list, A_BC, TOpCmp2AsmCond[cond], 0, l); -end; - -procedure tcgppc.a_jmp_name(list: taasmoutput; const s: string); -var - p: taicpu; -begin - p := taicpu.op_sym(A_B, objectlibrary.newasmsymbol(s, AB_EXTERNAL, - AT_LABEL)); - p.is_jmp := true; - list.concat(p) -end; - -procedure tcgppc.a_jmp_always(list: taasmoutput; l: tasmlabel); - -begin - a_jmp(list, A_B, C_None, 0, l); -end; - -procedure tcgppc.a_jmp_flags(list: taasmoutput; const f: TResFlags; l: - tasmlabel); - -var - c: tasmcond; -begin - c := flags_to_cond(f); - a_jmp(list, A_BC, c.cond, c.cr - RS_CR0, l); -end; - -procedure tcgppc.g_flags2reg(list: taasmoutput; size: TCgSize; const f: - TResFlags; reg: TRegister); -var - testbit: byte; - bitvalue: boolean; -begin - { get the bit to extract from the conditional register + its requested value (0 or 1) } - testbit := ((f.cr - RS_CR0) * 4); - case f.flag of - F_EQ, F_NE: - begin - inc(testbit, 2); - bitvalue := f.flag = F_EQ; - end; - F_LT, F_GE: - begin - bitvalue := f.flag = F_LT; - end; - F_GT, F_LE: - begin - inc(testbit); - bitvalue := f.flag = F_GT; - end; - else - internalerror(200112261); - end; - { load the conditional register in the destination reg } - list.concat(taicpu.op_reg(A_MFCR, reg)); - { we will move the bit that has to be tested to bit 0 by rotating left } - testbit := (testbit + 1) and 31; - { extract bit } - list.concat(taicpu.op_reg_reg_const_const_const( - A_RLWINM,reg,reg,testbit,31,31)); - - { if we need the inverse, xor with 1 } - if not bitvalue then - list.concat(taicpu.op_reg_reg_const(A_XORI, reg, reg, 1)); -end; - -{ *********** entry/exit code and address loading ************ } - -procedure tcgppc.g_save_standard_registers(list: Taasmoutput); -begin - { this work is done in g_proc_entry } -end; - -procedure tcgppc.g_restore_standard_registers(list: Taasmoutput); -begin - { this work is done in g_proc_exit } -end; - -procedure tcgppc.calcFirstUsedFPR(out firstfpr : TSuperRegister; out fprcount : aint); -var - reg : TSuperRegister; -begin - fprcount := 0; - firstfpr := RS_F31; - if not (po_assembler in current_procinfo.procdef.procoptions) then begin - for reg := RS_F14 to RS_F31 do begin - if reg in rg[R_FPUREGISTER].used_in_proc then begin - fprcount := ord(RS_F31)-ord(reg)+1; - firstfpr := reg; - break; - end; - end; - end; -end; - -procedure tcgppc.calcFirstUsedGPR(out firstgpr : TSuperRegister; out gprcount : aint); -var - reg : TSuperRegister; -begin - gprcount := 0; - firstgpr := RS_R31; - if not (po_assembler in current_procinfo.procdef.procoptions) then begin - for reg := RS_R14 to RS_R31 do begin - if reg in rg[R_INTREGISTER].used_in_proc then begin - gprcount := ord(RS_R31)-ord(reg)+1; - firstgpr := reg; - break; - end; - end; - end; -end; - -procedure tcgppc.g_proc_entry(list: taasmoutput; localsize: longint; - nostackframe: boolean); -{ generated the entry code of a procedure/function. Note: localsize is the - sum of the size necessary for local variables and the maximum possible - combined size of ALL the parameters of a procedure called by the current - one. - This procedure may be called before, as well as after g_return_from_proc - is called. NOTE registers are not to be allocated through the register - allocator here, because the register colouring has already occured !! } -var - firstregfpu, firstreggpr: TSuperRegister; - href: treference; - needslinkreg: boolean; - regcount : TSuperRegister; - - fprcount, gprcount : aint; - -begin - { CR and LR only have to be saved in case they are modified by the current - procedure, but currently this isn't checked, so save them always - following is the entry code as described in "Altivec Programming - Interface Manual", bar the saving of AltiVec registers } - a_reg_alloc(list, NR_STACK_POINTER_REG); - a_reg_alloc(list, NR_R0); - - calcFirstUsedFPR(firstregfpu, fprcount); - calcFirstUsedGPR(firstreggpr, gprcount); - - { calculate real stack frame size } - localsize := tppcprocinfo(current_procinfo).calc_stackframe_size( - gprcount, fprcount); - - { determine whether we need to save the link register } - needslinkreg := ((not (po_assembler in current_procinfo.procdef.procoptions)) and - (pi_do_call in current_procinfo.flags)); - - { move link register to r0 } - if (needslinkreg) then begin - list.concat(taicpu.op_reg(A_MFLR, NR_R0)); - end; - { save old stack frame pointer } - if (localsize > 0) then begin - a_reg_alloc(list, NR_OLD_STACK_POINTER_REG); - list.concat(taicpu.op_reg_reg(A_MR, NR_OLD_STACK_POINTER_REG, NR_STACK_POINTER_REG)); - end; - { save registers, FPU first, then GPR } - reference_reset_base(href, NR_STACK_POINTER_REG, -8); - if (fprcount > 0) then begin - for regcount := RS_F31 downto firstregfpu do begin - a_loadfpu_reg_ref(list, OS_FLOAT, newreg(R_FPUREGISTER, regcount, - R_SUBNONE), href); - dec(href.offset, tcgsize2size[OS_FLOAT]); - end; - end; - if (gprcount > 0) then begin - for regcount := RS_R31 downto firstreggpr do begin - a_load_reg_ref(list, OS_INT, OS_INT, newreg(R_INTREGISTER, regcount, - R_SUBNONE), href); - dec(href.offset, tcgsize2size[OS_INT]); - end; - end; - - { VMX registers not supported by FPC atm } - - { we may need to store R0 (=LR) ourselves } - if (needslinkreg) then begin - reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_ELF); - list.concat(taicpu.op_reg_ref(A_STD, NR_R0, href)); - end; - - { create stack frame } - if (not nostackframe) and (localsize > 0) then begin - if (localsize <= high(smallint)) then begin - reference_reset_base(href, NR_STACK_POINTER_REG, -localsize); - a_load_store(list, A_STDU, NR_STACK_POINTER_REG, href); - end else begin - reference_reset_base(href, NR_NO, -localsize); - - { use R0 for loading the constant (which is definitely > 32k when entering - this branch) - Inlined at this position because it must not use temp registers because - register allocations have already been done :( } - { Code template: - lis r0,ofs@highest - ori r0,r0,ofs@higher - sldi r0,r0,32 - oris r0,r0,ofs@h - ori r0,r0,ofs@l - } - list.concat(taicpu.op_reg_const(A_LIS, NR_R0, word(href.offset shr 48))); - list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset shr 32))); - list.concat(taicpu.op_reg_reg_const(A_SLDI, NR_R0, NR_R0, 32)); - list.concat(taicpu.op_reg_reg_const(A_ORIS, NR_R0, NR_R0, word(href.offset shr 16))); - list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset))); - - list.concat(taicpu.op_reg_reg_reg(A_STDUX, NR_R1, NR_R1, NR_R0)); - end; - end; - { CR register not used by FPC atm } - - { keep R1 allocated??? } - a_reg_dealloc(list, NR_R0); -end; - -procedure tcgppc.g_proc_exit(list: taasmoutput; parasize: longint; nostackframe: - boolean); -{ This procedure may be called before, as well as after g_stackframe_entry } -{ is called. NOTE registers are not to be allocated through the register } -{ allocator here, because the register colouring has already occured !! } -var - regcount, firstregfpu, firstreggpr: TSuperRegister; - href: treference; - needslinkreg : boolean; - localsize, - fprcount, gprcount: aint; -begin - calcFirstUsedFPR(firstregfpu, fprcount); - calcFirstUsedGPR(firstreggpr, gprcount); - - { determine whether we need to restore the link register } - needslinkreg := ((not (po_assembler in current_procinfo.procdef.procoptions)) and - (pi_do_call in current_procinfo.flags)); - { calculate stack frame } - localsize := tppcprocinfo(current_procinfo).calc_stackframe_size( - gprcount, fprcount); - - { CR register not supported } - - { restore stack pointer } - if (not nostackframe) and (localsize > 0) then begin - if (localsize <= high(smallint)) then begin - list.concat(taicpu.op_reg_reg_const(A_ADDI, NR_STACK_POINTER_REG, NR_STACK_POINTER_REG, localsize)); - end else begin - reference_reset_base(href, NR_NO, localsize); - - { use R0 for loading the constant (which is definitely > 32k when entering - this branch) - Inlined because it must not use temp registers because register allocations - have already been done :( } - { Code template: - lis r0,ofs@highest - ori r0,ofs@higher - sldi r0,r0,32 - oris r0,r0,ofs@h - ori r0,r0,ofs@l - } - list.concat(taicpu.op_reg_const(A_LIS, NR_R0, word(href.offset shr 48))); - list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset shr 32))); - list.concat(taicpu.op_reg_reg_const(A_SLDI, NR_R0, NR_R0, 32)); - list.concat(taicpu.op_reg_reg_const(A_ORIS, NR_R0, NR_R0, word(href.offset shr 16))); - list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset))); - - list.concat(taicpu.op_reg_reg_reg(A_ADD, NR_R1, NR_R1, NR_R0)); - end; - end; - - { load registers, FPR first, then GPR } - {$note ts:todo change order of loading} - reference_reset_base(href, NR_STACK_POINTER_REG, -tcgsize2size[OS_FLOAT]); - if (fprcount > 0) then begin - for regcount := RS_F31 downto firstregfpu do begin - a_loadfpu_ref_reg(list, OS_FLOAT, href, newreg(R_FPUREGISTER, regcount, - R_SUBNONE)); - dec(href.offset, tcgsize2size[OS_FLOAT]); - end; - end; - if (gprcount > 0) then begin - for regcount := RS_R31 downto firstreggpr do begin - a_load_ref_reg(list, OS_INT, OS_INT, href, newreg(R_INTREGISTER, regcount, - R_SUBNONE)); - dec(href.offset, tcgsize2size[OS_INT]); - end; - end; - - { VMX not supported... } - - { restore LR (if needed) } - if (needslinkreg) then begin - reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_ELF); - list.concat(taicpu.op_reg_ref(A_LD, NR_R0, href)); - list.concat(taicpu.op_reg(A_MTLR, NR_R0)); - end; - - { generate return instruction } - list.concat(taicpu.op_none(A_BLR)); -end; - - -procedure tcgppc.a_loadaddr_ref_reg(list: taasmoutput; const ref: treference; r: - tregister); - -var - ref2, tmpref: treference; - { register used to construct address } - tempreg : TRegister; - -begin - ref2 := ref; - fixref(list, ref2, OS_64); - { load a symbol } - if assigned(ref2.symbol) or (hasLargeOffset(ref2)) then begin - { add the symbol's value to the base of the reference, and if the } - { reference doesn't have a base, create one } - reference_reset(tmpref); - tmpref.offset := ref2.offset; - tmpref.symbol := ref2.symbol; - tmpref.relsymbol := ref2.relsymbol; - { load 64 bit reference into r. If the reference already has a base register, - first load the 64 bit value into a temp register, then add it to the result - register rD } - if (ref2.base <> NR_NO) then begin - { already have a base register, so allocate a new one } - tempreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE); - end else begin - tempreg := r; - end; - - { code for loading a reference from a symbol into a register rD } - (* - lis rX,SYM@highest - ori rX,SYM@higher - sldi rX,rX,32 - oris rX,rX,SYM@h - ori rX,rX,SYM@l - *) - tmpref.refaddr := addr_highest; - list.concat(taicpu.op_reg_ref(A_LIS, tempreg, tmpref)); - tmpref.refaddr := addr_higher; - list.concat(taicpu.op_reg_reg_ref(A_ORI, tempreg, tempreg, tmpref)); - list.concat(taicpu.op_reg_reg_const(A_SLDI, tempreg, tempreg, 32)); - tmpref.refaddr := addr_high; - list.concat(taicpu.op_reg_reg_ref(A_ORIS, tempreg, tempreg, tmpref)); - tmpref.refaddr := addr_low; - list.concat(taicpu.op_reg_reg_ref(A_ORI, tempreg, tempreg, tmpref)); - - { if there's already a base register, add the temp register contents to - the base register } - if (ref2.base <> NR_NO) then begin - list.concat(taicpu.op_reg_reg_reg(A_ADD, r, tempreg, ref2.base)); - end; - end else if ref2.offset <> 0 then begin - { no symbol, but offset <> 0 } - if ref2.base <> NR_NO then begin - a_op_const_reg_reg(list, OP_ADD, OS_64, ref2.offset, ref2.base, r) - { FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never - occurs, so now only ref.offset has to be loaded } - end else begin - a_load_const_reg(list, OS_64, ref2.offset, r) - end; - end else if ref.index <> NR_NO then - list.concat(taicpu.op_reg_reg_reg(A_ADD, r, ref2.base, ref2.index)) - else if (ref2.base <> NR_NO) and - (r <> ref2.base) then - a_load_reg_reg(list, OS_ADDR, OS_ADDR, ref2.base, r) - else begin - list.concat(taicpu.op_reg_const(A_LI, r, 0)); - end; -end; - -{ ************* concatcopy ************ } - -const - maxmoveunit = 8; - - -procedure tcgppc.g_concatcopy(list: taasmoutput; const source, dest: treference; - len: aint); - -var - countreg, tempreg: TRegister; - src, dst: TReference; - lab: tasmlabel; - count, count2: longint; - size: tcgsize; - -begin -{$IFDEF extdebug} - if len > high(aint) then - internalerror(2002072704); -{$ENDIF extdebug} - { make sure short loads are handled as optimally as possible } - - if (len <= maxmoveunit) and - (byte(len) in [1, 2, 4, 8]) then - begin - if len < 8 then - begin - size := int_cgsize(len); - a_load_ref_ref(list, size, size, source, dest); - end - else - begin - a_reg_alloc(list, NR_F0); - a_loadfpu_ref_reg(list, OS_F64, source, NR_F0); - a_loadfpu_reg_ref(list, OS_F64, NR_F0, dest); - a_reg_dealloc(list, NR_F0); - end; - exit; - end; - - count := len div maxmoveunit; - - reference_reset(src); - reference_reset(dst); - { load the address of source into src.base } - if (count > 4) or - not issimpleref(source) or - ((source.index <> NR_NO) and - ((source.offset + len) > high(smallint))) then begin - src.base := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE); - a_loadaddr_ref_reg(list, source, src.base); - end else begin - src := source; - end; - { load the address of dest into dst.base } - if (count > 4) or - not issimpleref(dest) or - ((dest.index <> NR_NO) and - ((dest.offset + len) > high(smallint))) then begin - dst.base := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE); - a_loadaddr_ref_reg(list, dest, dst.base); - end else begin - dst := dest; - end; - - { generate a loop } - if count > 4 then begin - { the offsets are zero after the a_loadaddress_ref_reg and just - have to be set to 8. I put an Inc there so debugging may be - easier (should offset be different from zero here, it will be - easy to notice in the generated assembler } - inc(dst.offset, 8); - inc(src.offset, 8); - list.concat(taicpu.op_reg_reg_const(A_SUBI, src.base, src.base, 8)); - list.concat(taicpu.op_reg_reg_const(A_SUBI, dst.base, dst.base, 8)); - countreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE); - a_load_const_reg(list, OS_32, count, countreg); - { explicitely allocate F0 since it can be used safely here - (for holding date that's being copied) } - a_reg_alloc(list, NR_F0); - objectlibrary.getjumplabel(lab); - a_label(list, lab); - list.concat(taicpu.op_reg_reg_const(A_SUBIC_, countreg, countreg, 1)); - list.concat(taicpu.op_reg_ref(A_LFDU, NR_F0, src)); - list.concat(taicpu.op_reg_ref(A_STFDU, NR_F0, dst)); - a_jmp(list, A_BC, C_NE, 0, lab); - a_reg_dealloc(list, NR_F0); - len := len mod 8; - end; - - count := len div 8; - { unrolled loop } - if count > 0 then begin - a_reg_alloc(list, NR_F0); - for count2 := 1 to count do begin - a_loadfpu_ref_reg(list, OS_F64, src, NR_F0); - a_loadfpu_reg_ref(list, OS_F64, NR_F0, dst); - inc(src.offset, 8); - inc(dst.offset, 8); - end; - a_reg_dealloc(list, NR_F0); - len := len mod 8; - end; - - if (len and 4) <> 0 then begin - a_reg_alloc(list, NR_R0); - a_load_ref_reg(list, OS_32, OS_32, src, NR_R0); - a_load_reg_ref(list, OS_32, OS_32, NR_R0, dst); - inc(src.offset, 4); - inc(dst.offset, 4); - a_reg_dealloc(list, NR_R0); - end; - { copy the leftovers } - if (len and 2) <> 0 then begin - a_reg_alloc(list, NR_R0); - a_load_ref_reg(list, OS_16, OS_16, src, NR_R0); - a_load_reg_ref(list, OS_16, OS_16, NR_R0, dst); - inc(src.offset, 2); - inc(dst.offset, 2); - a_reg_dealloc(list, NR_R0); - end; - if (len and 1) <> 0 then begin - a_reg_alloc(list, NR_R0); - a_load_ref_reg(list, OS_8, OS_8, src, NR_R0); - a_load_reg_ref(list, OS_8, OS_8, NR_R0, dst); - a_reg_dealloc(list, NR_R0); - end; - -end; - -procedure tcgppc.g_overflowcheck(list: taasmoutput; const l: tlocation; def: - tdef); -var - hl: tasmlabel; - flags : TResFlags; -begin - if not (cs_check_overflow in aktlocalswitches) then - exit; - objectlibrary.getjumplabel(hl); - if not ((def.deftype = pointerdef) or - ((def.deftype = orddef) and - (torddef(def).typ in [u64bit, u16bit, u32bit, u8bit, uchar, - bool8bit, bool16bit, bool32bit]))) then - begin - { ... instructions setting overflow flag ... - mfxerf R0 - mtcrf 128, R0 - ble cr0, label } - list.concat(taicpu.op_reg(A_MFXER, NR_R0)); - list.concat(taicpu.op_const_reg(A_MTCRF, 128, NR_R0)); - flags.cr := RS_CR0; - flags.flag := F_LE; - a_jmp_flags(list, flags, hl); - end else - a_jmp_cond(list, OC_AE, hl); - a_call_name(list, 'FPC_OVERFLOW'); - a_label(list, hl); -end; - -procedure tcgppc.g_intf_wrapper(list: TAAsmoutput; procdef: tprocdef; const - labelname: string; ioffset: longint); - - procedure loadvmttor11; - var - href: treference; - begin - reference_reset_base(href, NR_R3, 0); - cg.a_load_ref_reg(list, OS_ADDR, OS_ADDR, href, NR_R11); - end; - - procedure op_onr11methodaddr; - var - href: treference; - begin - if (procdef.extnumber = $FFFF) then - Internalerror(200006139); - { call/jmp vmtoffs(%eax) ; method offs } - reference_reset_base(href, NR_R11, - procdef._class.vmtmethodoffset(procdef.extnumber)); - if not (hasLargeOffset(href)) then begin - list.concat(taicpu.op_reg_reg_const(A_ADDIS, NR_R11, NR_R11, - smallint((href.offset shr 16) + ord(smallint(href.offset and $FFFF) < - 0)))); - href.offset := smallint(href.offset and $FFFF); - end else - { add support for offsets > 16 bit } - internalerror(200510201); - list.concat(taicpu.op_reg_ref(A_LD, NR_R11, href)); - { the loaded reference is a function descriptor reference, so deref again - (at ofs 0 there's the real pointer) } - {$warning ts:TODO: update GOT reference} - reference_reset_base(href, NR_R11, 0); - list.concat(taicpu.op_reg_ref(A_LD, NR_R11, href)); - - list.concat(taicpu.op_reg(A_MTCTR, NR_R11)); - list.concat(taicpu.op_none(A_BCTR)); - { NOP needed for the linker...? } - list.concat(taicpu.op_none(A_NOP)); - end; - -var - make_global: boolean; -begin - if (not (procdef.proctypeoption in [potype_function, potype_procedure])) then - Internalerror(200006137); - if not assigned(procdef._class) or - (procdef.procoptions * [po_classmethod, po_staticmethod, - po_methodpointer, po_interrupt, po_iocheck] <> []) then - Internalerror(200006138); - if procdef.owner.symtabletype <> objectsymtable then - Internalerror(200109191); - - make_global := false; - if (not current_module.is_unit) or - (cs_create_smart in aktmoduleswitches) or - (procdef.owner.defowner.owner.symtabletype = globalsymtable) then - make_global := true; - - if make_global then - List.concat(Tai_symbol.Createname_global(labelname, AT_FUNCTION, 0)) - else - List.concat(Tai_symbol.Createname(labelname, AT_FUNCTION, 0)); - - { set param1 interface to self } - g_adjust_self_value(list, procdef, ioffset); - - if po_virtualmethod in procdef.procoptions then begin - loadvmttor11; - op_onr11methodaddr; - end else - {$note ts:todo add GOT change?? - think not needed :) } - list.concat(taicpu.op_sym(A_B, - objectlibrary.newasmsymbol('.' + procdef.mangledname, AB_EXTERNAL, - AT_FUNCTION))); - - List.concat(Tai_symbol_end.Createname(labelname)); -end; - -{***************** This is private property, keep out! :) *****************} - -function tcgppc.issimpleref(const ref: treference): boolean; - -begin - if (ref.base = NR_NO) and - (ref.index <> NR_NO) then - internalerror(200208101); - result := - not (assigned(ref.symbol)) and - (((ref.index = NR_NO) and - (ref.offset >= low(smallint)) and - (ref.offset <= high(smallint))) or - ((ref.index <> NR_NO) and - (ref.offset = 0))); -end; - -function tcgppc.fixref(list: taasmoutput; var ref: treference; const size : TCgsize): boolean; -var - tmpreg: tregister; - needsAlign : boolean; -begin - result := false; - needsAlign := size in [OS_S32, OS_64, OS_S64]; - - if (ref.base = NR_NO) then begin - ref.base := ref.index; - ref.index := NR_NO; - end; - if (ref.base <> NR_NO) and (ref.index <> NR_NO) and - ((ref.offset <> 0) or assigned(ref.symbol)) then begin - result := true; - tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE); - a_op_reg_reg_reg(list, OP_ADD, size, ref.base, ref.index, tmpreg); - ref.index := NR_NO; - ref.base := tmpreg; - end; -end; - -procedure tcgppc.a_load_store(list: taasmoutput; op: tasmop; reg: tregister; - ref: treference); -var - tmpreg, tmpreg2: tregister; - tmpref: treference; - largeOffset: Boolean; -begin - { at this point there must not be a combination of values in the ref treference - which is not possible to directly map to instructions of the PowerPC architecture } - if (ref.index <> NR_NO) and ((ref.offset <> 0) or (assigned(ref.symbol))) then - internalerror(200310131); - - { for some instructions we need to check that the offset is divisible by at - least four. If not, add the bytes which are "off" to the base register and - adjust the offset accordingly } - case op of - A_LD, A_LDU, A_STD, A_STDU, A_LWA : - if ((ref.offset mod 4) <> 0) then begin - tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE); - - if (ref.base <> NR_NO) then begin - a_op_const_reg_reg(list, OP_ADD, OS_ADDR, ref.offset mod 4, ref.base, tmpreg); - ref.base := tmpreg; - end else begin - list.concat(taicpu.op_reg_const(A_LI, tmpreg, ref.offset mod 4)); - ref.base := tmpreg; - end; - ref.offset := (ref.offset div 4) * 4; - end; - end; - - { if we have to load/store from a symbol or large addresses, use a temporary register - containing the address } - if assigned(ref.symbol) or (hasLargeOffset(ref)) then begin - tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE); - - if (hasLargeOffset(ref) and (ref.base = NR_NO)) then begin - ref.base := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE); - a_load_const_reg(list, OS_ADDR, ref.offset, ref.base); - ref.offset := 0; - end; - - reference_reset(tmpref); - tmpref.symbol := ref.symbol; - tmpref.relsymbol := ref.relsymbol; - tmpref.offset := ref.offset; - if (ref.base <> NR_NO) then begin - { As long as the TOC isn't working we try to achieve highest speed (in this - case by allowing instructions execute in parallel) as possible at the cost - of using another temporary register. So the code template when there is - a base register and an offset is the following: - - lis rT1, SYM+offs@highest - ori rT1, rT1, SYM+offs@higher - lis rT2, SYM+offs@hi - ori rT2, SYM+offs@lo - rldimi rT2, rT1, 32 - - <op>X reg, base, rT2 - } - - tmpreg2 := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE); - tmpref.refaddr := addr_highest; - list.concat(taicpu.op_reg_ref(A_LIS, tmpreg, tmpref)); - tmpref.refaddr := addr_higher; - list.concat(taicpu.op_reg_reg_ref(A_ORI, tmpreg, tmpreg, tmpref)); - - tmpref.refaddr := addr_high; - list.concat(taicpu.op_reg_ref(A_LIS, tmpreg2, tmpref)); - tmpref.refaddr := addr_low; - list.concat(taicpu.op_reg_reg_ref(A_ORI, tmpreg2, tmpreg2, tmpref)); - - list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, tmpreg2, tmpreg, 32, 0)); - - reference_reset(tmpref); - tmpref.base := ref.base; - tmpref.index := tmpreg2; - case op of - { the code generator doesn't generate update instructions anyway, so - error out on those instructions } - A_LBZ : op := A_LBZX; - A_LHZ : op := A_LHZX; - A_LWZ : op := A_LWZX; - A_LD : op := A_LDX; - A_LHA : op := A_LHAX; - A_LWA : op := A_LWAX; - A_LFS : op := A_LFSX; - A_LFD : op := A_LFDX; - - A_STB : op := A_STBX; - A_STH : op := A_STHX; - A_STW : op := A_STWX; - A_STD : op := A_STDX; - - A_STFS : op := A_STFSX; - A_STFD : op := A_STFDX; - else - { unknown load/store opcode } - internalerror(2005101302); - end; - list.concat(taicpu.op_reg_ref(op, reg, tmpref)); - end else begin - { when accessing value from a reference without a base register, use the - following code template: - - lis rT,SYM+offs@highesta - ori rT,SYM+offs@highera - sldi rT,rT,32 - oris rT,rT,SYM+offs@ha - ld rD,SYM+offs@l(rT) - } - tmpref.refaddr := addr_highesta; - list.concat(taicpu.op_reg_ref(A_LIS, tmpreg, tmpref)); - tmpref.refaddr := addr_highera; - list.concat(taicpu.op_reg_reg_ref(A_ORI, tmpreg, tmpreg, tmpref)); - list.concat(taicpu.op_reg_reg_const(A_SLDI, tmpreg, tmpreg, 32)); - tmpref.refaddr := addr_higha; - list.concat(taicpu.op_reg_reg_ref(A_ORIS, tmpreg, tmpreg, tmpref)); - - tmpref.base := tmpreg; - tmpref.refaddr := addr_low; - list.concat(taicpu.op_reg_ref(op, reg, tmpref)); - end; - end else begin - list.concat(taicpu.op_reg_ref(op, reg, ref)); - end; -end; - -procedure tcgppc.a_jmp(list: taasmoutput; op: tasmop; c: tasmcondflag; - crval: longint; l: tasmlabel); -var - p: taicpu; - -begin - p := taicpu.op_sym(op, objectlibrary.newasmsymbol(l.name, AB_EXTERNAL, - AT_LABEL)); - if op <> A_B then - create_cond_norm(c, crval, p.condition); - p.is_jmp := true; - list.concat(p) -end; - -function tcgppc.hasLargeOffset(const ref : TReference) : Boolean; -begin - { this rather strange calculation is required because offsets of TReferences are unsigned } - result := aword(ref.offset-low(smallint)) > high(smallint)-low(smallint); -end; - -begin - cg := tcgppc.create; -end. diff --git a/compiler/powerpc64/cpubase.pas b/compiler/powerpc64/cpubase.pas deleted file mode 100644 index 0fe3932355..0000000000 --- a/compiler/powerpc64/cpubase.pas +++ /dev/null @@ -1,544 +0,0 @@ -{ - Copyright (c) 1998-2002 by Florian Klaempfl - - Contains the base types for the PowerPC - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -{ This Unit contains the base types for the PowerPC64 -} -unit cpubase; - -{$I fpcdefs.inc} - -interface - -uses - strings, globtype, - cutils, cclasses, aasmbase, cpuinfo, cgbase; - -{***************************************************************************** - Assembler Opcodes -*****************************************************************************} - -type - TAsmOp = (A_None, - { normal opcodes } - a_add, a_add_, a_addo, a_addo_, a_addc, a_addc_, a_addco, a_addco_, - a_adde, a_adde_, a_addeo, a_addeo_, a_addi, a_addic, a_addic_, a_addis, - a_addme, a_addme_, a_addmeo, a_addmeo_, a_addze, a_addze_, a_addzeo, - a_addzeo_, a_and, a_and_, a_andc, a_andc_, a_andi_, a_andis_, a_b, - a_ba, a_bl, a_bla, a_bc, a_bca, a_bcl, a_bcla, a_bcctr, a_bcctrl, a_bclr, - a_bclrl, a_cmp, a_cmpi, a_cmpl, a_cmpli, a_cntlzw, a_cntlzw_, a_crand, - a_crandc, a_creqv, a_crnand, a_crnor, a_cror, a_crorc, a_crxor, a_dcba, - a_dcbf, a_dcbi, a_dcbst, a_dcbt, a_dcbtst, a_dcbz, a_divw, a_divw_, a_divwo, - a_divwo_, - a_divwu, a_divwu_, a_divwuo, a_divwuo_, a_eciwx, a_ecowx, a_eieio, a_eqv, - a_eqv_, a_extsb, a_extsb_, a_extsh, a_extsh_, a_fabs, a_fabs_, a_fadd, - a_fadd_, a_fadds, a_fadds_, a_fcmpo, a_fcmpu, a_fctiw, a_fctw_, a_fctwz, - a_fctwz_, a_fdiv, a_fdiv_, a_fdivs, a_fdivs_, a_fmadd, a_fmadd_, a_fmadds, - a_fmadds_, a_fmr, a_fmsub, a_fmsub_, a_fmsubs, a_fmsubs_, a_fmul, a_fmul_, - a_fmuls, a_fmuls_, a_fnabs, a_fnabs_, a_fneg, a_fneg_, a_fnmadd, - a_fnmadd_, a_fnmadds, a_fnmadds_, a_fnmsub, a_fnmsub_, a_fnmsubs, - a_fnmsubs_, a_fres, a_fres_, a_frsp, a_frsp_, a_frsqrte, a_frsqrte_, - a_fsel, a_fsel_, a_fsqrt, a_fsqrt_, a_fsqrts, a_fsqrts_, a_fsub, a_fsub_, - a_fsubs, a_fsubs_, a_icbi, a_isync, a_lbz, a_lbzu, a_lbzux, a_lbzx, - a_lfd, a_lfdu, a_lfdux, a_lfdx, a_lfs, a_lfsu, a_lfsux, a_lfsx, a_lha, - a_lhau, a_lhaux, a_lhax, a_hbrx, a_lhz, a_lhzu, a_lhzux, a_lhzx, a_lmw, - a_lswi, a_lswx, a_lwarx, a_lwbrx, a_lwz, a_lwzu, a_lwzux, a_lwzx, a_mcrf, - a_mcrfs, a_mcrxr, a_mfcr, a_mffs, a_mffs_, a_mfmsr, a_mfspr, a_mfsr, - a_mfsrin, a_mftb, a_mtcrf, a_mtfsb0, a_mtfsb1, a_mtfsf, a_mtfsf_, - a_mtfsfi, a_mtfsfi_, a_mtmsr, a_mtspr, a_mtsr, a_mtsrin, a_mulhw, - a_mulhw_, a_mulhwu, a_mulhwu_, a_mulli, a_mullw, a_mullw_, a_mullwo, - a_mullwo_, a_nand, a_nand_, a_neg, a_neg_, a_nego, a_nego_, a_nor, a_nor_, - a_or, a_or_, a_orc, a_orc_, a_ori, a_oris, a_rfi, a_rlwimi, a_rlwimi_, - a_rlwinm, a_rlwinm_, a_rlwnm, a_sc, a_slw, a_slw_, a_sraw, a_sraw_, - a_srawi, a_srawi_, a_srw, a_srw_, a_stb, a_stbu, a_stbux, a_stbx, a_stfd, - a_stfdu, a_stfdux, a_stfdx, a_stfiwx, a_stfs, a_stfsu, a_stfsux, a_stfsx, - a_sth, a_sthbrx, a_sthu, a_sthux, a_sthx, a_stmw, a_stswi, a_stswx, a_stw, - a_stwbrx, a_stwcx_, a_stwu, a_stwux, a_stwx, a_subf, a_subf_, a_subfo, - a_subfo_, a_subfc, a_subfc_, a_subfco, a_subfco_, a_subfe, a_subfe_, - a_subfeo, a_subfeo_, a_subfic, a_subfme, a_subfme_, a_subfmeo, a_subfmeo_, - a_subfze, a_subfze_, a_subfzeo, a_subfzeo_, a_sync, a_tlbia, a_tlbie, - a_tlbsync, a_tw, a_twi, a_xor, a_xor_, a_xori, a_xoris, - { simplified mnemonics } - a_subi, a_subis, a_subic, a_subic_, a_sub, a_sub_, a_subo, a_subo_, - a_subc, a_subc_, a_subco, a_subco_, a_cmpwi, a_cmpw, a_cmplwi, a_cmplw, - a_extlwi, a_extlwi_, a_extrwi, a_extrwi_, a_inslwi, a_inslwi_, a_insrwi, - a_insrwi_, a_rotlwi, a_rotlwi_, a_rotlw, a_rotlw_, a_slwi, a_slwi_, - a_srwi, a_srwi_, a_clrlwi, a_clrlwi_, a_clrrwi, a_clrrwi_, a_clrslwi, - a_clrslwi_, a_blr, a_bctr, a_blrl, a_bctrl, a_crset, a_crclr, a_crmove, - a_crnot, a_mt {move to special prupose reg}, a_mf - {move from special purpose reg}, - a_nop, a_li, a_lis, a_la, a_mr, a_mr_, a_not, a_mtcr, a_mtlr, a_mflr, - a_mtctr, a_mfctr, - A_EXTSW, - A_RLDIMI, - A_STD, A_STDU, A_STDX, A_STDUX, - A_LD, A_LDU, A_LDX, A_LDUX, - A_CMPD, A_CMPDI, A_CMPLD, A_CMPLDI, - A_SRDI, A_SRADI, - A_SLDI, - A_RLDICL, - A_DIVDU, A_DIVDU_, A_DIVD, A_DIVD_, A_MULLD, A_MULLD_, A_MULHD, A_MULHD_, A_SRAD, A_SLD, A_SRD, - A_DIVDUO_, A_DIVDO_, - A_LWA, A_LWAX, A_LWAUX, - A_FCFID, - A_LDARX, A_STDCX_, A_CNTLZD, - A_LVX, A_STVX, - A_MULLDO, A_MULLDO_, A_MULHDU, A_MULHDU_, - A_MFXER, - A_FCTID, A_FCTID_, A_FCTIDZ, A_FCTIDZ_); - - {# This should define the array of instructions as string } - op2strtable = array[tasmop] of string[8]; - -const - {# First value of opcode enumeration } - firstop = low(tasmop); - {# Last value of opcode enumeration } - lastop = high(tasmop); - - {***************************************************************************** - Registers - *****************************************************************************} - -type - { Number of registers used for indexing in tables } - tregisterindex = 0..{$I rppcnor.inc} - 1; - totherregisterset = set of tregisterindex; - -const - maxvarregs = 32 - 6; - { 32 int registers - r0 - stackpointer - r2 - 3 scratch registers } - maxfpuvarregs = 28; { 32 fpuregisters - some scratch registers (minimally 2) } - { Available Superregisters } -{$I rppcsup.inc} - - { No Subregisters } - R_SUBWHOLE = R_SUBNONE; - - { Available Registers } -{$I rppccon.inc} - - { Integer Super registers first and last } - first_int_imreg = $20; - - { Float Super register first and last } - first_fpu_imreg = $20; - - { MM Super register first and last } - first_mm_imreg = $20; - -{$WARNING TODO Calculate bsstart} - regnumber_count_bsstart = 64; - - regnumber_table: array[tregisterindex] of tregister = ( -{$I rppcnum.inc} - ); - - regstabs_table: array[tregisterindex] of shortint = ( -{$I rppcstab.inc} - ); - - regdwarf_table: array[tregisterindex] of shortint = ( -{$I rppcdwrf.inc} - ); - - {***************************************************************************** - Conditions - *****************************************************************************} - -type - TAsmCondFlag = (C_None { unconditional jumps }, - { conditions when not using ctr decrement etc } - C_LT, C_LE, C_EQ, C_GE, C_GT, C_NL, C_NE, C_NG, C_SO, C_NS, C_UN, C_NU, - { conditions when using ctr decrement etc } - C_T, C_F, C_DNZ, C_DNZT, C_DNZF, C_DZ, C_DZT, C_DZF); - - TDirHint = (DH_None, DH_Minus, DH_Plus); - -const - { these are in the XER, but when moved to CR_x they correspond with the } - { bits below } - C_OV = C_GT; - C_CA = C_EQ; - C_NO = C_NG; - C_NC = C_NE; - -type - TAsmCond = packed record - dirhint: tdirhint; - case simple: boolean of - false: (BO, BI: byte); - true: ( - cond: TAsmCondFlag; - case byte of - 0: (); - { specifies in which part of the cr the bit has to be } - { tested for blt,bgt,beq,..,bnu } - 1: (cr: RS_CR0..RS_CR7); - { specifies the bit to test for bt,bf,bdz,..,bdzf } - 2: (crbit: byte) - ); - end; - -const - AsmCondFlag2BO: array[C_T..C_DZF] of Byte = - (12, 4, 16, 8, 0, 18, 10, 2); - - AsmCondFlag2BOLT_NU: array[C_LT..C_NU] of Byte = - (12, 4, 12, 4, 12, 4, 4, 4, 12, 4, 12, 4); - - AsmCondFlag2BI: array[C_LT..C_NU] of Byte = - (0, 1, 2, 0, 1, 0, 2, 1, 3, 3, 3, 3); - - AsmCondFlagTF: array[TAsmCondFlag] of Boolean = - (false, true, false, true, false, true, false, false, false, true, false, - true, false, - true, false, false, true, false, false, true, false); - - AsmCondFlag2Str: array[TAsmCondFlag] of string[4] = ({cf_none}'', - { conditions when not using ctr decrement etc} - 'lt', 'le', 'eq', 'ge', 'gt', 'nl', 'ne', 'ng', 'so', 'ns', 'un', 'nu', - 't', 'f', 'dnz', 'dnzt', 'dnzf', 'dz', 'dzt', 'dzf'); - - UpperAsmCondFlag2Str: array[TAsmCondFlag] of string[4] = ({cf_none}'', - { conditions when not using ctr decrement etc} - 'LT', 'LE', 'EQ', 'GE', 'GT', 'NL', 'NE', 'NG', 'SO', 'NS', 'UN', 'NU', - 'T', 'F', 'DNZ', 'DNZT', 'DNZF', 'DZ', 'DZT', 'DZF'); - -const - CondAsmOps = 3; - CondAsmOp: array[0..CondAsmOps - 1] of TasmOp = ( - A_BC, A_TW, A_TWI - ); - - {***************************************************************************** - Flags - *****************************************************************************} - -type - TResFlagsEnum = (F_EQ, F_NE, F_LT, F_LE, F_GT, F_GE, F_SO, F_FX, F_FEX, F_VX, - F_OX); - TResFlags = record - cr: RS_CR0..RS_CR7; - flag: TResFlagsEnum; - end; - -{***************************************************************************** - Reference -*****************************************************************************} - -const - symaddr2str: array[trefaddr] of string[9] = ('', '', '', '@l', '@h', '@higher', '@highest', '@ha', '@highera', '@highesta'); - -const - { MacOS only. Whether the direct data area (TOC) directly contain - global variables. Otherwise it contains pointers to global variables. } - macos_direct_globals = false; - - {***************************************************************************** - Operand Sizes - *****************************************************************************} - - {***************************************************************************** - Constants - *****************************************************************************} - -const - max_operands = 5; - - {***************************************************************************** - Default generic sizes - *****************************************************************************} - - {# Defines the default address size for a processor, } - OS_ADDR = OS_64; - {# the natural int size for a processor, } - OS_INT = OS_64; - {# the maximum float size for a processor, } - OS_FLOAT = OS_F64; - {# the size of a vector register for a processor } - OS_VECTOR = OS_M128; - - {***************************************************************************** - GDB Information - *****************************************************************************} - - {# Register indexes for stabs information, when some - parameters or variables are stored in registers. - - Taken from rs6000.h (DBX_REGISTER_NUMBER) - from GCC 3.x source code. PowerPC has 1:1 mapping - according to the order of the registers defined - in GCC - - } - - stab_regindex: array[tregisterindex] of shortint = ( -{$I rppcstab.inc} - ); - - {***************************************************************************** - Generic Register names - *****************************************************************************} - - // Stack pointer register - NR_STACK_POINTER_REG = NR_R1; - RS_STACK_POINTER_REG = RS_R1; - // old stack pointer register used during copying variables from the caller - // stack frame - NR_OLD_STACK_POINTER_REG = NR_R12; - // Frame pointer register - NR_FRAME_POINTER_REG = NR_STACK_POINTER_REG; - RS_FRAME_POINTER_REG = RS_STACK_POINTER_REG; - {# Register for addressing absolute data in a position independant way, - such as in PIC code. The exact meaning is ABI specific. For - further information look at GCC source : PIC_OFFSET_TABLE_REGNUM - - Taken from GCC rs6000.h - } -{$WARNING As indicated in rs6000.h, but can't find it anywhere else!} - NR_PIC_OFFSET_REG = NR_R30; - { Return address of a function } - NR_RETURN_ADDRESS_REG = NR_R0; - { Results are returned in this register (64-bit values) } - NR_FUNCTION_RETURN_REG = NR_R3; - RS_FUNCTION_RETURN_REG = RS_R3; - { The value returned from a function is available in this register } - NR_FUNCTION_RESULT_REG = NR_FUNCTION_RETURN_REG; - RS_FUNCTION_RESULT_REG = RS_FUNCTION_RETURN_REG; - - NR_FPU_RESULT_REG = NR_F1; - NR_MM_RESULT_REG = NR_M0; - - {***************************************************************************** - GCC /ABI linking information - *****************************************************************************} - - {# Registers which must be saved when calling a routine declared as - cppdecl, cdecl, stdcall, safecall, palmossyscall. The registers - saved should be the ones as defined in the target ABI and / or GCC. - - This value can be deduced from CALLED_USED_REGISTERS array in the - GCC source. - } - saved_standard_registers: array[0..17] of tsuperregister = ( - RS_R14, RS_R15, RS_R16, RS_R17, RS_R18, RS_R19, - RS_R20, RS_R21, RS_R22, RS_R23, RS_R24, RS_R25, - RS_R26, RS_R27, RS_R28, RS_R29, RS_R30, RS_R31 - ); - - {# Required parameter alignment when calling a routine declared as - stdcall and cdecl. The alignment value should be the one defined - by GCC or the target ABI. - } - std_param_align = 16; - - {***************************************************************************** - CPU Dependent Constants - *****************************************************************************} - - LinkageAreaSizeELF = 48; - { offset in the linkage area for the saved stack pointer } - LA_SP = 0; - { offset in the linkage area for the saved conditional register} - LA_CR_ELF = 8; - { offset in the linkage area for the saved link register} - LA_LR_ELF = 16; - { offset in the linkage area for the saved RTOC register} - LA_RTOC_ELF = 40; - - PARENT_FRAMEPOINTER_OFFSET = 24; - - NR_RTOC = NR_R2; - - ELF_STACK_ALIGN = 16; - - {***************************************************************************** - Helpers - *****************************************************************************} - -function is_calljmp(o: tasmop): boolean; - -procedure inverse_flags(var r: TResFlags); -function flags_to_cond(const f: TResFlags): TAsmCond; -procedure create_cond_imm(BO, BI: byte; var r: TAsmCond); -procedure create_cond_norm(cond: TAsmCondFlag; cr: byte; var r: TasmCond); - -function cgsize2subreg(s: Tcgsize): Tsubregister; -{ Returns the tcgsize corresponding with the size of reg.} -function reg_cgsize(const reg: tregister): tcgsize; - -function findreg_by_number(r: Tregister): tregisterindex; -function std_regnum_search(const s: string): Tregister; -function std_regname(r: Tregister): string; -function is_condreg(r: tregister): boolean; - -function inverse_cond(const c: TAsmCond): Tasmcond; -{$IFDEF USEINLINE}inline;{$ENDIF USEINLINE} -function conditions_equal(const c1, c2: TAsmCond): boolean; - -implementation - -uses - rgBase, verbose; - -const - std_regname_table: array[tregisterindex] of string[7] = ( -{$I rppcstd.inc} - ); - - regnumber_index: array[tregisterindex] of tregisterindex = ( -{$I rppcrni.inc} - ); - - std_regname_index: array[tregisterindex] of tregisterindex = ( -{$I rppcsri.inc} - ); - - {***************************************************************************** - Helpers - *****************************************************************************} - -function is_calljmp(o: tasmop): boolean; -begin - is_calljmp := false; - case o of - A_B, A_BA, A_BL, A_BLA, A_BC, A_BCA, A_BCL, A_BCLA, A_BCCTR, A_BCCTRL, - A_BCLR, - A_BCLRL, A_TW, A_TWI: is_calljmp := true; - end; -end; - -procedure inverse_flags(var r: TResFlags); -const - inv_flags: array[F_EQ..F_GE] of TResFlagsEnum = - (F_NE, F_EQ, F_GE, F_GE, F_LE, F_LT); -begin - r.flag := inv_flags[r.flag]; -end; - -function inverse_cond(const c: TAsmCond): Tasmcond; -{$IFDEF USEINLINE}inline; -{$ENDIF USEINLINE} -const - inv_condflags: array[TAsmCondFlag] of TAsmCondFlag = (C_None, - C_GE, C_GT, C_NE, C_LT, C_LE, C_LT, C_EQ, C_GT, C_NS, C_SO, C_NU, C_UN, - C_F, C_T, C_DNZ, C_DNZF, C_DNZT, C_DZ, C_DZF, C_DZT); -begin - if (c.cond in [C_DNZ, C_DZ]) then - internalerror(2005022501); - result := c; - result.cond := inv_condflags[c.cond]; -end; - -function conditions_equal(const c1, c2: TAsmCond): boolean; -begin - result := - (c1.simple and c2.simple) and - (c1.cond = c2.cond) and - ((not (c1.cond in [C_T..C_DZF]) and - (c1.cr = c2.cr)) or - (c1.crbit = c2.crbit)); -end; - -function flags_to_cond(const f: TResFlags): TAsmCond; -const - flag_2_cond: array[F_EQ..F_SO] of TAsmCondFlag = - (C_EQ, C_NE, C_LT, C_LE, C_GT, C_GE, C_SO); -begin - if f.flag > high(flag_2_cond) then - internalerror(200112301); - result.simple := true; - result.cr := f.cr; - result.cond := flag_2_cond[f.flag]; -end; - -procedure create_cond_imm(BO, BI: byte; var r: TAsmCond); -begin - r.simple := false; - r.bo := bo; - r.bi := bi; -end; - -procedure create_cond_norm(cond: TAsmCondFlag; cr: byte; var r: TasmCond); -begin - r.simple := true; - r.cond := cond; - case cond of - C_NONE: ; - C_T..C_DZF: r.crbit := cr - else - r.cr := RS_CR0 + cr; - end; -end; - -function is_condreg(r: tregister): boolean; -var - supreg: tsuperregister; -begin - result := false; - if (getregtype(r) = R_SPECIALREGISTER) then - begin - supreg := getsupreg(r); - result := (supreg >= RS_CR0) and (supreg <= RS_CR7); - end; -end; - -function reg_cgsize(const reg: tregister): tcgsize; -begin - case getregtype(reg) of - R_MMREGISTER, - R_FPUREGISTER, - R_INTREGISTER: - result := OS_64; - else - internalerror(200303181); - end; -end; - -function cgsize2subreg(s: Tcgsize): Tsubregister; -begin - cgsize2subreg := R_SUBWHOLE; -end; - -function findreg_by_number(r: Tregister): tregisterindex; -begin - result := rgBase.findreg_by_number_table(r, regnumber_index); -end; - -function std_regnum_search(const s: string): Tregister; -begin - result := regnumber_table[findreg_by_name_table(s, std_regname_table, - std_regname_index)]; -end; - -function std_regname(r: Tregister): string; -var - p: tregisterindex; -begin - p := findreg_by_number_table(r, regnumber_index); - if p <> 0 then - result := std_regname_table[p] - else - result := generic_regname(r); -end; - -end. - diff --git a/compiler/powerpc64/cpuinfo.pas b/compiler/powerpc64/cpuinfo.pas deleted file mode 100644 index 7a59e11314..0000000000 --- a/compiler/powerpc64/cpuinfo.pas +++ /dev/null @@ -1,67 +0,0 @@ -{ - Copyright (c) 1998-2002 by the Free Pascal development team - - Basic Processor information for the PowerPC - - 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 = extended; - ts128real = extended; - ts64comp = comp; - - pbestreal = ^bestreal; - - { possible supported processors for this target } - tprocessors = - (no_processor, - ppc970 - ); - - tfputype = - (no_fpuprocessor, - fpu_soft, - fpu_standard - ); - -const - { calling conventions supported by the code generator } - supported_calling_conventions: tproccalloptions = [ - pocall_internproc, - pocall_stdcall, - { the difference to stdcall is only the name mangling } - pocall_cdecl, - { the difference to stdcall is only the name mangling } - pocall_cppdecl - ]; - - processorsstr: array[tprocessors] of string[10] = ('', - '970' - ); - - fputypestr: array[tfputype] of string[8] = ('', - 'SOFT', - 'STANDARD' - ); - -implementation - -end. - diff --git a/compiler/powerpc64/cpunode.pas b/compiler/powerpc64/cpunode.pas deleted file mode 100644 index ffa6532916..0000000000 --- a/compiler/powerpc64/cpunode.pas +++ /dev/null @@ -1,51 +0,0 @@ -{ - Copyright (c) 2000-2002 by Florian Klaempfl - - Includes the PowerPC64 code generator - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit cpunode; - -{$I fpcdefs.inc} - -interface - -implementation - -uses - { generic nodes } - ncgbas, ncgld, ncgflw, ncgcnv, ncgmem, ncgcon, ncgcal, ncgset, ncginl, ncgopt, - { to be able to only parts of the generic code, - the processor specific nodes must be included - after the generic one (FK) - } - nppcadd, - nppccal, - // nppccon, - // nppcflw, - // nppcmem, - nppcset, - nppcinl, - // nppcopt, - nppcmat, - nppccnv, - nppcld - ; - -end. - diff --git a/compiler/powerpc64/cpupara.pas b/compiler/powerpc64/cpupara.pas deleted file mode 100644 index 38ed3d9927..0000000000 --- a/compiler/powerpc64/cpupara.pas +++ /dev/null @@ -1,470 +0,0 @@ -{ - Copyright (c) 2002 by Florian Klaempfl - - PowerPC64 specific calling conventions - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - **************************************************************************** -} -unit cpupara; - -{$I fpcdefs.inc} - -interface - -uses - globtype, - aasmtai, - cpubase, - symconst, symtype, symdef, symsym, - paramgr, parabase, cgbase; - -type - tppcparamanager = class(tparamanager) - function get_volatile_registers_int(calloption: tproccalloption): - tcpuregisterset; override; - function get_volatile_registers_fpu(calloption: tproccalloption): - tcpuregisterset; override; - function push_addr_param(varspez: tvarspez; def: tdef; calloption: - tproccalloption): boolean; override; - - procedure getintparaloc(calloption: tproccalloption; nr: longint; var - cgpara: TCGPara); override; - function create_paraloc_info(p: tabstractprocdef; side: tcallercallee): - longint; override; - function create_varargs_paraloc_info(p: tabstractprocdef; varargspara: - tvarargsparalist): longint; override; - procedure create_funcretloc_info(p: tabstractprocdef; side: tcallercallee); - - private - procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; - var cur_stack_offset: aword); - function create_paraloc_info_intern(p: tabstractprocdef; side: - tcallercallee; paras: tparalist; - var curintreg, curfloatreg, curmmreg: tsuperregister; var - cur_stack_offset: aword): longint; - function parseparaloc(p: tparavarsym; const s: string): boolean; override; - end; - -implementation - -uses - verbose, systems, - defutil, - cgutils; - -function tppcparamanager.get_volatile_registers_int(calloption: - tproccalloption): tcpuregisterset; -begin - result := [RS_R3..RS_R12]; -end; - -function tppcparamanager.get_volatile_registers_fpu(calloption: - tproccalloption): tcpuregisterset; -begin - result := [RS_F0..RS_F13]; -end; - -procedure tppcparamanager.getintparaloc(calloption: tproccalloption; nr: - longint; var cgpara: TCGPara); -var - paraloc: pcgparalocation; -begin - cgpara.reset; - cgpara.size := OS_INT; - cgpara.intsize := tcgsize2size[OS_INT]; - cgpara.alignment := get_para_align(calloption); - paraloc := cgpara.add_location; - with paraloc^ do begin - size := OS_INT; - if (nr <= 8) then begin - if nr = 0 then - internalerror(200309271); - loc := LOC_REGISTER; - register := newreg(R_INTREGISTER, RS_R2 + nr, R_SUBWHOLE); - end else begin - loc := LOC_REFERENCE; - paraloc^.reference.index := NR_STACK_POINTER_REG; - reference.offset := sizeof(aint) * (nr - 8); - end; - end; -end; - -function getparaloc(p: tdef): tcgloc; - -begin - { Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER - if push_addr_param for the def is true - } - case p.deftype of - orddef: - result := LOC_REGISTER; - floatdef: - result := LOC_FPUREGISTER; - enumdef: - result := LOC_REGISTER; - pointerdef: - result := LOC_REGISTER; - formaldef: - result := LOC_REGISTER; - classrefdef: - result := LOC_REGISTER; - recorddef: - result := LOC_REGISTER; - objectdef: - if is_object(p) then - result := LOC_REFERENCE - else - result := LOC_REGISTER; - stringdef: - if is_shortstring(p) or is_longstring(p) then - result := LOC_REFERENCE - else - result := LOC_REGISTER; - procvardef: - if (po_methodpointer in tprocvardef(p).procoptions) then - result := LOC_REFERENCE - else - result := LOC_REGISTER; - filedef: - result := LOC_REGISTER; - arraydef: - result := LOC_REFERENCE; - setdef: - if is_smallset(p) then - result := LOC_REGISTER - else - result := LOC_REFERENCE; - variantdef: - result := LOC_REFERENCE; - { avoid problems with errornous definitions } - errordef: - result := LOC_REGISTER; - else - internalerror(2002071001); - end; -end; - -function tppcparamanager.push_addr_param(varspez: tvarspez; def: tdef; - calloption: tproccalloption): boolean; -begin - result := false; - { var,out always require address } - if varspez in [vs_var, vs_out] then - begin - result := true; - exit; - end; - case def.deftype of - variantdef, - formaldef: - result := true; - recorddef: - result := - ((varspez = vs_const) and - ( - (not (calloption in [pocall_cdecl, pocall_cppdecl]) and - (def.size > 8)) - ) - ); - arraydef: - result := (tarraydef(def).highrange >= tarraydef(def).lowrange) or - is_open_array(def) or - is_array_of_const(def) or - is_array_constructor(def); - objectdef: - result := is_object(def); - setdef: - result := (tsetdef(def).settype <> smallset); - stringdef: - result := tstringdef(def).string_typ in [st_shortstring, st_longstring]; - procvardef: - result := po_methodpointer in tprocvardef(def).procoptions; - end; -end; - -procedure tppcparamanager.init_values(var curintreg, curfloatreg, curmmreg: - tsuperregister; var cur_stack_offset: aword); -begin - { register parameter save area begins at 48(r2) } - cur_stack_offset := 48; - curintreg := RS_R3; - curfloatreg := RS_F1; - curmmreg := RS_M2; -end; - -procedure tppcparamanager.create_funcretloc_info(p: tabstractprocdef; side: - tcallercallee); -var - retcgsize: tcgsize; -begin - { Constructors return self instead of a boolean } - if (p.proctypeoption = potype_constructor) then - retcgsize := OS_ADDR - else - retcgsize := def_cgsize(p.rettype.def); - - location_reset(p.funcretloc[side], LOC_INVALID, OS_NO); - p.funcretloc[side].size := retcgsize; - { void has no location } - if is_void(p.rettype.def) then begin - p.funcretloc[side].loc := LOC_VOID; - exit; - end; - - { Return in FPU register? } - if p.rettype.def.deftype = floatdef then begin - p.funcretloc[side].loc := LOC_FPUREGISTER; - p.funcretloc[side].register := NR_FPU_RESULT_REG; - p.funcretloc[side].size := retcgsize; - end else - { Return in register? } - if not ret_in_param(p.rettype.def, p.proccalloption) then begin - p.funcretloc[side].loc := LOC_REGISTER; - p.funcretloc[side].size := retcgsize; - if side = callerside then - p.funcretloc[side].register := newreg(R_INTREGISTER, - RS_FUNCTION_RESULT_REG, cgsize2subreg(retcgsize)) - else - p.funcretloc[side].register := newreg(R_INTREGISTER, - RS_FUNCTION_RETURN_REG, cgsize2subreg(retcgsize)); - end else begin - p.funcretloc[side].loc := LOC_REFERENCE; - p.funcretloc[side].size := retcgsize; - end; -end; - -function tppcparamanager.create_paraloc_info(p: tabstractprocdef; side: - tcallercallee): longint; - -var - cur_stack_offset: aword; - curintreg, curfloatreg, curmmreg: tsuperregister; -begin - init_values(curintreg, curfloatreg, curmmreg, cur_stack_offset); - - result := create_paraloc_info_intern(p, side, p.paras, curintreg, curfloatreg, - curmmreg, cur_stack_offset); - - create_funcretloc_info(p, side); -end; - -function tppcparamanager.create_paraloc_info_intern(p: tabstractprocdef; side: - tcallercallee; paras: tparalist; - var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: - aword): longint; -var - stack_offset: longint; - paralen: aint; - nextintreg, nextfloatreg, nextmmreg : tsuperregister; - paradef: tdef; - paraloc: pcgparalocation; - i: integer; - hp: tparavarsym; - loc: tcgloc; - paracgsize: tcgsize; - -begin -{$IFDEF extdebug} - if po_explicitparaloc in p.procoptions then - internalerror(200411141); -{$ENDIF extdebug} - - result := 0; - nextintreg := curintreg; - nextfloatreg := curfloatreg; - nextmmreg := curmmreg; - stack_offset := cur_stack_offset; - - for i := 0 to paras.count - 1 do begin - hp := tparavarsym(paras[i]); - paradef := hp.vartype.def; - { Syscall for Morphos can have already a paraloc set } - if (vo_has_explicit_paraloc in hp.varoptions) then begin - if not (vo_is_syscall_lib in hp.varoptions) then - internalerror(200412153); - continue; - end; - hp.paraloc[side].reset; - { currently only support C-style array of const } - if (p.proccalloption in [pocall_cdecl, pocall_cppdecl]) and - is_array_of_const(paradef) then begin - paraloc := hp.paraloc[side].add_location; - { hack: the paraloc must be valid, but is not actually used } - paraloc^.loc := LOC_REGISTER; - paraloc^.register := NR_R0; - paraloc^.size := OS_ADDR; - break; - end; - - if (hp.varspez in [vs_var, vs_out]) or - push_addr_param(hp.varspez, paradef, p.proccalloption) or - is_open_array(paradef) or - is_array_of_const(paradef) then begin - paradef := voidpointertype.def; - loc := LOC_REGISTER; - paracgsize := OS_ADDR; - paralen := tcgsize2size[OS_ADDR]; - end else begin - if not is_special_array(paradef) then - paralen := paradef.size - else - paralen := tcgsize2size[def_cgsize(paradef)]; - if (paradef.deftype = recorddef) and - (hp.varspez in [vs_value, vs_const]) then begin - { if a record has only one field and that field is } - { non-composite (not array or record), it must be } - { passed according to the rules of that type. } - if (trecorddef(hp.vartype.def).symtable.symindex.count = 1) and - (not trecorddef(hp.vartype.def).isunion) and - (tabstractvarsym(trecorddef(hp.vartype.def).symtable.symindex.search(1)).vartype.def.deftype = floatdef) then begin - paradef := - tabstractvarsym(trecorddef(hp.vartype.def).symtable.symindex.search(1)).vartype.def; - loc := getparaloc(paradef); - paracgsize := def_cgsize(paradef); - end else begin - loc := LOC_REGISTER; - paracgsize := int_cgsize(paralen); - end; - end else begin - loc := getparaloc(paradef); - paracgsize := def_cgsize(paradef); - { for things like formaldef } - if (paracgsize = OS_NO) then begin - paracgsize := OS_ADDR; - paralen := tcgsize2size[OS_ADDR]; - end; - end - end; - hp.paraloc[side].alignment := std_param_align; - hp.paraloc[side].size := paracgsize; - hp.paraloc[side].intsize := paralen; - if (paralen = 0) then - if (paradef.deftype = recorddef) then begin - paraloc := hp.paraloc[side].add_location; - paraloc^.loc := LOC_VOID; - end else - internalerror(2005011310); - { can become < 0 for e.g. 3-byte records } - while (paralen > 0) do begin - paraloc := hp.paraloc[side].add_location; - if (loc = LOC_REGISTER) and - (nextintreg <= RS_R10) then begin - paraloc^.loc := loc; - { make sure we don't lose whether or not the type is signed } - if (paradef.deftype <> orddef) then - paracgsize := int_cgsize(paralen); - if (paracgsize in [OS_NO]) then - paraloc^.size := OS_INT - else - paraloc^.size := paracgsize; - paraloc^.register := newreg(R_INTREGISTER, nextintreg, R_SUBNONE); - inc(nextintreg); - dec(paralen, tcgsize2size[paraloc^.size]); - - inc(stack_offset, tcgsize2size[OS_INT]); - end else if (loc = LOC_FPUREGISTER) and - (nextfloatreg <= RS_F13) then begin - paraloc^.loc := loc; - paraloc^.size := paracgsize; - paraloc^.register := newreg(R_FPUREGISTER, nextfloatreg, R_SUBWHOLE); - { the PPC64 ABI says that the GPR index is increased for every parameter, no matter - which type it is stored in } - inc(nextintreg); - inc(nextfloatreg); - dec(paralen, tcgsize2size[paraloc^.size]); - - inc(stack_offset, tcgsize2size[OS_FLOAT]); - end else if (loc = LOC_MMREGISTER) then begin - { Altivec not supported } - internalerror(200510192); - end else begin - { either LOC_REFERENCE, or one of the above which must be passed on the - stack because of insufficient registers } - paraloc^.loc := LOC_REFERENCE; - paraloc^.size := int_cgsize(paralen); - if (side = callerside) then - paraloc^.reference.index := NR_STACK_POINTER_REG - else - { during procedure entry, NR_OLD_STACK_POINTER_REG contains the old stack pointer } - paraloc^.reference.index := NR_OLD_STACK_POINTER_REG; - paraloc^.reference.offset := stack_offset; - - { align temp contents to next register size } - inc(stack_offset, align(paralen, 8)); - paralen := 0; - end; - end; - end; - - curintreg := nextintreg; - curfloatreg := nextfloatreg; - curmmreg := nextmmreg; - cur_stack_offset := stack_offset; - result := stack_offset; -end; - -function tppcparamanager.create_varargs_paraloc_info(p: tabstractprocdef; - varargspara: tvarargsparalist): longint; -var - cur_stack_offset: aword; - parasize, l: longint; - curintreg, firstfloatreg, curfloatreg, curmmreg: tsuperregister; - i: integer; - hp: tparavarsym; - paraloc: pcgparalocation; -begin - init_values(curintreg, curfloatreg, curmmreg, cur_stack_offset); - firstfloatreg := curfloatreg; - - result := create_paraloc_info_intern(p, callerside, p.paras, curintreg, - curfloatreg, curmmreg, cur_stack_offset); - if (p.proccalloption in [pocall_cdecl, pocall_cppdecl]) then begin - { just continue loading the parameters in the registers } - result := create_paraloc_info_intern(p, callerside, varargspara, curintreg, - curfloatreg, curmmreg, cur_stack_offset); - { varargs routines have to reserve at least 64 bytes for the PPC64 ABI } - if (result < 64) then - result := 64; - end else begin - parasize := cur_stack_offset; - for i := 0 to varargspara.count - 1 do begin - hp := tparavarsym(varargspara[i]); - hp.paraloc[callerside].alignment := 8; - paraloc := hp.paraloc[callerside].add_location; - paraloc^.loc := LOC_REFERENCE; - paraloc^.size := def_cgsize(hp.vartype.def); - paraloc^.reference.index := NR_STACK_POINTER_REG; - l := push_size(hp.varspez, hp.vartype.def, p.proccalloption); - paraloc^.reference.offset := parasize; - parasize := parasize + l; - end; - result := parasize; - end; - if curfloatreg <> firstfloatreg then - include(varargspara.varargsinfo, va_uses_float_reg); -end; - -function tppcparamanager.parseparaloc(p: tparavarsym; const s: string): boolean; -begin - { not supported/required for PowerPC64-linux target } - internalerror(200404182); - result := true; -end; - -begin - paramanager := tppcparamanager.create; -end. - diff --git a/compiler/powerpc64/cpupi.pas b/compiler/powerpc64/cpupi.pas deleted file mode 100644 index f733950e09..0000000000 --- a/compiler/powerpc64/cpupi.pas +++ /dev/null @@ -1,112 +0,0 @@ -{ - Copyright (c) 2002 by Florian Klaempfl - - This unit contains the CPU specific part of tprocinfo - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} - -{ This unit contains the CPU specific part of tprocinfo. } -unit cpupi; - -{$I fpcdefs.inc} - -interface - -uses - cutils, - procinfo, cpuinfo, psub; - -type - tppcprocinfo = class(tcgprocinfo) - { offset where the frame pointer from the outer procedure is stored. } - parent_framepointer_offset: longint; - constructor create(aparent: tprocinfo); override; - procedure set_first_temp_offset; override; - procedure allocate_push_parasize(size: longint); override; - function calc_stackframe_size: longint; override; - function calc_stackframe_size(numgpr, numfpr : longint): longint; - end; - -implementation - -uses - globtype, globals, systems, - cpubase, cgbase, - aasmtai, - tgobj, - symconst, symsym, paramgr, symutil, - verbose; - -constructor tppcprocinfo.create(aparent: tprocinfo); - -begin - inherited create(aparent); - maxpushedparasize := 0; -end; - -procedure tppcprocinfo.set_first_temp_offset; -var - ofs: aword; - locals: longint; -begin - if not (po_assembler in procdef.procoptions) then begin - { align the stack properly } - ofs := align(maxpushedparasize + LinkageAreaSizeELF, 8); - - { the ABI specification says that it is required to always allocate space for 8 * 8 bytes - for registers R3-R10 and stack header if there's a stack frame, but GCC doesn't do that, - so we don't that too. Uncomment the next three lines if this is required } -// if (ofs < 112) then begin -// ofs := 112; -// end; - tg.setfirsttemp(ofs); - end else begin - locals := 0; - current_procinfo.procdef.localst.foreach_static(@count_locals, @locals); - if locals <> 0 then - { at 0(r1), the previous value of r1 will be stored } - tg.setfirsttemp(8); - end; -end; - -procedure tppcprocinfo.allocate_push_parasize(size: longint); -begin - if size > maxpushedparasize then - maxpushedparasize := size; -end; - -function tppcprocinfo.calc_stackframe_size: longint; -begin - result := calc_stackframe_size(18, 18); -end; - -function tppcprocinfo.calc_stackframe_size(numgpr, numfpr : longint) : longint; -begin - { more or less copied from cgcpu.pas/g_stackframe_entry } - if not (po_assembler in procdef.procoptions) then begin - // no VMX support - result := align(align(numgpr * tcgsize2size[OS_INT] + - numfpr * tcgsize2size[OS_FLOAT], ELF_STACK_ALIGN) + tg.lasttemp, ELF_STACK_ALIGN); - end else - result := align(tg.lasttemp, ELF_STACK_ALIGN); -end; - -begin - cprocinfo := tppcprocinfo; -end. - diff --git a/compiler/powerpc64/cpuswtch.pas b/compiler/powerpc64/cpuswtch.pas deleted file mode 100644 index 455aa1966e..0000000000 --- a/compiler/powerpc64/cpuswtch.pas +++ /dev/null @@ -1,125 +0,0 @@ -{ - Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller - - interprets the commandline options which are PowerPC64 specific - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit cpuswtch; - -{$I fpcdefs.inc} - -interface - -uses - options; - -type - toptionpowerpc = class(toption) - procedure interpret_proc_specific_options(const opt: string); override; - end; - -implementation - -uses - cutils, globtype, systems, globals; - -procedure toptionpowerpc.interpret_proc_specific_options(const opt: string); -var - more: string; - j: longint; -begin - More := Upper(copy(opt, 3, length(opt) - 2)); - case opt[2] of - 'O': - begin - j := 3; - while (j <= Length(Opt)) do - begin - case opt[j] of - '-': - begin - initglobalswitches := initglobalswitches - [cs_optimize, - cs_fastoptimize, cs_slowoptimize, cs_littlesize, - cs_regvars, cs_uncertainopts]; - FillChar(ParaAlignment, sizeof(ParaAlignment), 0); - end; - 'a': - begin - UpdateAlignmentStr(Copy(Opt, j + 1, 255), ParaAlignment); - j := length(Opt); - end; - 'g': initglobalswitches := initglobalswitches + [cs_littlesize]; - 'G': initglobalswitches := initglobalswitches - [cs_littlesize]; - 'r': - begin - initglobalswitches := initglobalswitches + [cs_regvars]; - Simplify_ppu := false; - end; - 'u': initglobalswitches := initglobalswitches + [cs_uncertainopts]; - '1': initglobalswitches := initglobalswitches - [cs_fastoptimize, - cs_slowoptimize] + [cs_optimize]; - '2': initglobalswitches := initglobalswitches - [cs_slowoptimize] + - [cs_optimize, cs_fastoptimize]; - '3': initglobalswitches := initglobalswitches + [cs_optimize, - cs_fastoptimize, cs_slowoptimize]; -{$IFDEF dummy} - 'p': - begin - if j < Length(Opt) then - begin - case opt[j + 1] of - '1': initoptprocessor := Class386; - '2': initoptprocessor := ClassP5; - '3': initoptprocessor := ClassP6 - else - IllegalPara(Opt) - end; - Inc(j); - end - else - IllegalPara(opt) - end; -{$ENDIF dummy} - else - IllegalPara(opt); - end; - Inc(j) - end; - end; -{$IFDEF dummy} - 'R': - begin - if More = 'GAS' then - initasmmode := asmmode_ppc_gas - else if More = 'MOTOROLA' then - initasmmode := asmmode_ppc_motorola - else if More = 'DIRECT' then - initasmmode := asmmode_direct - else - IllegalPara(opt); - end; -{$ENDIF dummy} - else - IllegalPara(opt); - end; -end; - -initialization - coption := toptionpowerpc; -end. - diff --git a/compiler/powerpc64/cputarg.pas b/compiler/powerpc64/cputarg.pas deleted file mode 100644 index 412ec516eb..0000000000 --- a/compiler/powerpc64/cputarg.pas +++ /dev/null @@ -1,78 +0,0 @@ -{ - Copyright (c) 2001-2002 by Peter Vreman - - Includes the powerpc dependent target units - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit cputarg; - -{$i fpcdefs.inc} - -interface - - -implementation - - uses - systems { prevent a syntax error when nothing is included } - -{************************************** - Targets -**************************************} - - {$ifndef NOTARGETLINUX} - ,t_linux - {$endif} - -{************************************** - Assemblers -**************************************} - - {$ifndef NOAGPPCGAS} - ,agppcgas - {$endif} - -{************************************** - Assembler Readers -**************************************} - - {$ifndef NoRaPPCGas} - ,rappcgas - {$endif NoRaPPCGas} - -{************************************** - Debuginfo -**************************************} - - {$ifndef NoDbgStabs} - ,dbgstabs - {$endif NoDbgStabs} - {$ifndef NoDbgDwarf} - ,dbgdwarf - {$endif NoDbgDwarf} - -{************************************** - Optimizer -**************************************} - - {$ifndef NOOPT} - , aoptcpu - {$endif NOOPT} - ; - -end. diff --git a/compiler/powerpc64/itcpugas.pas b/compiler/powerpc64/itcpugas.pas deleted file mode 100644 index 73dc51bccd..0000000000 --- a/compiler/powerpc64/itcpugas.pas +++ /dev/null @@ -1,159 +0,0 @@ -{ - Copyright (c) 1998-2002 by Florian Klaempfl - - This unit contains the PowerPC GAS instruction tables - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit itcpugas; - -{$I fpcdefs.inc} - -interface - -uses - cpubase, cgbase; - -const - gas_op2str: array[tasmop] of string[14] = ('<none>', - 'add', 'add.', 'addo', 'addo.', 'addc', 'addc.', 'addco', 'addco.', - 'adde', 'adde.', 'addeo', 'addeo.', 'addi', 'addic', 'addic.', 'addis', - 'addme', 'addme.', 'addmeo', 'addmeo.', 'addze', 'addze.', 'addzeo', - 'addzeo.', 'and', 'and.', 'andc', 'andc.', 'andi.', 'andis.', 'b', - 'ba', 'bl', 'bla', 'bc', 'bca', 'bcl', 'bcla', 'bcctr', 'bcctrl', 'bclr', - 'bclrl', 'cmp', 'cmpi', 'cmpl', 'cmpli', 'cntlzw', 'cntlzw.', 'crand', - 'crandc', 'creqv', 'crnand', 'crnor', 'cror', 'crorc', 'crxor', 'dcba', - 'dcbf', 'dcbi', 'dcbst', 'dcbt', 'dcbtst', 'dcbz', 'divw', 'divw.', 'divwo', - 'divwo.', - 'divwu', 'divwu.', 'divwuo', 'divwuo.', 'eciwx', 'ecowx', 'eieio', 'eqv', - 'eqv.', 'extsb', 'extsb.', 'extsh', 'extsh.', 'fabs', 'fabs.', 'fadd', - 'fadd.', 'fadds', 'fadds.', 'fcmpo', 'fcmpu', 'fctiw', 'fctiw.', 'fctiwz', - 'fctiwz.', 'fdiv', 'fdiv.', 'fdivs', 'fdivs.', 'fmadd', 'fmadd.', 'fmadds', - 'fmadds.', 'fmr', 'fmsub', 'fmsub.', 'fmsubs', 'fmsubs.', 'fmul', 'fmul.', - 'fmuls', 'fmuls.', 'fnabs', 'fnabs.', 'fneg', 'fneg.', 'fnmadd', - 'fnmadd.', 'fnmadds', 'fnmadds.', 'fnmsub', 'fnmsub.', 'fnmsubs', - 'fnmsubs.', 'fres', 'fres.', 'frsp', 'frsp.', 'frsqrte', 'frsqrte.', - 'fsel', 'fsel.', 'fsqrt', 'fsqrt.', 'fsqrts', 'fsqrts.', 'fsub', 'fsub.', - 'fsubs', 'fsubs.', 'icbi', 'isync', 'lbz', 'lbzu', 'lbzux', 'lbzx', - 'lfd', 'lfdu', 'lfdux', 'lfdx', 'lfs', 'lfsu', 'lfsux', 'lfsx', 'lha', - 'lhau', 'lhaux', 'lhax', 'hbrx', 'lhz', 'lhzu', 'lhzux', 'lhzx', 'lmw', - 'lswi', 'lswx', 'lwarx', 'lwbrx', 'lwz', 'lwzu', 'lwzux', 'lwzx', 'mcrf', - 'mcrfs', 'mcrxr', 'mfcr', 'mffs', 'mffs.', 'mfmsr', 'mfspr', 'mfsr', - 'mfsrin', 'mftb', 'mtcrf', 'mtfsb0', 'mtfsb1', 'mtfsf', 'mtfsf.', - 'mtfsfi', 'mtfsfi.', 'mtmsr', 'mtspr', 'mtsr', 'mtsrin', 'mulhw', - 'mulhw.', 'mulhwu', 'mulhwu.', 'mulli', 'mullw', 'mullw.', 'mullwo', - 'mullwo.', 'nand', 'nand.', 'neg', 'neg.', 'nego', 'nego.', 'nor', 'nor.', - 'or', 'or.', 'orc', 'orc.', 'ori', 'oris', 'rfi', 'rlwimi', 'rlwimi.', - 'rlwinm', 'rlwinm.', 'rlwnm', 'sc', 'slw', 'slw.', 'sraw', 'sraw.', - 'srawi', 'srawi.', 'srw', 'srw.', 'stb', 'stbu', 'stbux', 'stbx', 'stfd', - 'stfdu', 'stfdux', 'stfdx', 'stfiwx', 'stfs', 'stfsu', 'stfsux', 'stfsx', - 'sth', 'sthbrx', 'sthu', 'sthux', 'sthx', 'stmw', 'stswi', 'stswx', 'stw', - 'stwbrx', 'stwcx.', 'stwu', 'stwux', 'stwx', 'subf', 'subf.', 'subfo', - 'subfo.', 'subfc', 'subc.', 'subfco', 'subfco.', 'subfe', 'subfe.', - 'subfeo', 'subfeo.', 'subfic', 'subfme', 'subfme.', 'subfmeo', 'subfmeo.', - 'subfze', 'subfze.', 'subfzeo', 'subfzeo.', 'sync', 'tlbia', 'tlbie', - 'tlbsync', 'tw', 'twi', 'xor', 'xor.', 'xori', 'xoris', - { some simplified mnemonics } - 'subi', 'subis', 'subic', 'subic.', 'sub', 'sub.', 'subo', 'subo.', - 'subc', 'subc.', 'subco', 'subco.', 'cmpwi', 'cmpw', 'cmplwi', 'cmplw', - 'extlwi', 'extlwi.', 'extrwi', 'extrwi.', 'inslwi', 'inslwi.', 'insrwi', - 'insrwi.', 'rotlwi', 'rotlwi.', 'rotlw', 'rotlw.', 'slwi', 'slwi.', - 'srwi', 'srwi.', 'clrlwi', 'clrlwi.', 'clrrwi', 'clrrwi.', 'clrslwi', - 'clrslwi.', 'blr', 'bctr', 'blrl', 'bctrl', 'crset', 'crclr', 'crmove', - 'crnot', 'mt', 'mf', 'nop', 'li', 'lis', 'la', 'mr', 'mr.', 'not', 'mtcr', - 'mtlr', 'mflr', - 'mtctr', 'mfctr', - 'extsw', 'rldimi', - 'std', 'stdu', 'stdx', 'stdux', - 'ld', 'ldu', 'ldx', 'ldux', - 'cmpd', 'cmpdi', 'cmpld', 'cmpldi', - 'srdi', 'sradi', - 'sldi', - 'rldicl', - 'divdu', 'divdu.', 'divd', 'divd.', 'mulld', 'mulld.', 'mulhd', 'mulhd.', 'srad', 'sld', 'srd', - 'divduo.', 'divdo.', - 'lwa', 'lwax', 'lwaux', - 'fcfid', - 'ldarx', 'stdcx.', 'cntlzd', - 'lvx', 'stvx', - 'mulldo', 'mulldo.', 'mulhdu', 'mulhdu.', - 'mfxer', - 'fctid', 'fctid.', 'fctidz', 'fctidz.'); - -function gas_regnum_search(const s: string): Tregister; -function gas_regname(r: Tregister): string; - -implementation - -uses - globtype, globals, - cutils, verbose, systems; - -const - gas_regname_table: array[tregisterindex] of string[7] = ( -{$I rppcgas.inc} - ); - - gas_regname_short_table: array[tregisterindex] of string[7] = ( -{$I rppcgss.inc} - ); - - gas_regname_index: array[tregisterindex] of tregisterindex = ( -{$I rppcgri.inc} - ); - -function findreg_by_gasname(const s: string): tregisterindex; -var - i, p: tregisterindex; -begin - {Binary search.} - p := 0; - i := regnumber_count_bsstart; - repeat - if (p + i <= high(tregisterindex)) and (gas_regname_table[gas_regname_index[p - + i]] <= s) then - p := p + i; - i := i shr 1; - until i = 0; - if gas_regname_table[gas_regname_index[p]] = s then - findreg_by_gasname := gas_regname_index[p] - else - findreg_by_gasname := 0; -end; - -function gas_regnum_search(const s: string): Tregister; -begin - result := regnumber_table[findreg_by_gasname(s)]; -end; - -function gas_regname(r: Tregister): string; -var - p: longint; -begin - p := findreg_by_number(r); - if p <> 0 then - if (cs_create_smart in aktmoduleswitches) and - (target_info.system <> system_powerpc_darwin) then - result := gas_regname_short_table[p] - else - result := gas_regname_table[p] - else - result := generic_regname(r); -end; - -end. - diff --git a/compiler/powerpc64/nppcadd.pas b/compiler/powerpc64/nppcadd.pas deleted file mode 100644 index 67212ac3bb..0000000000 --- a/compiler/powerpc64/nppcadd.pas +++ /dev/null @@ -1,844 +0,0 @@ -{ - Copyright (c) 2000-2002 by Florian Klaempfl and Jonas Maebe - - Code generation for add nodes on the PowerPC64 - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit nppcadd; - -{$I fpcdefs.inc} - -interface - -uses - node, nadd, ncgadd, cpubase; - -type - tppcaddnode = class(tcgaddnode) - function pass_1: tnode; override; - procedure pass_2; override; - private - procedure pass_left_and_right; - procedure load_left_right(cmpop, load_constants: boolean); - function getresflags: tresflags; - procedure emit_compare(unsigned: boolean); - procedure second_addfloat; override; - procedure second_addboolean; override; - procedure second_addsmallset; override; - end; - -implementation - -uses - sysutils, - - globtype, systems, - cutils, verbose, globals, - symconst, symdef, paramgr, - aasmbase, aasmtai, aasmcpu, defutil, htypechk, - cgbase, cpuinfo, pass_1, pass_2, regvars, - cpupara, cgcpu, cgutils, - ncon, nset, - ncgutil, tgobj, rgobj, rgcpu, cgobj; - -{***************************************************************************** - Pass 1 -*****************************************************************************} - -function tppcaddnode.pass_1: tnode; -begin - resulttypepass(left); - if (nodetype in [equaln, unequaln]) and - (left.resulttype.def.deftype = orddef) {and - is_64bit(left.resulttype.def)}then - begin - result := nil; - firstpass(left); - firstpass(right); - expectloc := LOC_FLAGS; - calcregisters(self, 2, 0, 0); - exit; - end; - result := inherited pass_1; -end; - -{***************************************************************************** - Helpers -*****************************************************************************} - -procedure tppcaddnode.pass_left_and_right; -begin - { calculate the operator which is more difficult } - firstcomplex(self); - - { in case of constant put it to the left } - if (left.nodetype = ordconstn) then - swapleftright; - - secondpass(left); - secondpass(right); -end; - -procedure tppcaddnode.load_left_right(cmpop, load_constants: boolean); - - procedure load_node(var n: tnode); - begin - case n.location.loc of - LOC_REGISTER: - if not cmpop then - begin - location.register := n.location.register; - end; - LOC_REFERENCE, LOC_CREFERENCE: - begin - location_force_reg(exprasmlist, n.location, - def_cgsize(n.resulttype.def), false); - if not cmpop then - begin - location.register := n.location.register; - end; - end; - LOC_CONSTANT: - begin - if load_constants then - begin - location_force_reg(exprasmlist, n.location, - def_cgsize(n.resulttype.def), false); - if not cmpop then - location.register := n.location.register; - end; - end; - end; - end; - -begin - load_node(left); - load_node(right); - if not (cmpop) and - (location.register = NR_NO) then - begin - location.register := cg.getintregister(exprasmlist, OS_INT); - end; -end; - -function tppcaddnode.getresflags: tresflags; -begin - if (left.resulttype.def.deftype <> floatdef) then - result.cr := RS_CR0 - else - result.cr := RS_CR1; - case nodetype of - equaln: result.flag := F_EQ; - unequaln: result.flag := F_NE; - else - if nf_swaped in flags then - case nodetype of - ltn: result.flag := F_GT; - lten: result.flag := F_GE; - gtn: result.flag := F_LT; - gten: result.flag := F_LE; - end - else - case nodetype of - ltn: result.flag := F_LT; - lten: result.flag := F_LE; - gtn: result.flag := F_GT; - gten: result.flag := F_GE; - end; - end -end; - -procedure tppcaddnode.emit_compare(unsigned: boolean); -var - op: tasmop; - tmpreg: tregister; - useconst: boolean; -begin - // get the constant on the right if there is one - if (left.location.loc = LOC_CONSTANT) then - swapleftright; - // can we use an immediate, or do we have to load the - // constant in a register first? - if (right.location.loc = LOC_CONSTANT) then begin - if (nodetype in [equaln, unequaln]) then - if (unsigned and - (aword(right.location.value) > high(word))) or - (not unsigned and - (aint(right.location.value) < low(smallint)) or - (aint(right.location.value) > high(smallint))) then - { we can then maybe use a constant in the 'othersigned' case - (the sign doesn't matter for // equal/unequal)} - unsigned := not unsigned; - - if (unsigned and - (aword(right.location.value) <= high(word))) or - (not (unsigned) and - (aint(right.location.value) >= low(smallint)) and - (aint(right.location.value) <= high(smallint))) then - useconst := true - else begin - useconst := false; - tmpreg := cg.getintregister(exprasmlist, OS_INT); - cg.a_load_const_reg(exprasmlist, OS_INT, - right.location.value, tmpreg); - end - end else - useconst := false; - location.loc := LOC_FLAGS; - location.resflags := getresflags; - if not unsigned then - if useconst then - op := A_CMPDI - else - op := A_CMPD - else if useconst then - op := A_CMPLDI - else - op := A_CMPLD; - - if (right.location.loc = LOC_CONSTANT) then begin - if useconst then - exprasmlist.concat(taicpu.op_reg_const(op, left.location.register, - longint(right.location.value))) - else - exprasmlist.concat(taicpu.op_reg_reg(op, left.location.register, tmpreg)); - end else - exprasmlist.concat(taicpu.op_reg_reg(op, - left.location.register, right.location.register)); -end; - -{***************************************************************************** - AddBoolean -*****************************************************************************} - -procedure tppcaddnode.second_addboolean; -var - cgop: TOpCg; - cgsize: TCgSize; - cmpop, - isjump: boolean; - otl, ofl: tasmlabel; -begin - { calculate the operator which is more difficult } - firstcomplex(self); - - cmpop := false; - if (torddef(left.resulttype.def).typ = bool8bit) or - (torddef(right.resulttype.def).typ = bool8bit) then - cgsize := OS_8 - else if (torddef(left.resulttype.def).typ = bool16bit) or - (torddef(right.resulttype.def).typ = bool16bit) then - cgsize := OS_16 - else - cgsize := OS_32; - - if (cs_full_boolean_eval in aktlocalswitches) or - (nodetype in [unequaln, ltn, lten, gtn, gten, equaln, xorn]) then - begin - if left.nodetype in [ordconstn, realconstn] then - swapleftright; - - isjump := (left.expectloc = LOC_JUMP); - if isjump then - begin - otl := truelabel; - objectlibrary.getjumplabel(truelabel); - ofl := falselabel; - objectlibrary.getjumplabel(falselabel); - end; - secondpass(left); - if left.location.loc in [LOC_FLAGS, LOC_JUMP] then - location_force_reg(exprasmlist, left.location, cgsize, false); - if isjump then - begin - truelabel := otl; - falselabel := ofl; - end - else if left.location.loc = LOC_JUMP then - internalerror(2003122901); - - isjump := (right.expectloc = LOC_JUMP); - if isjump then - begin - otl := truelabel; - objectlibrary.getjumplabel(truelabel); - ofl := falselabel; - objectlibrary.getjumplabel(falselabel); - end; - secondpass(right); - if right.location.loc in [LOC_FLAGS, LOC_JUMP] then - location_force_reg(exprasmlist, right.location, cgsize, false); - if isjump then - begin - truelabel := otl; - falselabel := ofl; - end - else if right.location.loc = LOC_JUMP then - internalerror(200312292); - - cmpop := nodetype in [ltn, lten, gtn, gten, equaln, unequaln]; - - { set result location } - if not cmpop then - location_reset(location, LOC_REGISTER, def_cgsize(resulttype.def)) - else - location_reset(location, LOC_FLAGS, OS_NO); - - load_left_right(cmpop, false); - - if (left.location.loc = LOC_CONSTANT) then - swapleftright; - - { compare the } - case nodetype of - ltn, lten, gtn, gten, - equaln, unequaln: - begin - if (right.location.loc <> LOC_CONSTANT) then - exprasmlist.concat(taicpu.op_reg_reg(A_CMPLW, - left.location.register, right.location.register)) - else - exprasmlist.concat(taicpu.op_reg_const(A_CMPLWI, - left.location.register, longint(right.location.value))); - location.resflags := getresflags; - end; - else - begin - case nodetype of - xorn: - cgop := OP_XOR; - orn: - cgop := OP_OR; - andn: - cgop := OP_AND; - else - internalerror(200203247); - end; - - if right.location.loc <> LOC_CONSTANT then - cg.a_op_reg_reg_reg(exprasmlist, cgop, OS_INT, - left.location.register, right.location.register, - location.register) - else - cg.a_op_const_reg_reg(exprasmlist, cgop, OS_INT, - right.location.value, left.location.register, - location.register); - end; - end; - end - else - begin - // just to make sure we free the right registers - cmpop := true; - case nodetype of - andn, - orn: - begin - location_reset(location, LOC_JUMP, OS_NO); - case nodetype of - andn: - begin - otl := truelabel; - objectlibrary.getjumplabel(truelabel); - secondpass(left); - maketojumpbool(exprasmlist, left, lr_load_regvars); - cg.a_label(exprasmlist, truelabel); - truelabel := otl; - end; - orn: - begin - ofl := falselabel; - objectlibrary.getjumplabel(falselabel); - secondpass(left); - maketojumpbool(exprasmlist, left, lr_load_regvars); - cg.a_label(exprasmlist, falselabel); - falselabel := ofl; - end; - else - internalerror(200403181); - end; - secondpass(right); - maketojumpbool(exprasmlist, right, lr_load_regvars); - end; - end; - end; -end; - -{***************************************************************************** - AddFloat -*****************************************************************************} - -procedure tppcaddnode.second_addfloat; -var - op: TAsmOp; - cmpop: boolean; -begin - pass_left_and_right; - - cmpop := false; - case nodetype of - addn: - op := A_FADD; - muln: - op := A_FMUL; - subn: - op := A_FSUB; - slashn: - op := A_FDIV; - ltn, lten, gtn, gten, - equaln, unequaln: - begin - op := A_FCMPO; - cmpop := true; - end; - else - internalerror(200403182); - end; - - // get the operands in the correct order, there are no special cases - // here, everything is register-based - if nf_swaped in flags then - swapleftright; - - // put both operands in a register - location_force_fpureg(exprasmlist, right.location, true); - location_force_fpureg(exprasmlist, left.location, true); - - // initialize de result - if not cmpop then - begin - location_reset(location, LOC_FPUREGISTER, def_cgsize(resulttype.def)); - if left.location.loc = LOC_FPUREGISTER then - location.register := left.location.register - else if right.location.loc = LOC_FPUREGISTER then - location.register := right.location.register - else - location.register := cg.getfpuregister(exprasmlist, location.size); - end - else - begin - location_reset(location, LOC_FLAGS, OS_NO); - location.resflags := getresflags; - end; - - // emit the actual operation - if not cmpop then - begin - exprasmlist.concat(taicpu.op_reg_reg_reg(op, - location.register, left.location.register, - right.location.register)) - end - else - begin - exprasmlist.concat(taicpu.op_reg_reg_reg(op, - newreg(R_SPECIALREGISTER, location.resflags.cr, R_SUBNONE), - left.location.register, right.location.register)) - end; -end; - -{***************************************************************************** - AddSmallSet -*****************************************************************************} - -procedure tppcaddnode.second_addsmallset; -var - cgop: TOpCg; - tmpreg: tregister; - opdone, - cmpop: boolean; - - astring : string; - // ts: todo - speed up by using 32 bit compares/adds/ands here -begin - pass_left_and_right; - - { when a setdef is passed, it has to be a smallset } - if ((left.resulttype.def.deftype = setdef) and - (tsetdef(left.resulttype.def).settype <> smallset)) or - ((right.resulttype.def.deftype = setdef) and - (tsetdef(right.resulttype.def).settype <> smallset)) then - internalerror(200203301); - - opdone := false; - cmpop := nodetype in [equaln, unequaln, lten, gten]; - - { set result location } - if not cmpop then - location_reset(location, LOC_REGISTER, def_cgsize(resulttype.def)) - else - location_reset(location, LOC_FLAGS, OS_NO); - - load_left_right(cmpop, false); - - if not (cmpop) and - (location.register = NR_NO) then - location.register := cg.getintregister(exprasmlist, OS_64); - - astring := 'addsmallset0 ' + inttostr(aword(1) shl aword(right.location.value)) + ' ' + inttostr(right.location.value); - exprasmlist.concat(tai_comment.create(strpnew(astring))); - - - case nodetype of - addn: - begin - if (nf_swaped in flags) and (left.nodetype = setelementn) then - swapleftright; - { are we adding set elements ? } - if right.nodetype = setelementn then begin - { no range support for smallsets! } - if assigned(tsetelementnode(right).right) then - internalerror(43244); - if (right.location.loc = LOC_CONSTANT) then begin - - astring := 'addsmallset1 ' + inttostr(aword(1) shl aword(right.location.value)) + ' ' + inttostr(right.location.value); - exprasmlist.concat(tai_comment.create(strpnew(astring))); - - - cg.a_op_const_reg_reg(exprasmlist, OP_OR, OS_64, - aint(1) shl aint(right.location.value), - left.location.register, location.register) - end else - begin - tmpreg := cg.getintregister(exprasmlist, OS_64); - cg.a_load_const_reg(exprasmlist, OS_64, 1, tmpreg); - cg.a_op_reg_reg(exprasmlist, OP_SHL, OS_64, - right.location.register, tmpreg); - if left.location.loc <> LOC_CONSTANT then begin - cg.a_op_reg_reg_reg(exprasmlist, OP_OR, OS_64, tmpreg, - left.location.register, location.register) - end else begin - astring := 'addsmallset2 ' + inttostr(left.location.value); - exprasmlist.concat(tai_comment.create(strpnew(astring))); - - cg.a_op_const_reg_reg(exprasmlist, OP_OR, OS_64, - left.location.value, tmpreg, location.register); - end; - end; - opdone := true; - end else begin - cgop := OP_OR; - end; - end; - symdifn: - cgop := OP_XOR; - muln: - cgop := OP_AND; - subn: - begin - cgop := OP_AND; - if (not (nf_swaped in flags)) then - if (right.location.loc = LOC_CONSTANT) then - right.location.value := not (right.location.value) - else - opdone := true - else if (left.location.loc = LOC_CONSTANT) then - left.location.value := not (left.location.value) - else begin - swapleftright; - opdone := true; - end; - if opdone then begin - if left.location.loc = LOC_CONSTANT then - begin - tmpreg := cg.getintregister(exprasmlist, OS_64); - cg.a_load_const_reg(exprasmlist, OS_64, - left.location.value, tmpreg); - exprasmlist.concat(taicpu.op_reg_reg_reg(A_ANDC, - location.register, tmpreg, right.location.register)); - end - else - exprasmlist.concat(taicpu.op_reg_reg_reg(A_ANDC, - location.register, left.location.register, - right.location.register)); - end; - end; - equaln, - unequaln: - begin - emit_compare(true); - opdone := true; - end; - lten, gten: - begin - if (not (nf_swaped in flags) and - (nodetype = lten)) or - ((nf_swaped in flags) and - (nodetype = gten)) then - swapleftright; - // now we have to check whether left >= right - tmpreg := cg.getintregister(exprasmlist, OS_64); - if left.location.loc = LOC_CONSTANT then begin - cg.a_op_const_reg_reg(exprasmlist, OP_AND, OS_64, - not (left.location.value), right.location.register, tmpreg); - exprasmlist.concat(taicpu.op_reg_const(A_CMPDI, tmpreg, 0)); - // the two instructions above should be folded together by - // the peepholeoptimizer - end else begin - if right.location.loc = LOC_CONSTANT then begin - cg.a_load_const_reg(exprasmlist, OS_64, - right.location.value, tmpreg); - exprasmlist.concat(taicpu.op_reg_reg_reg(A_ANDC_, tmpreg, - tmpreg, left.location.register)); - end else - exprasmlist.concat(taicpu.op_reg_reg_reg(A_ANDC_, tmpreg, - right.location.register, left.location.register)); - end; - location.resflags.cr := RS_CR0; - location.resflags.flag := F_EQ; - opdone := true; - end; - else - internalerror(2002072701); - end; - - if not opdone then begin - // these are all commutative operations - if (left.location.loc = LOC_CONSTANT) then - swapleftright; - if (right.location.loc = LOC_CONSTANT) then begin - astring := 'addsmallset4 ' + inttostr(right.location.value); - exprasmlist.concat(tai_comment.create(strpnew(astring))); - - cg.a_op_const_reg_reg(exprasmlist, cgop, OS_64, - right.location.value, left.location.register, - location.register) - end else begin - cg.a_op_reg_reg_reg(exprasmlist, cgop, OS_64, - right.location.register, left.location.register, - location.register); - end; - end; -end; - -{***************************************************************************** - pass_2 -*****************************************************************************} - -procedure tppcaddnode.pass_2; -{ is also being used for xor, and "mul", "sub, or and comparative } -{ operators } -var - cgop: topcg; - op: tasmop; - tmpreg: tregister; - hl: tasmlabel; - cmpop: boolean; - - { true, if unsigned types are compared } - unsigned: boolean; - -begin - { to make it more readable, string and set (not smallset!) have their - own procedures } - case left.resulttype.def.deftype of - orddef: - begin - { handling boolean expressions } - if is_boolean(left.resulttype.def) and - is_boolean(right.resulttype.def) then - begin - second_addboolean; - exit; - end; - end; - stringdef: - begin - internalerror(2002072402); - exit; - end; - setdef: - begin - { normalsets are already handled in pass1 } - if (tsetdef(left.resulttype.def).settype <> smallset) then - internalerror(200109041); - second_addsmallset; - exit; - end; - arraydef: - begin -{$IFDEF SUPPORT_MMX} - if is_mmx_able_array(left.resulttype.def) then - begin - second_addmmx; - exit; - end; -{$ENDIF SUPPORT_MMX} - end; - floatdef: - begin - second_addfloat; - exit; - end; - end; - - { defaults } - cmpop := nodetype in [ltn, lten, gtn, gten, equaln, unequaln]; - unsigned := not (is_signed(left.resulttype.def)) or - not (is_signed(right.resulttype.def)); - - pass_left_and_right; - - { Convert flags to register first } - { can any of these things be in the flags actually?? (JM) } - - if (left.location.loc = LOC_FLAGS) or - (right.location.loc = LOC_FLAGS) then - internalerror(2002072602); - - { set result location } - if not cmpop then - location_reset(location, LOC_REGISTER, def_cgsize(resulttype.def)) - else - location_reset(location, LOC_FLAGS, OS_NO); - - load_left_right(cmpop, (cs_check_overflow in aktlocalswitches) and - (nodetype in [addn, subn, muln])); - - if (location.register = NR_NO) and - not (cmpop) then - location.register := cg.getintregister(exprasmlist, OS_INT); - - if not (cs_check_overflow in aktlocalswitches) or - (cmpop) or - (nodetype in [orn, andn, xorn]) then - begin - case nodetype of - addn, muln, xorn, orn, andn: - begin - case nodetype of - addn: - cgop := OP_ADD; - muln: - if unsigned then - cgop := OP_MUL - else - cgop := OP_IMUL; - xorn: - cgop := OP_XOR; - orn: - cgop := OP_OR; - andn: - cgop := OP_AND; - end; - if (left.location.loc = LOC_CONSTANT) then - swapleftright; - if (right.location.loc <> LOC_CONSTANT) then - cg.a_op_reg_reg_reg(exprasmlist, cgop, OS_INT, - left.location.register, right.location.register, - location.register) - else - cg.a_op_const_reg_reg(exprasmlist, cgop, OS_INT, - right.location.value, left.location.register, - location.register); - end; - subn: - begin - if (nf_swaped in flags) then - swapleftright; - if left.location.loc <> LOC_CONSTANT then - if right.location.loc <> LOC_CONSTANT then begin - cg.a_op_reg_reg_reg(exprasmlist, OP_SUB, OS_INT, - right.location.register, left.location.register, - location.register); - end else begin - cg.a_op_const_reg_reg(exprasmlist, OP_SUB, OS_INT, - right.location.value, left.location.register, - location.register); - end - else - begin - tmpreg := cg.getintregister(exprasmlist, OS_INT); - cg.a_load_const_reg(exprasmlist, OS_INT, - left.location.value, tmpreg); - cg.a_op_reg_reg_reg(exprasmlist, OP_SUB, OS_INT, - right.location.register, tmpreg, location.register); - end; - end; - ltn, lten, gtn, gten, equaln, unequaln: - begin - emit_compare(unsigned); - end; - end; - end - else - // overflow checking is on and we have an addn, subn or muln - begin - if is_signed(resulttype.def) then - begin - case nodetype of - addn: - op := A_ADDO; - subn: - begin - op := A_SUBO; - if (nf_swaped in flags) then - swapleftright; - end; - muln: - op := A_MULLDO; - else - internalerror(2002072601); - end; - exprasmlist.concat(taicpu.op_reg_reg_reg(op, location.register, - left.location.register, right.location.register)); - cg.g_overflowcheck(exprasmlist, location, resulttype.def); - end - else - begin - case nodetype of - addn: - begin - exprasmlist.concat(taicpu.op_reg_reg_reg(A_ADD, location.register, - left.location.register, right.location.register)); - exprasmlist.concat(taicpu.op_reg_reg(A_CMPLD, location.register, - left.location.register)); - cg.g_overflowcheck(exprasmlist, location, resulttype.def); - end; - subn: - begin - exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUB, location.register, - left.location.register, right.location.register)); - exprasmlist.concat(taicpu.op_reg_reg(A_CMPLD, - left.location.register, location.register)); - cg.g_overflowcheck(exprasmlist, location, resulttype.def); - end; - muln: - begin - { calculate the upper 64 bits of the product, = 0 if no overflow } - cg.a_reg_alloc(exprasmlist, NR_R0); - exprasmlist.concat(taicpu.op_reg_reg_reg(A_MULHDU_, NR_R0, - left.location.register, right.location.register)); - cg.a_reg_dealloc(exprasmlist, NR_R0); - { calculate the real result } - exprasmlist.concat(taicpu.op_reg_reg_reg(A_MULLD, location.register, - left.location.register, right.location.register)); - { g_overflowcheck generates a OC_AE instead of OC_EQ :/ } - objectlibrary.getjumplabel(hl); - tcgppc(cg).a_jmp_cond(exprasmlist, OC_EQ, hl); - cg.a_call_name(exprasmlist, 'FPC_OVERFLOW'); - cg.a_label(exprasmlist, hl); - end; - end; - end; - end; -end; - -begin - caddnode := tppcaddnode; -end. - diff --git a/compiler/powerpc64/nppccal.pas b/compiler/powerpc64/nppccal.pas deleted file mode 100644 index b8f947f158..0000000000 --- a/compiler/powerpc64/nppccal.pas +++ /dev/null @@ -1,51 +0,0 @@ -{ - Copyright (c) 2002 by Florian Klaempfl - - Implements the PowerPC specific part of call nodes - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published bymethodpointer - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit nppccal; - -{$I fpcdefs.inc} - -interface - -uses - symdef, node, ncal, ncgcal; - -type - tppccallnode = class(tcgcallnode) - end; - -implementation - -uses - globtype, systems, - cutils, verbose, globals, - symconst, symbase, symsym, symtable, defutil, paramgr, parabase, - cgbase, pass_2, - cpuinfo, cpubase, aasmbase, aasmtai, aasmcpu, - nmem, nld, ncnv, - ncgutil, cgutils, cgobj, tgobj, regvars, rgobj, rgcpu, - cgcpu, cpupi, procinfo; - - -begin - ccallnode := tppccallnode; -end. - diff --git a/compiler/powerpc64/nppccnv.pas b/compiler/powerpc64/nppccnv.pas deleted file mode 100644 index 7cdcf2a434..0000000000 --- a/compiler/powerpc64/nppccnv.pas +++ /dev/null @@ -1,303 +0,0 @@ -{ - Copyright (c) 1998-2002 by Florian Klaempfl - - Generate PowerPC assembler for type converting nodes - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit nppccnv; - -{$I fpcdefs.inc} - -interface - -uses - node, ncnv, ncgcnv, defcmp; - -type - tppctypeconvnode = class(tcgtypeconvnode) - protected - { procedure second_int_to_int;override; } - { procedure second_string_to_string;override; } - { procedure second_cstring_to_pchar;override; } - { procedure second_string_to_chararray;override; } - { procedure second_array_to_pointer;override; } - function first_int_to_real: tnode; override; - { procedure second_pointer_to_array;override; } - { procedure second_chararray_to_string;override; } - { procedure second_char_to_string;override; } - procedure second_int_to_real; override; - { procedure second_real_to_real; override;} - { procedure second_cord_to_pointer;override; } - { procedure second_proc_to_procvar;override; } - { procedure second_bool_to_int;override; } - procedure second_int_to_bool; override; - { procedure second_load_smallset;override; } - { procedure second_ansistring_to_pchar;override; } - { procedure second_pchar_to_string;override; } - { procedure second_class_to_intf;override; } - { procedure second_char_to_char;override; } - end; - -implementation - -uses - verbose, globtype, globals, systems, - symconst, symdef, aasmbase, aasmtai, - defutil, - cgbase, cgutils, pass_1, pass_2, - ncon, ncal, - ncgutil, - cpubase, aasmcpu, - rgobj, tgobj, cgobj; - -{***************************************************************************** - FirstTypeConv -*****************************************************************************} - -function tppctypeconvnode.first_int_to_real: tnode; -begin - if (is_currency(left.resulttype.def)) then begin - // hack to avoid double division by 10000, as it's - // already done by resulttypepass.resulttype_int_to_real - left.resulttype := s64inttype; - end else begin - // everything that is less than 64 bits is converted to a 64 bit signed - // integer - because the int_to_real conversion is faster for 64 bit - // signed ints compared to 64 bit unsigned ints. - if (not (torddef(left.resulttype.def).typ in [s64bit, u64bit])) then begin - inserttypeconv(left, s64inttype); - end; - end; - firstpass(left); - result := nil; - if registersfpu < 1 then - registersfpu := 1; - expectloc := LOC_FPUREGISTER; -end; - -{***************************************************************************** - SecondTypeConv -*****************************************************************************} - -procedure tppctypeconvnode.second_int_to_real; -const - convconst : double = $100000000; -var - tempconst : trealconstnode; - disp, disp2: treference; - // temp registers for converting signed ints - valuereg, leftreg, - // additional temp registers for converting unsigned 64 bit ints - tmpintreg1, tmpintreg2, tmpfpureg, tmpfpuconst : tregister; - size: tcgsize; - signed: boolean; -begin - - location_reset(location, LOC_FPUREGISTER, def_cgsize(resulttype.def)); - - { the code here comes from the PowerPC Compiler Writer's Guide } - { * longint to double (works for all rounding modes) } - { std R3,disp(R1) # store doubleword } - { lfd FR1,disp(R1) # load float double } - { fcfid FR1,FR1 # convert to floating-point integer } - - { * unsigned 64 bit int to fp value (works for all rounding modes) } - { rldicl rT1,rS,32,32 # isolate high half } - { rldicl rT2,rS,0,32 # isolate low half } - { std rT1,disp(R1) # store high half } - { std rT2,disp+8(R1) # store low half } - { lfd frT1,disp(R1) # load high half } - { lfd frD,disp+8(R1) # load low half } - { fcfid frT1,frT1 # convert each half to floating } - { fcfid frD,frD # point integer (no round) } - { fmadd frD,frC,frT1,frD # (2^32)*high + low } - { # (only add can round) } - tg.Gettemp(exprasmlist, 8, tt_normal, disp); - - { do the signed case for everything but 64 bit unsigned integers } - signed := (left.location.size <> OS_64); - - { we need a certain constant for the conversion of unsigned 64 bit integers, - so create them here. Additonally another temporary location is neeted } - if (not signed) then begin - // allocate temp for constant value used for unsigned 64 bit ints - tempconst := - crealconstnode.create(convconst, pbestrealtype^); - resulttypepass(tempconst); - firstpass(tempconst); - secondpass(tempconst); - if (tempconst.location.loc <> LOC_CREFERENCE) then - internalerror(200110011); - - // allocate second temp memory - tg.Gettemp(exprasmlist, 8, tt_normal, disp2); - end; - - case left.location.loc of - // the conversion algorithm does not modify the input register, so it can - // be used for both LOC_REGISTER and LOC_CREGISTER - LOC_REGISTER, LOC_CREGISTER: - begin - leftreg := left.location.register; - valuereg := leftreg; - end; - LOC_REFERENCE, LOC_CREFERENCE: - begin - leftreg := cg.getintregister(exprasmlist, OS_INT); - valuereg := leftreg; - if signed then - size := OS_S64 - else - size := OS_64; - cg.a_load_ref_reg(exprasmlist, def_cgsize(left.resulttype.def), - size, left.location.reference, leftreg); - end - else - internalerror(200110012); - end; - - if (signed) then begin - // std rS, disp(r1) - cg.a_load_reg_ref(exprasmlist, OS_S64, OS_S64, valuereg, disp); - // lfd frD, disp(r1) - location.register := cg.getfpuregister(exprasmlist,OS_F64); - cg.a_loadfpu_ref_reg(exprasmlist,OS_F64, disp, location.register); - // fcfid frD, frD - exprasmlist.concat(taicpu.op_reg_reg(A_FCFID, location.register, - location.register)); - end else begin - { ts:todo use TOC for this constant or at least schedule better } - // lfd frC, const - tmpfpuconst := cg.getfpuregister(exprasmlist,OS_F64); - cg.a_loadfpu_ref_reg(exprasmlist,OS_F64,tempconst.location.reference, - tmpfpuconst); - tempconst.free; - - tmpintreg1 := cg.getintregister(exprasmlist, OS_64); - // rldicl rT1, rS, 32, 32 - exprasmlist.concat(taicpu.op_reg_reg_const_const(A_RLDICL, tmpintreg1, valuereg, 32, 32)); - // rldicl rT2, rS, 0, 32 - tmpintreg2 := cg.getintregister(exprasmlist, OS_64); - exprasmlist.concat(taicpu.op_reg_reg_const_const(A_RLDICL, tmpintreg2, valuereg, 0, 32)); - - // std rT1, disp(r1) - cg.a_load_reg_ref(exprasmlist, OS_S64, OS_S64, tmpintreg1, disp); - // std rT2, disp2(r1) - cg.a_load_reg_ref(exprasmlist, OS_S64, OS_S64, tmpintreg2, disp2); - - // lfd frT1, disp(R1) - tmpfpureg := cg.getfpuregister(exprasmlist,OS_F64); - cg.a_loadfpu_ref_reg(exprasmlist,OS_F64, disp, tmpfpureg); - // lfd frD, disp+8(R1) - location.register := cg.getfpuregister(exprasmlist,OS_F64); - cg.a_loadfpu_ref_reg(exprasmlist,OS_F64, disp2, location.register); - - // fcfid frT1, frT1 - exprasmlist.concat(taicpu.op_reg_reg(A_FCFID, tmpfpureg, - tmpfpureg)); - // fcfid frD, frD - exprasmlist.concat(taicpu.op_reg_reg(A_FCFID, location.register, - location.register)); - // fmadd frD,frC,frT1,frD # (2^32)*high + low } - exprasmlist.concat(taicpu.op_reg_reg_reg_reg(A_FMADD, location.register, tmpfpuconst, - tmpfpureg, location.register)); - - // free used temps - tg.ungetiftemp(exprasmlist, disp2); - end; - // free reference - tg.ungetiftemp(exprasmlist, disp); - -end; - -procedure tppctypeconvnode.second_int_to_bool; -var - hreg1, - hreg2: tregister; - resflags: tresflags; - opsize: tcgsize; - hlabel, oldtruelabel, oldfalselabel: tasmlabel; -begin - oldtruelabel := truelabel; - oldfalselabel := falselabel; - objectlibrary.getjumplabel(truelabel); - objectlibrary.getjumplabel(falselabel); - secondpass(left); - if codegenerror then - exit; - - { byte(boolean) or word(wordbool) or longint(longbool) must } - { be accepted for var parameters } - if (nf_explicit in flags) and - (left.resulttype.def.size = resulttype.def.size) and - (left.location.loc in [LOC_REFERENCE, LOC_CREFERENCE, LOC_CREGISTER]) then - begin - truelabel := oldtruelabel; - falselabel := oldfalselabel; - location_copy(location, left.location); - exit; - end; - - location_reset(location, LOC_REGISTER, def_cgsize(resulttype.def)); - opsize := def_cgsize(left.resulttype.def); - case left.location.loc of - LOC_CREFERENCE, LOC_REFERENCE, LOC_REGISTER, LOC_CREGISTER: - begin - if left.location.loc in [LOC_CREFERENCE, LOC_REFERENCE] then - begin - hreg1 := cg.getintregister(exprasmlist, OS_INT); - cg.a_load_ref_reg(exprasmlist, opsize, opsize, - left.location.reference, hreg1); - end - else - begin - hreg1 := left.location.register; - end; - hreg2 := cg.getintregister(exprasmlist, OS_INT); - exprasmlist.concat(taicpu.op_reg_reg_const(A_SUBIC, hreg2, hreg1, 1)); - exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBFE, hreg1, hreg2, hreg1)); - end; - LOC_FLAGS: - begin - hreg1 := cg.getintregister(exprasmlist, OS_INT); - resflags := left.location.resflags; - cg.g_flags2reg(exprasmlist, location.size, resflags, hreg1); - end; - LOC_JUMP: - begin - hreg1 := cg.getintregister(exprasmlist, OS_INT); - objectlibrary.getjumplabel(hlabel); - cg.a_label(exprasmlist, truelabel); - cg.a_load_const_reg(exprasmlist, OS_INT, 1, hreg1); - cg.a_jmp_always(exprasmlist, hlabel); - cg.a_label(exprasmlist, falselabel); - cg.a_load_const_reg(exprasmlist, OS_INT, 0, hreg1); - cg.a_label(exprasmlist, hlabel); - end; - else - internalerror(10062); - end; - location.register := hreg1; - truelabel := oldtruelabel; - falselabel := oldfalselabel; -end; - -begin - ctypeconvnode := tppctypeconvnode; -end. - diff --git a/compiler/powerpc64/nppcinl.pas b/compiler/powerpc64/nppcinl.pas deleted file mode 100644 index 1f2809141b..0000000000 --- a/compiler/powerpc64/nppcinl.pas +++ /dev/null @@ -1,151 +0,0 @@ -{ - Copyright (c) 1998-2002 by Florian Klaempfl - - Generate i386 inline nodes - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit nppcinl; - -{$I fpcdefs.inc} - -interface - -uses - node, ninl, ncginl; - -type - tppcinlinenode = class(tcginlinenode) - { first pass override - so that the code generator will actually generate - these nodes. - } - function first_abs_real: tnode; override; - function first_sqr_real: tnode; override; - - { trunc/round/frac?/int can't be inlined? } - - procedure second_abs_real; override; - procedure second_sqr_real; override; - procedure second_prefetch; override; - private - procedure load_fpu_location; - end; - -implementation - -uses - cutils, globals, verbose, - aasmtai, aasmcpu, - symconst, symdef, - defutil, - cgbase, pass_2, - cpubase, ncgutil, - cgutils, cgobj, rgobj; - -{***************************************************************************** - TPPCINLINENODE -*****************************************************************************} - -function tppcinlinenode.first_abs_real: tnode; -begin - expectloc := LOC_FPUREGISTER; - registersint := left.registersint; - registersfpu := max(left.registersfpu, 1); -{$IFDEF SUPPORT_MMX} - registersmmx := left.registersmmx; -{$ENDIF SUPPORT_MMX} - first_abs_real := nil; -end; - -function tppcinlinenode.first_sqr_real: tnode; -begin - expectloc := LOC_FPUREGISTER; - registersint := left.registersint; - registersfpu := max(left.registersfpu, 1); -{$IFDEF SUPPORT_MMX} - registersmmx := left.registersmmx; -{$ENDIF SUPPORT_MMX} - first_sqr_real := nil; -end; - -{ load the FPU into the an fpu register } - -procedure tppcinlinenode.load_fpu_location; -begin - location_reset(location, LOC_FPUREGISTER, def_cgsize(resulttype.def)); - secondpass(left); - location_force_fpureg(exprasmlist, left.location, true); - location_copy(location, left.location); - if (location.loc = LOC_CFPUREGISTER) then - begin - location.loc := LOC_FPUREGISTER; - location.register := cg.getfpuregister(exprasmlist, OS_F64); - end; -end; - -procedure tppcinlinenode.second_abs_real; -begin - location.loc := LOC_FPUREGISTER; - load_fpu_location; - exprasmlist.concat(taicpu.op_reg_reg(A_FABS, location.register, - left.location.register)); -end; - -procedure tppcinlinenode.second_sqr_real; -begin - location.loc := LOC_FPUREGISTER; - load_fpu_location; - exprasmlist.concat(taicpu.op_reg_reg_reg(A_FMUL, location.register, - left.location.register, left.location.register)); -end; - -procedure tppcinlinenode.second_prefetch; -var - r: tregister; -begin - secondpass(left); - case left.location.loc of - LOC_CREFERENCE, - LOC_REFERENCE: - begin - r := cg.getintregister(exprasmlist, OS_ADDR); - if (left.location.reference.offset = 0) and - not assigned(left.location.reference.symbol) then - begin - if (left.location.reference.index = NR_NO) then - exprasmlist.concat(taicpu.op_const_reg(A_DCBT, 0, - left.location.reference.base)) - else - exprasmlist.concat(taicpu.op_reg_reg(A_DCBT, - left.location.reference.base, left.location.reference.index)); - end - else - begin - cg.a_loadaddr_ref_reg(exprasmlist, left.location.reference, r); - exprasmlist.concat(taicpu.op_const_reg(A_DCBT, 0, r)); - end; - end; - else - internalerror(200402021); - end; -end; - -begin - cinlinenode := tppcinlinenode; -end. - diff --git a/compiler/powerpc64/nppcld.pas b/compiler/powerpc64/nppcld.pas deleted file mode 100644 index f60c3c50cf..0000000000 --- a/compiler/powerpc64/nppcld.pas +++ /dev/null @@ -1,62 +0,0 @@ -{ - Copyright (c) 1998-2002 by Florian Klaempfl - - Generate ppc assembler for nodes that handle loads and assignments - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit nppcld; - -{$I fpcdefs.inc} - -interface - -uses - node, ncgld; - -type - tppcloadnode = class(tcgloadnode) - procedure pass_2; override; - procedure generate_picvaraccess; override; - end; - -implementation - -uses - verbose, - systems, - cpubase, - cgutils, cgobj, - aasmbase, aasmtai, - symconst, symsym, - procinfo, - nld; - -procedure tppcloadnode.pass_2; -begin - inherited pass_2; -end; - -procedure tppcloadnode.generate_picvaraccess; -begin - internalerror(200402291); -end; - -begin - cloadnode := tppcloadnode; -end. - diff --git a/compiler/powerpc64/nppcmat.pas b/compiler/powerpc64/nppcmat.pas deleted file mode 100644 index 6da508c230..0000000000 --- a/compiler/powerpc64/nppcmat.pas +++ /dev/null @@ -1,393 +0,0 @@ -{ - Copyright (c) 1998-2002 by Florian Klaempfl - - Generate PowerPC assembler for math nodes - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit nppcmat; - -{$I fpcdefs.inc} - -interface - -uses - node, nmat; - -type - tppcmoddivnode = class(tmoddivnode) - function pass_1: tnode; override; - procedure pass_2; override; - end; - - tppcshlshrnode = class(tshlshrnode) - procedure pass_2; override; - end; - - tppcunaryminusnode = class(tunaryminusnode) - procedure pass_2; override; - end; - - tppcnotnode = class(tnotnode) - procedure pass_2; override; - end; - -implementation - -uses - globtype, systems, - cutils, verbose, globals, - symconst, symdef, - aasmbase, aasmcpu, aasmtai, - defutil, - cgbase, cgutils, cgobj, pass_1, pass_2, - ncon, procinfo, - cpubase, cpuinfo, - ncgutil, cgcpu, rgobj; - -{***************************************************************************** - TPPCMODDIVNODE -*****************************************************************************} - -function tppcmoddivnode.pass_1: tnode; -begin - result := inherited pass_1; - if not assigned(result) then - include(current_procinfo.flags, pi_do_call); -end; - -procedure tppcmoddivnode.pass_2; -const { signed overflow } - divops: array[boolean, boolean] of tasmop = - ((A_DIVDU, A_DIVDU_),(A_DIVD, A_DIVDO_)); - divcgops : array[boolean] of TOpCG = (OP_DIV, OP_IDIV); - zerocond: tasmcond = (dirhint: DH_Plus; simple: true; cond:C_NE; cr: RS_CR7); - tcgsize2native : array[OS_8..OS_S128] of tcgsize = ( - OS_64, OS_64, OS_64, OS_64, OS_NO, - OS_S64, OS_S64, OS_S64, OS_S64, OS_NO - ); -var - power : longint; - op : tasmop; - numerator, divider, - resultreg : tregister; - size : TCgSize; - hl : tasmlabel; - done: boolean; - - procedure genOrdConstNodeMod; - var - modreg, maskreg, tempreg : tregister; - isNegPower : boolean; - begin - if (tordconstnode(right).value = 0) then begin - internalerror(2005061702); - end else if (abs(tordconstnode(right).value) = 1) then begin - { x mod +/-1 is always zero } - cg.a_load_const_reg(exprasmlist, OS_INT, 0, resultreg); - end else if (ispowerof2(tordconstnode(right).value, power)) then begin - if (is_signed(right.resulttype.def)) then begin - tempreg := cg.getintregister(exprasmlist, OS_INT); - maskreg := cg.getintregister(exprasmlist, OS_INT); - modreg := cg.getintregister(exprasmlist, OS_INT); - - cg.a_load_const_reg(exprasmlist, OS_INT, abs(tordconstnode(right).value)-1, modreg); - cg.a_op_const_reg_reg(exprasmlist, OP_SAR, OS_INT, 63, numerator, maskreg); - cg.a_op_reg_reg_reg(exprasmlist, OP_AND, OS_INT, numerator, modreg, tempreg); - - exprasmlist.concat(taicpu.op_reg_reg_reg(A_ANDC, maskreg, maskreg, modreg)); - exprasmlist.concat(taicpu.op_reg_reg_const(A_SUBFIC, modreg, tempreg, 0)); - exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBFE, modreg, modreg, modreg)); - cg.a_op_reg_reg_reg(exprasmlist, OP_AND, OS_INT, modreg, maskreg, maskreg); - cg.a_op_reg_reg_reg(exprasmlist, OP_OR, OS_INT, maskreg, tempreg, resultreg); - end else begin - cg.a_op_const_reg_reg(exprasmlist, OP_AND, OS_INT, tordconstnode(right).value-1, numerator, - resultreg); - end; - end else begin - cg.a_op_const_reg_reg(exprasmlist, divCgOps[is_signed(right.resulttype.def)], OS_INT, - tordconstnode(right).value, numerator, resultreg); - cg.a_op_const_reg_reg(exprasmlist, OP_MUL, OS_INT, tordconstnode(right).value, resultreg, - resultreg); - cg.a_op_reg_reg_reg(exprasmlist, OP_SUB, OS_INT, resultreg, numerator, resultreg); - end; - end; - - -begin - secondpass(left); - secondpass(right); - location_copy(location,left.location); - - { put numerator in register } - size:=def_cgsize(left.resulttype.def); - location_force_reg(exprasmlist,left.location, - size,true); - location_copy(location,left.location); - numerator := location.register; - resultreg := location.register; - if (location.loc = LOC_CREGISTER) then begin - location.loc := LOC_REGISTER; - location.register := cg.getintregister(exprasmlist,size); - resultreg := location.register; - end else if (nodetype = modn) or (right.nodetype = ordconstn) then begin - { for a modulus op, and for const nodes we need the result register - to be an extra register } - resultreg := cg.getintregister(exprasmlist,size); - end; - done := false; - - if (cs_slowoptimize in aktglobalswitches) and (right.nodetype = ordconstn) then begin - if (nodetype = divn) then - cg.a_op_const_reg_reg(exprasmlist, divCgOps[is_signed(right.resulttype.def)], - size, tordconstnode(right).value, numerator, resultreg) - else - genOrdConstNodeMod; - done := true; - end; - - if (not done) then begin - { load divider in a register if necessary } - location_force_reg(exprasmlist,right.location,def_cgsize(right.resulttype.def),true); - if (right.nodetype <> ordconstn) then - exprasmlist.concat(taicpu.op_reg_reg_const(A_CMPDI, NR_CR7, - right.location.register, 0)) - else begin - if (tordconstnode(right).value = 0) then - internalerror(2005100301); - end; - divider := right.location.register; - - { select the correct opcode according to the sign of the result, whether we need - overflow checking } - op := divops[is_signed(right.resulttype.def), cs_check_overflow in aktlocalswitches]; - exprasmlist.concat(taicpu.op_reg_reg_reg(op, resultreg, numerator, - divider)); - - if (nodetype = modn) then begin - { multiply with the divisor again, taking care of the correct size } - exprasmlist.concat(taicpu.op_reg_reg_reg(A_MULLD,resultreg, - divider,resultreg)); - exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUB,location.register, - numerator,resultreg)); - resultreg := location.register; - end; - end; - { set result location } - location.loc:=LOC_REGISTER; - location.register:=resultreg; - if right.nodetype <> ordconstn then begin - objectlibrary.getjumplabel(hl); - exprasmlist.concat(taicpu.op_cond_sym(A_BC,zerocond,hl)); - cg.a_call_name(exprasmlist,'FPC_DIVBYZERO'); - cg.a_label(exprasmlist,hl); - end; - { unsigned division/module can only overflow in case of division by zero - (but checking this overflow flag is more convoluted than performing a - simple comparison with 0) } - if is_signed(right.resulttype.def) then - cg.g_overflowcheck(exprasmlist,location,resulttype.def); -end; - -{***************************************************************************** - TPPCSHLRSHRNODE -*****************************************************************************} - -procedure tppcshlshrnode.pass_2; - -var - resultreg, hregister1, hregister2 : tregister; - - op: topcg; - asmop1, asmop2: tasmop; - shiftval: aint; - -begin - secondpass(left); - secondpass(right); - - { load left operators in a register } - location_force_reg(exprasmlist, left.location, - def_cgsize(left.resulttype.def), true); - location_copy(location, left.location); - resultreg := location.register; - hregister1 := location.register; - if (location.loc = LOC_CREGISTER) then begin - location.loc := LOC_REGISTER; - resultreg := cg.getintregister(exprasmlist, OS_INT); - location.register := resultreg; - end; - - { determine operator } - if nodetype = shln then - op := OP_SHL - else - op := OP_SHR; - - { shifting by a constant directly coded: } - if (right.nodetype = ordconstn) then begin - // result types with size < 32 bits have their shift values masked - // differently... :/ - shiftval := tordconstnode(right).value and (tcgsize2size[def_cgsize(resulttype.def)] * 8 -1); - cg.a_op_const_reg_reg(exprasmlist, op, def_cgsize(resulttype.def), - shiftval, hregister1, resultreg) - end else begin - { load shift count in a register if necessary } - location_force_reg(exprasmlist, right.location, - def_cgsize(right.resulttype.def), true); - hregister2 := right.location.register; - cg.a_op_reg_reg_reg(exprasmlist, op, def_cgsize(resulttype.def), hregister2, - hregister1, resultreg); - end; -end; - -{***************************************************************************** - TPPCUNARYMINUSNODE -*****************************************************************************} - -procedure tppcunaryminusnode.pass_2; - -var - src1: tregister; - op: tasmop; - -begin - secondpass(left); - begin - location_copy(location, left.location); - location.loc := LOC_REGISTER; - case left.location.loc of - LOC_FPUREGISTER, LOC_REGISTER: - begin - src1 := left.location.register; - location.register := src1; - end; - LOC_CFPUREGISTER, LOC_CREGISTER: - begin - src1 := left.location.register; - if left.location.loc = LOC_CREGISTER then - location.register := cg.getintregister(exprasmlist, OS_INT) - else - location.register := cg.getfpuregister(exprasmlist, location.size); - end; - LOC_REFERENCE, LOC_CREFERENCE: - begin - if (left.resulttype.def.deftype = floatdef) then begin - src1 := cg.getfpuregister(exprasmlist, - def_cgsize(left.resulttype.def)); - location.register := src1; - cg.a_loadfpu_ref_reg(exprasmlist, - def_cgsize(left.resulttype.def), - left.location.reference, src1); - end else begin - src1 := cg.getintregister(exprasmlist, OS_64); - location.register := src1; - cg.a_load_ref_reg(exprasmlist, OS_64, OS_64, - left.location.reference, src1); - end; - end; - end; - { choose appropriate operand } - if left.resulttype.def.deftype <> floatdef then begin - if not (cs_check_overflow in aktlocalswitches) then - op := A_NEG - else - op := A_NEGO_; - location.loc := LOC_REGISTER; - end else begin - op := A_FNEG; - location.loc := LOC_FPUREGISTER; - end; - { emit operation } - exprasmlist.concat(taicpu.op_reg_reg(op, location.register, src1)); - end; - cg.g_overflowcheck(exprasmlist, location, resulttype.def); -end; - -{***************************************************************************** - TPPCNOTNODE -*****************************************************************************} - -procedure tppcnotnode.pass_2; - -var - hl: tasmlabel; - -begin - if is_boolean(resulttype.def) then - begin - { if the location is LOC_JUMP, we do the secondpass after the - labels are allocated - } - if left.expectloc = LOC_JUMP then - begin - hl := truelabel; - truelabel := falselabel; - falselabel := hl; - secondpass(left); - maketojumpbool(exprasmlist, left, lr_load_regvars); - hl := truelabel; - truelabel := falselabel; - falselabel := hl; - location.loc := LOC_JUMP; - end - else - begin - secondpass(left); - case left.location.loc of - LOC_FLAGS: - begin - location_copy(location, left.location); - inverse_flags(location.resflags); - end; - LOC_REGISTER, LOC_CREGISTER, LOC_REFERENCE, LOC_CREFERENCE: - begin - location_force_reg(exprasmlist, left.location, - def_cgsize(left.resulttype.def), true); - exprasmlist.concat(taicpu.op_reg_const(A_CMPDI, - left.location.register, 0)); - location_reset(location, LOC_FLAGS, OS_NO); - location.resflags.cr := RS_CR0; - location.resflags.flag := F_EQ; - end; - else - internalerror(2003042401); - end; - end; - end - else - begin - secondpass(left); - location_force_reg(exprasmlist, left.location, - def_cgsize(left.resulttype.def), true); - location_copy(location, left.location); - location.loc := LOC_REGISTER; - location.register := cg.getintregister(exprasmlist, OS_INT); - { perform the NOT operation } - cg.a_op_reg_reg(exprasmlist, OP_NOT, def_cgsize(resulttype.def), - left.location.register, - location.register); - end; -end; - -begin - cmoddivnode := tppcmoddivnode; - cshlshrnode := tppcshlshrnode; - cunaryminusnode := tppcunaryminusnode; - cnotnode := tppcnotnode; -end. - diff --git a/compiler/powerpc64/nppcset.pas b/compiler/powerpc64/nppcset.pas deleted file mode 100644 index 97fdb837ba..0000000000 --- a/compiler/powerpc64/nppcset.pas +++ /dev/null @@ -1,209 +0,0 @@ -{ - Copyright (c) 1998-2002 by Florian Klaempfl and Carl Eric Codere - - Generate PowerPC assembler for in set/case nodes - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit nppcset; - -{$I fpcdefs.inc} - -interface - -uses - node, nset, ncgset, cpubase, cgbase, cgobj, aasmbase, aasmtai, globtype; - -type - - tppccasenode = class(tcgcasenode) - protected - procedure optimizevalues(var max_linear_list : aint; var max_dist : aword); override; - - function has_jumptable : boolean; override; - procedure genjumptable(hp: pcaselabel; min_, max_ : aint); override; - procedure genlinearlist(hp: pcaselabel); override; - end; - -implementation - -uses - systems, - verbose, globals, - symconst, symdef, defutil, - paramgr, - cpuinfo, - pass_2, cgcpu, - ncon, - tgobj, ncgutil, regvars, rgobj, aasmcpu, - procinfo, cgutils; - -{***************************************************************************** - TCGCASENODE -*****************************************************************************} - -procedure tppccasenode.optimizevalues(var max_linear_list : aint; var max_dist : aword); -begin - max_linear_list := 10; -end; - -function tppccasenode.has_jumptable : boolean; -begin - has_jumptable := true; -end; - -procedure tppccasenode.genjumptable(hp : pcaselabel; min_, max_ : aint); -var - table : tasmlabel; - last : TConstExprInt; - indexreg : tregister; - href : treference; - - procedure genitem(list:taasmoutput;t : pcaselabel); - var - i : aint; - begin - if assigned(t^.less) then - genitem(list,t^.less); - { fill possible hole } - for i:=last+1 to t^._low-1 do - list.concat(Tai_const.Create_sym(elselabel)); - for i:=t^._low to t^._high do - list.concat(Tai_const.Create_sym(blocklabel(t^.blockid))); - last:=t^._high; - if assigned(t^.greater) then - genitem(list,t^.greater); - end; - -begin - { this is exactly the same code as for 32 bit PowerPC processors. It might be useful to change this - later (with e.g. TOC support) into a method which uses relative values in the jumptable to save space - and memory bandwidth. At the moment this is not a good idea, since these methods involve loading of - one or more 64 bit integer adresses which is slow } - if not(jumptable_no_range) then begin - { case expr less than min_ => goto elselabel } - cg.a_cmp_const_reg_label(exprasmlist,opsize,jmp_lt,aint(min_),hregister,elselabel); - { case expr greater than max_ => goto elselabel } - cg.a_cmp_const_reg_label(exprasmlist,opsize,jmp_gt,aint(max_),hregister,elselabel); - end; - objectlibrary.getjumplabel(table); - { allocate base and index registers register } - indexreg:= cg.makeregsize(exprasmlist, hregister, OS_INT); - { indexreg := hregister; } - cg.a_load_reg_reg(exprasmlist, opsize, OS_INT, hregister, indexreg); - { create reference, indexreg := indexreg * sizeof(OS_ADDR) } - cg.a_op_const_reg(exprasmlist, OP_MUL, OS_INT, tcgsize2size[OS_ADDR], indexreg); - reference_reset_symbol(href, table, (-aint(min_)) * tcgsize2size[OS_ADDR]); - href.index := indexreg; - - cg.a_load_ref_reg(exprasmlist, OS_INT, OS_INT, href, indexreg); - - exprasmlist.concat(taicpu.op_reg(A_MTCTR, indexreg)); - exprasmlist.concat(taicpu.op_none(A_BCTR)); - - { generate jump table } - new_section(current_procinfo.aktlocaldata,sec_data,current_procinfo.procdef.mangledname,sizeof(aint)); - current_procinfo.aktlocaldata.concat(Tai_label.Create(table)); - last:=min_; - genitem(current_procinfo.aktlocaldata,hp); -end; - -procedure tppccasenode.genlinearlist(hp: pcaselabel); -var - first, lastrange: boolean; - last: TConstExprInt; - - procedure genitem(t: pcaselabel); - - procedure gensub(value: aint); - var - tmpreg: tregister; - begin - value := -value; - if (value >= low(smallint)) and - (value <= high(smallint)) then - exprasmlist.concat(taicpu.op_reg_reg_const(A_ADDIC_, hregister, - hregister, value)) - else - begin - tmpreg := cg.getintregister(exprasmlist, OS_INT); - cg.a_load_const_reg(exprasmlist, OS_INT, value, tmpreg); - exprasmlist.concat(taicpu.op_reg_reg_reg(A_ADD_, hregister, - hregister, tmpreg)); - end; - end; - - begin - if assigned(t^.less) then - genitem(t^.less); - { need we to test the first value } - if first and (t^._low > get_min_value(left.resulttype.def)) then begin - cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_lt, aword(t^._low), - hregister, elselabel); - end; - if t^._low = t^._high then begin - if t^._low - last = 0 then - cg.a_cmp_const_reg_label(exprasmlist, opsize, OC_EQ, 0, hregister, - blocklabel(t^.blockid)) - else - gensub(aint(t^._low - last)); - tcgppc(cg).a_jmp_cond(exprasmlist, OC_EQ, blocklabel(t^.blockid)); - last := t^._low; - lastrange := false; - end else begin - { it begins with the smallest label, if the value } - { is even smaller then jump immediately to the } - { ELSE-label } - if first then begin - { have we to ajust the first value ? } - if (t^._low > get_min_value(left.resulttype.def)) then - gensub(aint(t^._low)); - end else begin - { if there is no unused label between the last and the } - { present label then the lower limit can be checked } - { immediately. else check the range in between: } - gensub(aint(t^._low - last)); - if ((t^._low - last) <> 1) or (not lastrange) then - tcgppc(cg).a_jmp_cond(exprasmlist, jmp_lt, elselabel); - end; - gensub(aint(t^._high - t^._low)); - tcgppc(cg).a_jmp_cond(exprasmlist, jmp_le, blocklabel(t^.blockid)); - last := t^._high; - lastrange := true; - end; - first := false; - if assigned(t^.greater) then - genitem(t^.greater); - end; - -begin - { do we need to generate cmps? } - if (with_sign and (min_label < 0)) or (opsize = OS_32) then - genlinearcmplist(hp) - else begin - last := 0; - lastrange := false; - first := true; - genitem(hp); - cg.a_jmp_always(exprasmlist, elselabel); - end; -end; - -begin - ccasenode := tppccasenode; -end. - diff --git a/compiler/powerpc64/ppcins.dat b/compiler/powerpc64/ppcins.dat deleted file mode 100644 index 708b1f8c0d..0000000000 --- a/compiler/powerpc64/ppcins.dat +++ /dev/null @@ -1,75 +0,0 @@ -;**************************************************************************** -; -; Copyright (c) 2002 by Florian Klaempfl -; -; Instruction template table for the PowerPC -; -; This program is free software; you can redistribute it and/or modify -; it under the terms of the GNU General Public License as published by -; the Free Software Foundation; either version 2 of the License, or -; (at your option) any later version. -; -; This program is distributed in the hope that it will be useful, -; but WITHOUT ANY WARRANTY; without even the implied warranty of -; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -; GNU General Public License for more details. -; -; You should have received a copy of the GNU General Public License -; along with this program; if not, write to the Free Software -; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -; -;**************************************************************************** -; -add rD,rA,rB opcode=31,op22=266,oe=0,rc=0 -add_ rD,rA,rB opcode=31,op22=266,oe=0,rc=1 -addo rD,rA,rB opcode=31,op22=266,oe=1,rc=0 -addo_ rD,rA,rB opcode=31,op22=266,oe=1,rc=1 -addc rD,rA,rB opcode=31,op22=10,oe=0,rc=0 -addc_ rD,rA,rB opcode=31,op22=10,oe=0,rc=1 -addco rD,rA,rB opcode=31,op22=10,oe=1,rc=0 -addco_ rD,rA,rB opcode=31,op22=10,oe=1,rc=1 -adde rD,rA,rB opcode=31,op22=138,oe=0,rc=0 -adde_ rD,rA,rB opcode=31,op22=138,oe=0,rc=1 -addeo rD,rA,rB opcode=31,op22=138,oe=1,rc=0 -addeo_ rD,rA,rB opcode=31,op22=138,oe=1,rc=1 -addi rD,rA,SIMM opcode=14 -addic rD,rA,SIMM opcode=12 -addic_ rD,rA,SIMM opcode=13 -addis rD,rA,SIMM opcode=15 -addme rD,rA opcode=31,op22=234,oe=0,rc=0,reserved=$000f0000 -addme_ rD,rA opcode=31,op22=234,oe=0,rc=1,reserved=$000f0000 -addmeo rD,rA opcode=31,op22=234,oe=1,rc=0,reserved=$000f0000 -addmeo_ rD,rA opcode=31,op22=234,oe=1,rc=1,reserved=$000f0000 -addze rD,rA opcode=31,op22=202,oe=0,rc=0,reserved=$000f0000 -addze_ rD,rA opcode=31,op22=202,oe=0,rc=1,reserved=$000f0000 -addzeo rD,rA opcode=31,op22=202,oe=1,rc=0,reserved=$000f0000 -addzeo_ rD,rA opcode=31,op22=202,oe=1,rc=1,reserved=$000f0000 -and rA,rS,rB opcode=31,op21=28,rc=0 -and_ rA,rS,rB opcode=31,op21=28,rc=1 -andc rA,rS,rB opcode=31,op21=60,rc=0 -andc_ rA,rS,rB opcode=31,op21=60,rc=1 -andi_ rA,rS,UIMM opcode=28 -andis_ rA,rS,UIMM opcode=29 -b TA24 opcode=18,aa=0,lk=0 -ba TA24 opcode=18,aa=1,lk=0 -bl TA24 opcode=18,aa=0,lk=1 -bla TA24 opcode=18,aa=1,lk=1 -bc BO,BI,TA14 opcode=16,aa=0,lk=0 -bca BO,BI,TA14 opcode=16,aa=1,lk=0 -bcl BO,BI,TA14 opcode=16,aa=0,lk=1 -bcla BO,BI,TA14 opcode=16,aa=1,lk=1 -bcctr BO,BI opcode=19,op21=528,lk=0,reserved=$000f0000 -bcctrl BO,BI opcode=19,op21=528,lk=1,reserved=$000f0000 -bcltr BO,BI opcode=19,op21=16,lk=0,reserved=$000f0000 -bcltrl BO,BI opcode=19,op21=16,lk=1,reserved=$000f0000 -cmp crfD,L,rA,rB opcode=31,op21=0,reserved=$80000200 -cmpi crfD,L,rA,SIMM opcode=11,reserved=$00000200 -cmpl crfD,L,rA,rB opcode=31,op21=32,reserved=$80000200 -cmpli crfD,L,rA,UIMM opcode=10,reserved=$00000200 - -; - -; Revision 1.1 2002/07/13 21:50:34 florian -; + initial version, a lot of instructions need to be added -; -; diff --git a/compiler/powerpc64/ppcreg.dat b/compiler/powerpc64/ppcreg.dat deleted file mode 100644 index aaf0542621..0000000000 --- a/compiler/powerpc64/ppcreg.dat +++ /dev/null @@ -1,143 +0,0 @@ -; -; -; PowerPC registers -; -; layout -; <name>,<value>,<stdname>,<gasname>,<gasshortname>,<motname>,<stabidx> -; -NO,$00,$00,INVALID,INVALID,INVALID,INVALID,-1,-1 - -R0,$01,$00,r0,r0,0,r0,0,0 -R1,$01,$01,r1,r1,1,r1,1,1 -R2,$01,$02,r2,r2,2,r2,2,2 -R3,$01,$03,r3,r3,3,r3,3,3 -R4,$01,$04,r4,r4,4,r4,4,4 -R5,$01,$05,r5,r5,5,r5,5,5 -R6,$01,$06,r6,r6,6,r6,6,6 -R7,$01,$07,r7,r7,7,r7,7,7 -R8,$01,$08,r8,r8,8,r8,8,8 -R9,$01,$09,r9,r9,9,r9,9,9 -R10,$01,$0a,r10,r10,10,r10,10,10 -R11,$01,$0b,r11,r11,11,r11,11,11 -R12,$01,$0c,r12,r12,12,r12,12,12 -R13,$01,$0d,r13,r13,13,r13,13,13 -R14,$01,$0e,r14,r14,14,r14,14,14 -R15,$01,$0f,r15,r15,15,r15,15,15 -R16,$01,$10,r16,r16,16,r16,16,16 -R17,$01,$11,r17,r17,17,r17,17,17 -R18,$01,$12,r18,r18,18,r18,18,18 -R19,$01,$13,r19,r19,19,r19,19,19 -R20,$01,$14,r20,r20,20,r20,20,20 -R21,$01,$15,r21,r21,21,r21,21,21 -R22,$01,$16,r22,r22,22,r22,22,22 -R23,$01,$17,r23,r23,23,r23,23,23 -R24,$01,$18,r24,r24,24,r24,24,24 -R25,$01,$19,r25,r25,25,r25,25,25 -R26,$01,$1a,r26,r26,26,r26,26,26 -R27,$01,$1b,r27,r27,27,r27,27,27 -R28,$01,$1c,r28,r28,28,r28,28,28 -R29,$01,$1d,r29,r29,29,r29,29,29 -R30,$01,$1e,r30,r30,30,r30,30,30 -R31,$01,$1f,r31,r31,31,r31,31,31 - -F0,$02,$00,F0,f0,0,F0,32,32 -F1,$02,$01,F1,f1,1,F1,33,33 -F2,$02,$02,F2,f2,2,F2,34,34 -F3,$02,$03,F3,f3,3,F3,35,35 -F4,$02,$04,F4,f4,4,F4,36,36 -F5,$02,$05,F5,f5,5,F5,37,37 -F6,$02,$06,F6,f6,6,F6,38,38 -F7,$02,$07,F7,f7,7,F7,39,39 -F8,$02,$08,F8,f8,8,F8,40,40 -F9,$02,$09,F9,f9,9,F9,41,41 -F10,$02,$0a,F10,f10,10,F10,42,42 -F11,$02,$0b,F11,f11,11,F11,43,43 -F12,$02,$0c,F12,f12,12,F12,44,44 -F13,$02,$0d,F13,f13,13,F13,45,45 -F14,$02,$0e,F14,f14,14,F14,46,46 -F15,$02,$0f,F15,f15,15,F15,47,47 -F16,$02,$10,F16,f16,16,F16,48,48 -F17,$02,$11,F17,f17,17,F17,49,49 -F18,$02,$12,F18,f18,18,F18,50,50 -F19,$02,$13,F19,f19,19,F19,51,51 -F20,$02,$14,F20,f20,20,F20,52,52 -F21,$02,$15,F21,f21,21,F21,53,53 -F22,$02,$16,F22,f22,22,F22,54,54 -F23,$02,$17,F23,f23,23,F23,55,55 -F24,$02,$18,F24,f24,24,F24,56,56 -F25,$02,$19,F25,f25,25,F25,57,57 -F26,$02,$1a,F26,f26,26,F26,58,58 -F27,$02,$1b,F27,f27,27,F27,59,59 -F28,$02,$1c,F28,f28,28,F28,60,60 -F29,$02,$1d,F29,f29,29,F29,61,61 -F30,$02,$1e,F30,f30,30,F30,62,62 -F31,$02,$1f,F31,f31,31,F31,63,63 - -M0,$03,$00,M0,v0,0,M0,-1,-1 -M1,$03,$01,M1,v1,1,M1,-1,-1 -M2,$03,$02,M2,v2,2,M2,-1,-1 -M3,$03,$03,M3,v3,3,M3,-1,-1 -M4,$03,$04,M4,v4,4,M4,-1,-1 -M5,$03,$05,M5,v5,5,M5,-1,-1 -M6,$03,$06,M6,v6,6,M6,-1,-1 -M7,$03,$07,M7,v7,7,M7,-1,-1 -M8,$03,$08,M8,v8,8,M8,-1,-1 -M9,$03,$09,M9,v9,9,M9,-1,-1 -M10,$03,$0a,M10,v10,10,M10,-1,-1 -M11,$03,$0b,M11,v11,11,M11,-1,-1 -M12,$03,$0c,M12,v12,12,M12,-1,-1 -M13,$03,$0d,M13,v13,13,M13,-1,-1 -M14,$03,$0e,M14,v14,14,M14,-1,-1 -M15,$03,$0f,M15,v15,15,M15,-1,-1 -M16,$03,$10,M16,v16,16,M16,-1,-1 -M17,$03,$11,M17,v17,17,M17,-1,-1 -M18,$03,$12,M18,v18,18,M18,-1,-1 -M19,$03,$13,M19,v19,19,M19,-1,-1 -M20,$03,$14,M20,v20,20,M20,-1,-1 -M21,$03,$15,M21,v21,21,M21,-1,-1 -M22,$03,$16,M22,v22,22,M22,-1,-1 -M23,$03,$17,M23,v23,23,M23,-1,-1 -M24,$03,$18,M24,v24,24,M24,-1,-1 -M25,$03,$19,M25,v25,25,M25,-1,-1 -M26,$03,$1a,M26,v26,26,M26,-1,-1 -M27,$03,$1b,M27,v27,27,M27,-1,-1 -M28,$03,$1c,M28,v28,28,M28,-1,-1 -M29,$03,$1d,M29,v29,29,M29,-1,-1 -M30,$03,$1e,M30,v30,30,M30,-1,-1 -M31,$03,$1f,M31,v31,31,M31,-1,-1 - -CR,$05,$00,CR,cr,cr,CR,-1,-1 -CR0,$05,$01,CR0,cr0,cr0,CR0,68,68 -CR1,$05,$02,CR1,cr1,cr1,CR1,69,69 -CR2,$05,$03,CR2,cr2,cr2,CR2,70,70 -CR3,$05,$04,CR3,cr3,cr3,CR3,71,71 -CR4,$05,$05,CR4,cr4,cr4,CR4,72,72 -CR5,$05,$06,CR5,cr5,cr5,CR5,73,73 -CR6,$05,$07,CR6,cr6,cr5,CR6,74,74 -CR7,$05,$08,CR7,cr7,cr6,CR7,75,75 -XER,$05,$09,XER,xer,xer,XER,76,76 -LR,$05,$0a,LR,lr,lr,LR,65,65 -CTR,$05,$0b,CTR,ctr,ctr,CTR,66,66 -FPSCR,$05,$0c,FPSCR,fpscr,fpscr,FPSCR,-1,-1 - -; - -; Revision 1.6 2004/06/17 16:55:46 peter -; * powerpc compiles again -; -; Revision 1.5 2003/12/10 22:19:27 florian -; + short gas register names for smartlinking added -; -; Revision 1.4 2003/09/04 21:07:03 florian -; * ARM compiler compiles again -; -; Revision 1.3 2003/09/03 19:35:24 peter -; * powerpc compiles again -; -; Revision 1.2 2003/09/03 15:55:01 peter -; * NEWRA branch merged -; -; Revision 1.1.2.1 2003/09/02 20:48:22 peter -; * powerpc registers -; -; diff --git a/compiler/powerpc64/rappc.pas b/compiler/powerpc64/rappc.pas deleted file mode 100644 index 4b16f7055d..0000000000 --- a/compiler/powerpc64/rappc.pas +++ /dev/null @@ -1,42 +0,0 @@ -{ - Copyright (c) 1998-2003 by Carl Eric Codere and Peter Vreman - - Handles the common ppc assembler reader routines - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit rappc; - -{$I fpcdefs.inc} - -interface - -uses - aasmbase, aasmtai, aasmcpu, - cpubase, rautils, cclasses; - -type - TPPCOperand = class(TOperand) - end; - - TPPCInstruction = class(TInstruction) - end; - -implementation - -end. - diff --git a/compiler/powerpc64/rappcgas.pas b/compiler/powerpc64/rappcgas.pas deleted file mode 100644 index 941496f392..0000000000 --- a/compiler/powerpc64/rappcgas.pas +++ /dev/null @@ -1,731 +0,0 @@ -{ - $Id: rappcgas.pas,v 1.19 2005/02/14 17:13:10 peter Exp $ - Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman - - Does the parsing for the PowerPC GNU AS styled inline assembler. - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit rappcgas; - -{$I fpcdefs.inc} - -interface - -uses - raatt, rappc; - -type - tppcattreader = class(tattreader) - function is_asmopcode(const s: string): boolean; override; - procedure handleopcode; override; - procedure BuildReference(oper: tppcoperand); - procedure BuildOperand(oper: tppcoperand); - procedure BuildOpCode(instr: tppcinstruction); - procedure ReadAt(oper: tppcoperand); - procedure ReadSym(oper: tppcoperand); - procedure ConvertCalljmp(instr: tppcinstruction); - end; - -implementation - -uses - { helpers } - cutils, - { global } - globtype, verbose, - systems, - { aasm } - cpubase, aasmbase, aasmtai, aasmcpu, - { symtable } - symconst, symsym, - { parser } - procinfo, - rabase, rautils, - cgbase, cgobj - ; - -procedure tppcattreader.ReadSym(oper: tppcoperand); -var - tempstr: string; - typesize, l, k: aint; -begin - tempstr := actasmpattern; - Consume(AS_ID); - { typecasting? } - if (actasmtoken = AS_LPAREN) and - SearchType(tempstr, typesize) then - begin - oper.hastype := true; - Consume(AS_LPAREN); - BuildOperand(oper); - Consume(AS_RPAREN); - if oper.opr.typ in [OPR_REFERENCE, OPR_LOCAL] then - oper.SetSize(typesize, true); - end - else if not oper.SetupVar(tempstr, false) then - Message1(sym_e_unknown_id, tempstr); - { record.field ? } - if actasmtoken = AS_DOT then - begin - BuildRecordOffsetSize(tempstr, l, k); - inc(oper.opr.ref.offset, l); - end; -end; - -procedure tppcattreader.ReadAt(oper: tppcoperand); -begin - { check for ...@ } - if actasmtoken = AS_AT then - begin - if (oper.opr.ref.symbol = nil) and - (oper.opr.ref.offset = 0) then - Message(asmr_e_invalid_reference_syntax); - Consume(AS_AT); - if actasmtoken = AS_ID then - begin - if upper(actasmpattern) = 'L' then - oper.opr.ref.refaddr := addr_low - else if upper(actasmpattern) = 'HA' then - oper.opr.ref.refaddr := addr_higha - else if upper(actasmpattern) = 'H' then - oper.opr.ref.refaddr := addr_high - else if upper(actasmpattern) = 'HIGHERA' then - oper.opr.ref.refaddr := addr_highera - else if upper(actasmpattern) = 'HIGHESTA' then - oper.opr.ref.refaddr := addr_highesta - else if upper(actasmpattern) = 'HIGHER' then - oper.opr.ref.refaddr := addr_higher - else if upper(actasmpattern) = 'HIGHEST' then - oper.opr.ref.refaddr := addr_highest - else - Message(asmr_e_invalid_reference_syntax); - Consume(AS_ID); - end - else - Message(asmr_e_invalid_reference_syntax); - end; -end; - -procedure tppcattreader.BuildReference(oper: tppcoperand); - - procedure Consume_RParen; - begin - if actasmtoken <> AS_RPAREN then - begin - Message(asmr_e_invalid_reference_syntax); - RecoverConsume(true); - end - else - begin - Consume(AS_RPAREN); - if not (actasmtoken in [AS_COMMA, AS_SEPARATOR, AS_END]) then - begin - Message(asmr_e_invalid_reference_syntax); - RecoverConsume(true); - end; - end; - end; - -var - l: aint; - -begin - Consume(AS_LPAREN); - case actasmtoken of - AS_INTNUM, - AS_MINUS, - AS_PLUS: - begin - { offset(offset) is invalid } - if oper.opr.Ref.Offset <> 0 then - begin - Message(asmr_e_invalid_reference_syntax); - RecoverConsume(true); - end - else - begin - oper.opr.Ref.Offset := BuildConstExpression(false, true); - Consume(AS_RPAREN); - if actasmtoken = AS_AT then - ReadAt(oper); - end; - exit; - end; - AS_REGISTER: { (reg ... } - begin - if ((oper.opr.typ = OPR_REFERENCE) and (oper.opr.ref.base <> NR_NO)) or - ((oper.opr.typ = OPR_LOCAL) and (oper.opr.localsym.localloc.loc <> - LOC_REGISTER)) then - message(asmr_e_cannot_index_relative_var); - oper.opr.ref.base := actasmregister; - Consume(AS_REGISTER); - { can either be a register or a right parenthesis } - { (reg) } - if actasmtoken = AS_RPAREN then - begin - Consume_RParen; - exit; - end; - { (reg,reg .. } - Consume(AS_COMMA); - if (actasmtoken = AS_REGISTER) and - (oper.opr.Ref.Offset = 0) then - begin - oper.opr.ref.index := actasmregister; - Consume(AS_REGISTER); - Consume_RParen; - end - else - begin - Message(asmr_e_invalid_reference_syntax); - RecoverConsume(false); - end; - end; {end case } - AS_ID: - begin - ReadSym(oper); - { add a constant expression? } - if (actasmtoken = AS_PLUS) then - begin - l := BuildConstExpression(true, true); - case oper.opr.typ of - OPR_CONSTANT: - inc(oper.opr.val, l); - OPR_LOCAL: - inc(oper.opr.localsymofs, l); - OPR_REFERENCE: - inc(oper.opr.ref.offset, l); - else - internalerror(200309202); - end; - end; - Consume(AS_RPAREN); - if actasmtoken = AS_AT then - ReadAt(oper); - end; - AS_COMMA: { (, ... can either be scaling, or index } - begin - Consume(AS_COMMA); - { Index } - if (actasmtoken = AS_REGISTER) then - begin - oper.opr.ref.index := actasmregister; - Consume(AS_REGISTER); - { check for scaling ... } - Consume_RParen; - end - else - begin - Message(asmr_e_invalid_reference_syntax); - RecoverConsume(false); - end; - end; - else - begin - Message(asmr_e_invalid_reference_syntax); - RecoverConsume(false); - end; - end; -end; - -procedure tppcattreader.BuildOperand(oper: tppcoperand); -var - expr: string; - typesize, l: aint; - - procedure AddLabelOperand(hl: tasmlabel); - begin - if not (actasmtoken in [AS_PLUS, AS_MINUS, AS_LPAREN]) and - is_calljmp(actopcode) then - begin - oper.opr.typ := OPR_SYMBOL; - oper.opr.symbol := hl; - end - else - begin - oper.InitRef; - oper.opr.ref.symbol := hl; - end; - end; - - procedure MaybeRecordOffset; - var - hasdot: boolean; - l, - toffset, - tsize: aint; - begin - if not (actasmtoken in [AS_DOT, AS_PLUS, AS_MINUS]) then - exit; - l := 0; - hasdot := (actasmtoken = AS_DOT); - if hasdot then - begin - if expr <> '' then - begin - BuildRecordOffsetSize(expr, toffset, tsize); - inc(l, toffset); - oper.SetSize(tsize, true); - end; - end; - if actasmtoken in [AS_PLUS, AS_MINUS] then - inc(l, BuildConstExpression(true, false)); - case oper.opr.typ of - OPR_LOCAL: - begin - { don't allow direct access to fields of parameters, because that - will generate buggy code. Allow it only for explicit typecasting } - if hasdot and - (not oper.hastype) and - (tabstractvarsym(oper.opr.localsym).owner.symtabletype = - parasymtable) and - (current_procinfo.procdef.proccalloption <> pocall_register) then - Message(asmr_e_cannot_access_field_directly_for_parameters); - inc(oper.opr.localsymofs, l) - end; - OPR_CONSTANT: - inc(oper.opr.val, l); - OPR_REFERENCE: - inc(oper.opr.ref.offset, l); - else - internalerror(200309221); - end; - end; - - function MaybeBuildReference: boolean; - { Try to create a reference, if not a reference is found then false - is returned } - begin - MaybeBuildReference := true; - case actasmtoken of - AS_INTNUM, - AS_MINUS, - AS_PLUS: - begin - oper.opr.ref.offset := BuildConstExpression(True, False); - if actasmtoken <> AS_LPAREN then - Message(asmr_e_invalid_reference_syntax) - else - BuildReference(oper); - end; - AS_LPAREN: - BuildReference(oper); - AS_ID: { only a variable is allowed ... } - begin - ReadSym(oper); - case actasmtoken of - AS_END, - AS_SEPARATOR, - AS_COMMA: ; - AS_LPAREN: - BuildReference(oper); - else - begin - Message(asmr_e_invalid_reference_syntax); - Consume(actasmtoken); - end; - end; {end case } - end; - else - MaybeBuildReference := false; - end; { end case } - end; - -var - tempreg: tregister; - hl: tasmlabel; - ofs: aint; -begin - expr := ''; - case actasmtoken of - AS_LPAREN: { Memory reference or constant expression } - begin - oper.InitRef; - BuildReference(oper); - end; - - AS_INTNUM, - AS_MINUS, - AS_PLUS: - begin - { Constant memory offset } - { This must absolutely be followed by ( } - oper.InitRef; - oper.opr.ref.offset := BuildConstExpression(True, False); - if actasmtoken <> AS_LPAREN then - begin - ofs := oper.opr.ref.offset; - BuildConstantOperand(oper); - inc(oper.opr.val, ofs); - end - else - BuildReference(oper); - end; - - AS_ID: { A constant expression, or a Variable ref. } - begin - { Local Label ? } - if is_locallabel(actasmpattern) then - begin - CreateLocalLabel(actasmpattern, hl, false); - Consume(AS_ID); - AddLabelOperand(hl); - end - else - { Check for label } if SearchLabel(actasmpattern, hl, false) then - begin - Consume(AS_ID); - AddLabelOperand(hl); - end - else - { probably a variable or normal expression } - { or a procedure (such as in CALL ID) } - begin - { is it a constant ? } - if SearchIConstant(actasmpattern, l) then - begin - if not (oper.opr.typ in [OPR_NONE, OPR_CONSTANT]) then - Message(asmr_e_invalid_operand_type); - BuildConstantOperand(oper); - end - else - begin - expr := actasmpattern; - Consume(AS_ID); - { typecasting? } - if (actasmtoken = AS_LPAREN) and - SearchType(expr, typesize) then - begin - oper.hastype := true; - Consume(AS_LPAREN); - BuildOperand(oper); - Consume(AS_RPAREN); - if oper.opr.typ in [OPR_REFERENCE, OPR_LOCAL] then - oper.SetSize(typesize, true); - end - else - begin - if oper.SetupVar(expr, false) then - ReadAt(oper) - else - begin - { look for special symbols ... } - if expr = '__HIGH' then - begin - consume(AS_LPAREN); - if not oper.setupvar('high' + actasmpattern, false) then - Message1(sym_e_unknown_id, 'high' + actasmpattern); - consume(AS_ID); - consume(AS_RPAREN); - end - else if expr = '__RESULT' then - oper.SetUpResult - else if expr = '__SELF' then - oper.SetupSelf - else if expr = '__OLDEBP' then - oper.SetupOldEBP - else - Message1(sym_e_unknown_id, expr); - end; - end; - end; - if actasmtoken = AS_DOT then - MaybeRecordOffset; - { add a constant expression? } - if (actasmtoken = AS_PLUS) then - begin - l := BuildConstExpression(true, false); - case oper.opr.typ of - OPR_CONSTANT: - inc(oper.opr.val, l); - OPR_LOCAL: - inc(oper.opr.localsymofs, l); - OPR_REFERENCE: - inc(oper.opr.ref.offset, l); - else - internalerror(200309202); - end; - end - end; - { Do we have a indexing reference, then parse it also } - if actasmtoken = AS_LPAREN then - BuildReference(oper); - end; - - AS_REGISTER: { Register, a variable reference or a constant reference } - begin - { save the type of register used. } - tempreg := actasmregister; - Consume(AS_REGISTER); - if (actasmtoken in [AS_END, AS_SEPARATOR, AS_COMMA]) then - if is_condreg(tempreg) and - ((actopcode = A_BC) or - (actopcode = A_BCCTR) or - (actopcode = A_BCLR) or - (actopcode = A_TW) or - (actopcode = A_TWI)) then - begin - { it isn't a real operand, everything is stored in the condition } - oper.opr.typ := OPR_NONE; - actcondition.cr := getsupreg(tempreg); - end - else - begin - if not (oper.opr.typ in [OPR_NONE, OPR_REGISTER]) then - Message(asmr_e_invalid_operand_type); - oper.opr.typ := OPR_REGISTER; - oper.opr.reg := tempreg; - end - else if is_condreg(tempreg) then - begin - if not (actcondition.cond in [C_T..C_DZF]) then - Message(asmr_e_syn_operand); - if actasmtoken = AS_STAR then - begin - consume(AS_STAR); - if (actasmtoken = AS_INTNUM) then - begin - consume(AS_INTNUM); - if actasmtoken = AS_PLUS then - begin - consume(AS_PLUS); - if (actasmtoken = AS_ID) then - begin - oper.opr.typ := OPR_NONE; - if actasmpattern = 'LT' then - actcondition.crbit := (getsupreg(tempreg) - (RS_CR0)) * 4 - else if actasmpattern = 'GT' then - actcondition.crbit := (getsupreg(tempreg) - (RS_CR0)) * 4 + 1 - else if actasmpattern = 'EQ' then - actcondition.crbit := (getsupreg(tempreg) - (RS_CR0)) * 4 + 2 - else if actasmpattern = 'SO' then - actcondition.crbit := (getsupreg(tempreg) - (RS_CR0)) * 4 + 3 - else - Message(asmr_e_syn_operand); - consume(AS_ID); - end - else - Message(asmr_e_syn_operand); - end - else - Message(asmr_e_syn_operand); - end - else - Message(asmr_e_syn_operand); - end - else - Message(asmr_e_syn_operand); - end - else - Message(asmr_e_syn_operand); - end; - AS_END, - AS_SEPARATOR, - AS_COMMA: ; - else - begin - Message(asmr_e_syn_operand); - Consume(actasmtoken); - end; - end; { end case } -end; - -{***************************************************************************** - tppcattreader -*****************************************************************************} - -procedure tppcattreader.BuildOpCode(instr: tppcinstruction); -var - operandnum: longint; -begin - { opcode } - if (actasmtoken <> AS_OPCODE) then - begin - Message(asmr_e_invalid_or_missing_opcode); - RecoverConsume(true); - exit; - end; - { Fill the instr object with the current state } - with instr do - begin - Opcode := ActOpcode; - condition := ActCondition; - end; - - { We are reading operands, so opcode will be an AS_ID } - operandnum := 1; - Consume(AS_OPCODE); - { Zero operand opcode ? } - if actasmtoken in [AS_SEPARATOR, AS_END] then - begin - operandnum := 0; - exit; - end; - { Read the operands } - repeat - case actasmtoken of - AS_COMMA: { Operand delimiter } - begin - if operandnum > Max_Operands then - Message(asmr_e_too_many_operands) - else - begin - { condition operands doesn't set the operand but write to the - condition field of the instruction - } - if instr.Operands[operandnum].opr.typ <> OPR_NONE then - Inc(operandnum); - end; - Consume(AS_COMMA); - end; - AS_SEPARATOR, - AS_END: { End of asm operands for this opcode } - begin - break; - end; - else - BuildOperand(instr.Operands[operandnum] as tppcoperand); - end; { end case } - until false; - if (operandnum = 1) and (instr.Operands[operandnum].opr.typ = OPR_NONE) then - dec(operandnum); - instr.Ops := operandnum; -end; - -function tppcattreader.is_asmopcode(const s: string): boolean; -var - str2opentry: tstr2opentry; - cond: tasmcondflag; - hs: string; - -begin - { making s a value parameter would break other assembler readers } - hs := s; - is_asmopcode := false; - - { clear op code } - actopcode := A_None; - { clear condition } - fillchar(actcondition, sizeof(actcondition), 0); - - { check for direction hint } - if hs[length(s)] = '-' then - begin - dec(ord(hs[0])); - actcondition.dirhint := DH_Minus; - end - else if hs[length(s)] = '+' then - begin - dec(ord(hs[0])); - actcondition.dirhint := DH_Plus; - end; - str2opentry := tstr2opentry(iasmops.search(hs)); - if assigned(str2opentry) then - begin - if actcondition.dirhint <> DH_None then - message1(asmr_e_unknown_opcode, actasmpattern); - actopcode := str2opentry.op; - actasmtoken := AS_OPCODE; - is_asmopcode := true; - exit; - end; - { not found, check branch instructions } - if hs[1] = 'B' then - begin - { we can search here without an extra table which is sorted by string length - because we take the whole remaining string without the leading B } - if copy(hs, length(s) - 1, 2) = 'LR' then - begin - actopcode := A_BCLR; - setlength(hs, length(hs) - 2) - end - else if copy(hs, length(s) - 2, 3) = 'CTR' then - begin - actopcode := A_BCCTR; - setlength(hs, length(hs) - 3) - end - else - actopcode := A_BC; - for cond := low(TAsmCondFlag) to high(TAsmCondFlag) do - if copy(hs, 2, length(s) - 1) = UpperAsmCondFlag2Str[cond] then - begin - actcondition.simple := true; - actcondition.cond := cond; - if (cond in [C_LT, C_LE, C_EQ, C_GE, C_GT, C_NL, C_NE, C_NG, C_SO, C_NS, - C_UN, C_NU]) then - actcondition.cr := RS_CR0; - actasmtoken := AS_OPCODE; - is_asmopcode := true; - exit; - end; - end; -end; - -procedure tppcattreader.ConvertCalljmp(instr: tppcinstruction); -begin - if instr.Operands[1].opr.typ = OPR_REFERENCE then - begin - instr.Operands[1].opr.ref.refaddr := addr_full; - if (instr.Operands[1].opr.ref.base <> NR_NO) or - (instr.Operands[1].opr.ref.index <> NR_NO) then - Message(asmr_e_syn_operand); - end; -end; - -procedure tppcattreader.handleopcode; -var - instr: tppcinstruction; -begin - instr := TPPCInstruction.Create(TPPCOperand); - BuildOpcode(instr); - instr.condition := actcondition; - if is_calljmp(instr.opcode) then - ConvertCalljmp(instr); - { - instr.AddReferenceSizes; - instr.SetInstructionOpsize; - instr.CheckOperandSizes; - } - instr.ConcatInstruction(curlist); - instr.Free; -end; - -{***************************************************************************** - Initialize -*****************************************************************************} - -const - asmmode_ppc_att_info: tasmmodeinfo = - ( - id: asmmode_ppc_gas; - idtxt: 'GAS'; - casmreader: tppcattreader; - ); - - asmmode_ppc_standard_info: tasmmodeinfo = - ( - id: asmmode_standard; - idtxt: 'STANDARD'; - casmreader: tppcattreader; - ); - -initialization - RegisterAsmMode(asmmode_ppc_att_info); - RegisterAsmMode(asmmode_ppc_standard_info); -end. - diff --git a/compiler/powerpc64/rgcpu.pas b/compiler/powerpc64/rgcpu.pas deleted file mode 100644 index fd8d33fe21..0000000000 --- a/compiler/powerpc64/rgcpu.pas +++ /dev/null @@ -1,46 +0,0 @@ -{ - Copyright (c) 1998-2002 by Florian Klaempfl - - This unit implements the powerpc specific class for the register - allocator - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} - -unit rgcpu; - -{$I fpcdefs.inc} - -interface - -uses - aasmbase, aasmtai, - cpubase, - rgobj; - -type - trgcpu = class(trgobj) - end; - -implementation - -uses - cgobj, verbose, cutils; - - -end. - diff --git a/compiler/powerpc64/rppccon.inc b/compiler/powerpc64/rppccon.inc deleted file mode 100644 index 4ff6799228..0000000000 --- a/compiler/powerpc64/rppccon.inc +++ /dev/null @@ -1,111 +0,0 @@ -{ don't edit, this file is generated from ppcreg.dat } -NR_NO = tregister($00000000); -NR_R0 = tregister($01000000); -NR_R1 = tregister($01000001); -NR_R2 = tregister($01000002); -NR_R3 = tregister($01000003); -NR_R4 = tregister($01000004); -NR_R5 = tregister($01000005); -NR_R6 = tregister($01000006); -NR_R7 = tregister($01000007); -NR_R8 = tregister($01000008); -NR_R9 = tregister($01000009); -NR_R10 = tregister($0100000a); -NR_R11 = tregister($0100000b); -NR_R12 = tregister($0100000c); -NR_R13 = tregister($0100000d); -NR_R14 = tregister($0100000e); -NR_R15 = tregister($0100000f); -NR_R16 = tregister($01000010); -NR_R17 = tregister($01000011); -NR_R18 = tregister($01000012); -NR_R19 = tregister($01000013); -NR_R20 = tregister($01000014); -NR_R21 = tregister($01000015); -NR_R22 = tregister($01000016); -NR_R23 = tregister($01000017); -NR_R24 = tregister($01000018); -NR_R25 = tregister($01000019); -NR_R26 = tregister($0100001a); -NR_R27 = tregister($0100001b); -NR_R28 = tregister($0100001c); -NR_R29 = tregister($0100001d); -NR_R30 = tregister($0100001e); -NR_R31 = tregister($0100001f); -NR_F0 = tregister($02000000); -NR_F1 = tregister($02000001); -NR_F2 = tregister($02000002); -NR_F3 = tregister($02000003); -NR_F4 = tregister($02000004); -NR_F5 = tregister($02000005); -NR_F6 = tregister($02000006); -NR_F7 = tregister($02000007); -NR_F8 = tregister($02000008); -NR_F9 = tregister($02000009); -NR_F10 = tregister($0200000a); -NR_F11 = tregister($0200000b); -NR_F12 = tregister($0200000c); -NR_F13 = tregister($0200000d); -NR_F14 = tregister($0200000e); -NR_F15 = tregister($0200000f); -NR_F16 = tregister($02000010); -NR_F17 = tregister($02000011); -NR_F18 = tregister($02000012); -NR_F19 = tregister($02000013); -NR_F20 = tregister($02000014); -NR_F21 = tregister($02000015); -NR_F22 = tregister($02000016); -NR_F23 = tregister($02000017); -NR_F24 = tregister($02000018); -NR_F25 = tregister($02000019); -NR_F26 = tregister($0200001a); -NR_F27 = tregister($0200001b); -NR_F28 = tregister($0200001c); -NR_F29 = tregister($0200001d); -NR_F30 = tregister($0200001e); -NR_F31 = tregister($0200001f); -NR_M0 = tregister($03000000); -NR_M1 = tregister($03000001); -NR_M2 = tregister($03000002); -NR_M3 = tregister($03000003); -NR_M4 = tregister($03000004); -NR_M5 = tregister($03000005); -NR_M6 = tregister($03000006); -NR_M7 = tregister($03000007); -NR_M8 = tregister($03000008); -NR_M9 = tregister($03000009); -NR_M10 = tregister($0300000a); -NR_M11 = tregister($0300000b); -NR_M12 = tregister($0300000c); -NR_M13 = tregister($0300000d); -NR_M14 = tregister($0300000e); -NR_M15 = tregister($0300000f); -NR_M16 = tregister($03000010); -NR_M17 = tregister($03000011); -NR_M18 = tregister($03000012); -NR_M19 = tregister($03000013); -NR_M20 = tregister($03000014); -NR_M21 = tregister($03000015); -NR_M22 = tregister($03000016); -NR_M23 = tregister($03000017); -NR_M24 = tregister($03000018); -NR_M25 = tregister($03000019); -NR_M26 = tregister($0300001a); -NR_M27 = tregister($0300001b); -NR_M28 = tregister($0300001c); -NR_M29 = tregister($0300001d); -NR_M30 = tregister($0300001e); -NR_M31 = tregister($0300001f); -NR_CR = tregister($05000000); -NR_CR0 = tregister($05000001); -NR_CR1 = tregister($05000002); -NR_CR2 = tregister($05000003); -NR_CR3 = tregister($05000004); -NR_CR4 = tregister($05000005); -NR_CR5 = tregister($05000006); -NR_CR6 = tregister($05000007); -NR_CR7 = tregister($05000008); -NR_XER = tregister($05000009); -NR_LR = tregister($0500000a); -NR_CTR = tregister($0500000b); -NR_FPSCR = tregister($0500000c); diff --git a/compiler/powerpc64/rppcdwrf.inc b/compiler/powerpc64/rppcdwrf.inc deleted file mode 100644 index 2c9c9942a8..0000000000 --- a/compiler/powerpc64/rppcdwrf.inc +++ /dev/null @@ -1,111 +0,0 @@ -{ don't edit, this file is generated from ppcreg.dat } --1, -0, -1, -2, -3, -4, -5, -6, -7, -8, -9, -10, -11, -12, -13, -14, -15, -16, -17, -18, -19, -20, -21, -22, -23, -24, -25, -26, -27, -28, -29, -30, -31, -32, -33, -34, -35, -36, -37, -38, -39, -40, -41, -42, -43, -44, -45, -46, -47, -48, -49, -50, -51, -52, -53, -54, -55, -56, -57, -58, -59, -60, -61, -62, -63, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, -68, -69, -70, -71, -72, -73, -74, -75, -76, -65, -66, --1 diff --git a/compiler/powerpc64/rppcgas.inc b/compiler/powerpc64/rppcgas.inc deleted file mode 100644 index 3c68549ce1..0000000000 --- a/compiler/powerpc64/rppcgas.inc +++ /dev/null @@ -1,111 +0,0 @@ -{ don't edit, this file is generated from ppcreg.dat } -'INVALID', -'r0', -'r1', -'r2', -'r3', -'r4', -'r5', -'r6', -'r7', -'r8', -'r9', -'r10', -'r11', -'r12', -'r13', -'r14', -'r15', -'r16', -'r17', -'r18', -'r19', -'r20', -'r21', -'r22', -'r23', -'r24', -'r25', -'r26', -'r27', -'r28', -'r29', -'r30', -'r31', -'f0', -'f1', -'f2', -'f3', -'f4', -'f5', -'f6', -'f7', -'f8', -'f9', -'f10', -'f11', -'f12', -'f13', -'f14', -'f15', -'f16', -'f17', -'f18', -'f19', -'f20', -'f21', -'f22', -'f23', -'f24', -'f25', -'f26', -'f27', -'f28', -'f29', -'f30', -'f31', -'v0', -'v1', -'v2', -'v3', -'v4', -'v5', -'v6', -'v7', -'v8', -'v9', -'v10', -'v11', -'v12', -'v13', -'v14', -'v15', -'v16', -'v17', -'v18', -'v19', -'v20', -'v21', -'v22', -'v23', -'v24', -'v25', -'v26', -'v27', -'v28', -'v29', -'v30', -'v31', -'cr', -'cr0', -'cr1', -'cr2', -'cr3', -'cr4', -'cr5', -'cr6', -'cr7', -'xer', -'lr', -'ctr', -'fpscr' diff --git a/compiler/powerpc64/rppcgri.inc b/compiler/powerpc64/rppcgri.inc deleted file mode 100644 index b26f900caa..0000000000 --- a/compiler/powerpc64/rppcgri.inc +++ /dev/null @@ -1,111 +0,0 @@ -{ don't edit, this file is generated from ppcreg.dat } -0, -97, -98, -99, -100, -101, -102, -103, -104, -105, -108, -33, -34, -43, -44, -45, -46, -47, -48, -49, -50, -51, -52, -35, -53, -54, -55, -56, -57, -58, -59, -60, -61, -62, -36, -63, -64, -37, -38, -39, -40, -41, -42, -109, -107, -1, -2, -11, -12, -13, -14, -15, -16, -17, -18, -19, -20, -3, -21, -22, -23, -24, -25, -26, -27, -28, -29, -30, -4, -31, -32, -5, -6, -7, -8, -9, -10, -65, -66, -75, -76, -77, -78, -79, -80, -81, -82, -83, -84, -67, -85, -86, -87, -88, -89, -90, -91, -92, -93, -94, -68, -95, -96, -69, -70, -71, -72, -73, -74, -106 diff --git a/compiler/powerpc64/rppcgss.inc b/compiler/powerpc64/rppcgss.inc deleted file mode 100644 index df78c36d00..0000000000 --- a/compiler/powerpc64/rppcgss.inc +++ /dev/null @@ -1,111 +0,0 @@ -{ don't edit, this file is generated from ppcreg.dat } -'INVALID', -'0', -'1', -'2', -'3', -'4', -'5', -'6', -'7', -'8', -'9', -'10', -'11', -'12', -'13', -'14', -'15', -'16', -'17', -'18', -'19', -'20', -'21', -'22', -'23', -'24', -'25', -'26', -'27', -'28', -'29', -'30', -'31', -'0', -'1', -'2', -'3', -'4', -'5', -'6', -'7', -'8', -'9', -'10', -'11', -'12', -'13', -'14', -'15', -'16', -'17', -'18', -'19', -'20', -'21', -'22', -'23', -'24', -'25', -'26', -'27', -'28', -'29', -'30', -'31', -'0', -'1', -'2', -'3', -'4', -'5', -'6', -'7', -'8', -'9', -'10', -'11', -'12', -'13', -'14', -'15', -'16', -'17', -'18', -'19', -'20', -'21', -'22', -'23', -'24', -'25', -'26', -'27', -'28', -'29', -'30', -'31', -'cr', -'cr0', -'cr1', -'cr2', -'cr3', -'cr4', -'cr5', -'cr5', -'cr6', -'xer', -'lr', -'ctr', -'fpscr' diff --git a/compiler/powerpc64/rppcmot.inc b/compiler/powerpc64/rppcmot.inc deleted file mode 100644 index 4fc340afd7..0000000000 --- a/compiler/powerpc64/rppcmot.inc +++ /dev/null @@ -1,111 +0,0 @@ -{ don't edit, this file is generated from ppcreg.dat } -'INVALID', -'r0', -'r1', -'r2', -'r3', -'r4', -'r5', -'r6', -'r7', -'r8', -'r9', -'r10', -'r11', -'r12', -'r13', -'r14', -'r15', -'r16', -'r17', -'r18', -'r19', -'r20', -'r21', -'r22', -'r23', -'r24', -'r25', -'r26', -'r27', -'r28', -'r29', -'r30', -'r31', -'F0', -'F1', -'F2', -'F3', -'F4', -'F5', -'F6', -'F7', -'F8', -'F9', -'F10', -'F11', -'F12', -'F13', -'F14', -'F15', -'F16', -'F17', -'F18', -'F19', -'F20', -'F21', -'F22', -'F23', -'F24', -'F25', -'F26', -'F27', -'F28', -'F29', -'F30', -'F31', -'M0', -'M1', -'M2', -'M3', -'M4', -'M5', -'M6', -'M7', -'M8', -'M9', -'M10', -'M11', -'M12', -'M13', -'M14', -'M15', -'M16', -'M17', -'M18', -'M19', -'M20', -'M21', -'M22', -'M23', -'M24', -'M25', -'M26', -'M27', -'M28', -'M29', -'M30', -'M31', -'CR', -'CR0', -'CR1', -'CR2', -'CR3', -'CR4', -'CR5', -'CR6', -'CR7', -'XER', -'LR', -'CTR', -'FPSCR' diff --git a/compiler/powerpc64/rppcmri.inc b/compiler/powerpc64/rppcmri.inc deleted file mode 100644 index 9a59178c7d..0000000000 --- a/compiler/powerpc64/rppcmri.inc +++ /dev/null @@ -1,111 +0,0 @@ -{ don't edit, this file is generated from ppcreg.dat } -97, -98, -99, -100, -101, -102, -103, -104, -105, -108, -33, -34, -43, -44, -45, -46, -47, -48, -49, -50, -51, -52, -35, -53, -54, -55, -56, -57, -58, -59, -60, -61, -62, -36, -63, -64, -37, -38, -39, -40, -41, -42, -109, -0, -107, -65, -66, -75, -76, -77, -78, -79, -80, -81, -82, -83, -84, -67, -85, -86, -87, -88, -89, -90, -91, -92, -93, -94, -68, -95, -96, -69, -70, -71, -72, -73, -74, -106, -1, -2, -11, -12, -13, -14, -15, -16, -17, -18, -19, -20, -3, -21, -22, -23, -24, -25, -26, -27, -28, -29, -30, -4, -31, -32, -5, -6, -7, -8, -9, -10 diff --git a/compiler/powerpc64/rppcnor.inc b/compiler/powerpc64/rppcnor.inc deleted file mode 100644 index 387be62acb..0000000000 --- a/compiler/powerpc64/rppcnor.inc +++ /dev/null @@ -1,2 +0,0 @@ -{ don't edit, this file is generated from ppcreg.dat } -110 diff --git a/compiler/powerpc64/rppcnum.inc b/compiler/powerpc64/rppcnum.inc deleted file mode 100644 index d612e34d8a..0000000000 --- a/compiler/powerpc64/rppcnum.inc +++ /dev/null @@ -1,111 +0,0 @@ -{ don't edit, this file is generated from ppcreg.dat } -tregister($00000000), -tregister($01000000), -tregister($01000001), -tregister($01000002), -tregister($01000003), -tregister($01000004), -tregister($01000005), -tregister($01000006), -tregister($01000007), -tregister($01000008), -tregister($01000009), -tregister($0100000a), -tregister($0100000b), -tregister($0100000c), -tregister($0100000d), -tregister($0100000e), -tregister($0100000f), -tregister($01000010), -tregister($01000011), -tregister($01000012), -tregister($01000013), -tregister($01000014), -tregister($01000015), -tregister($01000016), -tregister($01000017), -tregister($01000018), -tregister($01000019), -tregister($0100001a), -tregister($0100001b), -tregister($0100001c), -tregister($0100001d), -tregister($0100001e), -tregister($0100001f), -tregister($02000000), -tregister($02000001), -tregister($02000002), -tregister($02000003), -tregister($02000004), -tregister($02000005), -tregister($02000006), -tregister($02000007), -tregister($02000008), -tregister($02000009), -tregister($0200000a), -tregister($0200000b), -tregister($0200000c), -tregister($0200000d), -tregister($0200000e), -tregister($0200000f), -tregister($02000010), -tregister($02000011), -tregister($02000012), -tregister($02000013), -tregister($02000014), -tregister($02000015), -tregister($02000016), -tregister($02000017), -tregister($02000018), -tregister($02000019), -tregister($0200001a), -tregister($0200001b), -tregister($0200001c), -tregister($0200001d), -tregister($0200001e), -tregister($0200001f), -tregister($03000000), -tregister($03000001), -tregister($03000002), -tregister($03000003), -tregister($03000004), -tregister($03000005), -tregister($03000006), -tregister($03000007), -tregister($03000008), -tregister($03000009), -tregister($0300000a), -tregister($0300000b), -tregister($0300000c), -tregister($0300000d), -tregister($0300000e), -tregister($0300000f), -tregister($03000010), -tregister($03000011), -tregister($03000012), -tregister($03000013), -tregister($03000014), -tregister($03000015), -tregister($03000016), -tregister($03000017), -tregister($03000018), -tregister($03000019), -tregister($0300001a), -tregister($0300001b), -tregister($0300001c), -tregister($0300001d), -tregister($0300001e), -tregister($0300001f), -tregister($05000000), -tregister($05000001), -tregister($05000002), -tregister($05000003), -tregister($05000004), -tregister($05000005), -tregister($05000006), -tregister($05000007), -tregister($05000008), -tregister($05000009), -tregister($0500000a), -tregister($0500000b), -tregister($0500000c) diff --git a/compiler/powerpc64/rppcrni.inc b/compiler/powerpc64/rppcrni.inc deleted file mode 100644 index 1a49189c1d..0000000000 --- a/compiler/powerpc64/rppcrni.inc +++ /dev/null @@ -1,111 +0,0 @@ -{ don't edit, this file is generated from ppcreg.dat } -0, -1, -2, -3, -4, -5, -6, -7, -8, -9, -10, -11, -12, -13, -14, -15, -16, -17, -18, -19, -20, -21, -22, -23, -24, -25, -26, -27, -28, -29, -30, -31, -32, -33, -34, -35, -36, -37, -38, -39, -40, -41, -42, -43, -44, -45, -46, -47, -48, -49, -50, -51, -52, -53, -54, -55, -56, -57, -58, -59, -60, -61, -62, -63, -64, -65, -66, -67, -68, -69, -70, -71, -72, -73, -74, -75, -76, -77, -78, -79, -80, -81, -82, -83, -84, -85, -86, -87, -88, -89, -90, -91, -92, -93, -94, -95, -96, -97, -98, -99, -100, -101, -102, -103, -104, -105, -106, -107, -108, -109 diff --git a/compiler/powerpc64/rppcsri.inc b/compiler/powerpc64/rppcsri.inc deleted file mode 100644 index 9a59178c7d..0000000000 --- a/compiler/powerpc64/rppcsri.inc +++ /dev/null @@ -1,111 +0,0 @@ -{ don't edit, this file is generated from ppcreg.dat } -97, -98, -99, -100, -101, -102, -103, -104, -105, -108, -33, -34, -43, -44, -45, -46, -47, -48, -49, -50, -51, -52, -35, -53, -54, -55, -56, -57, -58, -59, -60, -61, -62, -36, -63, -64, -37, -38, -39, -40, -41, -42, -109, -0, -107, -65, -66, -75, -76, -77, -78, -79, -80, -81, -82, -83, -84, -67, -85, -86, -87, -88, -89, -90, -91, -92, -93, -94, -68, -95, -96, -69, -70, -71, -72, -73, -74, -106, -1, -2, -11, -12, -13, -14, -15, -16, -17, -18, -19, -20, -3, -21, -22, -23, -24, -25, -26, -27, -28, -29, -30, -4, -31, -32, -5, -6, -7, -8, -9, -10 diff --git a/compiler/powerpc64/rppcstab.inc b/compiler/powerpc64/rppcstab.inc deleted file mode 100644 index 2c9c9942a8..0000000000 --- a/compiler/powerpc64/rppcstab.inc +++ /dev/null @@ -1,111 +0,0 @@ -{ don't edit, this file is generated from ppcreg.dat } --1, -0, -1, -2, -3, -4, -5, -6, -7, -8, -9, -10, -11, -12, -13, -14, -15, -16, -17, -18, -19, -20, -21, -22, -23, -24, -25, -26, -27, -28, -29, -30, -31, -32, -33, -34, -35, -36, -37, -38, -39, -40, -41, -42, -43, -44, -45, -46, -47, -48, -49, -50, -51, -52, -53, -54, -55, -56, -57, -58, -59, -60, -61, -62, -63, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, --1, -68, -69, -70, -71, -72, -73, -74, -75, -76, -65, -66, --1 diff --git a/compiler/powerpc64/rppcstd.inc b/compiler/powerpc64/rppcstd.inc deleted file mode 100644 index 4fc340afd7..0000000000 --- a/compiler/powerpc64/rppcstd.inc +++ /dev/null @@ -1,111 +0,0 @@ -{ don't edit, this file is generated from ppcreg.dat } -'INVALID', -'r0', -'r1', -'r2', -'r3', -'r4', -'r5', -'r6', -'r7', -'r8', -'r9', -'r10', -'r11', -'r12', -'r13', -'r14', -'r15', -'r16', -'r17', -'r18', -'r19', -'r20', -'r21', -'r22', -'r23', -'r24', -'r25', -'r26', -'r27', -'r28', -'r29', -'r30', -'r31', -'F0', -'F1', -'F2', -'F3', -'F4', -'F5', -'F6', -'F7', -'F8', -'F9', -'F10', -'F11', -'F12', -'F13', -'F14', -'F15', -'F16', -'F17', -'F18', -'F19', -'F20', -'F21', -'F22', -'F23', -'F24', -'F25', -'F26', -'F27', -'F28', -'F29', -'F30', -'F31', -'M0', -'M1', -'M2', -'M3', -'M4', -'M5', -'M6', -'M7', -'M8', -'M9', -'M10', -'M11', -'M12', -'M13', -'M14', -'M15', -'M16', -'M17', -'M18', -'M19', -'M20', -'M21', -'M22', -'M23', -'M24', -'M25', -'M26', -'M27', -'M28', -'M29', -'M30', -'M31', -'CR', -'CR0', -'CR1', -'CR2', -'CR3', -'CR4', -'CR5', -'CR6', -'CR7', -'XER', -'LR', -'CTR', -'FPSCR' diff --git a/compiler/powerpc64/rppcsup.inc b/compiler/powerpc64/rppcsup.inc deleted file mode 100644 index 4e6f879355..0000000000 --- a/compiler/powerpc64/rppcsup.inc +++ /dev/null @@ -1,111 +0,0 @@ -{ don't edit, this file is generated from ppcreg.dat } -RS_NO = $00; -RS_R0 = $00; -RS_R1 = $01; -RS_R2 = $02; -RS_R3 = $03; -RS_R4 = $04; -RS_R5 = $05; -RS_R6 = $06; -RS_R7 = $07; -RS_R8 = $08; -RS_R9 = $09; -RS_R10 = $0a; -RS_R11 = $0b; -RS_R12 = $0c; -RS_R13 = $0d; -RS_R14 = $0e; -RS_R15 = $0f; -RS_R16 = $10; -RS_R17 = $11; -RS_R18 = $12; -RS_R19 = $13; -RS_R20 = $14; -RS_R21 = $15; -RS_R22 = $16; -RS_R23 = $17; -RS_R24 = $18; -RS_R25 = $19; -RS_R26 = $1a; -RS_R27 = $1b; -RS_R28 = $1c; -RS_R29 = $1d; -RS_R30 = $1e; -RS_R31 = $1f; -RS_F0 = $00; -RS_F1 = $01; -RS_F2 = $02; -RS_F3 = $03; -RS_F4 = $04; -RS_F5 = $05; -RS_F6 = $06; -RS_F7 = $07; -RS_F8 = $08; -RS_F9 = $09; -RS_F10 = $0a; -RS_F11 = $0b; -RS_F12 = $0c; -RS_F13 = $0d; -RS_F14 = $0e; -RS_F15 = $0f; -RS_F16 = $10; -RS_F17 = $11; -RS_F18 = $12; -RS_F19 = $13; -RS_F20 = $14; -RS_F21 = $15; -RS_F22 = $16; -RS_F23 = $17; -RS_F24 = $18; -RS_F25 = $19; -RS_F26 = $1a; -RS_F27 = $1b; -RS_F28 = $1c; -RS_F29 = $1d; -RS_F30 = $1e; -RS_F31 = $1f; -RS_M0 = $00; -RS_M1 = $01; -RS_M2 = $02; -RS_M3 = $03; -RS_M4 = $04; -RS_M5 = $05; -RS_M6 = $06; -RS_M7 = $07; -RS_M8 = $08; -RS_M9 = $09; -RS_M10 = $0a; -RS_M11 = $0b; -RS_M12 = $0c; -RS_M13 = $0d; -RS_M14 = $0e; -RS_M15 = $0f; -RS_M16 = $10; -RS_M17 = $11; -RS_M18 = $12; -RS_M19 = $13; -RS_M20 = $14; -RS_M21 = $15; -RS_M22 = $16; -RS_M23 = $17; -RS_M24 = $18; -RS_M25 = $19; -RS_M26 = $1a; -RS_M27 = $1b; -RS_M28 = $1c; -RS_M29 = $1d; -RS_M30 = $1e; -RS_M31 = $1f; -RS_CR = $00; -RS_CR0 = $01; -RS_CR1 = $02; -RS_CR2 = $03; -RS_CR3 = $04; -RS_CR4 = $05; -RS_CR5 = $06; -RS_CR6 = $07; -RS_CR7 = $08; -RS_XER = $09; -RS_LR = $0a; -RS_CTR = $0b; -RS_FPSCR = $0c; diff --git a/compiler/pp.pas b/compiler/pp.pas index 5d7c4b5c3e..258af74ecf 100644 --- a/compiler/pp.pas +++ b/compiler/pp.pas @@ -22,15 +22,15 @@ program pp; { - possible compiler switches: + possible compiler switches (* marks a currently required switch): ----------------------------------------------------------------- + GDB* support of the GNU Debugger CMEM use cmem unit for better memory debugging I386 generate a compiler for the Intel i386+ x86_64 generate a compiler for the AMD x86-64 architecture M68K generate a compiler for the M68000 SPARC generate a compiler for SPARC POWERPC generate a compiler for the PowerPC - POWERPC64 generate a compiler for the PowerPC64 architecture VIS generate a compile for the VIS DEBUG version with debug code is generated EXTDEBUG some extra debug code is executed @@ -39,6 +39,10 @@ program pp; MMX instructions EXTERN_MSG Don't compile the msgfiles in the compiler, always use external messagefiles, default for TP + NOAG386INT no Intel Assembler output + NOAG386NSM no NASM output + NOAG386BIN leaves out the binary writer, default for TP + NORA386DIR No direct i386 assembler reader TEST_GENERIC Test Generic version of code generator (uses generic RTL calls) ----------------------------------------------------------------- @@ -49,12 +53,16 @@ program pp; ----------------------------------------------------------------- Required switches for a i386 compiler be compiled by Free Pascal Compiler: - I386 + GDB;I386 } {$i fpcdefs.inc} {$ifdef FPC} + {$ifndef GDB} + { people can try to compile without GDB } + { $error The compiler switch GDB must be defined} + {$endif GDB} { exactly one target CPU must be defined } {$ifdef I386} {$ifdef CPUDEFINED} @@ -92,12 +100,6 @@ program pp; {$endif CPUDEFINED} {$define CPUDEFINED} {$endif POWERPC} - {$ifdef POWERPC64} - {$ifdef CPUDEFINED} - {$fatal ONLY one of the switches for the CPU type must be defined} - {$endif CPUDEFINED} - {$define CPUDEFINED} - {$endif POWERPC64} {$ifdef ALPHA} {$ifdef CPUDEFINED} {$fatal ONLY one of the switches for the CPU type must be defined} diff --git a/compiler/ppu.pas b/compiler/ppu.pas index 3f06f7a7b8..71784b967c 100644 --- a/compiler/ppu.pas +++ b/compiler/ppu.pas @@ -73,6 +73,7 @@ const iblinkotherofiles = 8; iblinkotherstaticlibs = 9; iblinkothersharedlibs = 10; + ibdbxcount = 11; ibsymref = 12; ibdefref = 13; ibendsymtablebrowser = 14; @@ -133,6 +134,7 @@ const uf_init = $1; uf_finalize = $2; uf_big_endian = $4; + uf_has_dbx = $8; uf_has_browser = $10; uf_in_library = $20; { is the file in another file than <ppufile>.* ? } uf_smart_linked = $40; { the ppu can be smartlinked } @@ -150,8 +152,8 @@ const uf_local_symtable = $20000; { this unit has a local symtable stored } uf_uses_variants = $40000; { this unit uses variants } uf_has_resourcefiles = $80000; { this unit has external resources (using $R directive)} - - + + type ppureal=extended; diff --git a/compiler/procinfo.pas b/compiler/procinfo.pas index 262fefb6d1..f1cc60ed83 100644 --- a/compiler/procinfo.pas +++ b/compiler/procinfo.pas @@ -144,8 +144,8 @@ implementation aktlocaldata:=Taasmoutput.Create; reference_reset(save_regs_ref); { labels } - objectlibrary.getjumplabel(aktexitlabel); - objectlibrary.getjumplabel(gotlabel); + objectlibrary.getlabel(aktexitlabel); + objectlibrary.getlabel(gotlabel); end; diff --git a/compiler/psub.pas b/compiler/psub.pas index 28e3fea805..a92bdf79bd 100644 --- a/compiler/psub.pas +++ b/compiler/psub.pas @@ -95,9 +95,9 @@ implementation scanner,import,gendef, pbase,pstatmnt,pdecl,pdecsub,pexports, { codegen } - tgobj,cgobj,dbgbase, + tgobj,cgobj, ncgutil,regvars -{$if defined(arm) or defined(powerpc) or defined(powerpc64)} +{$if defined(arm) or defined(powerpc)} ,aasmcpu {$endif arm} {$ifndef NOOPT} @@ -610,7 +610,6 @@ implementation oldfilepos : tfileposinfo; templist : Taasmoutput; headertai : tai; - curralign : longint; begin { the initialization procedure can be empty, then we don't need to generate anything. When it was an empty @@ -846,35 +845,30 @@ implementation aktproccode.concatlist(templist); {$ifdef ARM} - { because of the limited constant size of the arm, all data access is done pc relative } insertpcrelativedata(aktproccode,aktlocaldata); {$endif ARM} {$ifdef POWERPC} fixup_jmps(aktproccode); {$endif POWERPC} -{$ifdef POWERPC64} - fixup_jmps(aktproccode); -{$endif POWERPC64} - { insert line debuginfo } - if (cs_debuginfo in aktmoduleswitches) or - (cs_use_lineinfo in aktglobalswitches) then - debuginfo.insertlineinfo(aktproccode); - - { gprof uses 16 byte granularity } - if (cs_profile in aktmoduleswitches) then - curralign:=16 - else - curralign:=aktalignment.procalign; - - { add the procedure to the al_procedures } - maybe_new_object_file(asmlist[al_procedures]); - new_section(asmlist[al_procedures],sec_code,lower(procdef.mangledname),curralign); - asmlist[al_procedures].concatlist(aktproccode); { save local data (casetable) also in the same file } if assigned(aktlocaldata) and (not aktlocaldata.empty) then - asmlist[al_procedures].concatlist(aktlocaldata); + begin + { because of the limited constant size of the arm, all data access is done pc relative } + if target_info.cpu=cpu_arm then + aktproccode.concatlist(aktlocaldata) + else + begin + new_section(aktproccode,sec_data,lower(procdef.mangledname),0); + aktproccode.concatlist(aktlocaldata); + end; + end; + + { add the procedure to the codesegment } + maybe_new_object_file(codesegment); + new_section(codesegment,sec_code,lower(procdef.mangledname),aktalignment.procalign); + codesegment.concatlist(aktproccode); { only now we can remove the temps } tg.resettempgen; @@ -1305,12 +1299,12 @@ implementation not( assigned(pd.import_dll) and (target_info.system in [system_i386_win32,system_i386_wdosx, - system_i386_emx,system_i386_os2,system_arm_wince,system_i386_wince]) + system_i386_emx,system_i386_os2]) ) then begin s:=proc_get_importname(pd); if s<>'' then - gen_external_stub(asmlist[al_procedures],pd,{$IFDEF POWERPC64}'.'+{$ENDIF}s); + gen_external_stub(codesegment,pd,s); end; { Import DLL specified? } diff --git a/compiler/psystem.pas b/compiler/psystem.pas index 40f1e86cc6..98be816d4f 100644 --- a/compiler/psystem.pas +++ b/compiler/psystem.pas @@ -42,9 +42,11 @@ implementation uses globals,globtype,verbose, - systems, symconst,symtype,symsym,symdef,symtable, aasmtai,aasmcpu,ncgutil,fmodule, +{$ifdef GDB} + gdb, +{$endif GDB} node,nbas,nflw,nset,ncon,ncnv,nld,nmem,ncal,nmat,nadd,ninl,nopt ; @@ -119,13 +121,8 @@ implementation var hrecst : trecordsymtable; begin - if target_info.system=system_x86_64_win64 then - pbestrealtype:=@s64floattype; - {$ifdef cpufpemu} { Normal types } - (* we use the same types as without emulator, the only - difference is that direct calls to the emulator are generated if (cs_fp_emulation in aktmoduleswitches) then begin addtype('Single',s32floattype); @@ -136,7 +133,6 @@ implementation addtype('Extended',pbestrealtype^); end else - *) {$endif cpufpemu} begin addtype('Single',s32floattype); @@ -146,8 +142,7 @@ implementation addtype('Real',s64floattype); end; {$ifdef x86} - if target_info.system<>system_x86_64_win64 then - adddef('Comp',tfloatdef.create(s64comp)); + adddef('Comp',tfloatdef.create(s64comp)); {$endif x86} addtype('Currency',s64currencytype); addtype('Pointer',voidpointertype); @@ -364,10 +359,7 @@ implementation s32floattype.setdef(tfloatdef.create(s32real)); s64floattype.setdef(tfloatdef.create(s64real)); s80floattype.setdef(tfloatdef.create(s80real)); - if target_info.system<>system_x86_64_win64 then - s64currencytype.setdef(tfloatdef.create(s64currency)) - else - s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64))); + s64currencytype.setdef(tfloatdef.create(s64currency)); {$endif x86} {$ifdef powerpc} s32floattype.setdef(tfloatdef.create(s32real)); @@ -375,12 +367,6 @@ implementation s80floattype.setdef(tfloatdef.create(s80real)); s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64))); {$endif powerpc} -{$ifdef POWERPC64} - s32floattype.setdef(tfloatdef.create(s32real)); - s64floattype.setdef(tfloatdef.create(s64real)); - s80floattype.setdef(tfloatdef.create(s80real)); - s64currencytype.setdef(torddef.create(scurrency,low(int64),high(int64))); -{$endif POWERPC64} {$ifdef sparc} s32floattype.setdef(tfloatdef.create(s32real)); s64floattype.setdef(tfloatdef.create(s64real)); @@ -512,12 +498,12 @@ implementation aiclass[ait_align]:=tai_align; aiclass[ait_section]:=tai_section; aiclass[ait_comment]:=tai_comment; + aiclass[ait_direct]:=tai_direct; aiclass[ait_string]:=tai_string; aiclass[ait_instruction]:=taicpu; aiclass[ait_datablock]:=tai_datablock; aiclass[ait_symbol]:=tai_symbol; aiclass[ait_symbol_end]:=tai_symbol_end; - aiclass[ait_directive]:=tai_directive; aiclass[ait_label]:=tai_label; aiclass[ait_const_64bit]:=tai_const; aiclass[ait_const_32bit]:=tai_const; @@ -529,9 +515,12 @@ implementation aiclass[ait_real_64bit]:=tai_real_64bit; aiclass[ait_real_80bit]:=tai_real_80bit; aiclass[ait_comp_64bit]:=tai_comp_64bit; - aiclass[ait_stab]:=tai_stab; +{$ifdef GDB} + aiclass[ait_stabn]:=tai_stabn; + aiclass[ait_stabs]:=tai_stabs; aiclass[ait_force_line]:=tai_force_line; - aiclass[ait_function_name]:=tai_function_name; + aiclass[ait_stab_function_name]:=tai_stab_function_name; +{$endif GDB} {$ifdef alpha} { the follow is for the DEC Alpha } aiclass[ait_frame]:=tai_frame; diff --git a/compiler/ptconst.pas b/compiler/ptconst.pas index 5bd0a085cb..74ddf69ce0 100644 --- a/compiler/ptconst.pas +++ b/compiler/ptconst.pas @@ -46,7 +46,7 @@ implementation { parser specific stuff } pbase,pexpr, { codegen } - cpuinfo,cgbase,dbgbase + cpuinfo,cgbase ; {$ifdef fpc} @@ -66,6 +66,7 @@ implementation varalign : longint; offset, strlength : aint; + curconstsegment : TAAsmoutput; ll : tasmlabel; s,sorg : string; c : char; @@ -83,8 +84,6 @@ implementation error : boolean; old_block_type : tblock_type; storefilepos : tfileposinfo; - cursectype : TAsmSectionType; - cural : tasmlist; procedure check_range(def:torddef); begin @@ -102,37 +101,30 @@ implementation old_block_type:=block_type; block_type:=bt_const; - if writable then - begin - cural:=al_typedconsts; - cursectype:=sec_data; - end - else - begin - cural:=al_rotypedconsts; - cursectype:=sec_rodata; - end; + { put everything in the datasemgent to prevent + mixing array indexes with ansistring data } + curconstsegment:=datasegment; - { Add symbol name if this is specified. For array - elements sym=nil and we should skip this } if assigned(sym) then begin storefilepos:=aktfilepos; aktfilepos:=sym.fileinfo; - - { insert cut for smartlinking or alignment } l:=sym.getsize; - maybe_new_object_file(asmlist[cural]); - new_section(asmlist[cural],cursectype,lower(sym.mangledname),const_align(l)); - + { insert cut for smartlinking or alignment } + maybe_new_object_file(curconstSegment); + new_section(curconstSegment,sec_rodata,lower(sym.mangledname),const_align(l)); + {$ifdef GDB} + if (cs_debuginfo in aktmoduleswitches) then + sym.concatstabto(curconstSegment); + {$endif GDB} if (sym.owner.symtabletype=globalsymtable) or maybe_smartlink_symbol or (assigned(current_procinfo) and (po_inline in current_procinfo.procdef.procoptions)) or DLLSource then - asmlist[cural].concat(Tai_symbol.Createname_global(sym.mangledname,AT_DATA,l)) + curconstSegment.concat(Tai_symbol.Createname_global(sym.mangledname,AT_DATA,l)) else - asmlist[cural].concat(Tai_symbol.Createname(sym.mangledname,AT_DATA,l)); + curconstSegment.concat(Tai_symbol.Createname(sym.mangledname,AT_DATA,l)); aktfilepos:=storefilepos; end; @@ -144,28 +136,28 @@ implementation bool8bit : begin if is_constboolnode(p) then - asmlist[cural].concat(Tai_const.Create_8bit(byte(tordconstnode(p).value))) + curconstSegment.concat(Tai_const.Create_8bit(byte(tordconstnode(p).value))) else Message(parser_e_illegal_expression); end; bool16bit : begin if is_constboolnode(p) then - asmlist[cural].concat(Tai_const.Create_16bit(word(tordconstnode(p).value))) + curconstSegment.concat(Tai_const.Create_16bit(word(tordconstnode(p).value))) else Message(parser_e_illegal_expression); end; bool32bit : begin if is_constboolnode(p) then - asmlist[cural].concat(Tai_const.Create_32bit(longint(tordconstnode(p).value))) + curconstSegment.concat(Tai_const.Create_32bit(longint(tordconstnode(p).value))) else Message(parser_e_illegal_expression); end; uchar : begin if is_constcharnode(p) then - asmlist[cural].concat(Tai_const.Create_8bit(byte(tordconstnode(p).value))) + curconstSegment.concat(Tai_const.Create_8bit(byte(tordconstnode(p).value))) else Message(parser_e_illegal_expression); end; @@ -174,7 +166,7 @@ implementation if is_constcharnode(p) then inserttypeconv(p,cwidechartype); if is_constwidecharnode(p) then - asmlist[cural].concat(Tai_const.Create_16bit(word(tordconstnode(p).value))) + curconstSegment.concat(Tai_const.Create_16bit(word(tordconstnode(p).value))) else Message(parser_e_illegal_expression); end; @@ -183,7 +175,7 @@ implementation begin if is_constintnode(p) then begin - asmlist[cural].concat(Tai_const.Create_8bit(byte(tordconstnode(p).value))); + curconstSegment.concat(Tai_const.Create_8bit(byte(tordconstnode(p).value))); check_range(torddef(t.def)); end else @@ -194,7 +186,7 @@ implementation begin if is_constintnode(p) then begin - asmlist[cural].concat(Tai_const.Create_16bit(word(tordconstnode(p).value))); + curconstSegment.concat(Tai_const.Create_16bit(word(tordconstnode(p).value))); check_range(torddef(t.def)); end else @@ -205,7 +197,7 @@ implementation begin if is_constintnode(p) then begin - asmlist[cural].concat(Tai_const.Create_32bit(longint(tordconstnode(p).value))); + curconstSegment.concat(Tai_const.Create_32bit(longint(tordconstnode(p).value))); if torddef(t.def).typ<>u32bit then check_range(torddef(t.def)); end @@ -230,7 +222,7 @@ implementation intvalue:=0; Message(parser_e_illegal_expression); end; - asmlist[cural].concat(Tai_const.Create_64bit(intvalue)); + curconstSegment.concat(Tai_const.Create_64bit(intvalue)); end; else internalerror(3799); @@ -249,24 +241,24 @@ implementation case tfloatdef(t.def).typ of s32real : - asmlist[cural].concat(Tai_real_32bit.Create(ts32real(value))); + curconstSegment.concat(Tai_real_32bit.Create(ts32real(value))); s64real : {$ifdef ARM} if aktfputype in [fpu_fpa,fpu_fpa10,fpu_fpa11] then - asmlist[cural].concat(Tai_real_64bit.Create_hiloswapped(ts64real(value))) + curconstSegment.concat(Tai_real_64bit.Create_hiloswapped(ts64real(value))) else {$endif ARM} - asmlist[cural].concat(Tai_real_64bit.Create(ts64real(value))); + curconstSegment.concat(Tai_real_64bit.Create(ts64real(value))); s80real : - asmlist[cural].concat(Tai_real_80bit.Create(value)); + curconstSegment.concat(Tai_real_80bit.Create(value)); { the round is necessary for native compilers where comp isn't a float } s64comp : - asmlist[cural].concat(Tai_comp_64bit.Create(round(value))); + curconstSegment.concat(Tai_comp_64bit.Create(round(value))); s64currency: - asmlist[cural].concat(Tai_comp_64bit.Create(round(value*10000))); + curconstSegment.concat(Tai_comp_64bit.Create(round(value*10000))); s128real: - asmlist[cural].concat(Tai_real_128bit.Create(value)); + curconstSegment.concat(Tai_real_128bit.Create(value)); else internalerror(18); end; @@ -281,11 +273,11 @@ implementation begin if not Tobjectdef(pointertype.def).is_related(Tobjectdef(pointertype.def)) then message(parser_e_illegal_expression); - asmlist[cural].concat(Tai_const.Create_sym(objectlibrary.newasmsymbol( + curconstSegment.concat(Tai_const.Create_sym(objectlibrary.newasmsymbol( Tobjectdef(pointertype.def).vmt_mangledname,AB_EXTERNAL,AT_DATA))); end; niln: - asmlist[cural].concat(Tai_const.Create_sym(nil)); + curconstSegment.concat(Tai_const.Create_sym(nil)); else Message(parser_e_illegal_expression); end; p.free; @@ -316,30 +308,30 @@ implementation if (p.nodetype = pointerconstn) then begin if sizeof(TConstPtrUInt)=8 then - asmlist[cural].concat(Tai_const.Create_64bit(TConstPtrUInt(tpointerconstnode(p).value))) + curconstsegment.concat(Tai_const.Create_64bit(TConstPtrUInt(tpointerconstnode(p).value))) else if sizeof(TConstPtrUInt)=4 then - asmlist[cural].concat(Tai_const.Create_32bit(TConstPtrUInt(tpointerconstnode(p).value))) + curconstsegment.concat(Tai_const.Create_32bit(TConstPtrUInt(tpointerconstnode(p).value))) else internalerror(200404122); end { nil pointer ? } else if p.nodetype=niln then - asmlist[cural].concat(Tai_const.Create_sym(nil)) + curconstSegment.concat(Tai_const.Create_sym(nil)) { maybe pchar ? } else if is_char(tpointerdef(t.def).pointertype.def) and (p.nodetype<>addrn) then begin objectlibrary.getdatalabel(ll); - asmlist[cural].concat(Tai_const.Create_sym(ll)); + curconstSegment.concat(Tai_const.Create_sym(ll)); if p.nodetype=stringconstn then - varalign:=size_2_align(tstringconstnode(p).len) + varalign:=tstringconstnode(p).len else varalign:=0; varalign:=const_align(varalign); - asmlist[al_const].concat(Tai_align.Create(varalign)); - asmlist[al_const].concat(Tai_label.Create(ll)); + Consts.concat(Tai_align.Create(varalign)); + Consts.concat(Tai_label.Create(ll)); if p.nodetype=stringconstn then begin len:=tstringconstnode(p).len; @@ -349,13 +341,13 @@ implementation len:=255; getmem(ca,len+2); move(tstringconstnode(p).value_str^,ca^,len+1); - asmlist[al_const].concat(Tai_string.Create_pchar(ca,len+1)); + Consts.concat(Tai_string.Create_length_pchar(ca,len+1)); end else if is_constcharnode(p) then - asmlist[al_const].concat(Tai_string.Create(char(byte(tordconstnode(p).value))+#0)) + Consts.concat(Tai_string.Create(char(byte(tordconstnode(p).value))+#0)) else - message(parser_e_illegal_expression); + Message(parser_e_illegal_expression); end { maybe pwidechar ? } else @@ -363,9 +355,9 @@ implementation (p.nodetype<>addrn) then begin objectlibrary.getdatalabel(ll); - asmlist[cural].concat(Tai_const.Create_sym(ll)); - asmlist[al_typedconsts].concat(tai_align.create(const_align(sizeof(aint)))); - asmlist[al_typedconsts].concat(Tai_label.Create(ll)); + curconstSegment.concat(Tai_const.Create_sym(ll)); + Consts.concat(tai_align.create(const_align(sizeof(aint)))); + Consts.concat(Tai_label.Create(ll)); if (p.nodetype in [stringconstn,ordconstn]) then begin { convert to widestring stringconstn } @@ -375,9 +367,9 @@ implementation begin pw:=pcompilerwidestring(tstringconstnode(p).value_str); for i:=0 to tstringconstnode(p).len-1 do - asmlist[al_typedconsts].concat(Tai_const.Create_16bit(pw^.data[i])); + Consts.concat(Tai_const.Create_16bit(pw^.data[i])); { ending #0 } - asmlist[al_typedconsts].concat(Tai_const.Create_16bit(0)) + Consts.concat(Tai_const.Create_16bit(0)) end; end else @@ -445,17 +437,17 @@ implementation if po_abstractmethod in tprocsym(srsym).first_procdef.procoptions then Message(type_e_cant_take_address_of_abstract_method) else - asmlist[cural].concat(Tai_const.Createname(tprocsym(srsym).first_procdef.mangledname,AT_FUNCTION,offset)); + curconstSegment.concat(Tai_const.Createname(tprocsym(srsym).first_procdef.mangledname,AT_FUNCTION,offset)); end; globalvarsym : - asmlist[cural].concat(Tai_const.Createname(tglobalvarsym(srsym).mangledname,AT_DATA,offset)); + curconstSegment.concat(Tai_const.Createname(tglobalvarsym(srsym).mangledname,AT_DATA,offset)); typedconstsym : - asmlist[cural].concat(Tai_const.Createname(ttypedconstsym(srsym).mangledname,AT_DATA,offset)); + curconstSegment.concat(Tai_const.Createname(ttypedconstsym(srsym).mangledname,AT_DATA,offset)); labelsym : - asmlist[cural].concat(Tai_const.Createname(tlabelsym(srsym).mangledname,AT_LABEL,offset)); + curconstSegment.concat(Tai_const.Createname(tlabelsym(srsym).mangledname,AT_FUNCTION,offset)); constsym : if tconstsym(srsym).consttyp=constresourcestring then - asmlist[cural].concat(Tai_const.Createname(make_mangledname('RESOURCESTRINGLIST',tconstsym(srsym).owner,''),AT_DATA,tconstsym(srsym).resstrindex*(4+sizeof(aint)*3)+4+sizeof(aint))) + curconstSegment.concat(Tai_const.Createname(make_mangledname('RESOURCESTRINGLIST',tconstsym(srsym).owner,''),AT_DATA,tconstsym(srsym).resstrindex*(4+sizeof(aint)*3)+4+sizeof(aint))) else Message(type_e_variable_id_expected); else @@ -472,7 +464,7 @@ implementation begin if (tinlinenode(p).left.nodetype=typen) then begin - asmlist[cural].concat(Tai_const.createname( + curconstSegment.concat(Tai_const.createname( tobjectdef(tinlinenode(p).left.resulttype.def).vmt_mangledname,AT_DATA,0)); end else @@ -502,7 +494,7 @@ implementation if source_info.endian = target_info.endian then begin for l:=0 to p.resulttype.def.size-1 do - asmlist[cural].concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[l])); + curconstsegment.concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[l])); end else begin @@ -510,10 +502,10 @@ implementation j:=0; for l:=0 to ((p.resulttype.def.size-1) div 4) do begin - asmlist[cural].concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[j+3])); - asmlist[cural].concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[j+2])); - asmlist[cural].concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[j+1])); - asmlist[cural].concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[j])); + curconstsegment.concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[j+3])); + curconstsegment.concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[j+2])); + curconstsegment.concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[j+1])); + curconstsegment.concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[j])); Inc(j,4); end; end; @@ -532,9 +524,9 @@ implementation is_subequal(p.resulttype.def,t.def) then begin case longint(p.resulttype.def.size) of - 1 : asmlist[cural].concat(Tai_const.Create_8bit(Byte(tordconstnode(p).value))); - 2 : asmlist[cural].concat(Tai_const.Create_16bit(Word(tordconstnode(p).value))); - 4 : asmlist[cural].concat(Tai_const.Create_32bit(Longint(tordconstnode(p).value))); + 1 : curconstSegment.concat(Tai_const.Create_8bit(Byte(tordconstnode(p).value))); + 2 : curconstSegment.concat(Tai_const.Create_16bit(Word(tordconstnode(p).value))); + 4 : curconstSegment.concat(Tai_const.Create_32bit(Longint(tordconstnode(p).value))); end; end else @@ -584,12 +576,12 @@ implementation message2(parser_w_string_too_long,strpas(strval),tostr(t.def.size-1)); strlength:=t.def.size-1; end; - asmlist[cural].concat(Tai_const.Create_8bit(strlength)); + curconstSegment.concat(Tai_const.Create_8bit(strlength)); { this can also handle longer strings } getmem(ca,strlength+1); move(strval^,ca^,strlength); ca[strlength]:=#0; - asmlist[cural].concat(Tai_string.Create_pchar(ca,strlength)); + curconstSegment.concat(Tai_string.Create_length_pchar(ca,strlength)); { fillup with spaces if size is shorter } if t.def.size>strlength then begin @@ -599,51 +591,123 @@ implementation fillchar(ca[0],t.def.size-strlength-1,' '); ca[t.def.size-strlength-1]:=#0; { this can also handle longer strings } - asmlist[cural].concat(Tai_string.Create_pchar(ca,t.def.size-strlength-1)); + curconstSegment.concat(Tai_string.Create_length_pchar(ca,t.def.size-strlength-1)); end; end; - st_ansistring: + {$ifdef ansistrings_bits} + st_ansistring16: begin { an empty ansi string is nil! } if (strlength=0) then - asmlist[cural].concat(Tai_const.Create_sym(nil)) + curconstSegment.concat(Tai_const.Create_ptr(0)) else begin objectlibrary.getdatalabel(ll); - asmlist[cural].concat(Tai_const.Create_sym(ll)); - asmlist[al_const].concat(tai_align.create(const_align(sizeof(aint)))); - asmlist[al_const].concat(Tai_const.Create_aint(-1)); - asmlist[al_const].concat(Tai_const.Create_aint(strlength)); - asmlist[al_const].concat(Tai_label.Create(ll)); - getmem(ca,strlength+1); + curconstSegment.concat(Tai_const_symbol.Create(ll)); + { the actual structure starts at -12 from start label - CEC } + Consts.concat(tai_align.create(const_align(pointer_size))); + { first write the maximum size } + Consts.concat(Tai_const.Create_16bit(strlength)); + { second write the real length } + Consts.concat(Tai_const.Create_16bit(strlength)); + { redondent with maxlength but who knows ... (PM) } + { third write use count (set to -1 for safety ) } + Consts.concat(Tai_const.Create_16bit(-1)); + Consts.concat(Tai_label.Create(ll)); + getmem(ca,strlength+2); move(strval^,ca^,strlength); { The terminating #0 to be stored in the .data section (JM) } ca[strlength]:=#0; - asmlist[al_const].concat(Tai_string.Create_pchar(ca,strlength+1)); + { End of the PChar. The memory has to be allocated because in } + { tai_string.done, there is a freemem(len+1) (JM) } + ca[strlength+1]:=#0; + Consts.concat(Tai_string.Create_length_pchar(ca,strlength+1)); end; end; + {$endif} + {$ifdef ansistring_bits}st_ansistring32{$else}st_ansistring{$endif}: + begin + { an empty ansi string is nil! } + if (strlength=0) then + curconstSegment.concat(Tai_const.Create_sym(nil)) + else + begin + objectlibrary.getdatalabel(ll); + curconstSegment.concat(Tai_const.Create_sym(ll)); + Consts.concat(tai_align.create(const_align(sizeof(aint)))); + Consts.concat(Tai_const.Create_aint(-1)); + Consts.concat(Tai_const.Create_aint(strlength)); + Consts.concat(Tai_label.Create(ll)); + getmem(ca,strlength+2); + move(strval^,ca^,strlength); + { The terminating #0 to be stored in the .data section (JM) } + ca[strlength]:=#0; + { End of the PChar. The memory has to be allocated because in } + { tai_string.done, there is a freemem(len+1) (JM) } + ca[strlength+1]:=#0; + Consts.concat(Tai_string.Create_length_pchar(ca,strlength+1)); + end; + end; + {$ifdef ansistring_bits} + st_ansistring64: + begin + { an empty ansi string is nil! } + if (strlength=0) then + curconstSegment.concat(Tai_const.Create_ptr(0)) + else + begin + objectlibrary.getdatalabel(ll); + curconstSegment.concat(Tai_const_symbol.Create(ll)); + { the actual structure starts at -12 from start label - CEC } + Consts.concat(tai_align.create(const_align(pointer_size))); + { first write the maximum size } + Consts.concat(Tai_const.Create_64bit(strlength)); + { second write the real length } + Consts.concat(Tai_const.Create_64bit(strlength)); + { redondent with maxlength but who knows ... (PM) } + { third write use count (set to -1 for safety ) } + Consts.concat(Tai_const.Create_64bit(-1)); + Consts.concat(Tai_label.Create(ll)); + getmem(ca,strlength+2); + move(strval^,ca^,strlength); + { The terminating #0 to be stored in the .data section (JM) } + ca[strlength]:=#0; + { End of the PChar. The memory has to be allocated because in } + { tai_string.done, there is a freemem(len+1) (JM) } + ca[strlength+1]:=#0; + Consts.concat(Tai_string.Create_length_pchar(ca,strlength+1)); + end; + end; + {$endif} st_widestring: begin { an empty ansi string is nil! } if (strlength=0) then - asmlist[cural].concat(Tai_const.Create_sym(nil)) + curconstSegment.concat(Tai_const.Create_sym(nil)) else begin objectlibrary.getdatalabel(ll); - asmlist[cural].concat(Tai_const.Create_sym(ll)); - asmlist[al_const].concat(tai_align.create(const_align(sizeof(aint)))); - asmlist[al_const].concat(Tai_const.Create_aint(-1)); - asmlist[al_const].concat(Tai_const.Create_aint(strlength*cwidechartype.def.size)); - asmlist[al_const].concat(Tai_label.Create(ll)); + curconstSegment.concat(Tai_const.Create_sym(ll)); + consts.concat(tai_align.create(const_align(sizeof(aint)))); + consts.concat(Tai_const.Create_aint(-1)); + consts.concat(Tai_const.Create_aint(strlength*cwidechartype.def.size)); + consts.concat(Tai_label.Create(ll)); for i:=0 to strlength-1 do - asmlist[al_const].concat(Tai_const.Create_16bit(pcompilerwidestring(strval)^.data[i])); + Consts.concat(Tai_const.Create_16bit(pcompilerwidestring(strval)^.data[i])); { ending #0 } - asmlist[al_const].concat(Tai_const.Create_16bit(0)) + Consts.concat(Tai_const.Create_16bit(0)) end; end; st_longstring: begin internalerror(200107081); + {curconstSegment.concat(Tai_const.Create_32bit(strlength)))); + curconstSegment.concat(Tai_const.Create_8bit(0)); + getmem(ca,strlength+1); + move(strval^,ca^,strlength); + ca[strlength]:=#0; + generate_pascii(consts,ca,strlength); + curconstSegment.concat(Tai_const.Create_8bit(0));} end; end; end; @@ -656,7 +720,7 @@ implementation begin { Only allow nil initialization } consume(_NIL); - asmlist[cural].concat(Tai_const.Create_sym(nil)); + curconstSegment.concat(Tai_const.Create_sym(nil)); end else if try_to_consume(_LKLAMMER) then @@ -701,12 +765,12 @@ implementation begin if i+1-tarraydef(t.def).lowrange<=len then begin - asmlist[cural].concat(Tai_const.Create_8bit(byte(ca^))); + curconstSegment.concat(Tai_const.Create_8bit(byte(ca^))); inc(ca); end else {Fill the remaining positions with #0.} - asmlist[cural].concat(Tai_const.Create_8bit(0)); + curconstSegment.concat(Tai_const.Create_8bit(0)); end; p.free; end @@ -722,9 +786,9 @@ implementation { under tp: =nil or =var under fpc: =nil or =@var } if token=_NIL then begin - asmlist[cural].concat(Tai_const.Create_sym(nil)); + curconstSegment.concat(Tai_const.Create_sym(nil)); if (po_methodpointer in tprocvardef(t.def).procoptions) then - asmlist[cural].concat(Tai_const.Create_sym(nil)); + curconstSegment.concat(Tai_const.Create_sym(nil)); consume(_NIL); goto myexit; end; @@ -771,7 +835,7 @@ implementation if (p.nodetype=loadn) and (tloadnode(p).symtableentry.typ=procsym) then begin - asmlist[cural].concat(Tai_const.createname( + curconstSegment.concat(Tai_const.createname( tprocsym(tloadnode(p).symtableentry).first_procdef.mangledname,AT_FUNCTION,0)); end else @@ -793,11 +857,11 @@ implementation p.free; if string2guid(s,tmpguid) then begin - asmlist[cural].concat(Tai_const.Create_32bit(longint(tmpguid.D1))); - asmlist[cural].concat(Tai_const.Create_16bit(tmpguid.D2)); - asmlist[cural].concat(Tai_const.Create_16bit(tmpguid.D3)); + curconstSegment.concat(Tai_const.Create_32bit(longint(tmpguid.D1))); + curconstSegment.concat(Tai_const.Create_16bit(tmpguid.D2)); + curconstSegment.concat(Tai_const.Create_16bit(tmpguid.D3)); for i:=Low(tmpguid.D4) to High(tmpguid.D4) do - asmlist[cural].concat(Tai_const.Create_8bit(tmpguid.D4[i])); + curconstSegment.concat(Tai_const.Create_8bit(tmpguid.D4[i])); end else Message(parser_e_improper_guid_syntax); @@ -875,7 +939,7 @@ implementation { if needed fill (alignment) } if tfieldvarsym(srsym).fieldoffset>aktpos then for i:=1 to tfieldvarsym(srsym).fieldoffset-aktpos do - asmlist[cural].concat(Tai_const.Create_8bit(0)); + curconstSegment.concat(Tai_const.Create_8bit(0)); { new position } aktpos:=tfieldvarsym(srsym).fieldoffset+tfieldvarsym(srsym).vartype.def.size; @@ -904,7 +968,7 @@ implementation Message1(parser_w_skipped_fields_after,sorg); for i:=1 to t.def.size-aktpos do - asmlist[cural].concat(Tai_const.Create_8bit(0)); + curconstSegment.concat(Tai_const.Create_8bit(0)); consume(_RKLAMMER); end; @@ -922,7 +986,7 @@ implementation end else begin - asmlist[cural].concat(Tai_const.Create_sym(nil)); + curconstSegment.concat(Tai_const.Create_sym(nil)); end; p.free; end @@ -973,8 +1037,8 @@ implementation (vmt_offset<fieldoffset) then begin for i:=1 to vmt_offset-aktpos do - asmlist[cural].concat(tai_const.create_8bit(0)); - asmlist[cural].concat(tai_const.createname(vmt_mangledname,AT_DATA,0)); + curconstsegment.concat(tai_const.create_8bit(0)); + curconstsegment.concat(tai_const.createname(vmt_mangledname,AT_DATA,0)); { this is more general } aktpos:=vmt_offset + sizeof(aint); end; @@ -982,7 +1046,7 @@ implementation { if needed fill } if fieldoffset>aktpos then for i:=1 to fieldoffset-aktpos do - asmlist[cural].concat(Tai_const.Create_8bit(0)); + curconstSegment.concat(Tai_const.Create_8bit(0)); { new position } aktpos:=fieldoffset+vartype.def.size; @@ -1000,13 +1064,13 @@ implementation (tobjectdef(t.def).vmt_offset>=aktpos) then begin for i:=1 to tobjectdef(t.def).vmt_offset-aktpos do - asmlist[cural].concat(tai_const.create_8bit(0)); - asmlist[cural].concat(tai_const.createname(tobjectdef(t.def).vmt_mangledname,AT_DATA,0)); + curconstsegment.concat(tai_const.create_8bit(0)); + curconstsegment.concat(tai_const.createname(tobjectdef(t.def).vmt_mangledname,AT_DATA,0)); { this is more general } aktpos:=tobjectdef(t.def).vmt_offset + sizeof(aint); end; for i:=1 to t.def.size-aktpos do - asmlist[cural].concat(Tai_const.Create_8bit(0)); + curconstSegment.concat(Tai_const.Create_8bit(0)); consume(_RKLAMMER); end; end; diff --git a/compiler/ptype.pas b/compiler/ptype.pas index 62ae3c9e23..2ed4ddb573 100644 --- a/compiler/ptype.pas +++ b/compiler/ptype.pas @@ -232,7 +232,7 @@ implementation { for tp7 don't allow forward types } if m_tp7 in aktmodeswitches then typecanbeforward:=false; - read_var_decs([vd_record]); + read_var_decs(true,false,false); consume(_END); typecanbeforward:=storetypecanbeforward; current_object_option:=old_object_option; diff --git a/compiler/raatt.pas b/compiler/raatt.pas index 2e70b9c04a..9d5259b4d4 100644 --- a/compiler/raatt.pas +++ b/compiler/raatt.pas @@ -276,19 +276,6 @@ unit raatt; end end; {$endif POWERPC} -{$ifdef POWERPC64} - { some PowerPC instructions can have the postfix -, + or . - this code could be moved to is_asmopcode but I think - it's better to ifdef it here (FK) - } - case c of - '.', '-', '+': - begin - actasmpattern:=actasmpattern+c; - c:=current_scanner.asmgetchar; - end - end; -{$endif POWERPC64} { Opcode ? } If is_asmopcode(upper(actasmpattern)) then Begin @@ -1119,7 +1106,7 @@ unit raatt; commname:=actasmpattern; Consume(AS_ID); Consume(AS_COMMA); - curList.concat(Tai_datablock.Create(commname,BuildConstExpression(false,false))); + ConcatLocalBss(commname,BuildConstExpression(false,false)); if actasmtoken<>AS_SEPARATOR then Consume(AS_SEPARATOR); end; @@ -1130,7 +1117,7 @@ unit raatt; commname:=actasmpattern; Consume(AS_ID); Consume(AS_COMMA); - curList.concat(Tai_datablock.Create_global(commname,BuildConstExpression(false,false))); + ConcatGlobalBss(commname,BuildConstExpression(false,false)); if actasmtoken<>AS_SEPARATOR then Consume(AS_SEPARATOR); end; @@ -1395,7 +1382,7 @@ unit raatt; begin CreateLocalLabel(tempstr,hl,false); hs:=hl.name; - hssymtyp:=AT_LABEL; + hssymtyp:=AT_FUNCTION; end else if SearchLabel(tempstr,hl,false) then diff --git a/compiler/rabase.pas b/compiler/rabase.pas index 4cca4b3660..f6d3f40506 100644 --- a/compiler/rabase.pas +++ b/compiler/rabase.pas @@ -40,7 +40,7 @@ unit rabase; pasmmodeinfo = ^tasmmodeinfo; tasmmodeinfo = record id : tasmmode; - idtxt : string[12]; + idtxt : string[8]; casmreader : tcbaseasmreader; end; diff --git a/compiler/rautils.pas b/compiler/rautils.pas index 6f3d57a4ab..beb8ca0687 100644 --- a/compiler/rautils.pas +++ b/compiler/rautils.pas @@ -81,9 +81,6 @@ type {$ifdef powerpc} OPR_COND : (cond : tasmcond); {$endif powerpc} -{$ifdef POWERPC64} - OPR_COND : (cond : tasmcond); -{$endif POWERPC64} {$ifdef arm} OPR_REGSET : (regset : tcpuregisterset); OPR_SHIFTEROP : (shifterop : tshifterop); @@ -198,6 +195,7 @@ Function SearchIConstant(const s:string; var l:aint): boolean; ---------------------------------------------------------------------} Procedure ConcatPasString(p : TAAsmoutput;s:string); + Procedure ConcatDirect(p : TAAsmoutput;s:string); Procedure ConcatLabel(p: TAAsmoutput;var l : tasmlabel); Procedure ConcatConstant(p : TAAsmoutput;value: aint; constsize:byte); Procedure ConcatConstSymbol(p : TAAsmoutput;const sym:string;symtyp:tasmsymtype;l:aint); @@ -206,6 +204,8 @@ Function SearchIConstant(const s:string; var l:aint): boolean; procedure ConcatAlign(p:TAAsmoutput;l:aint); Procedure ConcatPublic(p:TAAsmoutput;const s : string); Procedure ConcatLocal(p:TAAsmoutput;const s : string); + Procedure ConcatGlobalBss(const s : string;size : aint); + Procedure ConcatLocalBss(const s : string;size : aint); Implementation @@ -852,7 +852,7 @@ Begin arraydef, floatdef : SetSize(tabstractvarsym(sym).getsize,false); - (* makes no sense when using sse instructions (FK) + { makes no sense when using sse instructions (FK) arraydef : begin { for arrays try to get the element size, take care of @@ -863,7 +863,7 @@ Begin harrdef:=tarraydef(harrdef.elementtype.def); SetSize(harrdef.elesize,false); end; - *) + } end; hasvar:=true; SetupVar:=true; @@ -1099,7 +1099,7 @@ function TLocalLabel.Gettasmlabel:tasmlabel; begin if not assigned(lab) then begin - objectlibrary.getjumplabel(lab); + objectlibrary.getlabel(lab); { this label is forced to be used so it's always written } lab.increfs; end; @@ -1389,7 +1389,7 @@ Begin labelsym : begin if not(assigned(tlabelsym(sym).asmblocklabel)) then - objectlibrary.getjumplabel(tlabelsym(sym).asmblocklabel); + objectlibrary.getlabel(tlabelsym(sym).asmblocklabel); hl:=tlabelsym(sym).asmblocklabel; if emit then tlabelsym(sym).defined:=true @@ -1416,7 +1416,7 @@ end; pc: PChar; Begin getmem(pc,length(s)+1); - p.concat(Tai_string.Create_pchar(strpcopy(pc,s),length(s))); + p.concat(Tai_string.Create_length_pchar(strpcopy(pc,s),length(s))); end; Procedure ConcatPasString(p : TAAsmoutput;s:string); @@ -1430,6 +1430,23 @@ end; p.concat(Tai_string.Create(s)); end; + Procedure ConcatDirect(p : TAAsmoutput;s:string); + {*********************************************************************} + { PROCEDURE ConcatDirect(s:string) } + { Description: This routine output the string directly to the asm } + { output, it is only sed when writing special labels in AT&T mode, } + { and should not be used without due consideration, since it may } + { cause problems. } + {*********************************************************************} + Var + pc: PChar; + Begin + getmem(pc,length(s)+1); + p.concat(Tai_direct.Create(strpcopy(pc,s))); + end; + + + Procedure ConcatConstant(p: TAAsmoutput; value: aint; constsize:byte); {*********************************************************************} @@ -1539,7 +1556,7 @@ end; { linked list of instructions.(used by AT&T styled asm) } {*********************************************************************} begin - p.concat(Tai_symbol.Createname_global(s,AT_LABEL,0)); + p.concat(Tai_symbol.Createname_global(s,AT_FUNCTION,0)); end; procedure ConcatLocal(p:TAAsmoutput;const s : string); @@ -1549,8 +1566,27 @@ end; { linked list of instructions. } {*********************************************************************} begin - p.concat(Tai_symbol.Createname(s,AT_LABEL,0)); + p.concat(Tai_symbol.Createname(s,AT_FUNCTION,0)); end; + Procedure ConcatGlobalBss(const s : string;size : aint); + {*********************************************************************} + { PROCEDURE ConcatGlobalBss } + { Description: This routine emits an global datablock to the } + { linked list of instructions. } + {*********************************************************************} + begin + bssSegment.concat(Tai_datablock.Create_global(s,size)); + end; + + Procedure ConcatLocalBss(const s : string;size : aint); + {*********************************************************************} + { PROCEDURE ConcatLocalBss } + { Description: This routine emits a local datablcok to the } + { linked list of instructions. } + {*********************************************************************} + begin + bssSegment.concat(Tai_datablock.Create(s,size)); + end; end. diff --git a/compiler/scandir.pas b/compiler/scandir.pas index 9975ab3a27..3b8793cc10 100644 --- a/compiler/scandir.pas +++ b/compiler/scandir.pas @@ -243,7 +243,7 @@ implementation var hs : string; begin - if not (target_info.system in system_all_windows + [system_i386_os2, + if not (target_info.system in [system_i386_win32,system_i386_os2, system_i386_emx, system_powerpc_macos]) then Message(scan_w_app_type_not_support); if not current_module.in_global then @@ -256,8 +256,6 @@ implementation apptype:=app_gui else if hs='CONSOLE' then apptype:=app_cui - else if (hs='NATIVE') and (target_info.system in system_windows) then - apptype:=app_native else if (hs='FS') and (target_info.system in [system_i386_os2, system_i386_emx]) then apptype:=app_fs @@ -691,6 +689,20 @@ implementation do_delphiswitch('P'); end; + procedure dir_output_format; + begin + if not current_module.in_global then + Message(scan_w_switch_is_global) + else + begin + current_scanner.skipspace; + if set_target_asm_by_string(current_scanner.readid) then + aktoutputformat:=target_asm.id + else + Message1(scan_w_illegal_switch,pattern); + end; + end; + procedure dir_overflowchecks; begin do_delphiswitch('Q'); @@ -864,7 +876,7 @@ implementation Message(scan_w_only_one_resourcefile_supported) else current_module.resourcefiles.insert(FixFileName(s)); - end + end else Message(scan_e_resourcefiles_not_supported); end; @@ -1182,6 +1194,7 @@ implementation AddDirective('OBJECTCHECKS',directive_all, @dir_objectchecks); AddDirective('OBJECTPATH',directive_all, @dir_objectpath); AddDirective('OPENSTRINGS',directive_all, @dir_openstrings); + AddDirective('OUTPUT_FORMAT',directive_all, @dir_output_format); AddDirective('OVERFLOWCHECKS',directive_all, @dir_overflowchecks); AddDirective('PACKENUM',directive_all, @dir_packenum); AddDirective('PACKRECORDS',directive_all, @dir_packrecords); diff --git a/compiler/scanner.pas b/compiler/scanner.pas index 81f8e521b4..0ea6c191e7 100644 --- a/compiler/scanner.pas +++ b/compiler/scanner.pas @@ -2037,7 +2037,7 @@ compile time variables as the old format (0/1), continue to work. preprocstack.accept:=false; preprocstack.typ:=pp_elseif; end - else if (not(assigned(preprocstack.next)) or (preprocstack.next.accept)) + else if (not(assigned(preprocstack.next)) or (preprocstack.next.accept)) and compile_time_predicate(valuedescr) then begin preprocstack.name:=valuedescr; diff --git a/compiler/sparc/cgcpu.pas b/compiler/sparc/cgcpu.pas index 593f936d66..6b3024d6a4 100644 --- a/compiler/sparc/cgcpu.pas +++ b/compiler/sparc/cgcpu.pas @@ -930,7 +930,7 @@ implementation var hl : tasmlabel; begin - objectlibrary.getjumplabel(hl); + objectlibrary.getlabel(hl); a_load_const_reg(list,size,1,reg); a_jmp_flags(list,f,hl); a_load_const_reg(list,size,0,reg); @@ -955,7 +955,7 @@ implementation begin if not(cs_check_overflow in aktlocalswitches) then exit; - objectlibrary.getjumplabel(hl); + objectlibrary.getlabel(hl); case ovloc.loc of LOC_VOID: begin @@ -1140,7 +1140,7 @@ implementation a_load_const_reg(list,OS_INT,count,countreg); { explicitely allocate R_O0 since it can be used safely here } { (for holding date that's being copied) } - objectlibrary.getjumplabel(lab); + objectlibrary.getlabel(lab); a_label(list, lab); list.concat(taicpu.op_ref_reg(A_LD,src,tmpreg1)); list.concat(taicpu.op_reg_ref(A_ST,tmpreg1,dst)); @@ -1228,7 +1228,7 @@ implementation a_load_const_reg(list,OS_INT,len,countreg); { explicitely allocate R_O0 since it can be used safely here } { (for holding date that's being copied) } - objectlibrary.getjumplabel(lab); + objectlibrary.getlabel(lab); a_label(list, lab); list.concat(taicpu.op_ref_reg(A_LDUB,src,tmpreg1)); list.concat(taicpu.op_reg_ref(A_STB,tmpreg1,dst)); diff --git a/compiler/sparc/cpupara.pas b/compiler/sparc/cpupara.pas index e8b9e3bdb4..9861e8ab94 100644 --- a/compiler/sparc/cpupara.pas +++ b/compiler/sparc/cpupara.pas @@ -175,7 +175,7 @@ implementation begin p.funcretloc[side].loc:=LOC_REGISTER; { high } - if (side=callerside) or (po_inline in p.procoptions) then + if (side=callerside) (po_inline in p.procoptions) then p.funcretloc[side].register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG else p.funcretloc[side].register64.reghi:=NR_FUNCTION_RETURN64_HIGH_REG; diff --git a/compiler/sparc/cputarg.pas b/compiler/sparc/cputarg.pas index a7b77c8467..555935c6de 100644 --- a/compiler/sparc/cputarg.pas +++ b/compiler/sparc/cputarg.pas @@ -52,25 +52,6 @@ implementation ,CpuGas -{************************************** - Assembler Readers -**************************************} - - {$ifndef NoSparcgas} - ,racpugas - {$endif NoSparcgas} - -{************************************** - Debuginfo -**************************************} - - {$ifndef NoDbgStabs} - ,dbgstabs - {$endif NoDbgStabs} - {$ifndef NoDbgDwarf} - ,dbgdwarf - {$endif NoDbgDwarf} - ; end. diff --git a/compiler/sparc/ncpucnv.pas b/compiler/sparc/ncpucnv.pas index 26df287315..50cc429202 100644 --- a/compiler/sparc/ncpucnv.pas +++ b/compiler/sparc/ncpucnv.pas @@ -147,7 +147,7 @@ implementation else begin objectlibrary.getdatalabel(l1); - objectlibrary.getjumplabel(l2); + objectlibrary.getlabel(l2); reference_reset_symbol(href,l1,0); hregister:=cg.getintregister(exprasmlist,OS_32); cg.a_load_loc_reg(exprasmlist,OS_32,left.location,hregister); @@ -169,14 +169,14 @@ implementation s64real: begin hregister:=cg.getfpuregister(exprasmlist,OS_F64); - asmlist[al_typedconsts].concat(tai_align.create(const_align(8))); - asmlist[al_typedconsts].concat(Tai_label.Create(l1)); + consts.concat(tai_align.create(const_align(8))); + consts.concat(Tai_label.Create(l1)); { I got this constant from a test program (FK) } - asmlist[al_typedconsts].concat(Tai_const.Create_32bit($41f00000)); - asmlist[al_typedconsts].concat(Tai_const.Create_32bit(0)); + consts.concat(Tai_const.Create_32bit($41f00000)); + consts.concat(Tai_const.Create_32bit(0)); cg.a_loadfpu_ref_reg(exprasmlist,OS_F64,href,hregister); - exprasmlist.concat(taicpu.op_reg_reg_reg(A_FADDD,location.register,hregister,location.register)); + exprasmList.concat(taicpu.op_reg_reg_reg(A_FADDD,location.register,hregister,location.register)); cg.a_label(exprasmlist,l2); { cut off if we should convert to single } @@ -228,8 +228,8 @@ implementation begin oldtruelabel:=truelabel; oldfalselabel:=falselabel; - objectlibrary.getjumplabel(truelabel); - objectlibrary.getjumplabel(falselabel); + objectlibrary.getlabel(truelabel); + objectlibrary.getlabel(falselabel); secondpass(left); if codegenerror then exit; @@ -279,7 +279,7 @@ implementation LOC_JUMP : begin hreg1:=cg.getintregister(exprasmlist,OS_INT); - objectlibrary.getjumplabel(hlabel); + objectlibrary.getlabel(hlabel); cg.a_label(exprasmlist,truelabel); cg.a_load_const_reg(exprasmlist,OS_INT,1,hreg1); cg.a_jmp_always(exprasmlist,hlabel); diff --git a/compiler/sparc/ncpumat.pas b/compiler/sparc/ncpumat.pas index 34879d9790..eaa33dac08 100644 --- a/compiler/sparc/ncpumat.pas +++ b/compiler/sparc/ncpumat.pas @@ -139,7 +139,7 @@ implementation if (nodetype = modn) then begin - objectlibrary.getjumplabel(overflowlabel); + objectlibrary.getlabel(overflowlabel); ai:=taicpu.op_cond_sym(A_Bxx,C_O,overflowlabel); ai.delayslot_annulled:=true; exprasmlist.concat(ai); diff --git a/compiler/sparc/ncpuset.pas b/compiler/sparc/ncpuset.pas index 6f0b955859..018506f973 100644 --- a/compiler/sparc/ncpuset.pas +++ b/compiler/sparc/ncpuset.pas @@ -68,24 +68,30 @@ unit ncpuset; last : TConstExprInt; indexreg,jmpreg,basereg : tregister; href : treference; + jumpsegment : TAAsmOutput; - procedure genitem(list:taasmoutput;t : pcaselabel); + procedure genitem(t : pcaselabel); var i : aint; begin if assigned(t^.less) then - genitem(list,t^.less); + genitem(t^.less); { fill possible hole } for i:=last+1 to t^._low-1 do - list.concat(Tai_const.Create_sym(elselabel)); + jumpSegment.concat(Tai_const.Create_sym(elselabel)); for i:=t^._low to t^._high do - list.concat(Tai_const.Create_sym(blocklabel(t^.blockid))); + jumpSegment.concat(Tai_const.Create_sym(blocklabel(t^.blockid))); last:=t^._high; if assigned(t^.greater) then - genitem(list,t^.greater); + genitem(t^.greater); end; begin + if (cs_create_smart in aktmoduleswitches) or + (af_smartlink_sections in target_asm.flags) then + jumpsegment:=current_procinfo.aktlocaldata + else + jumpsegment:=datasegment; if not(jumptable_no_range) then begin { case expr less than min_ => goto elselabel } @@ -93,7 +99,7 @@ unit ncpuset; { case expr greater than max_ => goto elselabel } cg.a_cmp_const_reg_label(exprasmlist,opsize,jmp_gt,aint(max_),hregister,elselabel); end; - objectlibrary.getjumplabel(table); + objectlibrary.getlabel(table); indexreg:=cg.getaddressregister(exprasmlist); cg.a_op_const_reg_reg(exprasmlist,OP_SHL,OS_ADDR,2,hregister,indexreg); { create reference } @@ -113,10 +119,11 @@ unit ncpuset; { Delay slot } exprasmlist.concat(taicpu.op_none(A_NOP)); { generate jump table } - new_section(current_procinfo.aktlocaldata,sec_data,current_procinfo.procdef.mangledname,sizeof(aint)); - current_procinfo.aktlocaldata.concat(Tai_label.Create(table)); + if not(cs_littlesize in aktglobalswitches) then + jumpSegment.concat(Tai_Align.Create_Op(4,0)); + jumpSegment.concat(Tai_label.Create(table)); last:=min_; - genitem(current_procinfo.aktlocaldata,hp); + genitem(hp); end; diff --git a/compiler/switches.pas b/compiler/switches.pas index 9f7549c7af..0269151d11 100644 --- a/compiler/switches.pas +++ b/compiler/switches.pas @@ -161,7 +161,7 @@ begin begin { Turning off debuginfo when lineinfo is requested is not possible } - if not((cs_use_lineinfo in aktglobalswitches) and + if not((cs_gdb_lineinfo in aktglobalswitches) and (tmoduleswitch(setsw)=cs_debuginfo)) then exclude(aktmoduleswitches,tmoduleswitch(setsw)); end; diff --git a/compiler/symbase.pas b/compiler/symbase.pas index 8e51a9076f..6aa27b800e 100644 --- a/compiler/symbase.pas +++ b/compiler/symbase.pas @@ -41,6 +41,11 @@ interface hasharraysize = 256; indexgrowsize = 64; +{$ifdef GDB} + memsizeinc = 4096; { for long stabstrings } +{$endif GDB} + + {************************************************ Needed forward pointers ************************************************} @@ -122,6 +127,9 @@ interface {$endif EXTDEBUG} function getdefnr(l : longint) : tdefentry; function getsymnr(l : longint) : tsymentry; +{$ifdef GDB} + function getnewtypecount : word; virtual; +{$endif GDB} end; var @@ -330,4 +338,12 @@ implementation end; +{$ifdef GDB} + function tsymtable.getnewtypecount : word; + begin + getnewtypecount:=0; + end; +{$endif GDB} + + end. diff --git a/compiler/symconst.pas b/compiler/symconst.pas index 3fad77b4d7..2e6382cab8 100644 --- a/compiler/symconst.pas +++ b/compiler/symconst.pas @@ -189,11 +189,16 @@ type ); { string types } - tstringtype = ( - st_conststring, + tstringtype = (st_default, st_shortstring, st_longstring, + {$ifndef ansistring_bits} st_ansistring, + {$else} + st_ansistring16, + st_ansistring32, + st_ansistring64, + {$endif} st_widestring ); @@ -393,6 +398,8 @@ type te_exact ); +{$ifdef GDB} +type tdefstabstatus = ( stab_state_unused, stab_state_used, @@ -400,6 +407,18 @@ type stab_state_written ); +const + tagtypes : Set of tdeftype = + [recorddef,enumdef, + {$IfNDef GDBKnowsStrings} + stringdef, + {$EndIf not GDBKnowsStrings} + {$IfNDef GDBKnowsFiles} + filedef, + {$EndIf not GDBKnowsFiles} + objectdef]; +{$endif GDB} + const inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has_protected, diff --git a/compiler/symdef.pas b/compiler/symdef.pas index a113e68bdd..751717e3ee 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -63,9 +63,13 @@ interface {$ifdef EXTDEBUG} fileinfo : tfileposinfo; {$endif} +{$ifdef GDB} + globalnb : word; + stab_state : tdefstabstatus; +{$endif GDB} constructor create; constructor ppuloaddef(ppufile:tcompilerppufile); - procedure reset;virtual; + procedure reset; function getcopy : tstoreddef;virtual; procedure ppuwritedef(ppufile:tcompilerppufile); procedure ppuwrite(ppufile:tcompilerppufile);virtual;abstract; @@ -78,6 +82,16 @@ interface function alignment:longint;override; function is_publishable : boolean;override; function needs_inittable : boolean;override; + { debug } +{$ifdef GDB} + function get_var_value(const s:string):string; + function stabstr_evaluate(const s:string;const vars:array of string):Pchar; + function stabstring : pchar;virtual; + procedure concatstabto(asmlist : taasmoutput);virtual; + function numberstring:string;virtual; + procedure set_globalnb;virtual; + function allstabstring : pchar;virtual; +{$endif GDB} { rtti generation } procedure write_rtti_name; procedure write_rtti_data(rt:trttitype);virtual; @@ -106,6 +120,11 @@ interface function gettypename:string;override; function getmangledparaname:string;override; procedure setsize; + { debug } +{$ifdef GDB} + function stabstring : pchar;override; + procedure concatstabto(asmlist : taasmoutput);override; +{$endif GDB} end; tvariantdef = class(tstoreddef) @@ -119,6 +138,11 @@ interface function is_publishable : boolean;override; function needs_inittable : boolean;override; procedure write_rtti_data(rt:trttitype);override; +{$ifdef GDB} + function numberstring:string;override; + function stabstring : pchar;override; + procedure concatstabto(asmlist : taasmoutput);override; +{$endif GDB} end; tformaldef = class(tstoreddef) @@ -126,6 +150,11 @@ interface constructor ppuload(ppufile:tcompilerppufile); procedure ppuwrite(ppufile:tcompilerppufile);override; function gettypename:string;override; +{$ifdef GDB} + function numberstring:string;override; + function stabstring : pchar;override; + procedure concatstabto(asmlist : taasmoutput);override; +{$endif GDB} end; tforwarddef = class(tstoreddef) @@ -141,6 +170,11 @@ interface procedure ppuwrite(ppufile:tcompilerppufile);override; function gettypename:string;override; function getmangledparaname : string;override; + { debug } +{$ifdef GDB} + function stabstring : pchar;override; + procedure concatstabto(asmlist : taasmoutput);override; +{$endif GDB} end; { tpointerdef and tclassrefdef should get a common @@ -159,18 +193,31 @@ interface procedure buildderef;override; procedure deref;override; function gettypename:string;override; + { debug } +{$ifdef GDB} + function stabstring : pchar;override; + procedure concatstabto(asmlist : taasmoutput);override; +{$endif GDB} + end; + + Trecord_stabgen_state=record + stabstring:Pchar; + stabsize,staballoc,recoffset:integer; end; tabstractrecorddef= class(tstoreddef) private Count : integer; FRTTIType : trttitype; +{$ifdef GDB} + procedure field_addname(p:Tnamedindexitem;arg:pointer); + procedure field_concatstabto(p:Tnamedindexitem;arg:pointer); +{$endif} procedure count_field_rtti(sym : tnamedindexitem;arg:pointer); procedure write_field_rtti(sym : tnamedindexitem;arg:pointer); procedure generate_field_rtti(sym : tnamedindexitem;arg:pointer); public symtable : tsymtable; - procedure reset;override; function getsymtable(t:tgetsymtable):tsymtable;override; end; @@ -189,6 +236,10 @@ interface function padalignment: longint; function gettypename:string;override; { debug } +{$ifdef GDB} + function stabstring : pchar;override; + procedure concatstabto(asmlist:taasmoutput);override; +{$endif GDB} function needs_inittable : boolean;override; { rtti } procedure write_child_rtti_data(rt:trttitype);override; @@ -213,6 +264,10 @@ interface tobjectdef = class(tabstractrecorddef) private +{$ifdef GDB} + procedure proc_addname(p :tnamedindexitem;arg:pointer); + procedure proc_concatstabto(p :tnamedindexitem;arg:pointer); +{$endif GDB} procedure count_published_properties(sym:tnamedindexitem;arg:pointer); procedure write_property_info(sym : tnamedindexitem;arg:pointer); procedure generate_published_child_rtti(sym : tnamedindexitem;arg:pointer); @@ -227,7 +282,9 @@ interface { to be able to have a variable vmt position } { and no vmt field for objects without virtuals } vmt_offset : longint; +{$ifdef GDB} writing_class_record_stab : boolean; +{$endif GDB} objecttype : tobjectdeftype; iidguid: pguid; iidstr: pstring; @@ -259,6 +316,14 @@ interface procedure insertvmt; procedure set_parent(c : tobjectdef); function searchdestructor : tprocdef; + { debug } +{$ifdef GDB} + function stabstring : pchar;override; + procedure set_globalnb;override; + function classnumberstring : string; + procedure concatstabto(asmlist : taasmoutput);override; + function allstabstring : pchar;override; +{$endif GDB} { rtti } procedure write_child_rtti_data(rt:trttitype);override; procedure write_rtti_data(rt:trttitype);override; @@ -305,6 +370,10 @@ interface procedure ppuwrite(ppufile:tcompilerppufile);override; function gettypename:string;override; function is_publishable : boolean;override; + { debug } +{$ifdef GDB} + function stabstring : pchar;override; +{$endif GDB} end; tarraydef = class(tstoreddef) @@ -329,6 +398,10 @@ interface function gettypename:string;override; function getmangledparaname : string;override; procedure setelementtype(t: ttype); +{$ifdef GDB} + function stabstring : pchar;override; + procedure concatstabto(asmlist : taasmoutput);override; +{$endif GDB} procedure buildderef;override; procedure deref;override; function size : aint;override; @@ -351,6 +424,10 @@ interface function gettypename:string;override; procedure setsize; function getvartype : longint;override; + { debug } +{$ifdef GDB} + function stabstring : pchar;override; +{$endif GDB} { rtti } procedure write_rtti_data(rt:trttitype);override; end; @@ -365,6 +442,11 @@ interface function is_publishable : boolean;override; procedure setsize; function getvartype:longint;override; + { debug } +{$ifdef GDB} + function stabstring : pchar;override; + procedure concatstabto(asmlist:taasmoutput);override; +{$endif GDB} { rtti } procedure write_rtti_data(rt:trttitype);override; end; @@ -398,6 +480,10 @@ interface procedure test_if_fpu_result; function is_methodpointer:boolean;virtual; function is_addressonly:boolean;virtual; + { debug } +{$ifdef GDB} + function stabstring : pchar;override; +{$endif GDB} private procedure count_para(p:tnamedindexitem;arg:pointer); procedure insert_para(p:tnamedindexitem;arg:pointer); @@ -417,6 +503,11 @@ interface function is_methodpointer:boolean;override; function is_addressonly:boolean;override; function getmangledparaname:string;override; + { debug } +{$ifdef GDB} + function stabstring : pchar;override; + procedure concatstabto(asmlist:taasmoutput);override; +{$endif GDB} { rtti } procedure write_rtti_data(rt:trttitype);override; end; @@ -452,6 +543,9 @@ interface tprocdef = class(tabstractprocdef) private _mangledname : pstring; +{$ifdef GDB} + isstabwritten : boolean; +{$endif GDB} public extnumber : word; messageinf : tmessageinf; @@ -503,9 +597,6 @@ interface {$ifdef oldregvars} regvarinfo: pregvarinfo; {$endif oldregvars} - { position in aasmoutput list } - procstarttai, - procendtai : tai; constructor create(level:byte); constructor ppuload(ppufile:tcompilerppufile); destructor destroy;override; @@ -514,7 +605,6 @@ interface procedure buildderefimpl;override; procedure deref;override; procedure derefimpl;override; - procedure reset;override; function getsymtable(t:tgetsymtable):tsymtable;override; function gettypename : string;override; function mangledname : string; @@ -531,6 +621,12 @@ interface function is_methodpointer:boolean;override; function is_addressonly:boolean;override; function is_visible_for_object(currobjdef:tobjectdef):boolean; + { debug } +{$ifdef GDB} + function numberstring:string;override; + function stabstring : pchar;override; + procedure concatstabto(asmlist : taasmoutput);override; +{$endif GDB} end; { single linked list of overloaded procs } @@ -563,6 +659,11 @@ interface function gettypename:string;override; function getmangledparaname:string;override; function is_publishable : boolean;override; + { debug } +{$ifdef GDB} + function stabstring : pchar;override; + procedure concatstabto(asmlist : taasmoutput);override; +{$endif GDB} function alignment : longint;override; { init/final } function needs_inittable : boolean;override; @@ -593,6 +694,10 @@ interface procedure setmin(_min:aint); function min:aint; function max:aint; + { debug } +{$ifdef GDB} + function stabstring : pchar;override; +{$endif GDB} { rtti } procedure write_rtti_data(rt:trttitype);override; procedure write_child_rtti_data(rt:trttitype);override; @@ -614,6 +719,11 @@ interface procedure deref;override; function gettypename:string;override; function is_publishable : boolean;override; + { debug } +{$ifdef GDB} + function stabstring : pchar;override; + procedure concatstabto(asmlist : taasmoutput);override; +{$endif GDB} { rtti } procedure write_rtti_data(rt:trttitype);override; procedure write_child_rtti_data(rt:trttitype);override; @@ -623,6 +733,12 @@ interface var aktobjectdef : tobjectdef; { used for private functions check !! } +{$ifdef GDB} + writing_def_stabs : boolean; + { for STAB debugging } + globaltypecount : word; + pglobaltypecount : pword; +{$endif GDB} { default types } generrortype, { error in definition } @@ -701,9 +817,6 @@ interface {$ifdef powerpc} pbestrealtype : ^ttype = @s64floattype; {$endif} -{$ifdef POWERPC64} - pbestrealtype : ^ttype = @s64floattype; -{$endif} {$ifdef ia64} pbestrealtype : ^ttype = @s64floattype; {$endif} @@ -732,10 +845,6 @@ interface function is_class_or_interface(def: tdef): boolean; -{$ifdef x86} - function use_sse(def : tdef) : boolean; -{$endif x86} - implementation uses @@ -747,6 +856,9 @@ implementation { symtable } symsym,symtable,symutil,defutil, { module } +{$ifdef GDB} + gdb, +{$endif GDB} fmodule, { other } gendef, @@ -894,6 +1006,10 @@ implementation {$endif} if registerdef then symtablestack.registerdef(self); +{$ifdef GDB} + stab_state:=stab_state_unused; + globalnb := 0; +{$endif GDB} fillchar(localrttilab,sizeof(localrttilab),0); end; @@ -904,6 +1020,10 @@ implementation {$ifdef EXTDEBUG} fillchar(fileinfo,sizeof(fileinfo),0); {$endif} +{$ifdef GDB} + stab_state:=stab_state_unused; + globalnb := 0; +{$endif GDB} fillchar(localrttilab,sizeof(localrttilab),0); { load } indexnr:=ppufile.getword; @@ -918,6 +1038,9 @@ implementation procedure Tstoreddef.reset; begin +{$ifdef GDB} + stab_state:=stab_state_unused; +{$endif GDB} if assigned(rttitablesym) then trttisym(rttitablesym).lab := nil; if assigned(inittablesym) then @@ -943,6 +1066,16 @@ implementation ppufile.putderef(rttitablesymderef); if df_has_inittable in defoptions then ppufile.putderef(inittablesymderef); +{$ifdef GDB} + if globalnb=0 then + begin + if (cs_gdb_dbx in aktglobalswitches) and + assigned(owner) then + globalnb := owner.getnewtypecount + else + set_globalnb; + end; +{$endif GDB} end; @@ -993,6 +1126,125 @@ implementation end; +{$ifdef GDB} + procedure tstoreddef.set_globalnb; + begin + globalnb:=PGlobalTypeCount^; + inc(PglobalTypeCount^); + end; + + + function Tstoreddef.get_var_value(const s:string):string; + begin + if s='numberstring' then + get_var_value:=numberstring + else if s='sym_name' then + if assigned(typesym) then + get_var_value:=Ttypesym(typesym).name + else + get_var_value:=' ' + else if s='N_LSYM' then + get_var_value:=tostr(N_LSYM) + else if s='savesize' then + get_var_value:=tostr(savesize); + end; + + + function Tstoreddef.stabstr_evaluate(const s:string;const vars:array of string):Pchar; + begin + stabstr_evaluate:=string_evaluate(s,@get_var_value,vars); + end; + + + function tstoreddef.stabstring : pchar; + begin + stabstring:=stabstr_evaluate('t${numberstring};',[]); + end; + + + function tstoreddef.numberstring : string; + begin + { Stab must already be written, or we must be busy writing it } + if writing_def_stabs and + not(stab_state in [stab_state_writing,stab_state_written]) then + internalerror(200403091); + { Keep track of used stabs, this info is only usefull for stabs + referenced by the symbols. Definitions will always include all + required stabs } + if stab_state=stab_state_unused then + stab_state:=stab_state_used; + { Need a new number? } + if globalnb=0 then + begin + if (cs_gdb_dbx in aktglobalswitches) and + assigned(owner) then + globalnb := owner.getnewtypecount + else + set_globalnb; + end; + if (cs_gdb_dbx in aktglobalswitches) and + assigned(typesym) and + (ttypesym(typesym).owner.symtabletype in [staticsymtable,globalsymtable]) and + (ttypesym(typesym).owner.iscurrentunit) then + result:='('+tostr(tabstractunitsymtable(ttypesym(typesym).owner).moduleid)+','+tostr(tstoreddef(ttypesym(typesym).restype.def).globalnb)+')' + else + result:=tostr(globalnb); + end; + + + function tstoreddef.allstabstring : pchar; + var + stabchar : string[2]; + ss,st,su : pchar; + begin + ss := stabstring; + stabchar := 't'; + if deftype in tagtypes then + stabchar := 'Tt'; + { Here we maybe generate a type, so we have to use numberstring } + st:=stabstr_evaluate('"${sym_name}:$1$2=',[stabchar,numberstring]); + reallocmem(st,strlen(ss)+512); + { line info is set to 0 for all defs, because the def can be in an other + unit and then the linenumber is invalid in the current sourcefile } + su:=stabstr_evaluate('",${N_LSYM},0,0,0',[]); + strcopy(strecopy(strend(st),ss),su); + reallocmem(st,strlen(st)+1); + allstabstring:=st; + strdispose(ss); + strdispose(su); + end; + + + procedure tstoreddef.concatstabto(asmlist : taasmoutput); + var + stab_str : pchar; + begin + if (stab_state in [stab_state_writing,stab_state_written]) then + exit; + If cs_gdb_dbx in aktglobalswitches then + begin + { otherwise you get two of each def } + If assigned(typesym) then + begin + if (ttypesym(typesym).owner = nil) or + ((ttypesym(typesym).owner.symtabletype = globalsymtable) and + tglobalsymtable(ttypesym(typesym).owner).dbx_count_ok) then + begin + {with DBX we get the definition from the other objects } + stab_state := stab_state_written; + exit; + end; + end; + end; + { to avoid infinite loops } + stab_state := stab_state_writing; + stab_str := allstabstring; + asmList.concat(Tai_stabs.Create(stab_str)); + stab_state := stab_state_written; + end; +{$endif GDB} + + procedure tstoreddef.write_rtti_name; var str : string; @@ -1001,16 +1253,16 @@ implementation if assigned(typesym) then begin str:=ttypesym(typesym).realname; - asmlist[al_rtti].concat(Tai_string.Create(chr(length(str))+str)); + rttiList.concat(Tai_string.Create(chr(length(str))+str)); end else - asmlist[al_rtti].concat(Tai_string.Create(#0)) + rttiList.concat(Tai_string.Create(#0)) end; procedure tstoreddef.write_rtti_data(rt:trttitype); begin - asmlist[al_rtti].concat(tai_const.create_8bit(tkUnknown)); + rttilist.concat(tai_const.create_8bit(tkUnknown)); write_rtti_name; end; @@ -1034,11 +1286,11 @@ implementation begin objectlibrary.getdatalabel(localrttilab[rt]); write_child_rtti_data(rt); - maybe_new_object_file(asmlist[al_rtti]); - new_section(asmlist[al_rtti],sec_rodata,localrttilab[rt].name,const_align(sizeof(aint))); - asmlist[al_rtti].concat(Tai_symbol.Create_global(localrttilab[rt],0)); + maybe_new_object_file(rttiList); + new_section(rttiList,sec_rodata,localrttilab[rt].name,const_align(sizeof(aint))); + rttiList.concat(Tai_symbol.Create_global(localrttilab[rt],0)); write_rtti_data(rt); - asmlist[al_rtti].concat(Tai_symbol_end.Create(localrttilab[rt])); + rttiList.concat(Tai_symbol_end.Create(localrttilab[rt])); end; get_rtti_label:=localrttilab[rt]; end; @@ -1080,9 +1332,9 @@ implementation function tstoreddef.is_fpuregable : boolean; begin {$ifdef x86} - result:=use_sse(self); + result:=false; {$else x86} - result:=(deftype=floatdef) and not(cs_fp_emulation in aktmoduleswitches); + result:=(deftype=floatdef); {$endif x86} end; @@ -1260,6 +1512,98 @@ implementation end; +{$ifdef GDB} + function tstringdef.stabstring : pchar; + var + bytest,charst,longst : string; + slen : aint; + begin + case string_typ of + st_shortstring: + begin + charst:=tstoreddef(cchartype.def).numberstring; + { this is what I found in stabs.texinfo but + gdb 4.12 for go32 doesn't understand that !! } + {$IfDef GDBknowsstrings} + stabstring:=stabstr_evaluate('n$1;$2',[charst,tostr(len)]); + {$else} + { fix length of openshortstring } + slen:=len; + if slen=0 then + slen:=255; + bytest:=tstoreddef(u8inttype.def).numberstring; + stabstring:=stabstr_evaluate('s$1length:$2,0,8;st:ar$2;1;$3;$4,8,$5;;', + [tostr(slen+1),bytest,tostr(slen),charst,tostr(slen*8)]); + {$EndIf} + end; + st_longstring: + begin + charst:=tstoreddef(cchartype.def).numberstring; + { this is what I found in stabs.texinfo but + gdb 4.12 for go32 doesn't understand that !! } + {$IfDef GDBknowsstrings} + stabstring:=stabstr_evaluate('n$1;$2',[charst,tostr(len)]); + {$else} + bytest:=tstoreddef(u8inttype.def).numberstring; + longst:=tstoreddef(u32inttype.def).numberstring; + stabstring:=stabstr_evaluate('s$1length:$2,0,32;dummy:$6,32,8;st:ar$2;1;$3;$4,40,$5;;', + [tostr(len+5),longst,tostr(len),charst,tostr(len*8),bytest]); + {$EndIf} + end; + {$ifdef ansistring_bits} + st_ansistring16,st_ansistring32,st_ansistring64: + {$else} + st_ansistring: + {$endif} + begin + { an ansi string looks like a pchar easy !! } + charst:=tstoreddef(cchartype.def).numberstring; + stabstring:=strpnew('*'+charst); + end; + st_widestring: + begin + { an ansi string looks like a pwidechar easy !! } + charst:=tstoreddef(cwidechartype.def).numberstring; + stabstring:=strpnew('*'+charst); + end; + end; + end; + + + procedure tstringdef.concatstabto(asmlist:taasmoutput); + begin + if (stab_state in [stab_state_writing,stab_state_written]) then + exit; + case string_typ of + st_shortstring: + begin + tstoreddef(cchartype.def).concatstabto(asmlist); + {$IfNDef GDBknowsstrings} + tstoreddef(u8inttype.def).concatstabto(asmlist); + {$EndIf} + end; + st_longstring: + begin + tstoreddef(cchartype.def).concatstabto(asmlist); + {$IfNDef GDBknowsstrings} + tstoreddef(u8inttype.def).concatstabto(asmlist); + tstoreddef(u32inttype.def).concatstabto(asmlist); + {$EndIf} + end; + {$ifdef ansistring_bits} + st_ansistring16,st_ansistring32,st_ansistring64: + {$else} + st_ansistring: + {$endif} + tstoreddef(cchartype.def).concatstabto(asmlist); + st_widestring: + tstoreddef(cwidechartype.def).concatstabto(asmlist); + end; + inherited concatstabto(asmlist); + end; +{$endif GDB} + + function tstringdef.needs_inittable : boolean; begin {$ifdef ansistring_bits} @@ -1311,43 +1655,43 @@ implementation {$ifdef ansistring_bits} st_ansistring16: begin - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkA16String)); + rttiList.concat(Tai_const.Create_8bit(tkA16String)); write_rtti_name; end; st_ansistring32: begin - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkA32String)); + rttiList.concat(Tai_const.Create_8bit(tkA32String)); write_rtti_name; end; st_ansistring64: begin - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkA64String)); + rttiList.concat(Tai_const.Create_8bit(tkA64String)); write_rtti_name; end; {$else} st_ansistring: begin - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkAString)); + rttiList.concat(Tai_const.Create_8bit(tkAString)); write_rtti_name; end; {$endif} st_widestring: begin - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkWString)); + rttiList.concat(Tai_const.Create_8bit(tkWString)); write_rtti_name; end; st_longstring: begin - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkLString)); + rttiList.concat(Tai_const.Create_8bit(tkLString)); write_rtti_name; end; st_shortstring: begin - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkSString)); + rttiList.concat(Tai_const.Create_8bit(tkSString)); write_rtti_name; - asmlist[al_rtti].concat(Tai_const.Create_8bit(len)); + rttiList.concat(Tai_const.Create_8bit(len)); {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt))); + rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt))); {$endif cpurequiresproperalignment} end; end; @@ -1534,6 +1878,43 @@ implementation +{$ifdef GDB} + function tenumdef.stabstring : pchar; + + var st:Pchar; + p:Tenumsym; + s:string; + memsize,stl:cardinal; + + begin + memsize:=memsizeinc; + getmem(st,memsize); + { we can specify the size with @s<size>; prefix PM } + if savesize <> std_param_align then + strpcopy(st,'@s'+tostr(savesize*8)+';e') + else + strpcopy(st,'e'); + p := tenumsym(firstenum); + stl:=strlen(st); + while assigned(p) do + begin + s :=p.name+':'+tostr(p.value)+','; + { place for the ending ';' also } + if (stl+length(s)+1>=memsize) then + begin + inc(memsize,memsizeinc); + reallocmem(st,memsize); + end; + strpcopy(st+stl,s); + inc(stl,length(s)); + p:=p.nextenum; + end; + st[stl]:=';'; + st[stl+1]:=#0; + reallocmem(st,stl+2); + stabstring:=st; + end; +{$endif GDB} procedure tenumdef.write_child_rtti_data(rt:trttitype); @@ -1547,36 +1928,36 @@ implementation var hp : tenumsym; begin - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkEnumeration)); + rttiList.concat(Tai_const.Create_8bit(tkEnumeration)); write_rtti_name; {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt))); + rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt))); {$endif cpurequiresproperalignment} case longint(savesize) of 1: - asmlist[al_rtti].concat(Tai_const.Create_8bit(otUByte)); + rttiList.concat(Tai_const.Create_8bit(otUByte)); 2: - asmlist[al_rtti].concat(Tai_const.Create_8bit(otUWord)); + rttiList.concat(Tai_const.Create_8bit(otUWord)); 4: - asmlist[al_rtti].concat(Tai_const.Create_8bit(otULong)); + rttiList.concat(Tai_const.Create_8bit(otULong)); end; {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(4)); + rttilist.concat(Tai_align.Create(4)); {$endif cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_const.Create_32bit(min)); - asmlist[al_rtti].concat(Tai_const.Create_32bit(max)); + rttiList.concat(Tai_const.Create_32bit(min)); + rttiList.concat(Tai_const.Create_32bit(max)); if assigned(basedef) then - asmlist[al_rtti].concat(Tai_const.Create_sym(basedef.get_rtti_label(rt))) + rttiList.concat(Tai_const.Create_sym(basedef.get_rtti_label(rt))) else - asmlist[al_rtti].concat(Tai_const.create_sym(nil)); + rttiList.concat(Tai_const.create_sym(nil)); hp:=tenumsym(firstenum); while assigned(hp) do begin - asmlist[al_rtti].concat(Tai_const.Create_8bit(length(hp.realname))); - asmlist[al_rtti].concat(Tai_string.Create(hp.realname)); + rttiList.concat(Tai_const.Create_8bit(length(hp.realname))); + rttiList.concat(Tai_string.Create(hp.realname)); hp:=hp.nextenum; end; - asmlist[al_rtti].concat(Tai_const.Create_8bit(0)); + rttiList.concat(Tai_const.Create_8bit(0)); end; @@ -1681,6 +2062,54 @@ implementation end; +{$ifdef GDB} + function torddef.stabstring : pchar; + begin + if cs_gdb_valgrind in aktglobalswitches then + begin + case typ of + uvoid : + stabstring := strpnew(numberstring); + bool8bit, + bool16bit, + bool32bit : + stabstring := stabstr_evaluate('r${numberstring};0;255;',[]); + u32bit, + s64bit, + u64bit : + stabstring:=stabstr_evaluate('r${numberstring};0;-1;',[]); + else + stabstring:=stabstr_evaluate('r${numberstring};$1;$2;',[tostr(longint(low)),tostr(longint(high))]); + end; + end + else + begin + case typ of + uvoid : + stabstring := strpnew(numberstring); + uchar : + stabstring := strpnew('-20;'); + uwidechar : + stabstring := strpnew('-30;'); + bool8bit : + stabstring := strpnew('-21;'); + bool16bit : + stabstring := strpnew('-22;'); + bool32bit : + stabstring := strpnew('-23;'); + u64bit : + stabstring := strpnew('-32;'); + s64bit : + stabstring := strpnew('-31;'); + {u32bit : stabstring := tstoreddef(s32inttype.def).numberstring+';0;-1;'); } + else + stabstring:=stabstr_evaluate('r${numberstring};$1;$2;',[tostr(longint(low)),tostr(longint(high))]); + end; + end; + end; +{$endif GDB} + + procedure torddef.write_rtti_data(rt:trttitype); procedure dointeger; @@ -1694,60 +2123,60 @@ implementation begin write_rtti_name; {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt))); + rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt))); {$endif cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_const.Create_8bit(byte(trans[typ]))); + rttiList.concat(Tai_const.Create_8bit(byte(trans[typ]))); {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(4)); + rttilist.concat(Tai_align.Create(4)); {$endif cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_const.Create_32bit(longint(low))); - asmlist[al_rtti].concat(Tai_const.Create_32bit(longint(high))); + rttiList.concat(Tai_const.Create_32bit(longint(low))); + rttiList.concat(Tai_const.Create_32bit(longint(high))); end; begin case typ of s64bit : begin - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkInt64)); + rttiList.concat(Tai_const.Create_8bit(tkInt64)); write_rtti_name; {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt))); + rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt))); {$endif cpurequiresproperalignment} { low } - asmlist[al_rtti].concat(Tai_const.Create_64bit(int64($80000000) shl 32)); + rttiList.concat(Tai_const.Create_64bit(int64($80000000) shl 32)); { high } - asmlist[al_rtti].concat(Tai_const.Create_64bit((int64($7fffffff) shl 32) or int64($ffffffff))); + rttiList.concat(Tai_const.Create_64bit((int64($7fffffff) shl 32) or int64($ffffffff))); end; u64bit : begin - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkQWord)); + rttiList.concat(Tai_const.Create_8bit(tkQWord)); write_rtti_name; {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt))); + rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt))); {$endif cpurequiresproperalignment} { low } - asmlist[al_rtti].concat(Tai_const.Create_64bit(0)); + rttiList.concat(Tai_const.Create_64bit(0)); { high } - asmlist[al_rtti].concat(Tai_const.Create_64bit(int64((int64($ffffffff) shl 32) or int64($ffffffff)))); + rttiList.concat(Tai_const.Create_64bit(int64((int64($ffffffff) shl 32) or int64($ffffffff)))); end; bool8bit: begin - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkBool)); + rttiList.concat(Tai_const.Create_8bit(tkBool)); dointeger; end; uchar: begin - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkChar)); + rttiList.concat(Tai_const.Create_8bit(tkChar)); dointeger; end; uwidechar: begin - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkWChar)); + rttiList.concat(Tai_const.Create_8bit(tkWChar)); dointeger; end; else begin - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkInteger)); + rttiList.concat(Tai_const.Create_8bit(tkInteger)); dointeger; end; end; @@ -1842,18 +2271,42 @@ implementation end; +{$ifdef GDB} + function Tfloatdef.stabstring:Pchar; + begin + case typ of + s32real,s64real,s80real: + stabstring:=stabstr_evaluate('r$1;${savesize};0;',[tstoreddef(s32inttype.def).numberstring]); + s64currency,s64comp: + stabstring:=stabstr_evaluate('r$1;-${savesize};0;',[tstoreddef(s32inttype.def).numberstring]); + else + internalerror(10005); + end; + end; + + + procedure tfloatdef.concatstabto(asmlist:taasmoutput); + begin + if (stab_state in [stab_state_writing,stab_state_written]) then + exit; + tstoreddef(s32inttype.def).concatstabto(asmlist); + inherited concatstabto(asmlist); + end; +{$endif GDB} + + procedure tfloatdef.write_rtti_data(rt:trttitype); const {tfloattype = (s32real,s64real,s80real,s64bit,s128bit);} translate : array[tfloattype] of byte = (ftSingle,ftDouble,ftExtended,ftComp,ftCurr,ftFloat128); begin - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkFloat)); + rttiList.concat(Tai_const.Create_8bit(tkFloat)); write_rtti_name; {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt))); + rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt))); {$endif cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_const.Create_8bit(translate[typ])); + rttiList.concat(Tai_const.Create_8bit(translate[typ])); end; @@ -1955,16 +2408,10 @@ implementation {$ifdef cpu64bit} case filetyp of ft_text : - if target_info.system in [system_x86_64_win64,system_ia64_win64] then - savesize:=632 - else - savesize:=628; + savesize:=628; ft_typed, ft_untyped : - if target_info.system in [system_x86_64_win64,system_ia64_win64] then - savesize:=372 - else - savesize:=368; + savesize:=368; end; {$else cpu64bit} case filetyp of @@ -1988,6 +2435,63 @@ implementation end; +{$ifdef GDB} + function tfiledef.stabstring : pchar; + begin + {$IfDef GDBknowsfiles} + case filetyp of + ft_typed : + stabstring := strpnew('d'+typedfiletype.def.numberstring{+';'}); + ft_untyped : + stabstring := strpnew('d'+voiddef.numberstring{+';'}); + ft_text : + stabstring := strpnew('d'+cchartype^.numberstring{+';'}); + end; + {$Else} +{$ifdef cpu64bit} + stabstring:=stabstr_evaluate('s${savesize}HANDLE:$1,0,32;MODE:$1,32,32;RECSIZE:$2,64,64;'+ + '_PRIVATE:ar$1;1;64;$3,128,256;USERDATA:ar$1;1;16;$3,384,128;'+ + 'NAME:ar$1;0;255;$4,512,2048;;',[tstoreddef(s32inttype.def).numberstring, + tstoreddef(s64inttype.def).numberstring, + tstoreddef(u8inttype.def).numberstring, + tstoreddef(cchartype.def).numberstring]); +{$else cpu64bit} + stabstring:=stabstr_evaluate('s${savesize}HANDLE:$1,0,32;MODE:$1,32,32;RECSIZE:$1,64,32;'+ + '_PRIVATE:ar$1;1;32;$3,96,256;USERDATA:ar$1;1;16;$2,352,128;'+ + 'NAME:ar$1;0;255;$3,480,2048;;',[tstoreddef(s32inttype.def).numberstring, + tstoreddef(u8inttype.def).numberstring, + tstoreddef(cchartype.def).numberstring]); +{$endif cpu64bit} + {$EndIf} + end; + + + procedure tfiledef.concatstabto(asmlist:taasmoutput); + begin + if (stab_state in [stab_state_writing,stab_state_written]) then + exit; + {$IfDef GDBknowsfiles} + case filetyp of + ft_typed : + tstoreddef(typedfiletype.def).concatstabto(asmlist); + ft_untyped : + tstoreddef(voidtype.def).concatstabto(asmlist); + ft_text : + tstoreddef(cchartype.def).concatstabto(asmlist); + end; + {$Else} + tstoreddef(s32inttype.def).concatstabto(asmlist); +{$ifdef cpu64bit} + tstoreddef(s64inttype.def).concatstabto(asmlist); +{$endif cpu64bit} + tstoreddef(u8inttype.def).concatstabto(asmlist); + tstoreddef(cchartype.def).concatstabto(asmlist); + {$EndIf} + inherited concatstabto(asmlist); + end; +{$endif GDB} + + function tfiledef.gettypename : string; begin case filetyp of @@ -2069,7 +2573,7 @@ implementation procedure tvariantdef.write_rtti_data(rt:trttitype); begin - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkVariant)); + rttiList.concat(Tai_const.Create_8bit(tkVariant)); end; @@ -2078,6 +2582,25 @@ implementation needs_inittable:=true; end; +{$ifdef GDB} + function tvariantdef.stabstring : pchar; + begin + stabstring:=stabstr_evaluate('formal${numberstring};',[]); + end; + + + function tvariantdef.numberstring:string; + begin + result:=tstoreddef(voidtype.def).numberstring; + end; + + + procedure tvariantdef.concatstabto(asmlist : taasmoutput); + begin + { don't know how to handle this } + end; +{$endif GDB} + function tvariantdef.is_publishable : boolean; begin @@ -2150,6 +2673,59 @@ implementation end; +{$ifdef GDB} + function tpointerdef.stabstring : pchar; + begin + stabstring := strpnew('*'+tstoreddef(pointertype.def).numberstring); + end; + + + procedure tpointerdef.concatstabto(asmlist : taasmoutput); + var st,nb : string; + + begin + if (stab_state in [stab_state_writing,stab_state_written]) then + exit; + stab_state:=stab_state_writing; + + tstoreddef(pointertype.def).concatstabto(asmlist); + + if (pointertype.def.deftype in [recorddef,objectdef]) then + begin + if pointertype.def.deftype=objectdef then + nb:=tobjectdef(pointertype.def).classnumberstring + else + nb:=tstoreddef(pointertype.def).numberstring; + {to avoid infinite recursion in record with next-like fields } + if tstoreddef(pointertype.def).stab_state=stab_state_writing then + begin + if assigned(pointertype.def.typesym) then + begin + if assigned(typesym) then + st := ttypesym(typesym).name + else + st := ' '; + asmlist.concat(Tai_stabs.create(stabstr_evaluate( + '"$1:t${numberstring}=*$2=xs$3:",${N_LSYM},0,0,0', + [st,nb,pointertype.def.typesym.name]))); + end; + stab_state:=stab_state_written; + end + else + begin + stab_state:=stab_state_used; + inherited concatstabto(asmlist); + end; + end + else + begin + stab_state:=stab_state_used; + inherited concatstabto(asmlist); + end; + end; +{$endif GDB} + + function tpointerdef.gettypename : string; begin if is_far then @@ -2190,6 +2766,14 @@ implementation end; +{$ifdef GDB} + function tclassrefdef.stabstring : pchar; + begin + stabstring:=strpnew(tstoreddef(pvmttype.def).numberstring); + end; +{$endif GDB} + + function tclassrefdef.gettypename : string; begin gettypename:='Class Of '+pointertype.def.typename; @@ -2292,6 +2876,23 @@ implementation end; +{$ifdef GDB} + function tsetdef.stabstring : pchar; + begin + stabstring:=stabstr_evaluate('@s$1;S$2',[tostr(savesize*8),tstoreddef(elementtype.def).numberstring]); + end; + + + procedure tsetdef.concatstabto(asmlist:taasmoutput); + begin + if (stab_state in [stab_state_writing,stab_state_written]) then + exit; + tstoreddef(elementtype.def).concatstabto(asmlist); + inherited concatstabto(asmlist); + end; +{$endif GDB} + + procedure tsetdef.buildderef; begin inherited buildderef; @@ -2314,16 +2915,16 @@ implementation procedure tsetdef.write_rtti_data(rt:trttitype); begin - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkSet)); + rttiList.concat(Tai_const.Create_8bit(tkSet)); write_rtti_name; {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt))); + rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt))); {$endif cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_const.Create_8bit(otULong)); + rttiList.concat(Tai_const.Create_8bit(otULong)); {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt))); + rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt))); {$endif cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_const.Create_sym(tstoreddef(elementtype.def).get_rtti_label(rt))); + rttiList.concat(Tai_const.Create_sym(tstoreddef(elementtype.def).get_rtti_label(rt))); end; @@ -2380,6 +2981,26 @@ implementation end; +{$ifdef GDB} + function tformaldef.stabstring : pchar; + begin + stabstring:=stabstr_evaluate('formal${numberstring};',[]); + end; + + + function tformaldef.numberstring:string; + begin + result:=tstoreddef(voidtype.def).numberstring; + end; + + + procedure tformaldef.concatstabto(asmlist : taasmoutput); + begin + { formaldef can't be stab'ed !} + end; +{$endif GDB} + + function tformaldef.gettypename : string; begin gettypename:='<Formal type>'; @@ -2471,6 +3092,25 @@ implementation end; +{$ifdef GDB} + function tarraydef.stabstring : pchar; + begin + stabstring:=stabstr_evaluate('ar$1;$2;$3;$4',[Tstoreddef(rangetype.def).numberstring, + tostr(lowrange),tostr(highrange),Tstoreddef(_elementtype.def).numberstring]); + end; + + + procedure tarraydef.concatstabto(asmlist:taasmoutput); + begin + if (stab_state in [stab_state_writing,stab_state_written]) then + exit; + tstoreddef(rangetype.def).concatstabto(asmlist); + tstoreddef(_elementtype.def).concatstabto(asmlist); + inherited concatstabto(asmlist); + end; +{$endif GDB} + + function tarraydef.elesize : aint; begin elesize:=_elementtype.def.size; @@ -2571,21 +3211,21 @@ implementation procedure tarraydef.write_rtti_data(rt:trttitype); begin if IsDynamicArray then - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkdynarray)) + rttiList.concat(Tai_const.Create_8bit(tkdynarray)) else - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkarray)); + rttiList.concat(Tai_const.Create_8bit(tkarray)); write_rtti_name; {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt))); + rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt))); {$endif cpurequiresproperalignment} { size of elements } - asmlist[al_rtti].concat(Tai_const.Create_aint(elesize)); + rttiList.concat(Tai_const.Create_aint(elesize)); if not(IsDynamicArray) then - asmlist[al_rtti].concat(Tai_const.Create_aint(elecount)); + rttiList.concat(Tai_const.Create_aint(elecount)); { element type } - asmlist[al_rtti].concat(Tai_const.Create_sym(tstoreddef(elementtype.def).get_rtti_label(rt))); + rttiList.concat(Tai_const.Create_sym(tstoreddef(elementtype.def).get_rtti_label(rt))); { variant type } - asmlist[al_rtti].concat(Tai_const.Create_32bit(tstoreddef(elementtype.def).getvartype)); + rttilist.concat(Tai_const.Create_32bit(tstoreddef(elementtype.def).getvartype)); end; @@ -2636,12 +3276,55 @@ implementation end; - procedure tabstractrecorddef.reset; +{$ifdef GDB} + procedure tabstractrecorddef.field_addname(p:Tnamedindexitem;arg:pointer); + var + newrec:Pchar; + spec:string[3]; + varsize : aint; + state : ^Trecord_stabgen_state; + begin + state:=arg; + { static variables from objects are like global objects } + if (Tsym(p).typ=fieldvarsym) and not (sp_static in Tsym(p).symoptions) then + begin + if ([sp_protected,sp_strictprotected]*tsym(p).symoptions)<>[] then + spec:='/1' + else if ([sp_private,sp_strictprivate]*tsym(p).symoptions)<>[] then + spec:='/0' + else + spec:=''; + varsize:=tfieldvarsym(p).vartype.def.size; + { open arrays made overflows !! } + if varsize>$fffffff then + varsize:=$fffffff; + newrec:=stabstr_evaluate('$1:$2,$3,$4;',[p.name, + spec+tstoreddef(tfieldvarsym(p).vartype.def).numberstring, + tostr(tfieldvarsym(p).fieldoffset*8),tostr(varsize*8)]); + if state^.stabsize+strlen(newrec)>=state^.staballoc-256 then + begin + inc(state^.staballoc,memsizeinc); + reallocmem(state^.stabstring,state^.staballoc); + end; + strcopy(state^.stabstring+state^.stabsize,newrec); + inc(state^.stabsize,strlen(newrec)); + strdispose(newrec); + {This should be used for case !!} + inc(state^.recoffset,Tfieldvarsym(p).vartype.def.size); + end; + end; + + + procedure tabstractrecorddef.field_concatstabto(p:Tnamedindexitem;arg:pointer); begin - tstoredsymtable(symtable).reset_all_defs; + if (Tsym(p).typ=fieldvarsym) and not (sp_static in Tsym(p).symoptions) then + tstoreddef(tfieldvarsym(p).vartype.def).concatstabto(taasmoutput(arg)); end; +{$endif GDB} + + procedure tabstractrecorddef.count_field_rtti(sym : tnamedindexitem;arg:pointer); begin if (FRTTIType=fullrtti) or @@ -2666,8 +3349,8 @@ implementation ((tsym(sym).typ=fieldvarsym) and tfieldvarsym(sym).vartype.def.needs_inittable) then begin - asmlist[al_rtti].concat(Tai_const.Create_sym(tstoreddef(tfieldvarsym(sym).vartype.def).get_rtti_label(FRTTIType))); - asmlist[al_rtti].concat(Tai_const.Create_32bit(tfieldvarsym(sym).fieldoffset)); + rttiList.concat(Tai_const.Create_sym(tstoreddef(tfieldvarsym(sym).vartype.def).get_rtti_label(FRTTIType))); + rttiList.concat(Tai_const.Create_32bit(tfieldvarsym(sym).fieldoffset)); end; end; @@ -2785,6 +3468,33 @@ implementation padalignment := trecordsymtable(symtable).padalignment; end; +{$ifdef GDB} + function trecorddef.stabstring : pchar; + var + state:Trecord_stabgen_state; + begin + getmem(state.stabstring,memsizeinc); + state.staballoc:=memsizeinc; + strpcopy(state.stabstring,'s'+tostr(size)); + state.recoffset:=0; + state.stabsize:=strlen(state.stabstring); + symtable.foreach(@field_addname,@state); + state.stabstring[state.stabsize]:=';'; + state.stabstring[state.stabsize+1]:=#0; + reallocmem(state.stabstring,state.stabsize+2); + stabstring:=state.stabstring; + end; + + + procedure trecorddef.concatstabto(asmlist:taasmoutput); + begin + if (stab_state in [stab_state_writing,stab_state_written]) then + exit; + symtable.foreach(@field_concatstabto,asmlist); + inherited concatstabto(asmlist); + end; +{$endif GDB} + procedure trecorddef.write_child_rtti_data(rt:trttitype); begin @@ -2795,16 +3505,16 @@ implementation procedure trecorddef.write_rtti_data(rt:trttitype); begin - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkrecord)); + rttiList.concat(Tai_const.Create_8bit(tkrecord)); write_rtti_name; {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt))); + rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt))); {$endif cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_const.Create_32bit(size)); + rttiList.concat(Tai_const.Create_32bit(size)); Count:=0; FRTTIType:=rt; symtable.foreach(@count_field_rtti,nil); - asmlist[al_rtti].concat(Tai_const.Create_32bit(Count)); + rttiList.concat(Tai_const.Create_32bit(Count)); symtable.foreach(@write_field_rtti,nil); end; @@ -3126,6 +3836,14 @@ implementation end; +{$ifdef GDB} + function tabstractprocdef.stabstring : pchar; + begin + stabstring := strpnew('abstractproc'+numberstring+';'); + end; +{$endif GDB} + + {*************************************************************************** TPROCDEF ***************************************************************************} @@ -3157,6 +3875,9 @@ implementation import_name:=nil; import_nr:=0; inlininginfo:=nil; +{$ifdef GDB} + isstabwritten := false; +{$endif GDB} end; @@ -3227,6 +3948,9 @@ implementation lastwritten:=nil; defref:=nil; refcount:=0; +{$ifdef GDB} + isstabwritten := false; +{$endif GDB} { Disable po_has_inlining until the derefimpl is done } exclude(procoptions,po_has_inlininginfo); end; @@ -3352,14 +4076,6 @@ implementation end; - procedure tprocdef.reset; - begin - inherited reset; - procstarttai:=nil; - procendtai:=nil; - end; - - procedure tprocdef.insert_localst; begin localst:=tlocalsymtable.create(parast.symtablelevel); @@ -3611,6 +4327,76 @@ implementation aktlocalsymtable:=oldlocalsymtable; end; +{$ifdef GDB} + function tprocdef.numberstring : string; + begin + { procdefs are always available } + stab_state:=stab_state_written; + result:=inherited numberstring; + end; + + + function tprocdef.stabstring: pchar; + Var + RType : Char; + Obj,Info : String; + stabsstr : string; + p : pchar; + begin + obj := procsym.name; + info := ''; + if tprocsym(procsym).is_global then + RType := 'F' + else + RType := 'f'; + if assigned(owner) then + begin + if (owner.symtabletype = objectsymtable) then + obj := owner.name^+'__'+procsym.name; + if not(cs_gdb_valgrind in aktglobalswitches) and + (owner.symtabletype=localsymtable) and + assigned(owner.defowner) and + assigned(tprocdef(owner.defowner).procsym) then + info := ','+procsym.name+','+tprocdef(owner.defowner).procsym.name; + end; + stabsstr:=mangledname; + getmem(p,length(stabsstr)+255); + strpcopy(p,'"'+obj+':'+RType + +tstoreddef(rettype.def).numberstring+info+'",'+tostr(n_function) + +',0,'+ + tostr(fileinfo.line) + +','); + strpcopy(strend(p),stabsstr); + stabstring:=strnew(p); + freemem(p,length(stabsstr)+255); + end; + + + procedure tprocdef.concatstabto(asmlist : taasmoutput); + begin + { released procdef? } + if not assigned(parast) then + exit; + if (proccalloption=pocall_internproc) then + exit; + { be sure to have a number assigned for this def } + numberstring; + { write stabs } + stab_state:=stab_state_writing; + asmList.concat(Tai_stabs.Create(stabstring)); + if not(po_external in procoptions) then + begin + tparasymtable(parast).concatstabto(asmlist); + { local type defs and vars should not be written + inside the main proc stab } + if assigned(localst) and + (localst.symtabletype=localsymtable) then + tlocalsymtable(localst).concatstabto(asmlist); + end; + stab_state:=stab_state_written; + end; +{$endif GDB} + procedure tprocdef.buildderef; var @@ -4056,6 +4842,54 @@ implementation end; +{$ifdef GDB} + function tprocvardef.stabstring : pchar; + var + nss : pchar; + { i : longint; } + begin + { i := maxparacount; } + getmem(nss,1024); + { it is not a function but a function pointer !! (PM) } + + strpcopy(nss,'*f'+tstoreddef(rettype.def).numberstring{+','+tostr(i)}); + { this confuses gdb !! + we should use 'F' instead of 'f' but + as we use c++ language mode + it does not like that either + Please do not remove this part + might be used once + gdb for pascal is ready PM } + {$ifdef disabled} + param := para1; + i := 0; + while assigned(param) do + begin + inc(i); + if param^.paratyp = vs_value then vartyp := '1' else vartyp := '0'; + {Here we have lost the parameter names !!} + pst := strpnew('p'+tostr(i)+':'+param^.vartype.def.numberstring+','+vartyp+';'); + strcat(nss,pst); + strdispose(pst); + param := param^.next; + end; + {$endif} + {strpcopy(strend(nss),';');} + stabstring := strnew(nss); + freemem(nss,1024); + end; + + + procedure tprocvardef.concatstabto(asmlist : taasmoutput); + begin + if (stab_state in [stab_state_writing,stab_state_written]) then + exit; + tstoreddef(rettype.def).concatstabto(asmlist); + inherited concatstabto(asmlist); + end; +{$endif GDB} + + procedure tprocvardef.write_rtti_data(rt:trttitype); procedure write_para(parasym:tparavarsym); @@ -4072,10 +4906,10 @@ implementation vs_out : paraspec := pfOut; end; { write flags for current parameter } - asmlist[al_rtti].concat(Tai_const.Create_8bit(paraspec)); + rttiList.concat(Tai_const.Create_8bit(paraspec)); { write name of current parameter } - asmlist[al_rtti].concat(Tai_const.Create_8bit(length(parasym.realname))); - asmlist[al_rtti].concat(Tai_string.Create(parasym.realname)); + rttiList.concat(Tai_const.Create_8bit(length(parasym.realname))); + rttiList.concat(Tai_string.Create(parasym.realname)); { write name of type of current parameter } tstoreddef(parasym.vartype.def).write_rtti_name; @@ -4089,21 +4923,21 @@ implementation if po_methodpointer in procoptions then begin { write method id and name } - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkmethod)); + rttiList.concat(Tai_const.Create_8bit(tkmethod)); write_rtti_name; {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt))); + rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt))); {$endif cpurequiresproperalignment} { write kind of method (can only be function or procedure)} if rettype.def = voidtype.def then methodkind := mkProcedure else methodkind := mkFunction; - asmlist[al_rtti].concat(Tai_const.Create_8bit(methodkind)); + rttiList.concat(Tai_const.Create_8bit(methodkind)); { get # of parameters } - asmlist[al_rtti].concat(Tai_const.Create_8bit(maxparacount)); + rttiList.concat(Tai_const.Create_8bit(maxparacount)); { write parameter info. The parameters must be written in reverse order if this method uses right to left parameter pushing! } @@ -4123,7 +4957,7 @@ implementation end else begin - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkprocvar)); + rttilist.concat(Tai_const.Create_8bit(tkprocvar)); write_rtti_name; end; end; @@ -4193,7 +5027,10 @@ implementation implementedinterfaces:=timplementedinterfaces.create else implementedinterfaces:=nil; + +{$ifdef GDB} writing_class_record_stab:=false; +{$endif GDB} end; @@ -4254,7 +5091,9 @@ implementation (objecttype=odt_interfacecom) and (objname^='IUNKNOWN') then interface_iunknown:=self; +{$ifdef GDB} writing_class_record_stab:=false; +{$endif GDB} end; destructor tobjectdef.destroy; @@ -4285,7 +5124,9 @@ implementation { to be able to have a variable vmt position } { and no vmt field for objects without virtuals } vmt_offset : longint; +{$ifdef GDB} writing_class_record_stab : boolean; +{$endif GDB} objecttype : tobjectdeftype; iidguid: pguid; iidstr: pstring; @@ -4374,9 +5215,9 @@ implementation begin {$warning TODO Remove getparentdef hack} { With 2 forward declared classes with the child class before the - parent class the child class is written earlier to the ppu. Leaving it - possible to have a reference to the parent class for property overriding, - but the parent class still has the childof not resolved yet (PFV) } + parent class the child class is written earlier to the ppu. Leaving it + possible to have a reference to the parent class for property overriding, + but the parent class still has the childof not resolved yet (PFV) } if childof=nil then childof:=tobjectdef(childofderef.resolve); result:=childof; @@ -4590,6 +5431,251 @@ implementation end; +{$ifdef GDB} + procedure tobjectdef.proc_addname(p :tnamedindexitem;arg:pointer); + var virtualind,argnames : string; + newrec : pchar; + pd : tprocdef; + lindex : longint; + arglength : byte; + sp : char; + state:^Trecord_stabgen_state; + olds:integer; + i : integer; + parasym : tparavarsym; + begin + state:=arg; + if tsym(p).typ = procsym then + begin + pd := tprocsym(p).first_procdef; + if (po_virtualmethod in pd.procoptions) then + begin + lindex := pd.extnumber; + {doesnt seem to be necessary + lindex := lindex or $80000000;} + virtualind := '*'+tostr(lindex)+';'+pd._class.classnumberstring+';' + end + else + virtualind := '.'; + + { used by gdbpas to recognize constructor and destructors } + if (pd.proctypeoption=potype_constructor) then + argnames:='__ct__' + else if (pd.proctypeoption=potype_destructor) then + argnames:='__dt__' + else + argnames := ''; + + { arguments are not listed here } + {we don't need another definition} + for i:=0 to pd.paras.count-1 do + begin + parasym:=tparavarsym(pd.paras[i]); + if Parasym.vartype.def.deftype = formaldef then + begin + case Parasym.varspez of + vs_var : + argnames := argnames+'3var'; + vs_const : + argnames:=argnames+'5const'; + vs_out : + argnames:=argnames+'3out'; + end; + end + else + begin + { if the arg definition is like (v: ^byte;.. + there is no sym attached to data !!! } + if assigned(Parasym.vartype.def.typesym) then + begin + arglength := length(Parasym.vartype.def.typesym.name); + argnames := argnames + tostr(arglength)+Parasym.vartype.def.typesym.name; + end + else + argnames:=argnames+'11unnamedtype'; + end; + end; + { here 2A must be changed for private and protected } + { 0 is private 1 protected and 2 public } + if ([sp_private,sp_strictprivate]*tsym(p).symoptions)<>[] then + sp:='0' + else if ([sp_protected,sp_strictprotected]*tsym(p).symoptions)<>[] then + sp:='1' + else + sp:='2'; + newrec:=stabstr_evaluate('$1::$2=##$3;:$4;$5A$6;',[p.name,pd.numberstring, + Tstoreddef(pd.rettype.def).numberstring,argnames,sp, + virtualind]); + { get spare place for a string at the end } + olds:=state^.stabsize; + inc(state^.stabsize,strlen(newrec)); + if state^.stabsize>=state^.staballoc-256 then + begin + inc(state^.staballoc,memsizeinc); + reallocmem(state^.stabstring,state^.staballoc); + end; + strcopy(state^.stabstring+olds,newrec); + strdispose(newrec); + {This should be used for case !! + RecOffset := RecOffset + pd.size;} + end; + end; + + + procedure tobjectdef.proc_concatstabto(p :tnamedindexitem;arg:pointer); + var + pd : tprocdef; + begin + if tsym(p).typ = procsym then + begin + pd := tprocsym(p).first_procdef; + tstoreddef(pd.rettype.def).concatstabto(taasmoutput(arg)); + end; + end; + + + function tobjectdef.stabstring : pchar; + var anc : tobjectdef; + state:Trecord_stabgen_state; + ts : string; + begin + if not (objecttype=odt_class) or writing_class_record_stab then + begin + state.staballoc:=memsizeinc; + getmem(state.stabstring,state.staballoc); + strpcopy(state.stabstring,'s'+tostr(tobjectsymtable(symtable).datasize)); + if assigned(childof) then + begin + {only one ancestor not virtual, public, at base offset 0 } + { !1 , 0 2 0 , } + strpcopy(strend(state.stabstring),'!1,020,'+childof.classnumberstring+';'); + end; + {virtual table to implement yet} + state.recoffset:=0; + state.stabsize:=strlen(state.stabstring); + symtable.foreach(@field_addname,@state); + if (oo_has_vmt in objectoptions) then + if not assigned(childof) or not(oo_has_vmt in childof.objectoptions) then + begin + ts:='$vf'+classnumberstring+':'+tstoreddef(vmtarraytype.def).numberstring+','+tostr(vmt_offset*8)+';'; + strpcopy(state.stabstring+state.stabsize,ts); + inc(state.stabsize,length(ts)); + end; + symtable.foreach(@proc_addname,@state); + if (oo_has_vmt in objectoptions) then + begin + anc := self; + while assigned(anc.childof) and (oo_has_vmt in anc.childof.objectoptions) do + anc := anc.childof; + { just in case anc = self } + ts:=';~%'+anc.classnumberstring+';'; + end + else + ts:=';'; + strpcopy(state.stabstring+state.stabsize,ts); + inc(state.stabsize,length(ts)); + reallocmem(state.stabstring,state.stabsize+1); + stabstring:=state.stabstring; + end + else + begin + stabstring:=strpnew('*'+classnumberstring); + end; + end; + + procedure tobjectdef.set_globalnb; + begin + globalnb:=PglobalTypeCount^; + inc(PglobalTypeCount^); + { classes need two type numbers, the globalnb is set to the ptr } + if objecttype=odt_class then + begin + globalnb:=PGlobalTypeCount^; + inc(PglobalTypeCount^); + end; + end; + + + function tobjectdef.classnumberstring : string; + begin + if objecttype=odt_class then + begin + if globalnb=0 then + numberstring; + dec(globalnb); + classnumberstring:=numberstring; + inc(globalnb); + end + else + classnumberstring:=numberstring; + end; + + + function tobjectdef.allstabstring : pchar; + var + stabchar : string[2]; + ss,st : pchar; + sname : string; + begin + ss := stabstring; + getmem(st,strlen(ss)+512); + stabchar := 't'; + if deftype in tagtypes then + stabchar := 'Tt'; + if assigned(typesym) then + sname := typesym.name + else + sname := ' '; + if writing_class_record_stab then + strpcopy(st,'"'+sname+':'+stabchar+classnumberstring+'=') + else + strpcopy(st,'"'+sname+':'+stabchar+numberstring+'='); + strpcopy(strecopy(strend(st),ss),'",'+tostr(N_LSYM)+',0,0,0'); + allstabstring := strnew(st); + freemem(st,strlen(ss)+512); + strdispose(ss); + end; + + + procedure tobjectdef.concatstabto(asmlist : taasmoutput); + var + oldtypesym : tsym; + stab_str : pchar; + anc : tobjectdef; + begin + if (stab_state in [stab_state_writing,stab_state_written]) then + exit; + stab_state:=stab_state_writing; + tstoreddef(vmtarraytype.def).concatstabto(asmlist); + { first the parents } + anc:=self; + while assigned(anc.childof) do + begin + anc:=anc.childof; + anc.concatstabto(asmlist); + end; + symtable.foreach(@field_concatstabto,asmlist); + symtable.foreach(@proc_concatstabto,asmlist); + stab_state:=stab_state_used; + if objecttype=odt_class then + begin + { Write the record class itself } + writing_class_record_stab:=true; + inherited concatstabto(asmlist); + writing_class_record_stab:=false; + { Write the invisible pointer class } + oldtypesym:=typesym; + typesym:=nil; + stab_str := allstabstring; + asmList.concat(Tai_stabs.Create(stab_str)); + typesym:=oldtypesym; + end + else + inherited concatstabto(asmlist); + end; +{$endif GDB} + + function tobjectdef.needs_inittable : boolean; begin case objecttype of @@ -4635,7 +5721,7 @@ implementation begin if not(assigned(proc) and assigned(proc.firstsym)) then begin - asmlist[al_rtti].concat(Tai_const.create(ait_const_ptr,1)); + rttiList.concat(Tai_const.create(ait_const_ptr,1)); typvalue:=3; end else if proc.firstsym^.sym.typ=fieldvarsym then @@ -4668,7 +5754,7 @@ implementation end; hp:=hp^.next; end; - asmlist[al_rtti].concat(Tai_const.create(ait_const_ptr,address)); + rttiList.concat(Tai_const.create(ait_const_ptr,address)); typvalue:=0; end else @@ -4678,13 +5764,13 @@ implementation exit; if not(po_virtualmethod in tprocdef(proc.procdef).procoptions) then begin - asmlist[al_rtti].concat(Tai_const.createname(tprocdef(proc.procdef).mangledname,AT_FUNCTION,0)); + rttiList.concat(Tai_const.createname(tprocdef(proc.procdef).mangledname,AT_FUNCTION,0)); typvalue:=1; end else begin { virtual method, write vmt offset } - asmlist[al_rtti].concat(Tai_const.create(ait_const_ptr, + rttiList.concat(Tai_const.create(ait_const_ptr, tprocdef(proc.procdef)._class.vmtmethodoffset(tprocdef(proc.procdef).extnumber))); typvalue:=2; end; @@ -4703,20 +5789,20 @@ implementation internalerror(1509992); { access to implicit class property as field } proctypesinfo:=(0 shl 0) or (0 shl 2) or (0 shl 4); - asmlist[al_rtti].concat(Tai_const_symbol.Createname(tvarsym(sym.vartype.def.get_rtti_label),AT_DATA,0)); - asmlist[al_rtti].concat(Tai_const.create(ait_const_ptr,tvarsym(sym.address))); - asmlist[al_rtti].concat(Tai_const.create(ait_const_ptr,tvarsym(sym.address))); + rttiList.concat(Tai_const_symbol.Createname(tvarsym(sym.vartype.def.get_rtti_label),AT_DATA,0)); + rttiList.concat(Tai_const.create(ait_const_ptr,tvarsym(sym.address))); + rttiList.concat(Tai_const.create(ait_const_ptr,tvarsym(sym.address))); { by default stored } - asmlist[al_rtti].concat(Tai_const.Create_32bit(1)); + rttiList.concat(Tai_const.Create_32bit(1)); { index as well as ... } - asmlist[al_rtti].concat(Tai_const.Create_32bit(0)); + rttiList.concat(Tai_const.Create_32bit(0)); { default value are zero } - asmlist[al_rtti].concat(Tai_const.Create_32bit(0)); - asmlist[al_rtti].concat(Tai_const.Create_16bit(count)); + rttiList.concat(Tai_const.Create_32bit(0)); + rttiList.concat(Tai_const.Create_16bit(count)); inc(count); - asmlist[al_rtti].concat(Tai_const.Create_8bit(proctypesinfo)); - asmlist[al_rtti].concat(Tai_const.Create_8bit(length(tvarsym(sym.realname)))); - asmlist[al_rtti].concat(Tai_string.Create(tvarsym(sym.realname))); + rttiList.concat(Tai_const.Create_8bit(proctypesinfo)); + rttiList.concat(Tai_const.Create_8bit(length(tvarsym(sym.realname)))); + rttiList.concat(Tai_string.Create(tvarsym(sym.realname))); {$endif dummy} end; propertysym: @@ -4725,26 +5811,26 @@ implementation proctypesinfo:=$40 else proctypesinfo:=0; - asmlist[al_rtti].concat(Tai_const.Create_sym(tstoreddef(tpropertysym(sym).proptype.def).get_rtti_label(fullrtti))); + rttiList.concat(Tai_const.Create_sym(tstoreddef(tpropertysym(sym).proptype.def).get_rtti_label(fullrtti))); writeproc(tpropertysym(sym).readaccess,0); writeproc(tpropertysym(sym).writeaccess,2); { isn't it stored ? } if not(ppo_stored in tpropertysym(sym).propoptions) then begin - asmlist[al_rtti].concat(Tai_const.create_sym(nil)); + rttiList.concat(Tai_const.create_sym(nil)); proctypesinfo:=proctypesinfo or (3 shl 4); end else writeproc(tpropertysym(sym).storedaccess,4); - asmlist[al_rtti].concat(Tai_const.Create_32bit(tpropertysym(sym).index)); - asmlist[al_rtti].concat(Tai_const.Create_32bit(tpropertysym(sym).default)); - asmlist[al_rtti].concat(Tai_const.Create_16bit(count)); + rttiList.concat(Tai_const.Create_32bit(tpropertysym(sym).index)); + rttiList.concat(Tai_const.Create_32bit(tpropertysym(sym).default)); + rttiList.concat(Tai_const.Create_16bit(count)); inc(count); - asmlist[al_rtti].concat(Tai_const.Create_8bit(proctypesinfo)); - asmlist[al_rtti].concat(Tai_const.Create_8bit(length(tpropertysym(sym).realname))); - asmlist[al_rtti].concat(Tai_string.Create(tpropertysym(sym).realname)); + rttiList.concat(Tai_const.Create_8bit(proctypesinfo)); + rttiList.concat(Tai_const.Create_8bit(length(tpropertysym(sym).realname))); + rttiList.concat(Tai_string.Create(tpropertysym(sym).realname)); {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt))); + rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt))); {$endif cpurequiresproperalignment} end; else internalerror(1509992); @@ -4842,15 +5928,15 @@ implementation (tsym(sym).typ=fieldvarsym) then begin {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(sizeof(AInt))); + rttilist.concat(Tai_align.Create(sizeof(AInt))); {$endif cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_const.Create_aint(tfieldvarsym(sym).fieldoffset)); + rttiList.concat(Tai_const.Create_aint(tfieldvarsym(sym).fieldoffset)); hp:=searchclasstablelist(tobjectdef(tfieldvarsym(sym).vartype.def)); if not(assigned(hp)) then internalerror(0206002); - asmlist[al_rtti].concat(Tai_const.Create_16bit(hp.index)); - asmlist[al_rtti].concat(Tai_const.Create_8bit(length(tfieldvarsym(sym).realname))); - asmlist[al_rtti].concat(Tai_string.Create(tfieldvarsym(sym).realname)); + rttiList.concat(Tai_const.Create_16bit(hp.index)); + rttiList.concat(Tai_const.Create_8bit(length(tfieldvarsym(sym).realname))); + rttiList.concat(Tai_string.Create(tfieldvarsym(sym).realname)); end; end; @@ -4867,29 +5953,29 @@ implementation objectlibrary.getdatalabel(classtable); count:=0; tablecount:=0; - maybe_new_object_file(asmlist[al_rtti]); - new_section(asmlist[al_rtti],sec_rodata,classtable.name,const_align(sizeof(aint))); + maybe_new_object_file(rttiList); + new_section(rttiList,sec_rodata,classtable.name,const_align(sizeof(aint))); { fields } symtable.foreach({$ifdef FPC}@{$endif}count_published_fields,nil); - asmlist[al_rtti].concat(Tai_label.Create(fieldtable)); - asmlist[al_rtti].concat(Tai_const.Create_16bit(count)); + rttiList.concat(Tai_label.Create(fieldtable)); + rttiList.concat(Tai_const.Create_16bit(count)); {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt))); + rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt))); {$endif cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_const.Create_sym(classtable)); + rttiList.concat(Tai_const.Create_sym(classtable)); symtable.foreach({$ifdef FPC}@{$endif}writefields,nil); { generate the class table } - asmlist[al_rtti].concat(tai_align.create(const_align(sizeof(aint)))); - asmlist[al_rtti].concat(Tai_label.Create(classtable)); - asmlist[al_rtti].concat(Tai_const.Create_16bit(tablecount)); + rttilist.concat(tai_align.create(const_align(sizeof(aint)))); + rttiList.concat(Tai_label.Create(classtable)); + rttiList.concat(Tai_const.Create_16bit(tablecount)); {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt))); + rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt))); {$endif cpurequiresproperalignment} hp:=tclasslistitem(classtablelist.first); while assigned(hp) do begin - asmlist[al_rtti].concat(Tai_const.Createname(tobjectdef(hp.p).vmt_mangledname,AT_DATA,0)); + rttiList.concat(Tai_const.Createname(tobjectdef(hp.p).vmt_mangledname,AT_DATA,0)); hp:=tclasslistitem(hp.next); end; @@ -4918,33 +6004,33 @@ implementation begin case objecttype of odt_class: - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkclass)); + rttiList.concat(Tai_const.Create_8bit(tkclass)); odt_object: - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkobject)); + rttiList.concat(Tai_const.Create_8bit(tkobject)); odt_interfacecom: - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkinterface)); + rttiList.concat(Tai_const.Create_8bit(tkinterface)); odt_interfacecorba: - asmlist[al_rtti].concat(Tai_const.Create_8bit(tkinterfaceCorba)); + rttiList.concat(Tai_const.Create_8bit(tkinterfaceCorba)); else exit; end; { generate the name } - asmlist[al_rtti].concat(Tai_const.Create_8bit(length(objrealname^))); - asmlist[al_rtti].concat(Tai_string.Create(objrealname^)); + rttiList.concat(Tai_const.Create_8bit(length(objrealname^))); + rttiList.concat(Tai_string.Create(objrealname^)); {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt))); + rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt))); {$endif cpurequiresproperalignment} case rt of initrtti : begin - asmlist[al_rtti].concat(Tai_const.Create_32bit(size)); + rttiList.concat(Tai_const.Create_32bit(size)); if objecttype in [odt_class,odt_object] then begin count:=0; FRTTIType:=rt; symtable.foreach(@count_field_rtti,nil); - asmlist[al_rtti].concat(Tai_const.Create_32bit(count)); + rttiList.concat(Tai_const.Create_32bit(count)); symtable.foreach(@write_field_rtti,nil); end; end; @@ -4953,17 +6039,17 @@ implementation if not(objecttype in [odt_interfacecom,odt_interfacecorba]) then begin if (oo_has_vmt in objectoptions) then - asmlist[al_rtti].concat(Tai_const.Createname(vmt_mangledname,AT_DATA,0)) + rttiList.concat(Tai_const.Createname(vmt_mangledname,AT_DATA,0)) else - asmlist[al_rtti].concat(Tai_const.create_sym(nil)); + rttiList.concat(Tai_const.create_sym(nil)); end; { write parent typeinfo } if assigned(childof) and ((oo_can_have_published in childof.objectoptions) or (objecttype in [odt_interfacecom,odt_interfacecorba])) then - asmlist[al_rtti].concat(Tai_const.Create_sym(childof.get_rtti_label(fullrtti))) + rttiList.concat(Tai_const.Create_sym(childof.get_rtti_label(fullrtti))) else - asmlist[al_rtti].concat(Tai_const.create_sym(nil)); + rttiList.concat(Tai_const.create_sym(nil)); if objecttype in [odt_object,odt_class] then begin @@ -4975,12 +6061,12 @@ implementation { write it } symtable.foreach(@count_published_properties,nil); - asmlist[al_rtti].concat(Tai_const.Create_16bit(count)); + rttiList.concat(Tai_const.Create_16bit(count)); end else { interface: write flags, iid and iidstr } begin - asmlist[al_rtti].concat(Tai_const.Create_32bit( + rttiList.concat(Tai_const.Create_32bit( { ugly, but working } longint([ TCompilerIntfFlag(ord(ifHasGuid)*ord(assigned(iidguid))), @@ -4991,21 +6077,21 @@ implementation ifDispatch, } )); {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt))); + rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt))); {$endif cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_const.Create_32bit(longint(iidguid^.D1))); - asmlist[al_rtti].concat(Tai_const.Create_16bit(iidguid^.D2)); - asmlist[al_rtti].concat(Tai_const.Create_16bit(iidguid^.D3)); + rttilist.concat(Tai_const.Create_32bit(longint(iidguid^.D1))); + rttilist.concat(Tai_const.Create_16bit(iidguid^.D2)); + rttilist.concat(Tai_const.Create_16bit(iidguid^.D3)); for i:=Low(iidguid^.D4) to High(iidguid^.D4) do - asmlist[al_rtti].concat(Tai_const.Create_8bit(iidguid^.D4[i])); + rttilist.concat(Tai_const.Create_8bit(iidguid^.D4[i])); end; { write unit name } - asmlist[al_rtti].concat(Tai_const.Create_8bit(length(current_module.realmodulename^))); - asmlist[al_rtti].concat(Tai_string.Create(current_module.realmodulename^)); + rttiList.concat(Tai_const.Create_8bit(length(current_module.realmodulename^))); + rttiList.concat(Tai_string.Create(current_module.realmodulename^)); {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt))); + rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt))); {$endif cpurequiresproperalignment} { write iidstr } @@ -5013,13 +6099,13 @@ implementation begin if assigned(iidstr) then begin - asmlist[al_rtti].concat(Tai_const.Create_8bit(length(iidstr^))); - asmlist[al_rtti].concat(Tai_string.Create(iidstr^)); + rttiList.concat(Tai_const.Create_8bit(length(iidstr^))); + rttiList.concat(Tai_string.Create(iidstr^)); end else - asmlist[al_rtti].concat(Tai_const.Create_8bit(0)); + rttiList.concat(Tai_const.Create_8bit(0)); {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt))); + rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt))); {$endif cpurequiresproperalignment} end; @@ -5028,10 +6114,10 @@ implementation { write published properties count } count:=0; symtable.foreach(@count_published_properties,nil); - asmlist[al_rtti].concat(Tai_const.Create_16bit(count)); + rttiList.concat(Tai_const.Create_16bit(count)); {$ifdef cpurequiresproperalignment} - asmlist[al_rtti].concat(Tai_align.Create(sizeof(TConstPtrUInt))); + rttilist.concat(Tai_align.Create(sizeof(TConstPtrUInt))); {$endif cpurequiresproperalignment} end; @@ -5386,11 +6472,11 @@ implementation TERRORDEF ****************************************************************************} - constructor terrordef.create; - begin + constructor terrordef.create; + begin inherited create; deftype:=errordef; - end; + end; procedure terrordef.ppuwrite(ppufile:tcompilerppufile); @@ -5400,15 +6486,29 @@ implementation end; - function terrordef.gettypename:string; +{$ifdef GDB} + function terrordef.stabstring : pchar; begin - gettypename:='<erroneous type>'; + stabstring:=strpnew('error'+numberstring); end; + procedure terrordef.concatstabto(asmlist : taasmoutput); + begin + { No internal error needed, an normal error is already + thrown } + end; +{$endif GDB} + + function terrordef.gettypename:string; + + begin + gettypename:='<erroneous type>'; + end; function terrordef.getmangledparaname:string; + begin - getmangledparaname:='error'; + getmangledparaname:='error'; end; @@ -5473,13 +6573,4 @@ implementation (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba]); end; - -{$ifdef x86} - function use_sse(def : tdef) : boolean; - begin - use_sse:=(is_single(def) and (aktfputype in sse_singlescalar)) or - (is_double(def) and (aktfputype in sse_doublescalar)); - end; -{$endif x86} - end. diff --git a/compiler/symsym.pas b/compiler/symsym.pas index 71d8c093c8..a91e483ac5 100644 --- a/compiler/symsym.pas +++ b/compiler/symsym.pas @@ -35,7 +35,7 @@ interface ppu, cclasses,symnot, { aasm } - aasmbase, + aasmbase,aasmtai, cpuinfo,cpubase,cgbase,cgutils,parabase ; @@ -47,6 +47,12 @@ interface constructor ppuload(ppufile:tcompilerppufile); destructor destroy;override; procedure ppuwrite(ppufile:tcompilerppufile);virtual; +{$ifdef GDB} + function get_var_value(const s:string):string; + function stabstr_evaluate(const s:string;vars:array of string):Pchar; + procedure concatstabto(asmlist : taasmoutput); +{$endif GDB} + function mangledname : string; virtual; end; tlabelsym = class(tstoredsym) @@ -63,6 +69,9 @@ interface constructor create(const n : string); constructor ppuload(ppufile:tcompilerppufile); procedure ppuwrite(ppufile:tcompilerppufile);override; +{$ifdef GDB} + function stabstring : pchar;override; +{$endif GDB} end; tunitsym = class(Tstoredsym) @@ -86,6 +95,9 @@ interface function getprocdef(nr:cardinal):Tprocdef; public procdef_count : byte; +{$ifdef GDB} + is_global : boolean; +{$endif GDB} overloadchecked : boolean; property procdef[nr:cardinal]:Tprocdef read getprocdef; constructor create(const n : string); @@ -118,6 +130,9 @@ interface context is the object def we're really in, this is for the strict stuff } function is_visible_for_object(currobjdef:tdef;context:tdef):boolean;override; +{$ifdef GDB} + function stabstring : pchar;override; +{$endif GDB} end; ttypesym = class(Tstoredsym) @@ -130,6 +145,9 @@ interface function gettypedef:tdef;override; procedure load_references(ppufile:tcompilerppufile;locals:boolean);override; function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override; +{$ifdef GDB} + function stabstring : pchar;override; +{$endif GDB} end; tabstractvarsym = class(tstoredsym) @@ -162,6 +180,9 @@ interface constructor create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions); constructor ppuload(ppufile:tcompilerppufile); procedure ppuwrite(ppufile:tcompilerppufile);override; +{$ifdef GDB} + function stabstring : pchar;override; +{$endif GDB} end; tabstractnormalvarsym = class(tabstractvarsym) @@ -179,6 +200,9 @@ interface constructor create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions); constructor ppuload(ppufile:tcompilerppufile); procedure ppuwrite(ppufile:tcompilerppufile);override; +{$ifdef GDB} + function stabstring : pchar;override; +{$endif GDB} end; tparavarsym = class(tabstractnormalvarsym) @@ -191,6 +215,9 @@ interface constructor ppuload(ppufile:tcompilerppufile); destructor destroy;override; procedure ppuwrite(ppufile:tcompilerppufile);override; +{$ifdef GDB} + function stabstring : pchar;override; +{$endif GDB} end; tglobalvarsym = class(tabstractnormalvarsym) @@ -205,6 +232,9 @@ interface procedure ppuwrite(ppufile:tcompilerppufile);override; function mangledname:string;override; procedure set_mangledname(const s:string); +{$ifdef GDB} + function stabstring : pchar;override; +{$endif GDB} end; tabsolutevarsym = class(tabstractvarsym) @@ -224,6 +254,9 @@ interface procedure deref;override; function mangledname : string;override; procedure ppuwrite(ppufile:tcompilerppufile);override; +{$ifdef gdb} + function stabstring:Pchar;override; +{$endif gdb} end; tpropertysym = class(Tstoredsym) @@ -263,6 +296,9 @@ interface procedure buildderef;override; procedure deref;override; function getsize:longint; +{$ifdef GDB} + function stabstring : pchar;override; +{$endif GDB} end; tconstvalue = record @@ -287,6 +323,9 @@ interface procedure buildderef;override; procedure deref;override; procedure ppuwrite(ppufile:tcompilerppufile);override; +{$ifdef GDB} + function stabstring : pchar;override; +{$endif GDB} end; tenumsym = class(Tstoredsym) @@ -365,6 +404,9 @@ implementation { tree } node, { aasm } +{$ifdef gdb} + gdb, +{$endif gdb} { codegen } paramgr,cresstr, procinfo @@ -406,7 +448,9 @@ implementation refs:=0; lastwritten:=nil; refcount:=0; +{$ifdef GDB} isstabwritten := false; +{$endif GDB} end; @@ -435,6 +479,39 @@ implementation inherited destroy; end; +{$ifdef GDB} + function Tstoredsym.get_var_value(const s:string):string; + + begin + if s='mangledname' then + get_var_value:=mangledname + else + get_var_value:=inherited get_var_value(s); + end; + + function Tstoredsym.stabstr_evaluate(const s:string;vars:array of string):Pchar; + + begin + stabstr_evaluate:=string_evaluate(s,@get_var_value,vars); + end; + + + procedure tstoredsym.concatstabto(asmlist : taasmoutput); + var + stabstr : Pchar; + begin + stabstr:=stabstring; + if stabstr<>nil then + asmlist.concat(Tai_stabs.create(stabstr)); + end; +{$endif GDB} + + + function tstoredsym.mangledname : string; + begin + internalerror(200204171); + end; + {**************************************************************************** TLABELSYM @@ -472,6 +549,14 @@ implementation end; +{$ifdef GDB} + function Tlabelsym.stabstring : pchar; + begin + stabstring:=stabstr_evaluate('"${name}",${N_LSYM},0,${line},0',[]); + end; +{$endif GDB} + + {**************************************************************************** TUNITSYM ****************************************************************************} @@ -519,6 +604,9 @@ implementation pdlistfirst:=nil; pdlistlast:=nil; owner:=nil; +{$ifdef GDB} + is_global:=false; +{$endif GDB} { the tprocdef have their own symoptions, make the procsym always visible } symoptions:=[sp_public]; @@ -543,6 +631,9 @@ implementation ppufile.getderef(pdderef); addprocdef_deref(pdderef); end; +{$ifdef GDB} + is_global:=false; +{$endif GDB} overloadchecked:=false; end; @@ -1048,6 +1139,14 @@ implementation end; +{$ifdef GDB} + function tprocsym.stabstring : pchar; + begin + internalerror(200111171); + result:=nil; + end; +{$endif GDB} + {**************************************************************************** TERRORSYM @@ -1353,21 +1452,13 @@ implementation if tstoreddef(vartype.def).is_intregable then varregable:=vr_intreg else -{ $warning TODO: no fpu regvar in staticsymtable yet, need initialization with 0 } - if {( +{$warning TODO: no fpu regvar in staticsymtable yet, need initialization with 0} + if ( not assigned(owner) or (owner.symtabletype<>staticsymtable) - ) and } + ) and tstoreddef(vartype.def).is_fpuregable then - begin -{$ifdef x86} - if use_sse(vartype.def) then - varregable:=vr_mmreg - else -{$else x86} - varregable:=vr_fpureg; -{$endif x86} - end; + varregable:=vr_fpureg; end; end; @@ -1399,6 +1490,29 @@ implementation ppufile.writeentry(ibfieldvarsym); end; +{$ifdef GDB} + function tfieldvarsym.stabstring:Pchar; + var + st : string; + begin + stabstring:=nil; + case owner.symtabletype of + objectsymtable : + begin + if (sp_static in symoptions) then + begin + st:=tstoreddef(vartype.def).numberstring; + if (cs_gdb_gsym in aktglobalswitches) then + st:='G'+st + else + st:='S'+st; + stabstring:=stabstr_evaluate('"${ownername}__${name}:$1",${N_LCSYM},0,${line},${mangledname}',[st]); + end; + end; + end; + end; +{$endif GDB} + {**************************************************************************** TABSTRACTNORMALVARSYM @@ -1528,6 +1642,50 @@ implementation end; +{$ifdef GDB} + function Tglobalvarsym.stabstring:Pchar; + + var st:string; + threadvaroffset:string; + regidx:Tregisterindex; + begin + result:=nil; + st:=tstoreddef(vartype.def).numberstring; + case localloc.loc of + LOC_REGISTER, + LOC_CREGISTER, + LOC_MMREGISTER, + LOC_CMMREGISTER, + LOC_FPUREGISTER, + LOC_CFPUREGISTER : + begin + regidx:=findreg_by_number(localloc.register); + { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", } + { this is the register order for GDB} + if regidx<>0 then + stabstring:=stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]); + end; + else + begin + if (vo_is_thread_var in varoptions) then + threadvaroffset:='+'+tostr(sizeof(aint)) + else + threadvaroffset:=''; + { Here we used S instead of + because with G GDB doesn't look at the address field + but searches the same name or with a leading underscore + but these names don't exist in pascal !} + if (cs_gdb_gsym in aktglobalswitches) then + st:='G'+st + else + st:='S'+st; + stabstring:=stabstr_evaluate('"${name}:$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]); + end; + end; + end; +{$endif GDB} + + {**************************************************************************** TLOCALVARSYM ****************************************************************************} @@ -1553,6 +1711,42 @@ implementation end; +{$ifdef GDB} + function tlocalvarsym.stabstring:Pchar; + var st:string; + regidx:Tregisterindex; + begin + stabstring:=nil; + { There is no space allocated for not referenced locals } + if (owner.symtabletype=localsymtable) and (refs=0) then + exit; + + st:=tstoreddef(vartype.def).numberstring; + case localloc.loc of + LOC_REGISTER, + LOC_CREGISTER, + LOC_MMREGISTER, + LOC_CMMREGISTER, + LOC_FPUREGISTER, + LOC_CFPUREGISTER : + begin + regidx:=findreg_by_number(localloc.register); + { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", } + { this is the register order for GDB} + if regidx<>0 then + stabstring:=stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]); + end; + LOC_REFERENCE : + { offset to ebp => will not work if the framepointer is esp + so some optimizing will make things harder to debug } + stabstring:=stabstr_evaluate('"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(localloc.reference.offset)]) + else + internalerror(2003091814); + end; + end; +{$endif GDB} + + {**************************************************************************** TPARAVARSYM ****************************************************************************} @@ -1609,6 +1803,85 @@ implementation ppufile.writeentry(ibparavarsym); end; +{$ifdef GDB} + function tparavarsym.stabstring:Pchar; + var st:string; + regidx:Tregisterindex; + c:char; + + begin + result:=nil; + { set loc to LOC_REFERENCE to get somewhat usable debugging info for -Or } + { while stabs aren't adapted for regvars yet } + if (vo_is_self in varoptions) then + begin + case localloc.loc of + LOC_REGISTER, + LOC_CREGISTER: + regidx:=findreg_by_number(localloc.register); + LOC_REFERENCE: ; + else + internalerror(2003091815); + end; + if (po_classmethod in current_procinfo.procdef.procoptions) or + (po_staticmethod in current_procinfo.procdef.procoptions) then + begin + if (localloc.loc=LOC_REFERENCE) then + stabstring:=stabstr_evaluate('"pvmt:p$1",${N_TSYM},0,0,$2', + [Tstoreddef(pvmttype.def).numberstring,tostr(localloc.reference.offset)]); +(* else + stabstring:=stabstr_evaluate('"pvmt:r$1",${N_RSYM},0,0,$2', + [Tstoreddef(pvmttype.def).numberstring,tostr(regstabs_table[regidx])]) *) + end + else + begin + if not(is_class(current_procinfo.procdef._class)) then + c:='v' + else + c:='p'; + if (localloc.loc=LOC_REFERENCE) then + stabstring:=stabstr_evaluate('"$$t:$1",${N_TSYM},0,0,$2', + [c+current_procinfo.procdef._class.numberstring,tostr(localloc.reference.offset)]); +(* else + stabstring:=stabstr_evaluate('"$$t:r$1",${N_RSYM},0,0,$2', + [c+current_procinfo.procdef._class.numberstring,tostr(regstabs_table[regidx])]); *) + end; + end + else + begin + st:=tstoreddef(vartype.def).numberstring; + + if paramanager.push_addr_param(varspez,vartype.def,tprocdef(owner.defowner).proccalloption) and + not(vo_has_local_copy in varoptions) and + not is_open_string(vartype.def) then + st := 'v'+st { should be 'i' but 'i' doesn't work } + else + st := 'p'+st; + case localloc.loc of + LOC_REGISTER, + LOC_CREGISTER, + LOC_MMREGISTER, + LOC_CMMREGISTER, + LOC_FPUREGISTER, + LOC_CFPUREGISTER : + begin + regidx:=findreg_by_number(localloc.register); + { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", } + { this is the register order for GDB} + if regidx<>0 then + stabstring:=stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(longint(regstabs_table[regidx]))]); + end; + LOC_REFERENCE : + { offset to ebp => will not work if the framepointer is esp + so some optimizing will make things harder to debug } + stabstring:=stabstr_evaluate('"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(localloc.reference.offset)]) + else + internalerror(2003091814); + end; + end; + end; +{$endif GDB} + {**************************************************************************** TABSOLUTEVARSYM @@ -1715,6 +1988,14 @@ implementation end; +{$ifdef GDB} + function tabsolutevarsym.stabstring:Pchar; + begin + stabstring:=nil; + end; +{$endif GDB} + + {**************************************************************************** TTYPEDCONSTSYM *****************************************************************************} @@ -1806,6 +2087,22 @@ implementation end; +{$ifdef GDB} + function ttypedconstsym.stabstring : pchar; + + var st:char; + + begin + if (cs_gdb_gsym in aktglobalswitches) and (owner.symtabletype=globalsymtable) then + st:='G' + else + st:='S'; + stabstring:=stabstr_evaluate('"${name}:$1$2",${N_STSYM},0,${line},${mangledname}', + [st,Tstoreddef(typedconsttype.def).numberstring]); + end; +{$endif GDB} + + {**************************************************************************** TCONSTSYM ****************************************************************************} @@ -1856,7 +2153,7 @@ implementation consttype.reset; value.len:=l; if t=constresourcestring then - ResStrIndex:=resourcestrings.Register(name,pchar(value.valueptr),value.len); + ResStrIndex:=ResourceStrings.Register(name,pchar(value.valueptr),value.len); end; @@ -2014,6 +2311,40 @@ implementation ppufile.writeentry(ibconstsym); end; +{$ifdef GDB} + function Tconstsym.stabstring:Pchar; + + var st : string; + + begin + {even GDB v4.16 only now 'i' 'r' and 'e' !!!} + case consttyp of + conststring: + st:='s'''+backspace_quote(octal_quote(strpas(pchar(value.valueptr)),[#0..#9,#11,#12,#14..#31,'''']),['"','\',#10,#13])+''''; + constord: + st:='i'+tostr(value.valueord); + constpointer: + st:='i'+tostr(value.valueordptr); + constreal: + begin + system.str(pbestreal(value.valueptr)^,st); + st := 'r'+st; + end; + { if we don't know just put zero !! } + else st:='i0'; + {***SETCONST} + {constset:;} {*** I don't know what to do with a set.} + { sets are not recognized by GDB} + {***} + end; + { valgrind does not support constants } + if cs_gdb_valgrind in aktglobalswitches then + stabstring:=nil + else + stabstring:=stabstr_evaluate('"${name}:c=$1;",${N_FUNCTION},0,${line},0',[st]); + end; +{$endif GDB} + {**************************************************************************** TENUMSYM @@ -2192,6 +2523,25 @@ implementation end; +{$ifdef GDB} + function ttypesym.stabstring : pchar; + + var stabchar:string[2]; + + begin + stabstring:=nil; + if restype.def<>nil then + begin + if restype.def.deftype in tagtypes then + stabchar:='Tt' + else + stabchar:='t'; + stabstring:=stabstr_evaluate('"${name}:$1$2",${N_LSYM},0,${line},0',[stabchar,tstoreddef(restype.def).numberstring]); + end; + end; +{$endif GDB} + + {**************************************************************************** TSYSSYM ****************************************************************************} diff --git a/compiler/symtable.pas b/compiler/symtable.pas index 60fcacbe31..07e3e32807 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -78,6 +78,10 @@ interface procedure checklabels; function needs_init_final : boolean; procedure unchain_overloaded; +{$ifdef GDB} + procedure concatstabto(asmlist : taasmoutput);virtual; + function getnewtypecount : word; override; +{$endif GDB} procedure testfordefaultproperty(p : TNamedIndexItem;arg:pointer); end; @@ -128,7 +132,15 @@ interface tabstractunitsymtable = class(tstoredsymtable) public +{$ifdef GDB} + dbx_count : longint; + prev_dbx_counter : plongint; + dbx_count_ok : boolean; +{$endif GDB} constructor create(const n : string;id:word); +{$ifdef GDB} + procedure concattypestabto(asmlist : taasmoutput); +{$endif GDB} function iscurrentunit:boolean;override; end; @@ -141,6 +153,9 @@ interface procedure load_references(ppufile:tcompilerppufile;locals:boolean);override; procedure write_references(ppufile:tcompilerppufile;locals:boolean);override; procedure insert(sym : tsymentry);override; +{$ifdef GDB} + function getnewtypecount : word; override; +{$endif} end; tstaticsymtable = class(tabstractunitsymtable) @@ -264,6 +279,9 @@ implementation symutil,defcmp, { module } fmodule, +{$ifdef GDB} + gdb, +{$endif GDB} { codegen } procinfo ; @@ -819,6 +837,15 @@ implementation end; +{$ifdef GDB} + function tstoredsymtable.getnewtypecount : word; + begin + getnewtypecount:=pglobaltypecount^; + inc(pglobaltypecount^); + end; +{$endif GDB} + + {*********************************************** Process all entries ***********************************************} @@ -860,6 +887,32 @@ implementation end; +{$ifdef GDB} + procedure tstoredsymtable.concatstabto(asmlist : taasmoutput); + var + stabstr : Pchar; + p : tsym; + begin + p:=tsym(symindex.first); + while assigned(p) do + begin + { Procsym and typesym are already written } + if not(Tsym(p).typ in [procsym,typesym]) then + begin + if not Tsym(p).isstabwritten then + begin + stabstr:=Tsym(p).stabstring; + if stabstr<>nil then + asmlist.concat(Tai_stabs.create(stabstr)); + Tsym(p).isstabwritten:=true; + end; + end; + p:=tsym(p.indexnext); + end; + end; +{$endif} + + procedure TStoredSymtable._needs_init_final(p : tnamedindexitem;arg:pointer); begin if b_needs_init_final then @@ -1009,10 +1062,6 @@ implementation fieldalignment:=4 else if (varalign>1) and (fieldalignment<2) then fieldalignment:=2; - { darwin/x86 aligns long doubles on 16 bytes } - if (target_info.system = system_i386_darwin) and - (fieldalignment = 12) then - fieldalignment := 16; end; fieldalignment:=min(fieldalignment,aktalignment.maxCrecordalign); end; @@ -1300,6 +1349,12 @@ implementation inherited create(n); moduleid:=id; symsearch.usehash; +{$ifdef GDB} + { reset GDB things } + prev_dbx_counter := dbx_counter; + dbx_counter := nil; + dbx_count := -1; +{$endif GDB} end; @@ -1313,6 +1368,85 @@ implementation end; +{$ifdef GDB} + procedure tabstractunitsymtable.concattypestabto(asmlist : taasmoutput); + + procedure dowritestabs(asmlist:taasmoutput;st:tsymtable); + var + p : tstoreddef; + begin + p:=tstoreddef(st.defindex.first); + while assigned(p) do + begin + { also insert local types for the current unit } + if iscurrentunit then + begin + case p.deftype of + procdef : + if assigned(tprocdef(p).localst) then + dowritestabs(asmlist,tprocdef(p).localst); + objectdef : + dowritestabs(asmlist,tobjectdef(p).symtable); + end; + end; + if (p.stab_state=stab_state_used) then + p.concatstabto(asmlist); + p:=tstoreddef(p.indexnext); + end; + end; + + var + old_writing_def_stabs : boolean; + prev_dbx_count : plongint; + begin + if not assigned(name) then + name := stringdup('Main_program'); + asmList.concat(tai_comment.Create(strpnew('Begin unit '+name^+' has index '+tostr(moduleid)))); + if cs_gdb_dbx in aktglobalswitches then + begin + if dbx_count_ok then + begin + asmList.concat(tai_comment.Create(strpnew('"repeated" unit '+name^ + +' has index '+tostr(moduleid)+' dbx count = '+tostr(dbx_count)))); + asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",' + +tostr(N_EXCL)+',0,0,'+tostr(dbx_count)))); + exit; + end + else if not iscurrentunit then + begin + prev_dbx_count := dbx_counter; + dbx_counter := nil; + do_count_dbx:=false; + if (symtabletype = globalsymtable) then + asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0'))); + dbx_counter := @dbx_count; + dbx_count:=0; + do_count_dbx:=assigned(dbx_counter); + end; + end; + + old_writing_def_stabs:=writing_def_stabs; + writing_def_stabs:=true; + dowritestabs(asmlist,self); + writing_def_stabs:=old_writing_def_stabs; + + if cs_gdb_dbx in aktglobalswitches then + begin + if not iscurrentunit then + begin + dbx_counter := prev_dbx_count; + do_count_dbx:=false; + asmList.concat(Tai_stabs.Create(strpnew('"'+name^+'",' + +tostr(N_EINCL)+',0,0,0'))); + do_count_dbx:=assigned(dbx_counter); + dbx_count_ok := {true}false; + end; + end; + asmList.concat(tai_comment.Create(strpnew('End unit '+name^+' has index '+tostr(moduleid)))); + end; +{$endif GDB} + + {**************************************************************************** TStaticSymtable ****************************************************************************} @@ -1394,11 +1528,40 @@ implementation inherited create(n,id); symtabletype:=globalsymtable; symtablelevel:=main_program_level; +{$ifdef GDB} + if cs_gdb_dbx in aktglobalswitches then + begin + dbx_count := 0; + unittypecount:=1; + pglobaltypecount := @unittypecount; + {moduleid:=current_module.unitcount;} + {debugList.concat(tai_comment.Create(strpnew('Global '+name^+' has index '+tostr(moduleid)))); + debugList.concat(Tai_stabs.Create(strpnew('"'+name^+'",'+tostr(N_BINCL)+',0,0,0')));} + {inc(current_module.unitcount);} + { we can't use dbx_vcount, because we don't know + if the object file will be loaded before or afeter PM } + dbx_count_ok:=false; + dbx_counter:=@dbx_count; + do_count_dbx:=true; + end; +{$endif GDB} end; procedure tglobalsymtable.ppuload(ppufile:tcompilerppufile); +{$ifdef GDB} + var + b : byte; +{$endif GDB} begin +{$ifdef GDB} + if cs_gdb_dbx in aktglobalswitches then + begin + UnitTypeCount:=1; + PglobalTypeCount:=@UnitTypeCount; + end; +{$endif GDB} + next:=symtablestack; symtablestack:=self; @@ -1409,6 +1572,29 @@ implementation { restore symtablestack } symtablestack:=next; + + { read dbx count } +{$ifdef GDB} + if (current_module.flags and uf_has_dbx)<>0 then + begin + b:=ppufile.readentry; + if b<>ibdbxcount then + Message(unit_f_ppu_dbx_count_problem) + else + dbx_count:=ppufile.getlongint; +{$IfDef EXTDEBUG} + writeln('Read dbx_count ',dbx_count,' in unit ',name^,'.ppu'); +{$ENDIF EXTDEBUG} + { we can't use dbx_vcount, because we don't know + if the object file will be loaded before or afeter PM } + dbx_count_ok := {true}false; + end + else + begin + dbx_count:=-1; + dbx_count_ok:=false; + end; +{$endif GDB} end; @@ -1416,6 +1602,20 @@ implementation begin { write the symtable entries } inherited ppuwrite(ppufile); + + { write dbx count } +{$ifdef GDB} + if cs_gdb_dbx in aktglobalswitches then + begin +{$IfDef EXTDEBUG} + writeln('Writing dbx_count ',dbx_count,' in unit ',name^,'.ppu'); +{$ENDIF EXTDEBUG} + ppufile.do_crc:=false; + ppufile.putlongint(dbx_count); + ppufile.writeentry(ibdbxcount); + ppufile.do_crc:=true; + end; +{$endif GDB} end; @@ -1452,6 +1652,20 @@ implementation end; +{$ifdef GDB} + function tglobalsymtable.getnewtypecount : word; + begin + if not (cs_gdb_dbx in aktglobalswitches) then + getnewtypecount:=inherited getnewtypecount + else + begin + getnewtypecount:=unittypecount; + inc(unittypecount); + end; + end; +{$endif} + + {**************************************************************************** TWITHSYMTABLE ****************************************************************************} @@ -2271,6 +2485,10 @@ implementation symtablestack:=nil; macrosymtablestack:=nil; systemunit:=nil; +{$ifdef GDB} + globaltypecount:=1; + pglobaltypecount:=@globaltypecount; +{$endif GDB} { create error syms and def } generrorsym:=terrorsym.create; generrortype.setdef(terrordef.create); diff --git a/compiler/symtype.pas b/compiler/symtype.pas index a23b374324..97600e7682 100644 --- a/compiler/symtype.pas +++ b/compiler/symtype.pas @@ -69,9 +69,6 @@ interface tdef = class(tdefentry) typesym : tsym; { which type the definition was generated this def } - { stabs debugging } - stab_number : word; - stab_state : tdefstabstatus; defoptions : tdefoptions; constructor create; procedure buildderef;virtual;abstract; @@ -108,11 +105,15 @@ interface defref, lastwritten : tref; refcount : longint; +{$ifdef GDB} isstabwritten : boolean; + function get_var_value(const s:string):string; + function stabstr_evaluate(const s:string;vars:array of string):Pchar; + function stabstring : pchar;virtual; +{$endif GDB} constructor create(const n : string); destructor destroy;override; function realname:string; - function mangledname:string; virtual; procedure buildderef;virtual; procedure deref;virtual; function gettypedef:tdef;virtual; @@ -230,6 +231,9 @@ implementation uses verbose, fmodule +{$ifdef GDB} + ,gdb +{$endif GDB} ; @@ -244,8 +248,6 @@ implementation owner := nil; typesym := nil; defoptions:=[]; - stab_state:=stab_state_unused; - stab_number:=0; end; @@ -324,7 +326,9 @@ implementation inc(refcount); end; lastref:=defref; +{$ifdef GDB} isstabwritten := false; +{$endif GDB} symoptions:=current_object_option; end; @@ -351,6 +355,45 @@ implementation begin end; +{$ifdef GDB} + function Tsym.get_var_value(const s:string):string; + + begin + if s='name' then + get_var_value:=name + else if s='ownername' then + get_var_value:=owner.name^ + else if s='line' then + get_var_value:=tostr(fileinfo.line) + else if s='N_LSYM' then + get_var_value:=tostr(N_LSYM) + else if s='N_LCSYM' then + get_var_value:=tostr(N_LCSYM) + else if s='N_RSYM' then + get_var_value:=tostr(N_RSYM) + else if s='N_TSYM' then + get_var_value:=tostr(N_TSYM) + else if s='N_STSYM' then + get_var_value:=tostr(N_STSYM) + else if s='N_FUNCTION' then + get_var_value:=tostr(N_FUNCTION) + else + internalerror(200401152); + end; + + function Tsym.stabstr_evaluate(const s:string;vars:array of string):Pchar; + + begin + stabstr_evaluate:=string_evaluate(s,@get_var_value,vars); + end; + + function Tsym.stabstring : pchar; + + begin + stabstring:=nil; + end; +{$endif GDB} + function tsym.realname : string; begin @@ -361,12 +404,6 @@ implementation end; - function tsym.mangledname : string; - begin - internalerror(200204171); - end; - - function tsym.gettypedef:tdef; begin gettypedef:=nil; @@ -443,7 +480,7 @@ implementation end; - function tsym.is_visible_for_object(currobjdef:Tdef;context : tdef):boolean; + function Tsym.is_visible_for_object(currobjdef:Tdef;context : tdef):boolean; begin is_visible_for_object:=false; diff --git a/compiler/systems.pas b/compiler/systems.pas index 7f1a2ba4f0..7e31879bf2 100644 --- a/compiler/systems.pas +++ b/compiler/systems.pas @@ -157,11 +157,6 @@ interface ,res_gnu_windres,res_emxbind ,res_m68k_palmos,res_m68k_mpw ,res_powerpc_mpw,res_elf - ,res_gnu_wince_windres - ); - - tdbg = (dbg_none - ,dbg_stabs,dbg_dwarf ); tscripttype = (script_none @@ -240,12 +235,6 @@ interface rescmd : string[50]; end; - pdbginfo = ^tdbginfo; - tdbginfo = record - id : tdbg; - idtxt : string[12]; - end; - tsystemflags = (tf_none, tf_under_development, tf_need_export,tf_needs_isconsole, @@ -298,7 +287,6 @@ interface linkextern : tabstractlinkerclass; { external linker, used by -s } ar : tar; res : tres; - dbg : tdbg; script : tscripttype; endian : tendian; alignment : talignmentinfo; @@ -347,7 +335,6 @@ interface arinfos : array[tar] of parinfo; resinfos : array[tres] of presinfo; asminfos : array[tasm] of pasminfo; - dbginfos : array[tdbg] of pdbginfo; source_info : tsysteminfo; target_cpu : tsystemcpu; @@ -355,7 +342,6 @@ interface target_asm : tasminfo; target_ar : tarinfo; target_res : tresinfo; - target_dbg : tdbginfo; target_cpu_string, target_os_string : string[12]; { for rtl/<X>/,fcl/<X>/, etc. } target_full_string : string[24]; @@ -364,11 +350,9 @@ interface function set_target_asm(t:tasm):boolean; function set_target_ar(t:tar):boolean; function set_target_res(t:tres):boolean; - function set_target_dbg(t:tdbg):boolean; - function find_system_by_string(const s : string) : tsystem; - function find_asm_by_string(const s : string) : tasm; - function find_dbg_by_string(const s : string) : tdbg; + function set_target_by_string(const s : string) : boolean; + function set_target_asm_by_string(const s : string) : boolean; procedure set_source_info(const ti : tsysteminfo); @@ -450,7 +434,6 @@ begin set_target_asm(target_info.assem); set_target_ar(target_info.ar); set_target_res(target_info.res); - set_target_dbg(target_info.dbg); target_cpu:=target_info.cpu; target_os_string:=lower(target_info.shortname); target_cpu_string:=cpu2str[target_cpu]; @@ -477,11 +460,11 @@ end; function set_target_ar(t:tar):boolean; begin - result:=false; + set_target_ar:=false; if assigned(arinfos[t]) then begin target_ar:=arinfos[t]^; - result:=true; + set_target_ar:=true; exit; end; end; @@ -489,74 +472,47 @@ end; function set_target_res(t:tres):boolean; begin - result:=false; + set_target_res:=false; if assigned(resinfos[t]) then begin target_res:=resinfos[t]^; - result:=true; - exit; - end; -end; - - -function set_target_dbg(t:tdbg):boolean; -begin - result:=false; - if assigned(dbginfos[t]) then - begin - target_dbg:=dbginfos[t]^; - result:=true; + set_target_res:=true; exit; end; end; -function find_system_by_string(const s : string) : tsystem; +function set_target_by_string(const s : string) : boolean; var hs : string; t : tsystem; begin - result:=system_none; + set_target_by_string:=false; + { this should be case insensitive !! PM } hs:=upper(s); for t:=low(tsystem) to high(tsystem) do if assigned(targetinfos[t]) and (upper(targetinfos[t]^.shortname)=hs) then begin - result:=t; + set_target_by_string:=set_target(t); exit; end; end; -function find_asm_by_string(const s : string) : tasm; +function set_target_asm_by_string(const s : string) : boolean; var hs : string; t : tasm; begin - result:=as_none; + set_target_asm_by_string:=false; + { this should be case insensitive !! PM } hs:=upper(s); for t:=low(tasm) to high(tasm) do if assigned(asminfos[t]) and (asminfos[t]^.idtxt=hs) then begin - result:=t; - exit; - end; -end; - - -function find_dbg_by_string(const s : string) : tdbg; -var - hs : string; - t : tdbg; -begin - result:=dbg_none; - hs:=upper(s); - for t:=low(tdbg) to high(tdbg) do - if assigned(dbginfos[t]) and - (dbginfos[t]^.idtxt=hs) then - begin - result:=t; + set_target_asm_by_string:=set_target_asm(t); exit; end; end; @@ -770,13 +726,6 @@ begin default_target(system_powerpc_linux); {$endif cpupowerpc} {$endif powerpc} -{$ifdef POWERPC64} - {$ifdef cpupowerpc64} - default_target(source_info.system); - {$else cpupowerpc64} - default_target(system_powerpc64_linux); - {$endif cpupowerpc64} -{$endif POWERPC64} {$ifdef sparc} {$ifdef cpusparc} default_target(source_info.system); diff --git a/compiler/systems/i_amiga.pas b/compiler/systems/i_amiga.pas index 139eff7cfd..13beda08b6 100644 --- a/compiler/systems/i_amiga.pas +++ b/compiler/systems/i_amiga.pas @@ -65,7 +65,6 @@ unit i_amiga; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_amiga; endian : endian_big; alignment : @@ -86,8 +85,7 @@ unit i_amiga; first_parm_offset : 8; stacksize : 262144; DllScanSupported:false; - use_function_relative_addresses : true; - abi : abi_default; + use_function_relative_addresses : true ); system_powerpc_amiga_info : tsysteminfo = @@ -99,6 +97,8 @@ unit i_amiga; cpu : cpu_powerpc; unit_env : ''; extradefines : ''; + sourceext : '.pp'; + pasext : '.pas'; exeext : ''; defext : '.def'; scriptext : '.sh'; @@ -117,7 +117,6 @@ unit i_amiga; staticClibext : '.a'; staticClibprefix : 'lib'; sharedClibprefix : ''; - p_ext_support : false; Cprefix : ''; newline : #10; dirsep : '/'; @@ -128,7 +127,6 @@ unit i_amiga; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_amiga; endian : endian_big; alignment : @@ -149,8 +147,7 @@ unit i_amiga; first_parm_offset : 8; stacksize : 262144; DllScanSupported:false; - use_function_relative_addresses : true; - abi : abi_powerpc_sysv; + use_function_relative_addresses : true ); implementation diff --git a/compiler/systems/i_atari.pas b/compiler/systems/i_atari.pas index 9ecbcab126..a31bb36744 100644 --- a/compiler/systems/i_atari.pas +++ b/compiler/systems/i_atari.pas @@ -62,7 +62,6 @@ unit i_atari; linkextern : ld_m68k_atari; ar : ar_m68k_ar; res : res_none; - dbg : dbg_stabs; script : script_unix; endian : endian_big; stackalignment : 2; diff --git a/compiler/systems/i_beos.pas b/compiler/systems/i_beos.pas index b10777a401..6dd853d88a 100644 --- a/compiler/systems/i_beos.pas +++ b/compiler/systems/i_beos.pas @@ -65,7 +65,6 @@ unit i_beos; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_unix; endian : endian_little; alignment : diff --git a/compiler/systems/i_bsd.pas b/compiler/systems/i_bsd.pas index 4ed3c183df..d6aef894bf 100644 --- a/compiler/systems/i_bsd.pas +++ b/compiler/systems/i_bsd.pas @@ -68,7 +68,6 @@ unit i_bsd; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_unix; endian : endian_little; alignment : @@ -131,7 +130,6 @@ unit i_bsd; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_unix; endian : endian_little; alignment : @@ -194,7 +192,6 @@ unit i_bsd; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_unix; endian : endian_little; alignment : @@ -256,7 +253,6 @@ unit i_bsd; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_unix; endian : endian_little; alignment : @@ -318,7 +314,6 @@ unit i_bsd; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_unix; endian : endian_big; alignment : @@ -380,7 +375,6 @@ unit i_bsd; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_unix; endian : endian_big; alignment : @@ -445,7 +439,6 @@ unit i_bsd; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_unix; endian : endian_big; alignment : @@ -470,70 +463,6 @@ unit i_bsd; abi : abi_powerpc_aix; ); - - - system_i386_darwin_info : tsysteminfo = - ( - system : system_i386_darwin; - name : 'Darwin for i386'; - shortname : 'Darwin'; - flags : []; - cpu : cpu_i386; - unit_env : 'BSDUNITS'; - extradefines : 'UNIX;BSD;HASUNIX'; - exeext : ''; - defext : '.def'; - scriptext : '.sh'; - smartext : '.sl'; - unitext : '.ppu'; - unitlibext : '.ppl'; - asmext : '.s'; - objext : '.o'; - resext : '.res'; - resobjext : '.or'; - sharedlibext : '.dylib'; - staticlibext : '.a'; - staticlibprefix : 'libp'; - sharedlibprefix : 'lib'; - sharedClibext : '.dylib'; - staticClibext : '.a'; - staticClibprefix : 'lib'; - sharedClibprefix : 'lib'; - p_ext_support : true; - Cprefix : '_'; - newline : #10; - dirsep : '/'; - files_case_relevent : true; - assem : as_darwin; - assemextern : as_darwin; - link : nil; - linkextern : nil; - ar : ar_gnu_ar; - res : res_none; - dbg : dbg_stabs; - script : script_unix; - endian : endian_big; - alignment : - ( - procalign : 16; - loopalign : 4; - jumpalign : 0; - constalignmin : 0; - constalignmax : 4; - varalignmin : 0; - varalignmax : 4; - localalignmin : 0; - localalignmax : 4; - recordalignmin : 0; - recordalignmax : 16; - maxCrecordalign : 16 - ); - first_parm_offset : 8; - stacksize : 262144; - DllScanSupported:false; - use_function_relative_addresses : true; - ); - implementation initialization @@ -547,9 +476,6 @@ initialization {$ifdef OpenBSD} set_source_info(system_i386_NetBSD_info); {$endif} - {$ifdef Darwin} - set_source_info(system_i386_Darwin_info); - {$endif Darwin} {$endif cpu86} {$ifdef cpux86_64} {$ifdef FreeBSD} diff --git a/compiler/systems/i_emx.pas b/compiler/systems/i_emx.pas index 48d8769c64..1003662b97 100644 --- a/compiler/systems/i_emx.pas +++ b/compiler/systems/i_emx.pas @@ -73,7 +73,6 @@ unit i_emx; linkextern : nil; ar : ar_gnu_ar; res : res_emxbind; - dbg : dbg_stabs; script : script_dos; endian : endian_little; alignment : diff --git a/compiler/systems/i_go32v2.pas b/compiler/systems/i_go32v2.pas index d4989355f4..2908fe7af2 100644 --- a/compiler/systems/i_go32v2.pas +++ b/compiler/systems/i_go32v2.pas @@ -65,7 +65,6 @@ unit i_go32v2; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_dos; endian : endian_little; alignment : diff --git a/compiler/systems/i_linux.pas b/compiler/systems/i_linux.pas index 77edfc9c02..9cf9b51ced 100644 --- a/compiler/systems/i_linux.pas +++ b/compiler/systems/i_linux.pas @@ -25,7 +25,7 @@ unit i_linux; uses systems; - + const res_elf32_info : tresinfo = ( @@ -33,20 +33,20 @@ unit i_linux; resbin : 'fpcres'; rescmd : '-o $OBJ -i $RES' ); - + res_elf64_info : tresinfo = ( id : res_elf; resbin : 'fpcres'; rescmd : '-o $OBJ -i $RES' ); - + system_i386_linux_info : tsysteminfo = ( system : system_i386_LINUX; name : 'Linux for i386'; shortname : 'Linux'; - flags : [tf_needs_symbol_size,tf_pic_uses_got{,tf_smartlink_sections},tf_needs_symbol_type]; + flags : [tf_needs_symbol_size,tf_pic_uses_got{,tf_smartlink_sections}]; cpu : cpu_i386; unit_env : 'LINUXUNITS'; extradefines : 'UNIX;HASUNIX'; @@ -79,7 +79,6 @@ unit i_linux; linkextern : nil; ar : ar_gnu_ar; res : res_elf; - dbg : dbg_stabs; script : script_unix; endian : endian_little; alignment : @@ -142,7 +141,6 @@ unit i_linux; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_unix; endian : endian_little; alignment : @@ -172,7 +170,7 @@ unit i_linux; system : system_m68k_linux; name : 'Linux for m68k'; shortname : 'Linux'; - flags : [tf_needs_symbol_size,tf_needs_symbol_type]; + flags : [tf_needs_symbol_size]; cpu : cpu_m68k; unit_env : 'LINUXUNITS'; extradefines : 'UNIX;HASUNIX'; @@ -205,7 +203,6 @@ unit i_linux; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_unix; endian : endian_big; alignment : @@ -235,7 +232,7 @@ unit i_linux; system : system_powerpc_LINUX; name : 'Linux for PowerPC'; shortname : 'Linux'; - flags : [tf_needs_symbol_size,tf_needs_symbol_type]; + flags : [tf_needs_symbol_size]; cpu : cpu_powerpc; unit_env : ''; extradefines : 'UNIX;HASUNIX'; @@ -268,7 +265,6 @@ unit i_linux; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_unix; endian : endian_big; alignment : @@ -293,75 +289,12 @@ unit i_linux; abi : abi_powerpc_sysv; ); - system_powerpc64_linux_info : tsysteminfo = - ( - system : system_powerpc64_LINUX; - name : 'Linux for PowerPC64'; - shortname : 'Linux'; - flags : [tf_needs_symbol_size,tf_needs_symbol_type]; - cpu : cpu_powerpc64; - unit_env : ''; - extradefines : 'UNIX;HASUNIX'; - exeext : ''; - defext : '.def'; - scriptext : '.sh'; - smartext : '.sl'; - unitext : '.ppu'; - unitlibext : '.ppl'; - asmext : '.s'; - objext : '.o'; - resext : '.res'; - resobjext : '.or'; - sharedlibext : '.so'; - staticlibext : '.a'; - staticlibprefix : 'libp'; - sharedlibprefix : 'lib'; - sharedClibext : '.so'; - staticClibext : '.a'; - staticClibprefix : 'lib'; - sharedClibprefix : 'lib'; - p_ext_support : false; - Cprefix : ''; - newline : #10; - dirsep : '/'; - files_case_relevent : true; - assem : as_gas; - assemextern : as_gas; - link : nil; - linkextern : nil; - ar : ar_gnu_ar; - res : res_none; - dbg : dbg_stabs; - script : script_unix; - endian : endian_big; - alignment : - ( - procalign : 8; - loopalign : 4; - jumpalign : 0; - constalignmin : 0; - constalignmax : 8; - varalignmin : 0; - varalignmax : 8; - localalignmin : 4; - localalignmax : 8; - recordalignmin : 0; - recordalignmax : 8; - maxCrecordalign : 8 - ); - first_parm_offset : 8; - stacksize : 32*1024*1024; - DllScanSupported:false; - use_function_relative_addresses : true; - abi : abi_default - ); - system_alpha_linux_info : tsysteminfo = ( system : system_alpha_LINUX; name : 'Linux for Alpha'; shortname : 'Linux'; - flags : [tf_needs_symbol_size,tf_needs_symbol_type]; + flags : [tf_needs_symbol_size]; cpu : cpu_alpha; unit_env : 'LINUXUNITS'; extradefines : 'UNIX;HASUNIX'; @@ -394,7 +327,6 @@ unit i_linux; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_unix; endian : endian_little; alignment : @@ -425,7 +357,7 @@ unit i_linux; name : 'Linux for x86-64'; shortname : 'Linux'; flags : [tf_needs_symbol_size,tf_needs_dwarf_cfi, - tf_library_needs_pic,tf_needs_symbol_type]; + tf_library_needs_pic]; cpu : cpu_x86_64; unit_env : 'LINUXUNITS'; extradefines : 'UNIX;HASUNIX'; @@ -458,7 +390,6 @@ unit i_linux; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_unix; endian : endian_little; alignment : @@ -488,7 +419,7 @@ unit i_linux; system : system_SPARC_Linux; name : 'Linux for SPARC'; shortname : 'Linux'; - flags : [tf_needs_symbol_size,tf_library_needs_pic,tf_needs_symbol_type]; + flags : [tf_needs_symbol_size,tf_library_needs_pic]; cpu : cpu_SPARC; unit_env : 'LINUXUNITS'; extradefines : 'UNIX;HASUNIX'; @@ -521,7 +452,6 @@ unit i_linux; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_unix; endian : endian_big; alignment : @@ -551,7 +481,7 @@ unit i_linux; system : system_arm_Linux; name : 'Linux for ARM'; shortname : 'Linux'; - flags : [tf_needs_symbol_size,tf_needs_symbol_type]; + flags : [tf_needs_symbol_size]; cpu : cpu_arm; unit_env : 'LINUXUNITS'; extradefines : 'UNIX;HASUNIX'; @@ -584,7 +514,6 @@ unit i_linux; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_unix; endian : endian_little; alignment : @@ -640,16 +569,11 @@ initialization set_source_info(system_sparc_linux_info); {$endif linux} {$endif CPUSPARC} -{$ifdef CPUPOWERPC32} +{$ifdef CPUPOWERPC} {$ifdef linux} set_source_info(system_powerpc_linux_info); {$endif linux} -{$endif CPUPOWERPC32} -{$ifdef CPUPOWERPC64} - {$ifdef linux} - set_source_info(system_powerpc64_linux_info); - {$endif linux} -{$endif CPUPOWERPC64} +{$endif CPUPOWERPC} {$ifdef CPUARM} {$ifdef linux} set_source_info(system_arm_linux_info); diff --git a/compiler/systems/i_macos.pas b/compiler/systems/i_macos.pas index cdc387a841..5dafd52668 100644 --- a/compiler/systems/i_macos.pas +++ b/compiler/systems/i_macos.pas @@ -64,7 +64,6 @@ unit i_macos; linkextern : nil; ar : ar_mpw_ar; res : res_powerpc_mpw; - dbg : dbg_stabs; script : script_mpw; endian : endian_big; alignment : diff --git a/compiler/systems/i_morph.pas b/compiler/systems/i_morph.pas index a5d7bb1cdb..eeca6f7ce1 100644 --- a/compiler/systems/i_morph.pas +++ b/compiler/systems/i_morph.pas @@ -65,7 +65,6 @@ unit i_morph; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_amiga; endian : endian_big; alignment : diff --git a/compiler/systems/i_nwl.pas b/compiler/systems/i_nwl.pas index a1abad2f51..654a1da04d 100644 --- a/compiler/systems/i_nwl.pas +++ b/compiler/systems/i_nwl.pas @@ -65,7 +65,6 @@ unit i_nwl; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_unix; endian : endian_little; alignment : diff --git a/compiler/systems/i_nwm.pas b/compiler/systems/i_nwm.pas index 8880accfed..dcb941cebf 100644 --- a/compiler/systems/i_nwm.pas +++ b/compiler/systems/i_nwm.pas @@ -65,7 +65,6 @@ unit i_nwm; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_unix; endian : endian_little; alignment : diff --git a/compiler/systems/i_os2.pas b/compiler/systems/i_os2.pas index adb306689e..605a348520 100644 --- a/compiler/systems/i_os2.pas +++ b/compiler/systems/i_os2.pas @@ -73,7 +73,6 @@ unit i_os2; linkextern : nil; ar : ar_gnu_ar; res : res_emxbind; - dbg : dbg_stabs; script : script_dos; endian : endian_little; alignment : diff --git a/compiler/systems/i_palmos.pas b/compiler/systems/i_palmos.pas index fda9a52eb3..cb4977d8bb 100644 --- a/compiler/systems/i_palmos.pas +++ b/compiler/systems/i_palmos.pas @@ -62,7 +62,6 @@ unit i_palmos; linkextern : ld_m68k_palmos; ar : ar_m68k_ar; res : res_none; - dbg : dbg_stabs; script : script_unix; endian : endian_big; stackalignment : 2; diff --git a/compiler/systems/i_sunos.pas b/compiler/systems/i_sunos.pas index 073a3e4bfa..2eb22195b3 100644 --- a/compiler/systems/i_sunos.pas +++ b/compiler/systems/i_sunos.pas @@ -65,7 +65,6 @@ unit i_sunos; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_unix; endian : endian_little; alignment : @@ -127,7 +126,6 @@ unit i_sunos; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_unix; endian : endian_big; alignment : diff --git a/compiler/systems/i_watcom.pas b/compiler/systems/i_watcom.pas index 751357102b..7cdea56c0d 100644 --- a/compiler/systems/i_watcom.pas +++ b/compiler/systems/i_watcom.pas @@ -67,7 +67,6 @@ unit i_watcom; linkextern : nil; ar : ar_gnu_ar; res : res_none; - dbg : dbg_stabs; script : script_dos; endian : endian_little; alignment : diff --git a/compiler/systems/i_wdosx.pas b/compiler/systems/i_wdosx.pas index 75091db330..82aa080a5e 100644 --- a/compiler/systems/i_wdosx.pas +++ b/compiler/systems/i_wdosx.pas @@ -65,7 +65,6 @@ unit i_wdosx; linkextern : nil; ar : ar_gnu_ar; res : res_gnu_windres; - dbg : dbg_stabs; script : script_dos; endian : endian_little; alignment : diff --git a/compiler/systems/i_win.pas b/compiler/systems/i_win.pas deleted file mode 100644 index 46ef61c4b2..0000000000 --- a/compiler/systems/i_win.pas +++ /dev/null @@ -1,306 +0,0 @@ -{ - Copyright (c) 1998-2002 by Peter Vreman - - This unit implements support information structures for win32 - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - **************************************************************************** -} -{ This unit implements support information structures for win32. } -unit i_win; - - interface - - uses - systems; - - const - system_i386_win32_info : tsysteminfo = - ( - system : system_i386_WIN32; - name : 'Win32 for i386'; - shortname : 'Win32'; - flags : []; - cpu : cpu_i386; - unit_env : 'WIN32UNITS'; - extradefines : 'MSWINDOWS'; - exeext : '.exe'; - defext : '.def'; - scriptext : '.bat'; - smartext : '.sl'; - unitext : '.ppu'; - unitlibext : '.ppl'; - asmext : '.s'; - objext : '.o'; - resext : '.rc'; - resobjext : '.or'; - sharedlibext : '.dll'; - staticlibext : '.a'; - staticlibprefix : 'libp'; - sharedlibprefix : ''; - sharedClibext : '.dll'; - staticClibext : '.a'; - staticClibprefix : 'lib'; - sharedClibprefix : ''; - p_ext_support : false; - Cprefix : '_'; - newline : #13#10; - dirsep : '\'; - files_case_relevent : true; - assem : as_i386_pecoff; - assemextern : as_gas; - link : nil; - linkextern : nil; - ar : ar_gnu_ar; - res : res_gnu_windres; - dbg : dbg_stabs; - script : script_dos; - endian : endian_little; - alignment : - ( - procalign : 4; - loopalign : 4; - jumpalign : 0; - constalignmin : 0; - constalignmax : 16; - varalignmin : 0; - varalignmax : 16; - localalignmin : 4; - localalignmax : 8; - recordalignmin : 0; - recordalignmax : 4; - maxCrecordalign : 16 - ); - first_parm_offset : 8; - stacksize : 262144; - DllScanSupported:true; - use_function_relative_addresses : true - ); - - system_x64_win64_info : tsysteminfo = - ( - system : system_x86_64_win64; - name : 'Win64 for x64'; - shortname : 'Win64'; - flags : []; - cpu : cpu_x86_64; - unit_env : 'WIN64UNITS'; - extradefines : 'MSWINDOWS'; - exeext : '.exe'; - defext : '.def'; - scriptext : '.bat'; - smartext : '.sl'; - unitext : '.ppu'; - unitlibext : '.ppl'; - asmext : '.s'; - objext : '.o'; - resext : '.rc'; - resobjext : '.or'; - sharedlibext : '.dll'; - staticlibext : '.a'; - staticlibprefix : 'libp'; - sharedlibprefix : ''; - sharedClibext : '.dll'; - staticClibext : '.a'; - staticClibprefix : 'lib'; - sharedClibprefix : ''; - p_ext_support : false; - Cprefix : '_'; - newline : #13#10; - dirsep : '\'; - files_case_relevent : true; - assem : as_x86_64_pecoff; - assemextern : as_x86_64_masm; - link : nil; - linkextern : nil; - ar : ar_gnu_ar; - res : res_gnu_windres; - dbg : dbg_stabs; - script : script_dos; - endian : endian_little; - alignment : - ( - procalign : 8; - loopalign : 8; - jumpalign : 0; - constalignmin : 0; - constalignmax : 16; - varalignmin : 0; - varalignmax : 16; - localalignmin : 8; - localalignmax : 16; - recordalignmin : 0; - recordalignmax : 8; - maxCrecordalign : 16 - ); - first_parm_offset : 16; - stacksize : 262144; - DllScanSupported:true; - use_function_relative_addresses : true - ); - - system_arm_wince_info : tsysteminfo = - ( - system : system_arm_wince; - name : 'WinCE for ARM'; - shortname : 'WinCE'; - flags : []; - cpu : cpu_arm; - unit_env : ''; - extradefines : 'UNDER_CE'; - exeext : '.exe'; - defext : '.def'; - scriptext : '.bat'; - smartext : '.sl'; - unitext : '.ppu'; - unitlibext : '.ppl'; - asmext : '.s'; - objext : '.o'; - resext : '.rc'; - resobjext : '.or'; - sharedlibext : '.dll'; - staticlibext : '.a'; - staticlibprefix : 'libp'; - sharedlibprefix : ''; - sharedClibext : '.dll'; - staticClibext : '.a'; - staticClibprefix : 'lib'; - sharedClibprefix : ''; - p_ext_support : false; - Cprefix : '_'; - newline : #13#10; - dirsep : '\'; - files_case_relevent : true; - assem : as_gas; - assemextern : as_gas; - link : nil; - linkextern : nil; - ar : ar_gnu_ar; - res : res_gnu_wince_windres; - dbg : dbg_stabs; - script : script_dos; - endian : endian_little; - alignment : - ( - procalign : 4; - loopalign : 4; - jumpalign : 0; - constalignmin : 0; - constalignmax : 4; - varalignmin : 0; - varalignmax : 4; - localalignmin : 0; - localalignmax : 4; - recordalignmin : 0; - recordalignmax : 2; - maxCrecordalign : 4 - ); - first_parm_offset : 8; - stacksize : 262144; - DllScanSupported:false; - use_function_relative_addresses : true - ); - - system_i386_wince_info : tsysteminfo = - ( - system : system_i386_wince; - name : 'WinCE for i386'; - shortname : 'WinCE'; - flags : []; - cpu : cpu_i386; - unit_env : ''; - extradefines : 'UNDER_CE'; - exeext : '.exe'; - defext : '.def'; - scriptext : '.bat'; - smartext : '.sl'; - unitext : '.ppu'; - unitlibext : '.ppl'; - asmext : '.s'; - objext : '.o'; - resext : '.rc'; - resobjext : '.or'; - sharedlibext : '.dll'; - staticlibext : '.a'; - staticlibprefix : 'libp'; - sharedlibprefix : ''; - sharedClibext : '.dll'; - staticClibext : '.a'; - staticClibprefix : 'lib'; - sharedClibprefix : ''; - p_ext_support : false; - Cprefix : '_'; - newline : #13#10; - dirsep : '\'; - files_case_relevent : true; - assem : as_i386_pecoffwince; - assemextern : as_gas; - link : nil; - linkextern : nil; - ar : ar_gnu_ar; - res : res_gnu_windres; - dbg : dbg_stabs; - script : script_dos; - endian : endian_little; - alignment : - ( - procalign : 4; - loopalign : 4; - jumpalign : 0; - constalignmin : 0; - constalignmax : 4; - varalignmin : 0; - varalignmax : 4; - localalignmin : 4; - localalignmax : 4; - recordalignmin : 0; - recordalignmax : 4; - maxCrecordalign : 16 - ); - first_parm_offset : 8; - stacksize : 262144; - DllScanSupported:true; - use_function_relative_addresses : true - ); - - - implementation - -initialization -{$ifdef CPU86} - {$ifdef WIN32} - {$ifndef WDOSX} - set_source_info(system_i386_win32_info); - {$endif WDOSX} - {$endif WIN32} - {$ifdef WINCE} - set_source_info(system_i386_wince_info); - {$endif WINCE} -{$endif CPU86} - -{$ifdef CPUX86_64} - {$ifdef WIN64} - {$ifndef WDOSX} - set_source_info(system_x64_win64_info); - {$endif WDOSX} - {$endif WIN64} -{$endif CPUX86_64} - -{$ifdef CPUARM} - {$ifdef WINCE} - set_source_info(system_arm_wince_info); - {$endif WINCE} -{$endif CPUARM} -end. diff --git a/compiler/systems/i_gba.pas b/compiler/systems/i_win32.pas index ef5c1e2013..b6816e36fd 100644 --- a/compiler/systems/i_gba.pas +++ b/compiler/systems/i_win32.pas @@ -1,8 +1,8 @@ { - This unit implements support information structures for GameBoy Advance - Copyright (c) 1998-2002 by Peter Vreman + This unit implements support information structures for win32 + This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or @@ -18,8 +18,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. **************************************************************************** } -{ This unit implements support information structures for gba. } -unit i_gba; +{ This unit implements support information structures for win32. } +unit i_win32; interface @@ -27,46 +27,53 @@ unit i_gba; systems; const - system_arm_gba_info : tsysteminfo = + res_gnu_windres_info : tresinfo = + ( + id : res_gnu_windres; + resbin : 'windres'; + rescmd : '--include $INC -O coff -o $OBJ $RES' + ); + + const + system_i386_win32_info : tsysteminfo = ( - system : system_arm_gba; - name : 'GameBoy Advance'; - shortname : 'gba'; - flags : [tf_needs_symbol_size]; - cpu : cpu_arm; - unit_env : 'LINUXUNITS'; - extradefines : 'UNIX;HASUNIX'; - exeext : '.gba'; + system : system_i386_WIN32; + name : 'Win32 for i386'; + shortname : 'Win32'; + flags : []; + cpu : cpu_i386; + unit_env : 'WIN32UNITS'; + extradefines : 'MSWINDOWS'; + exeext : '.exe'; defext : '.def'; - scriptext : '.sh'; + scriptext : '.bat'; smartext : '.sl'; unitext : '.ppu'; unitlibext : '.ppl'; asmext : '.s'; objext : '.o'; - resext : '.res'; + resext : '.rc'; resobjext : '.or'; - sharedlibext : '.so'; + sharedlibext : '.dll'; staticlibext : '.a'; staticlibprefix : 'libp'; - sharedlibprefix : 'lib'; - sharedClibext : '.so'; + sharedlibprefix : ''; + sharedClibext : '.dll'; staticClibext : '.a'; staticClibprefix : 'lib'; - sharedClibprefix : 'lib'; + sharedClibprefix : ''; p_ext_support : false; - Cprefix : ''; - newline : #10; - dirsep : '/'; + Cprefix : '_'; + newline : #13#10; + dirsep : '\'; files_case_relevent : true; - assem : as_gas; + assem : as_i386_pecoff; assemextern : as_gas; link : nil; linkextern : nil; ar : ar_gnu_ar; - res : res_none; - dbg : dbg_stabs; - script : script_unix; + res : res_gnu_windres; + script : script_dos; endian : endian_little; alignment : ( @@ -74,28 +81,29 @@ unit i_gba; loopalign : 4; jumpalign : 0; constalignmin : 0; - constalignmax : 4; + constalignmax : 16; varalignmin : 0; - varalignmax : 4; + varalignmax : 16; localalignmin : 4; localalignmax : 8; recordalignmin : 0; - recordalignmax : 4; - maxCrecordalign : 4 + recordalignmax : 16; + maxCrecordalign : 16 ); first_parm_offset : 8; stacksize : 262144; - DllScanSupported:false; - use_function_relative_addresses : true; - abi : abi_default + DllScanSupported:true; + use_function_relative_addresses : true ); implementation initialization -{$ifdef arm} - {$ifdef gba} - set_source_info(system_arm_gba_info); - {$endif gba} -{$endif arm} +{$ifdef CPU86} + {$ifdef WIN32} + {$ifndef WDOSX} + set_source_info(system_i386_win32_info); + {$endif WDOSX} + {$endif WIN32} +{$endif CPU86} end. diff --git a/compiler/systems/t_beos.pas b/compiler/systems/t_beos.pas index 5e9ea9f54e..c5bf275223 100644 --- a/compiler/systems/t_beos.pas +++ b/compiler/systems/t_beos.pas @@ -164,11 +164,11 @@ begin if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then begin {$ifdef i386} - { place jump in al_procedures } - asmlist[al_procedures].concat(Tai_align.Create_op(4,$90)); - asmlist[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); - asmlist[al_procedures].concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).first_procdef.mangledname,AB_EXTERNAL,AT_FUNCTION))); - asmlist[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^)); + { place jump in codesegment } + codesegment.concat(Tai_align.Create_op(4,$90)); + codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); + codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).first_procdef.mangledname,AB_EXTERNAL,AT_FUNCTION))); + codeSegment.concat(Tai_symbol_end.Createname(hp2.name^)); {$endif i386} end; end diff --git a/compiler/systems/t_bsd.pas b/compiler/systems/t_bsd.pas index 9586b4e6a2..7edc760ce0 100644 --- a/compiler/systems/t_bsd.pas +++ b/compiler/systems/t_bsd.pas @@ -31,6 +31,9 @@ interface implementation uses +{$ifdef gdb} + gdb, +{$endif gdb} cutils,cclasses, {$ifdef USE_SYSUTILS} sysutils, @@ -90,8 +93,8 @@ implementation procedure timportlibdarwin.preparelib(const s : string); begin - if asmlist[al_imports]=nil then - asmlist[al_imports]:=TAAsmoutput.create; + if not(assigned(importssection)) then + importssection:=TAAsmoutput.create; end; @@ -221,17 +224,17 @@ begin if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then begin {$ifdef i386} - { place jump in al_procedures } - asmlist[al_procedures].concat(Tai_align.Create_op(4,$90)); - asmlist[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); - asmlist[al_procedures].concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).first_procdef.mangledname,AB_EXTERNAL,AT_FUNCTION))); - asmlist[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^)); + { place jump in codesegment } + codesegment.concat(Tai_align.Create_op(4,$90)); + codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); + codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).first_procdef.mangledname,AB_EXTERNAL,AT_FUNCTION))); + codeSegment.concat(Tai_symbol_end.Createname(hp2.name^)); {$endif i386} {$ifdef powerpc} - asmlist[al_procedures].concat(Tai_align.create(16)); - asmlist[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); - asmlist[al_procedures].concat(Taicpu.Op_sym(A_B,objectlibrary.newasmsymbol(tprocsym(hp2.sym).first_procdef.mangledname,AB_EXTERNAL,AT_FUNCTION))); - asmlist[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^)); + codesegment.concat(Tai_align.create(16)); + codesegment.concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); + codeSegment.concat(Taicpu.Op_sym(A_B,objectlibrary.newasmsymbol(tprocsym(hp2.sym).first_procdef.mangledname,AB_EXTERNAL,AT_FUNCTION))); + codeSegment.concat(Tai_symbol_end.Createname(hp2.name^)); {$endif powerpc} end; end diff --git a/compiler/systems/t_gba.pas b/compiler/systems/t_gba.pas deleted file mode 100644 index c937ca2a6d..0000000000 --- a/compiler/systems/t_gba.pas +++ /dev/null @@ -1,300 +0,0 @@ -{ - This unit implements support import,export,link routines - for the (arm) GameBoy Advance target - - Copyright (c) 2001-2002 by Peter Vreman - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** -} -unit t_gba; - -{$i fpcdefs.inc} - - -interface - - uses - symsym,symdef, - import,export,link; - - type - tlinkergba=class(texternallinker) - private - libctype:(libc5,glibc2,glibc21,uclibc); - Function WriteResponseFile : Boolean; - public - constructor Create;override; - procedure SetDefaultInfo;override; - function MakeExecutable:boolean;override; - end; - - -implementation - - - uses - cutils,cclasses,verbose,systems,globtype,globals, - symconst,script,fmodule,dos,aasmbase,aasmtai,aasmcpu, - cpubase,cgobj,i_gba; - - - -{***************************************************************************** - TLINKERLINUX -*****************************************************************************} - -Constructor TLinkerGba.Create; -begin - Inherited Create; - if not Dontlinkstdlibpath Then - LibrarySearchPath.AddPath('/lib;/usr/lib;/usr/X11R6/lib',true); -end; - - -procedure TLinkerGba.SetDefaultInfo; -{ - This will also detect which libc version will be used -} -begin - with Info do - begin - //ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -L. -o $EXE $RES'; - // Here we call ld with right options for GBA - ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -Ttext 0x08000000 -Tbss 0x03000000 -L. -o $EXE $RES'; - DllCmd[1]:='ld $OPT $INIT $FINI $SONAME -shared -L. -o $EXE $RES'; - DllCmd[2]:='strip --strip-unneeded $EXE'; - DynamicLinker:='/lib/ld-linux.so.2'; - libctype:=glibc2; - end; -end; - - -Function TLinkerGba.WriteResponseFile: Boolean; -Var - linkres : TLinkRes; - i : longint; - cprtobj, - gprtobj, - prtobj : string[80]; - HPath : TStringListItem; - s,s1,s2 : string; - found1, - found2, - linklibc : boolean; -begin - WriteResponseFile:=False; -{ set special options for some targets } - linklibc:=(SharedLibFiles.Find('c')<>nil); - prtobj:='prt0'; - case libctype of - glibc21: - begin - cprtobj:='cprt21'; - gprtobj:='gprt21'; - end; - uclibc: - begin - cprtobj:='ucprt0'; - gprtobj:='ugprt0'; - end - else - cprtobj:='cprt0'; - gprtobj:='gprt0'; - end; - - if cs_profile in aktmoduleswitches then - begin - prtobj:=gprtobj; - if not(libctype in [glibc2,glibc21]) then - AddSharedLibrary('gmon'); - AddSharedLibrary('c'); - linklibc:=true; - end - else - begin - if linklibc then - prtobj:=cprtobj; - end; - - { Open link.res file } - LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); - - { Write path to search libraries } - HPath:=TStringListItem(current_module.locallibrarysearchpath.First); - while assigned(HPath) do - begin - LinkRes.Add('SEARCH_DIR('+maybequoted(HPath.Str)+')'); - HPath:=TStringListItem(HPath.Next); - end; - HPath:=TStringListItem(LibrarySearchPath.First); - while assigned(HPath) do - begin - LinkRes.Add('SEARCH_DIR('+maybequoted(HPath.Str)+')'); - HPath:=TStringListItem(HPath.Next); - end; - - LinkRes.Add('INPUT('); - { add objectfiles, start with prt0 always } - if prtobj<>'' then - LinkRes.AddFileName(maybequoted(FindObjectFile(prtobj,'',false))); - { try to add crti and crtbegin if linking to C } - if linklibc then - begin - if librarysearchpath.FindFile('crtbegin.o',s) then - LinkRes.AddFileName(s); - if librarysearchpath.FindFile('crti.o',s) then - LinkRes.AddFileName(s); - end; - { main objectfiles } - while not ObjectFiles.Empty do - begin - s:=ObjectFiles.GetFirst; - if s<>'' then - LinkRes.AddFileName(maybequoted(s)); - end; - LinkRes.Add(')'); - - { Write staticlibraries } - if not StaticLibFiles.Empty then - begin - LinkRes.Add('GROUP('); - While not StaticLibFiles.Empty do - begin - S:=StaticLibFiles.GetFirst; - LinkRes.AddFileName(maybequoted(s)) - end; - LinkRes.Add(')'); - end; - - { Write sharedlibraries like -l<lib>, also add the needed dynamic linker - here to be sure that it gets linked this is needed for glibc2 systems (PFV) } - if not SharedLibFiles.Empty then - begin - LinkRes.Add('INPUT('); - While not SharedLibFiles.Empty do - begin - S:=SharedLibFiles.GetFirst; - if s<>'c' then - begin - i:=Pos(target_info.sharedlibext,S); - if i>0 then - Delete(S,i,255); - LinkRes.Add('-l'+s); - end - else - begin - linklibc:=true; - end; - end; - { be sure that libc is the last lib } - if linklibc then - LinkRes.Add('-lc'); - { when we have -static for the linker the we also need libgcc } - if (cs_link_staticflag in aktglobalswitches) then - LinkRes.Add('-lgcc'); - LinkRes.Add(')'); - end; - - { objects which must be at the end } - if linklibc and (libctype<>uclibc) then - begin - found1:=librarysearchpath.FindFile('crtend.o',s1); - found2:=librarysearchpath.FindFile('crtn.o',s2); - if found1 or found2 then - begin - LinkRes.Add('INPUT('); - if found1 then - LinkRes.AddFileName(s1); - if found2 then - LinkRes.AddFileName(s2); - LinkRes.Add(')'); - end; - end; -{ Write and Close response } - linkres.writetodisk; - linkres.Free; - - WriteResponseFile:=True; -end; - - -function TLinkerGba.MakeExecutable:boolean; -var - binstr : String; - cmdstr : TCmdStr; - success : boolean; - DynLinkStr : string[60]; - GCSectionsStr, - StaticStr, - StripStr : string[40]; -begin - if not(cs_link_extern in aktglobalswitches) then - Message1(exec_i_linking,current_module.exefilename^); - -{ Create some replacements } - StaticStr:=''; - StripStr:=''; - GCSectionsStr:=''; - DynLinkStr:=''; - if (cs_link_staticflag in aktglobalswitches) then - StaticStr:='-static'; - if (cs_link_strip in aktglobalswitches) then - StripStr:='-s'; - if (cs_link_smart in aktglobalswitches) and - (tf_smartlink_sections in target_info.flags) then - GCSectionsStr:='--gc-sections'; - If (cs_profile in aktmoduleswitches) or - ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then - begin - DynLinkStr:='-dynamic-linker='+Info.DynamicLinker; - if cshared Then - DynLinkStr:='--shared ' + DynLinkStr; - if rlinkpath<>'' Then - DynLinkStr:='--rpath-link '+rlinkpath + ' '+ DynLinkStr; - End; - -{ Write used files and libraries } - WriteResponseFile; - -{ Call linker } - SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); - Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); - Replace(cmdstr,'$OPT',Info.ExtraOptions); - Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); - Replace(cmdstr,'$STATIC',StaticStr); - Replace(cmdstr,'$STRIP',StripStr); - Replace(cmdstr,'$GCSECTIONS',GCSectionsStr); - Replace(cmdstr,'$DYNLINK',DynLinkStr); - success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,false); - -{ Remove ReponseFile } - if (success) and not(cs_link_extern in aktglobalswitches) then - RemoveFile(outputexedir+Info.ResName); - - MakeExecutable:=success; { otherwise a recursive call to link method } -end; - - - -{***************************************************************************** - Initialize -*****************************************************************************} - -initialization - RegisterExternalLinker(system_arm_gba_info,TLinkerGba); - RegisterTarget(system_arm_gba_info); -end. diff --git a/compiler/systems/t_linux.pas b/compiler/systems/t_linux.pas index 5421952d03..62d9054c0f 100644 --- a/compiler/systems/t_linux.pas +++ b/compiler/systems/t_linux.pas @@ -160,7 +160,7 @@ var sym : tasmsymbol; r : treference; begin - new_section(asmlist[al_procedures],sec_code,'',0); + new_section(codesegment,sec_code,'',0); hp2:=texported_item(current_module._exports.first); while assigned(hp2) do begin @@ -171,9 +171,9 @@ begin is declared with cdecl } if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then begin - { place jump in al_procedures } - asmlist[al_procedures].concat(tai_align.create(target_info.alignment.procalign)); - asmlist[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); + { place jump in codesegment } + codesegment.concat(tai_align.create(target_info.alignment.procalign)); + codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); if (cs_create_pic in aktmoduleswitches) and { other targets need to be checked how it works } (target_info.system in [system_x86_64_linux]) then @@ -185,16 +185,16 @@ begin r.refaddr:=addr_pic else r.refaddr:=addr_full; - asmlist[al_procedures].concat(taicpu.op_ref(A_JMP,S_NO,r)); + codesegment.concat(taicpu.op_ref(A_JMP,S_NO,r)); {$endif x86_64} end else - cg.a_jmp_name(asmlist[al_procedures],tprocsym(hp2.sym).first_procdef.mangledname); - asmlist[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^)); + cg.a_jmp_name(codesegment,tprocsym(hp2.sym).first_procdef.mangledname); + codeSegment.concat(Tai_symbol_end.Createname(hp2.name^)); end; end else - message1(parser_e_no_export_of_variables_for_target,'linux'); + Message1(parser_e_no_export_of_variables_for_target,'linux'); hp2:=texported_item(hp2.next); end; end; @@ -211,11 +211,7 @@ begin {$ifdef x86_64} LibrarySearchPath.AddPath('/lib64;/usr/lib64;/usr/X11R6/lib64',true); {$else} -{$ifdef powerpc64} - LibrarySearchPath.AddPath('/lib64;/usr/lib64;/usr/X11R6/lib64',true); -{$else powerpc64} LibrarySearchPath.AddPath('/lib;/usr/lib;/usr/X11R6/lib',true); -{$endif powerpc64} {$endif x86_64} end; @@ -224,16 +220,6 @@ procedure TLinkerLinux.SetDefaultInfo; { This will also detect which libc version will be used } - -const -{$ifdef i386} platform_select='-b elf32-i386 -m elf_i386';{$endif} -{$ifdef x86_64} platform_select='-b elf64-x86-64 -m elf_x86_64';{$endif} -{$ifdef powerpc}platform_select='-b elf32-powerpc -m elf32ppclinux';{$endif} -{$ifdef POWERPC64} platform_select='-b elf64-powerpc -m elf64ppc';{$endif} -{$ifdef sparc} platform_select='-b elf32-sparc -m elf32_sparc';{$endif} -{$ifdef arm} platform_select='';{$endif} {unknown :( } -{$ifdef m68k} platform_select='';{$endif} {unknown :( } - {$ifdef m68k} var St : SearchRec; @@ -241,8 +227,8 @@ var begin with Info do begin - ExeCmd[1]:='ld '+platform_select+' $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -L. -o $EXE $RES'; - DllCmd[1]:='ld '+platform_select+' $OPT $INIT $FINI $SONAME -shared -L. -o $EXE $RES'; + ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -L. -o $EXE $RES'; + DllCmd[1]:='ld $OPT $INIT $FINI $SONAME -shared -L. -o $EXE $RES'; DllCmd[2]:='strip --strip-unneeded $EXE'; {$ifdef m68k} libctype:=glibc2; @@ -297,11 +283,6 @@ begin libctype:=glibc2; {$endif powerpc} -{$ifdef powerpc64} - DynamicLinker:='/lib64/ld64.so.1'; - libctype:=glibc2; -{$endif powerpc64} - {$ifdef arm} DynamicLinker:='/lib/ld-linux.so.2'; libctype:=glibc2; @@ -459,113 +440,9 @@ begin LinkRes.Add(')'); end; end; - {Entry point.} - linkres.add('ENTRY(_start)'); - - {Sections.} -{ - commented out because it cause problems on several machines with different ld versions (FK) - linkres.add('SECTIONS'); - linkres.add('{'); - {Read-only sections, merged into text segment:} - linkres.add(' PROVIDE (__executable_start = 0x010000); . = 0x010000 +0x100;'); - linkres.add(' .interp : { *(.interp) }'); - linkres.add(' .hash : { *(.hash) }'); - linkres.add(' .dynsym : { *(.dynsym) }'); - linkres.add(' .dynstr : { *(.dynstr) }'); - linkres.add(' .gnu.version : { *(.gnu.version) }'); - linkres.add(' .gnu.version_d : { *(.gnu.version_d) }'); - linkres.add(' .gnu.version_r : { *(.gnu.version_r) }'); - linkres.add(' .rel.dyn :'); - linkres.add(' {'); - linkres.add(' *(.rel.init)'); - linkres.add(' *(.rel.text .rel.text.* .rel.gnu.linkonce.t.*)'); - linkres.add(' *(.rel.fini)'); - linkres.add(' *(.rel.rodata .rel.rodata.* .rel.gnu.linkonce.r.*)'); - linkres.add(' *(.rel.data.rel.ro*)'); - linkres.add(' *(.rel.data .rel.data.* .rel.gnu.linkonce.d.*)'); - linkres.add(' *(.rel.tdata .rel.tdata.* .rel.gnu.linkonce.td.*)'); - linkres.add(' *(.rel.tbss .rel.tbss.* .rel.gnu.linkonce.tb.*)'); - linkres.add(' *(.rel.got)'); - linkres.add(' *(.rel.bss .rel.bss.* .rel.gnu.linkonce.b.*)'); - linkres.add(' }'); - linkres.add(' .rela.dyn :'); - linkres.add(' {'); - linkres.add(' *(.rela.init)'); - linkres.add(' *(.rela.text .rela.text.* .rela.gnu.linkonce.t.*)'); - linkres.add(' *(.rela.fini)'); - linkres.add(' *(.rela.rodata .rela.rodata.* .rela.gnu.linkonce.r.*)'); - linkres.add(' *(.rela.data .rela.data.* .rela.gnu.linkonce.d.*)'); - linkres.add(' *(.rela.tdata .rela.tdata.* .rela.gnu.linkonce.td.*)'); - linkres.add(' *(.rela.tbss .rela.tbss.* .rela.gnu.linkonce.tb.*)'); - linkres.add(' *(.rela.got)'); - linkres.add(' *(.rela.bss .rela.bss.* .rela.gnu.linkonce.b.*)'); - linkres.add(' }'); - linkres.add(' .rel.plt : { *(.rel.plt) }'); - linkres.add(' .rela.plt : { *(.rela.plt) }'); - linkres.add(' .init :'); - linkres.add(' {'); - linkres.add(' KEEP (*(.init))'); - linkres.add(' } =0x90909090'); - linkres.add(' .plt : { *(.plt) }'); - linkres.add(' .text :'); - linkres.add(' {'); - linkres.add(' *(.text .stub .text.* .gnu.linkonce.t.*)'); - linkres.add(' KEEP (*(.text.*personality*))'); - {.gnu.warning sections are handled specially by elf32.em.} - linkres.add(' *(.gnu.warning)'); - linkres.add(' } =0x90909090'); - linkres.add(' .fini :'); - linkres.add(' {'); - linkres.add(' KEEP (*(.fini))'); - linkres.add(' } =0x90909090'); - linkres.add(' PROVIDE (_etext = .);'); - linkres.add(' .rodata : { *(.rodata .rodata.* .gnu.linkonce.r.*) }'); - {Adjust the address for the data segment. We want to adjust up to - the same address within the page on the next page up.} - linkres.add(' . = ALIGN (0x1000) - ((0x1000 - .) & (0x1000 - 1)); . = DATA_SEGMENT_ALIGN (0x1000, 0x1000);'); - linkres.add(' .dynamic : { *(.dynamic) }'); - linkres.add(' .got : { *(.got) }'); - linkres.add(' .got.plt : { *(.got.plt) }'); - linkres.add(' .data :'); - linkres.add(' {'); - linkres.add(' *(.data .data.* .gnu.linkonce.d.*)'); - linkres.add(' KEEP (*(.gnu.linkonce.d.*personality*))'); - linkres.add(' }'); - linkres.add(' _edata = .;'); - linkres.add(' PROVIDE (edata = .);'); -{$ifdef zsegment_threadvars} - linkres.add(' _z = .;'); - linkres.add(' .threadvar 0 : AT (_z) { *(.threadvar .threadvar.* .gnu.linkonce.tv.*) }'); - linkres.add(' PROVIDE (_threadvar_size = SIZEOF(.threadvar));'); - linkres.add(' . = _z + SIZEOF (.threadvar);'); -{$else} - linkres.add(' .threadvar : { *(.threadvar .threadvar.* .gnu.linkonce.tv.*) }'); -{$endif} - linkres.add(' __bss_start = .;'); - linkres.add(' .bss :'); - linkres.add(' {'); - linkres.add(' *(.dynbss)'); - linkres.add(' *(.bss .bss.* .gnu.linkonce.b.*)'); - linkres.add(' *(COMMON)'); - {Align here to ensure that the .bss section occupies space up to - _end. Align after .bss to ensure correct alignment even if the - .bss section disappears because there are no input sections.} - linkres.add(' . = ALIGN(32 / 8);'); - linkres.add(' }'); - linkres.add(' . = ALIGN(32 / 8);'); - linkres.add(' _end = .;'); - linkres.add(' PROVIDE (end = .);'); - linkres.add(' . = DATA_SEGMENT_END (.);'); - {Stabs debugging sections.} - linkres.add(' .stab 0 : { *(.stab) }'); - linkres.add(' .stabstr 0 : { *(.stabstr) }'); - linkres.add('}'); -} - { Write and Close response } - LinkRes.writetodisk; - LinkRes.Free; + linkres.writetodisk; + linkres.Free; WriteResponseFile:=True; end; @@ -593,7 +470,7 @@ begin StaticStr:='-static'; if (cs_link_strip in aktglobalswitches) then StripStr:='-s'; - if (af_smartlink_sections in target_asm.flags) and + if (cs_link_smart in aktglobalswitches) and (tf_smartlink_sections in target_info.flags) then GCSectionsStr:='--gc-sections'; If (cs_profile in aktmoduleswitches) or @@ -623,11 +500,11 @@ begin { Remove ReponseFile } if (success) and not(cs_link_extern in aktglobalswitches) then RemoveFile(outputexedir+Info.ResName); - + if (success) then success:=PostProcessExecutable(current_module.exefilename^,false); - - + + MakeExecutable:=success; { otherwise a recursive call to link method } end; @@ -700,13 +577,13 @@ begin Found:=((hp.u.flags and uf_has_resourcefiles)=uf_has_resourcefiles); hp:=tused_unit(hp.next); end; - end; + end; if found then - begin + begin cmdstr:=' -f -i '+maybequoted(fn); postprocessexecutable:=DoExec(FindUtil(utilsprefix+'fpcres'),cmdstr,false,false); end; - end; + end; end; @@ -739,12 +616,6 @@ initialization RegisterExport(system_powerpc_linux,texportliblinux); RegisterTarget(system_powerpc_linux_info); {$endif powerpc} -{$ifdef powerpc64} - RegisterExternalLinker(system_powerpc64_linux_info,TLinkerLinux); - RegisterImport(system_powerpc64_linux,timportliblinux); - RegisterExport(system_powerpc64_linux,texportliblinux); - RegisterTarget(system_powerpc64_linux_info); -{$endif powerpc64} {$ifdef alpha} RegisterExternalLinker(system_alpha_linux_info,TLinkerLinux); RegisterImport(system_alpha_linux,timportliblinux); diff --git a/compiler/systems/t_nwl.pas b/compiler/systems/t_nwl.pas index 78e1ba0d93..1cca9f0231 100644 --- a/compiler/systems/t_nwl.pas +++ b/compiler/systems/t_nwl.pas @@ -241,11 +241,11 @@ begin if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then begin {$ifdef i386} - { place jump in al_procedures } - asmlist[al_procedures].concat(Tai_align.Create_op(4,$90)); - asmlist[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); - asmlist[al_procedures].concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).first_procdef.mangledname,AB_EXTERNAL,AT_FUNCTION))); - asmlist[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^)); + { place jump in codesegment } + codesegment.concat(Tai_align.Create_op(4,$90)); + codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); + codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).first_procdef.mangledname,AB_EXTERNAL,AT_FUNCTION))); + codeSegment.concat(Tai_symbol_end.Createname(hp2.name^)); {$endif i386} end; end diff --git a/compiler/systems/t_nwm.pas b/compiler/systems/t_nwm.pas index d231a67c98..a8e6403efb 100644 --- a/compiler/systems/t_nwm.pas +++ b/compiler/systems/t_nwm.pas @@ -233,11 +233,11 @@ begin if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then begin {$ifdef i386} - { place jump in al_procedures } - asmlist[al_procedures].concat(Tai_align.Create_op(4,$90)); - asmlist[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); - asmlist[al_procedures].concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).first_procdef.mangledname,AB_EXTERNAL,AT_FUNCTION))); - asmlist[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^)); + { place jump in codesegment } + codesegment.concat(Tai_align.Create_op(4,$90)); + codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); + codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).first_procdef.mangledname,AB_EXTERNAL,AT_FUNCTION))); + codeSegment.concat(Tai_symbol_end.Createname(hp2.name^)); {$endif i386} end; end diff --git a/compiler/systems/t_sunos.pas b/compiler/systems/t_sunos.pas index d600f5d9a0..b02653179f 100644 --- a/compiler/systems/t_sunos.pas +++ b/compiler/systems/t_sunos.pas @@ -169,7 +169,7 @@ procedure texportlibsolaris.generatelib; var hp2 : texported_item; begin - new_section(asmlist[al_procedures],sec_code,'',0); + new_section(codesegment,sec_code,'',0); hp2:=texported_item(current_module._exports.first); while assigned(hp2) do begin @@ -180,11 +180,11 @@ begin is declared with cdecl } if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then begin - { place jump in al_procedures } - asmlist[al_procedures].concat(tai_align.create(target_info.alignment.procalign)); - asmlist[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); - cg.a_jmp_name(asmlist[al_procedures],tprocsym(hp2.sym).first_procdef.mangledname); - asmlist[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^)); + { place jump in codesegment } + codesegment.concat(tai_align.create(target_info.alignment.procalign)); + codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); + cg.a_jmp_name(codesegment,tprocsym(hp2.sym).first_procdef.mangledname); + codeSegment.concat(Tai_symbol_end.Createname(hp2.name^)); end; end else diff --git a/compiler/systems/t_wdosx.pas b/compiler/systems/t_wdosx.pas index 4eaa9eaf68..cd643443bb 100644 --- a/compiler/systems/t_wdosx.pas +++ b/compiler/systems/t_wdosx.pas @@ -31,7 +31,7 @@ implementation uses cutils, fmodule,globals,systems, - import,export,link,t_win,i_wdosx; + import,export,link,t_win32,i_wdosx; type timportlibwdosx=class(timportlibwin32) diff --git a/compiler/systems/t_win.pas b/compiler/systems/t_win32.pas index 3d6e435ae7..6164df68d8 100644 --- a/compiler/systems/t_win.pas +++ b/compiler/systems/t_win32.pas @@ -19,7 +19,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. **************************************************************************** } -unit t_win; +unit t_win32; {$i fpcdefs.inc} @@ -31,14 +31,17 @@ interface symconst,symdef,symsym, script,gendef, cpubase, - import,export,link,cgobj,i_win; +{$ifdef GDB} + gdb, +{$endif} + import,export,link,cgobj,i_win32; const MAX_DEFAULT_EXTENSIONS = 3; type - tStr4=array[1..MAX_DEFAULT_EXTENSIONS] of string[4]; + tStr4=array[1..MAX_DEFAULT_EXTENSIONS]of string[4]; pStr4=^tStr4; twin32imported_item = class(timported_item) @@ -97,32 +100,17 @@ interface implementation uses - cpuinfo,cgutils,dbgbase; + cpuinfo,cgutils; - const - res_gnu_windres_info : tresinfo = - ( - id : res_gnu_windres; - resbin : 'windres'; - rescmd : '--include $INC -O coff -o $OBJ $RES' - ); - - res_gnu_wince_windres_info : tresinfo = - ( - id : res_gnu_wince_windres; - resbin : 'windres'; - rescmd : '--include $INC -O coff -o $OBJ $RES' - ); - {***************************************************************************** TIMPORTLIBWIN32 *****************************************************************************} procedure timportlibwin32.preparelib(const s : string); begin - if asmlist[al_imports]=nil then - asmlist[al_imports]:=TAAsmoutput.create; + if not(assigned(importssection)) then + importssection:=TAAsmoutput.create; end; @@ -229,16 +217,22 @@ implementation var hp1 : timportlist; hp2 : twin32imported_item; + p : pchar; begin - new_section(asmlist[al_imports],sec_code,'',0); + new_section(importssection,sec_code,'',0); hp1:=timportlist(current_module.imports.first); while assigned(hp1) do begin hp2:=twin32imported_item(hp1.imported_items.first); while assigned(hp2) do begin - asmlist[al_imports].concat(tai_directive.create(asd_extern,hp2.func^)); - asmlist[al_imports].concat(tai_directive.create(asd_nasm_import,hp2.func^+' '+hp1.dllname^+' '+hp2.name^)); + if (aktoutputformat in [as_i386_tasm,as_i386_masm]) then + p:=strpnew(#9+'EXTRN '+hp2.func^) + else + p:=strpnew(#9+'EXTERN '+hp2.func^); + importssection.concat(tai_direct.create(p)); + p:=strpnew(#9+'import '+hp2.func^+' '+hp1.dllname^+' '+hp2.name^); + importssection.concat(tai_direct.create(p)); hp2:=twin32imported_item(hp2.next); end; hp1:=timportlist(hp1.next); @@ -250,14 +244,16 @@ implementation var hp1 : timportlist; mangledstring : string; +{$ifdef GDB} importname : string; suffix : integer; +{$endif GDB} hp2 : twin32imported_item; - lhead,lname,lcode, {$ifdef ARM} lpcode, {$endif ARM} + lhead,lname,lcode, lidata4,lidata5 : tasmlabel; href : treference; begin - if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then + if (aktoutputformat in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then begin generatenasmlib; exit; @@ -271,76 +267,71 @@ implementation objectlibrary.getaddrlabel(lidata4); objectlibrary.getaddrlabel(lidata5); { create header for this importmodule } - asmlist[al_imports].concat(Tai_cutobject.Create_begin); - new_section(asmlist[al_imports],sec_idata2,'',0); - asmlist[al_imports].concat(Tai_label.Create(lhead)); + importsSection.concat(Tai_cutobject.Create_begin); + new_section(importsSection,sec_idata2,'',0); + importsSection.concat(Tai_label.Create(lhead)); { pointer to procedure names } - asmlist[al_imports].concat(Tai_const.Create_rva_sym(lidata4)); + importsSection.concat(Tai_const.Create_rva_sym(lidata4)); { two empty entries follow } - asmlist[al_imports].concat(Tai_const.Create_32bit(0)); - asmlist[al_imports].concat(Tai_const.Create_32bit(0)); + importsSection.concat(Tai_const.Create_32bit(0)); + importsSection.concat(Tai_const.Create_32bit(0)); { pointer to dll name } - asmlist[al_imports].concat(Tai_const.Create_rva_sym(lname)); + importsSection.concat(Tai_const.Create_rva_sym(lname)); { pointer to fixups } - asmlist[al_imports].concat(Tai_const.Create_rva_sym(lidata5)); + importsSection.concat(Tai_const.Create_rva_sym(lidata5)); { first write the name references } - new_section(asmlist[al_imports],sec_idata4,'',0); - asmlist[al_imports].concat(Tai_const.Create_32bit(0)); - asmlist[al_imports].concat(Tai_label.Create(lidata4)); + new_section(importsSection,sec_idata4,'',0); + importsSection.concat(Tai_const.Create_32bit(0)); + importsSection.concat(Tai_label.Create(lidata4)); { then the addresses and create also the indirect jump } - new_section(asmlist[al_imports],sec_idata5,'',0); - asmlist[al_imports].concat(Tai_const.Create_32bit(0)); - asmlist[al_imports].concat(Tai_label.Create(lidata5)); + new_section(importsSection,sec_idata5,'',0); + importsSection.concat(Tai_const.Create_32bit(0)); + importsSection.concat(Tai_label.Create(lidata5)); { create procedures } hp2:=twin32imported_item(hp1.imported_items.first); while assigned(hp2) do begin { insert cuts } - asmlist[al_imports].concat(Tai_cutobject.Create); + importsSection.concat(Tai_cutobject.Create); { create indirect jump } if not hp2.is_var then begin - objectlibrary.getjumplabel(lcode); - {$ifdef ARM} - objectlibrary.getjumplabel(lpcode); - {$endif ARM} - { place jump in al_procedures, insert a code section in the - al_imports to reduce the amount of .s files (PFV) } - new_section(asmlist[al_imports],sec_code,'',0); + objectlibrary.getlabel(lcode); + reference_reset_symbol(href,lcode,0); + { place jump in codesegment, insert a code section in the + imporTSection to reduce the amount of .s files (PFV) } + new_section(importsSection,sec_code,'',0); +{$IfDef GDB} + if (cs_debuginfo in aktmoduleswitches) then + importsSection.concat(Tai_stab_function_name.Create(nil)); +{$EndIf GDB} if assigned(hp2.procdef) then mangledstring:=hp2.procdef.mangledname else mangledstring:=hp2.func^; - asmlist[al_imports].concat(Tai_symbol.Createname_global(mangledstring,AT_FUNCTION,0)); - asmlist[al_imports].concat(Tai_function_name.Create('')); - {$ifdef ARM} - reference_reset_symbol(href,lpcode,0); - asmlist[al_imports].concat(Taicpu.op_reg_ref(A_LDR,NR_R12,href)); - reference_reset_base(href,NR_R12,0); - asmlist[al_imports].concat(Taicpu.op_reg_ref(A_LDR,NR_R15,href)); - asmlist[al_imports].concat(Tai_label.Create(lpcode)); - reference_reset_symbol(href,lcode,0); - asmlist[al_imports].concat(tai_const.create_sym_offset(href.symbol,href.offset)); - {$else ARM} - reference_reset_symbol(href,lcode,0); - asmlist[al_imports].concat(Taicpu.Op_ref(A_JMP,S_NO,href)); - asmlist[al_imports].concat(Tai_align.Create_op(4,$90)); - {$endif ARM} + importsSection.concat(Tai_symbol.Createname_global(mangledstring,AT_FUNCTION,0)); + importsSection.concat(Taicpu.Op_ref(A_JMP,S_NO,href)); + importsSection.concat(Tai_align.Create_op(4,$90)); +{$IfDef GDB} + if (cs_debuginfo in aktmoduleswitches) and assigned(hp2.procdef) then + hp2.procdef.concatstabto(importssection); +{$EndIf GDB} end; { create head link } - new_section(asmlist[al_imports],sec_idata7,'',0); - asmlist[al_imports].concat(Tai_const.Create_rva_sym(lhead)); + new_section(importsSection,sec_idata7,'',0); + importsSection.concat(Tai_const.Create_rva_sym(lhead)); { fixup } - objectlibrary.getjumplabel(tasmlabel(hp2.lab)); - new_section(asmlist[al_imports],sec_idata4,'',0); - asmlist[al_imports].concat(Tai_const.Create_rva_sym(hp2.lab)); - { add jump field to al_imports } - new_section(asmlist[al_imports],sec_idata5,'',0); + objectlibrary.getlabel(tasmlabel(hp2.lab)); + new_section(importsSection,sec_idata4,'',0); + importsSection.concat(Tai_const.Create_rva_sym(hp2.lab)); + { add jump field to imporTSection } + new_section(importsSection,sec_idata5,'',0); if hp2.is_var then - asmlist[al_imports].concat(Tai_symbol.Createname_global(hp2.func^,AT_FUNCTION,0)) + importsSection.concat(Tai_symbol.Createname_global(hp2.func^,AT_FUNCTION,0)) else - asmlist[al_imports].concat(Tai_label.Create(lcode)); + importsSection.concat(Tai_label.Create(lcode)); +{$ifdef GDB} if (cs_debuginfo in aktmoduleswitches) then begin if assigned(hp2.name) then @@ -352,7 +343,7 @@ implementation inc(suffix); importname:='__imp_'+hp2.name^+'_'+tostr(suffix); end; - asmlist[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4)); + importssection.concat(tai_symbol.createname(importname,AT_FUNCTION,4)); end else begin @@ -363,34 +354,35 @@ implementation inc(suffix); importname:='__imp_by_ordinal'+tostr(hp2.ordnr)+'_'+tostr(suffix); end; - asmlist[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4)); + importssection.concat(tai_symbol.createname(importname,AT_FUNCTION,4)); end; end; +{$endif GDB} if hp2.name^<>'' then - asmlist[al_imports].concat(Tai_const.Create_rva_sym(hp2.lab)) + importsSection.concat(Tai_const.Create_rva_sym(hp2.lab)) else - asmlist[al_imports].concat(Tai_const.Create_32bit(longint($80000000) or longint(hp2.ordnr))); + importsSection.concat(Tai_const.Create_32bit(longint($80000000) or longint(hp2.ordnr))); { finally the import information } - new_section(asmlist[al_imports],sec_idata6,'',0); - asmlist[al_imports].concat(Tai_label.Create(hp2.lab)); - asmlist[al_imports].concat(Tai_const.Create_16bit(hp2.ordnr)); - asmlist[al_imports].concat(Tai_string.Create(hp2.name^+#0)); - asmlist[al_imports].concat(Tai_align.Create_op(2,0)); + new_section(importsSection,sec_idata6,'',0); + importsSection.concat(Tai_label.Create(hp2.lab)); + importsSection.concat(Tai_const.Create_16bit(hp2.ordnr)); + importsSection.concat(Tai_string.Create(hp2.name^+#0)); + importsSection.concat(Tai_align.Create_op(2,0)); hp2:=twin32imported_item(hp2.next); end; { write final section } - asmlist[al_imports].concat(Tai_cutobject.Create_end); + importsSection.concat(Tai_cutobject.Create_end); { end of name references } - new_section(asmlist[al_imports],sec_idata4,'',0); - asmlist[al_imports].concat(Tai_const.Create_32bit(0)); + new_section(importsSection,sec_idata4,'',0); + importsSection.concat(Tai_const.Create_32bit(0)); { end if addresses } - new_section(asmlist[al_imports],sec_idata5,'',0); - asmlist[al_imports].concat(Tai_const.Create_32bit(0)); + new_section(importsSection,sec_idata5,'',0); + importsSection.concat(Tai_const.Create_32bit(0)); { dllname } - new_section(asmlist[al_imports],sec_idata7,'',0); - asmlist[al_imports].concat(Tai_label.Create(lname)); - asmlist[al_imports].concat(Tai_string.Create(hp1.dllname^+#0)); + new_section(importsSection,sec_idata7,'',0); + importsSection.concat(Tai_label.Create(lname)); + importsSection.concat(Tai_string.Create(hp1.dllname^+#0)); hp1:=timportlist(hp1.next); end; @@ -401,13 +393,15 @@ implementation var hp1 : timportlist; hp2 : twin32imported_item; - l1,l2,l3,l4 {$ifdef ARM} ,l5 {$endif ARM} : tasmlabel; + l1,l2,l3,l4 : tasmlabel; mangledstring : string; +{$ifdef GDB} importname : string; suffix : integer; +{$endif GDB} href : treference; begin - if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then + if (aktoutputformat in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then begin generatenasmlib; exit; @@ -415,79 +409,74 @@ implementation hp1:=timportlist(current_module.imports.first); while assigned(hp1) do begin - { align al_procedures for the jumps } - new_section(asmlist[al_imports],sec_code,'',sizeof(aint)); + { align codesegment for the jumps } + new_section(importsSection,sec_code,'',sizeof(aint)); { Get labels for the sections } - objectlibrary.getjumplabel(l1); - objectlibrary.getjumplabel(l2); - objectlibrary.getjumplabel(l3); - new_section(asmlist[al_imports],sec_idata2,'',0); + objectlibrary.getlabel(l1); + objectlibrary.getlabel(l2); + objectlibrary.getlabel(l3); + new_section(importsSection,sec_idata2,'',0); { pointer to procedure names } - asmlist[al_imports].concat(Tai_const.Create_rva_sym(l2)); + importsSection.concat(Tai_const.Create_rva_sym(l2)); { two empty entries follow } - asmlist[al_imports].concat(Tai_const.Create_32bit(0)); - asmlist[al_imports].concat(Tai_const.Create_32bit(0)); + importsSection.concat(Tai_const.Create_32bit(0)); + importsSection.concat(Tai_const.Create_32bit(0)); { pointer to dll name } - asmlist[al_imports].concat(Tai_const.Create_rva_sym(l1)); + importsSection.concat(Tai_const.Create_rva_sym(l1)); { pointer to fixups } - asmlist[al_imports].concat(Tai_const.Create_rva_sym(l3)); + importsSection.concat(Tai_const.Create_rva_sym(l3)); { only create one section for each else it will create a lot of idata* } { first write the name references } - new_section(asmlist[al_imports],sec_idata4,'',0); - asmlist[al_imports].concat(Tai_label.Create(l2)); + new_section(importsSection,sec_idata4,'',0); + importsSection.concat(Tai_label.Create(l2)); hp2:=twin32imported_item(hp1.imported_items.first); while assigned(hp2) do begin - objectlibrary.getjumplabel(tasmlabel(hp2.lab)); + objectlibrary.getlabel(tasmlabel(hp2.lab)); if hp2.name^<>'' then - asmlist[al_imports].concat(Tai_const.Create_rva_sym(hp2.lab)) + importsSection.concat(Tai_const.Create_rva_sym(hp2.lab)) else - asmlist[al_imports].concat(Tai_const.Create_32bit(longint($80000000) or hp2.ordnr)); + importsSection.concat(Tai_const.Create_32bit(longint($80000000) or hp2.ordnr)); hp2:=twin32imported_item(hp2.next); end; { finalize the names ... } - asmlist[al_imports].concat(Tai_const.Create_32bit(0)); + importsSection.concat(Tai_const.Create_32bit(0)); { then the addresses and create also the indirect jump } - new_section(asmlist[al_imports],sec_idata5,'',0); - asmlist[al_imports].concat(Tai_label.Create(l3)); + new_section(importsSection,sec_idata5,'',0); + importsSection.concat(Tai_label.Create(l3)); hp2:=twin32imported_item(hp1.imported_items.first); while assigned(hp2) do begin if not hp2.is_var then begin - objectlibrary.getjumplabel(l4); - {$ifdef ARM} - objectlibrary.getjumplabel(l5); - {$endif ARM} - { create indirect jump and } - { place jump in al_procedures } - new_section(asmlist[al_imports],sec_code,'',0); + objectlibrary.getlabel(l4); + { create indirect jump } + reference_reset_symbol(href,l4,0); + { place jump in codesegment } + new_section(importsSection,sec_code,'',0); +{$IfDef GDB} + if (cs_debuginfo in aktmoduleswitches) then + importssection.concat(tai_stab_function_name.create(nil)); +{$EndIf GDB} if assigned(hp2.procdef) then mangledstring:=hp2.procdef.mangledname else mangledstring:=hp2.func^; - asmlist[al_imports].concat(Tai_symbol.Createname_global(mangledstring,AT_FUNCTION,0)); - asmlist[al_imports].concat(tai_function_name.create('')); - {$ifdef ARM} - reference_reset_symbol(href,l5,0); - asmlist[al_imports].concat(Taicpu.op_reg_ref(A_LDR,NR_R12,href)); - reference_reset_base(href,NR_R12,0); - asmlist[al_imports].concat(Taicpu.op_reg_ref(A_LDR,NR_R15,href)); - asmlist[al_imports].concat(Tai_label.Create(l5)); - reference_reset_symbol(href,l4,0); - asmlist[al_imports].concat(tai_const.create_sym_offset(href.symbol,href.offset)); - {$else ARM} - reference_reset_symbol(href,l4,0); - asmlist[al_imports].concat(Taicpu.Op_ref(A_JMP,S_NO,href)); - asmlist[al_imports].concat(Tai_align.Create_op(4,$90)); - {$endif ARM} - { add jump field to al_imports } - new_section(asmlist[al_imports],sec_idata5,'',0); + importsSection.concat(Tai_symbol.Createname_global(mangledstring,AT_FUNCTION,0)); + importsSection.concat(Taicpu.Op_ref(A_JMP,S_NO,href)); + importsSection.concat(Tai_align.Create_op(4,$90)); +{$IfDef GDB} + if (cs_debuginfo in aktmoduleswitches) and assigned(hp2.procdef) then + hp2.procdef.concatstabto(importssection); +{$EndIf GDB} + { add jump field to imporTSection } + new_section(importsSection,sec_idata5,'',0); +{$ifdef GDB} if (cs_debuginfo in aktmoduleswitches) then begin if assigned(hp2.name) then @@ -499,7 +488,7 @@ implementation inc(suffix); importname:='__imp_'+hp2.name^+'_'+tostr(suffix); end; - asmlist[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4)); + importssection.concat(tai_symbol.createname(importname,AT_FUNCTION,4)); end else begin @@ -510,37 +499,38 @@ implementation inc(suffix); importname:='__imp_by_ordinal'+tostr(hp2.ordnr)+'_'+tostr(suffix); end; - asmlist[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4)); + importssection.concat(tai_symbol.createname(importname,AT_FUNCTION,4)); end; end; - asmlist[al_imports].concat(Tai_label.Create(l4)); +{$endif GDB} + importsSection.concat(Tai_label.Create(l4)); end else begin - asmlist[al_imports].concat(Tai_symbol.Createname_global(hp2.func^,AT_DATA,0)); + importsSection.concat(Tai_symbol.Createname_global(hp2.func^,AT_DATA,0)); end; - asmlist[al_imports].concat(Tai_const.Create_rva_sym(hp2.lab)); + importsSection.concat(Tai_const.Create_rva_sym(hp2.lab)); hp2:=twin32imported_item(hp2.next); end; { finalize the addresses } - asmlist[al_imports].concat(Tai_const.Create_32bit(0)); + importsSection.concat(Tai_const.Create_32bit(0)); { finally the import information } - new_section(asmlist[al_imports],sec_idata6,'',0); + new_section(importsSection,sec_idata6,'',0); hp2:=twin32imported_item(hp1.imported_items.first); while assigned(hp2) do begin - asmlist[al_imports].concat(Tai_label.Create(hp2.lab)); + importsSection.concat(Tai_label.Create(hp2.lab)); { the ordinal number } - asmlist[al_imports].concat(Tai_const.Create_16bit(hp2.ordnr)); - asmlist[al_imports].concat(Tai_string.Create(hp2.name^+#0)); - asmlist[al_imports].concat(Tai_align.Create_op(2,0)); + importsSection.concat(Tai_const.Create_16bit(hp2.ordnr)); + importsSection.concat(Tai_string.Create(hp2.name^+#0)); + importsSection.concat(Tai_align.Create_op(2,0)); hp2:=twin32imported_item(hp2.next); end; { create import dll name } - new_section(asmlist[al_imports],sec_idata7,'',0); - asmlist[al_imports].concat(Tai_label.Create(l1)); - asmlist[al_imports].concat(Tai_string.Create(hp1.dllname^+#0)); + new_section(importsSection,sec_idata7,'',0); + importsSection.concat(Tai_label.Create(l1)); + importsSection.concat(Tai_string.Create(hp1.dllname^+#0)); hp1:=timportlist(hp1.next); end; @@ -553,14 +543,15 @@ implementation procedure texportlibwin32.preparelib(const s:string); begin - if asmlist[al_exports]=nil then - asmlist[al_exports]:=TAAsmoutput.create; + if not(assigned(exportssection)) then + exportssection:=TAAsmoutput.create; EList_indexed:=tList.Create; EList_nonindexed:=tList.Create; objectlibrary.getdatalabel(edatalabel); end; + procedure texportlibwin32.exportvar(hp : texported_item); begin { same code used !! PM } @@ -679,7 +670,7 @@ implementation exportfromlist(texported_item(EList_indexed.Items[i])); EList_indexed.Free; - if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then + if (aktoutputformat in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then begin generatenasmlib; exit; @@ -693,10 +684,10 @@ implementation ordinal_min:=$7FFFFFFF; entries:=0; named_entries:=0; - objectlibrary.getjumplabel(dll_name_label); - objectlibrary.getjumplabel(export_address_table); - objectlibrary.getjumplabel(export_name_table_pointers); - objectlibrary.getjumplabel(export_ordinal_table); + objectlibrary.getlabel(dll_name_label); + objectlibrary.getlabel(export_address_table); + objectlibrary.getlabel(export_name_table_pointers); + objectlibrary.getlabel(export_ordinal_table); { count entries } while assigned(hp) do @@ -717,38 +708,38 @@ implementation { we must also count the holes !! } entries:=ordinal_max-ordinal_base+1; - new_section(asmlist[al_exports],sec_edata,'',0); + new_section(exportsSection,sec_edata,'',0); { create label to reference from main so smartlink will include the .edata section } - asmlist[al_exports].concat(Tai_symbol.Create_global(edatalabel,0)); + exportsSection.concat(Tai_symbol.Create_global(edatalabel,0)); { export flags } - asmlist[al_exports].concat(Tai_const.Create_32bit(0)); + exportsSection.concat(Tai_const.Create_32bit(0)); { date/time stamp } - asmlist[al_exports].concat(Tai_const.Create_32bit(0)); + exportsSection.concat(Tai_const.Create_32bit(0)); { major version } - asmlist[al_exports].concat(Tai_const.Create_16bit(0)); + exportsSection.concat(Tai_const.Create_16bit(0)); { minor version } - asmlist[al_exports].concat(Tai_const.Create_16bit(0)); + exportsSection.concat(Tai_const.Create_16bit(0)); { pointer to dll name } - asmlist[al_exports].concat(Tai_const.Create_rva_sym(dll_name_label)); + exportsSection.concat(Tai_const.Create_rva_sym(dll_name_label)); { ordinal base normally set to 1 } - asmlist[al_exports].concat(Tai_const.Create_32bit(ordinal_base)); + exportsSection.concat(Tai_const.Create_32bit(ordinal_base)); { number of entries } - asmlist[al_exports].concat(Tai_const.Create_32bit(entries)); + exportsSection.concat(Tai_const.Create_32bit(entries)); { number of named entries } - asmlist[al_exports].concat(Tai_const.Create_32bit(named_entries)); + exportsSection.concat(Tai_const.Create_32bit(named_entries)); { address of export address table } - asmlist[al_exports].concat(Tai_const.Create_rva_sym(export_address_table)); + exportsSection.concat(Tai_const.Create_rva_sym(export_address_table)); { address of name pointer pointers } - asmlist[al_exports].concat(Tai_const.Create_rva_sym(export_name_table_pointers)); + exportsSection.concat(Tai_const.Create_rva_sym(export_name_table_pointers)); { address of ordinal number pointers } - asmlist[al_exports].concat(Tai_const.Create_rva_sym(export_ordinal_table)); + exportsSection.concat(Tai_const.Create_rva_sym(export_ordinal_table)); { the name } - asmlist[al_exports].concat(Tai_label.Create(dll_name_label)); + exportsSection.concat(Tai_label.Create(dll_name_label)); if st='' then - asmlist[al_exports].concat(Tai_string.Create(current_module.modulename^+target_info.sharedlibext+#0)) + exportsSection.concat(Tai_string.Create(current_module.modulename^+target_info.sharedlibext+#0)) else - asmlist[al_exports].concat(Tai_string.Create(st+target_info.sharedlibext+#0)); + exportsSection.concat(Tai_string.Create(st+target_info.sharedlibext+#0)); { export address table } address_table:=TAAsmoutput.create; @@ -768,7 +759,7 @@ implementation begin if (hp.options and eo_name)<>0 then begin - objectlibrary.getjumplabel(name_label); + objectlibrary.getlabel(name_label); name_table_pointers.concat(Tai_const.Create_rva_sym(name_label)); ordinal_table.concat(Tai_const.Create_16bit(hp.index-ordinal_base)); name_table.concat(Tai_align.Create_op(2,0)); @@ -817,10 +808,10 @@ implementation hp:=texported_item(hp.next); end; - asmlist[al_exports].concatlist(address_table); - asmlist[al_exports].concatlist(name_table_pointers); - asmlist[al_exports].concatlist(ordinal_table); - asmlist[al_exports].concatlist(name_table); + exportsSection.concatlist(address_table); + exportsSection.concatlist(name_table_pointers); + exportsSection.concatlist(ordinal_table); + exportsSection.concatlist(name_table); address_table.Free; name_table_pointers.free; ordinal_table.free; @@ -834,7 +825,7 @@ implementation p : pchar; s : string; begin - new_section(asmlist[al_exports],sec_code,'',0); + new_section(exportssection,sec_code,'',0); hp:=texported_item(current_module._exports.first); while assigned(hp) do begin @@ -849,7 +840,7 @@ implementation s:=''; end; p:=strpnew(#9+'export '+s+' '+hp.name^+' '+tostr(hp.index)); - {asmlist[al_exports].concat(tai_direct.create(p));} + exportssection.concat(tai_direct.create(p)); hp:=texported_item(hp.next); end; end; @@ -870,25 +861,18 @@ end; Procedure TLinkerWin32.SetDefaultInfo; -var - targetopts: string; begin with Info do begin - {$ifdef ARM} - targetopts:='-m armpe'; - {$else ARM} - targetopts:='-b pe-i386 -m i386pe'; - {$endif ARM} - ExeCmd[1]:='ld '+targetopts+' $OPT $STRIP $APPTYPE $IMAGEBASE $RELOC -o $EXE $RES'; - DllCmd[1]:='ld '+targetopts+' $OPT $STRIP --dll $APPTYPE $IMAGEBASE $RELOC -o $EXE $RES'; + ExeCmd[1]:='ld $OPT $STRIP $APPTYPE $IMAGEBASE $RELOC -o $EXE $RES'; + DllCmd[1]:='ld $OPT $STRIP --dll $APPTYPE $IMAGEBASE $RELOC -o $EXE $RES'; { ExeCmd[2]:='dlltool --as $ASBIN --dllname $EXE --output-exp exp.$$$ $RELOC $DEF'; use short forms to avoid 128 char limitation problem } ExeCmd[2]:='dlltool -S $ASBIN -D $EXE -e exp.$$$ $RELOC $DEF'; - ExeCmd[3]:='ld '+targetopts+' $OPT $STRIP $APPTYPE $IMAGEBASE -o $EXE $RES exp.$$$'; + ExeCmd[3]:='ld $OPT $STRIP $APPTYPE $IMAGEBASE -o $EXE $RES exp.$$$'; { DllCmd[2]:='dlltool --as $ASBIN --dllname $EXE --output-exp exp.$$$ $RELOC $DEF'; } DllCmd[2]:='dlltool -S $ASBIN -D $EXE -e exp.$$$ $RELOC $DEF'; - DllCmd[3]:='ld '+targetopts+' $OPT $STRIP --dll $APPTYPE $IMAGEBASE -o $EXE $RES exp.$$$'; + DllCmd[3]:='ld $OPT $STRIP --dll $APPTYPE $IMAGEBASE -o $EXE $RES exp.$$$'; end; end; @@ -1019,15 +1003,8 @@ begin AsBinStr:=FindUtil(utilsprefix+'as'); if RelocSection then RelocStr:='--base-file base.$$$'; - if target_info.system in [system_arm_wince,system_i386_wince] then - begin - AppTypeStr:='--subsystem wince'; - if apptype <> app_gui then - AppTypeStr:=AppTypeStr + ' --entry=mainCRTStartup'; - end - else - if apptype=app_gui then - AppTypeStr:='--subsystem windows'; + if apptype=app_gui then + AppTypeStr:='--subsystem windows'; if assigned(DLLImageBase) then ImageBaseStr:='--image-base=0x'+DLLImageBase^; if (cs_link_strip in aktglobalswitches) then @@ -1267,8 +1244,6 @@ begin if (cs_link_extern in aktglobalswitches) then begin case apptype of - app_native : - cmdstr:='--subsystem native'; app_gui : cmdstr:='--subsystem gui'; app_cui : @@ -1304,18 +1279,12 @@ begin { sub system } { gui=2 } { cui=3 } - { wincegui=9 } - if target_info.system in [system_arm_wince,system_i386_wince] then - peheader.Subsystem:=9 - else - case apptype of - app_native : - peheader.Subsystem:=1; - app_gui : - peheader.Subsystem:=2; - app_cui : - peheader.Subsystem:=3; - end; + case apptype of + app_gui : + peheader.Subsystem:=2; + app_cui : + peheader.Subsystem:=3; + end; if dllversion<>'' then begin peheader.MajorImageVersion:=dllmajor; @@ -1648,26 +1617,5 @@ initialization RegisterDLLScanner(system_i386_win32,TDLLScannerWin32); RegisterRes(res_gnu_windres_info); RegisterTarget(system_i386_win32_info); - - RegisterExternalLinker(system_i386_wince_info,TLinkerWin32); - RegisterImport(system_i386_wince,TImportLibWin32); - RegisterExport(system_i386_wince,TExportLibWin32); - RegisterDLLScanner(system_i386_wince,TDLLScannerWin32); - RegisterTarget(system_i386_wince_info); {$endif i386} -{$ifdef x86_64} - RegisterExternalLinker(system_x64_win64_info,TLinkerWin32); - RegisterImport(system_x86_64_win64,TImportLibWin32); - RegisterExport(system_x86_64_win64,TExportLibWin32); - RegisterDLLScanner(system_x86_64_win64,TDLLScannerWin32); - RegisterRes(res_gnu_windres_info); - RegisterTarget(system_x64_win64_info); -{$endif x86_64} -{$ifdef arm} - RegisterExternalLinker(system_arm_wince_info,TLinkerWin32); - RegisterImport(system_arm_wince,TImportLibWin32); - RegisterExport(system_arm_wince,TExportLibWin32); - RegisterRes(res_gnu_wince_windres_info); - RegisterTarget(system_arm_wince_info); -{$endif arm} end. diff --git a/compiler/tgobj.pas b/compiler/tgobj.pas index 6412f3e99e..7416e964bb 100644 --- a/compiler/tgobj.pas +++ b/compiler/tgobj.pas @@ -161,11 +161,7 @@ implementation {$ifdef powerpc} direction:=1; {$else powerpc} -{$ifdef POWERPC64} - direction:=1; -{$else POWERPC64} direction:=-1; -{$endif POWERPC64} {$endif powerpc} end; diff --git a/compiler/tokens.pas b/compiler/tokens.pas index 53c8f69f2f..5d2d68c180 100644 --- a/compiler/tokens.pas +++ b/compiler/tokens.pas @@ -180,7 +180,6 @@ type _IOCHECK, _LIBRARY, _MESSAGE, - _PACKAGE, _PRIVATE, _PROGRAM, _R12BASE, @@ -191,7 +190,6 @@ type _ABSOLUTE, _ABSTRACT, _BASESYSV, - _CONTAINS, _CONTINUE, _CPPCLASS, _EXTERNAL, @@ -204,7 +202,6 @@ type _PLATFORM, _PROPERTY, _REGISTER, - _REQUIRES, _RESIDENT, _SAFECALL, _SYSVBASE, @@ -420,7 +417,6 @@ const (str:'IOCHECK' ;special:false;keyword:m_none;op:NOTOKEN), (str:'LIBRARY' ;special:false;keyword:m_all;op:NOTOKEN), (str:'MESSAGE' ;special:false;keyword:m_none;op:NOTOKEN), - (str:'PACKAGE' ;special:false;keyword:m_none;op:NOTOKEN), (str:'PRIVATE' ;special:false;keyword:m_none;op:NOTOKEN), (str:'PROGRAM' ;special:false;keyword:m_all;op:NOTOKEN), (str:'R12BASE' ;special:false;keyword:m_none;op:NOTOKEN), { Syscall variation on MorphOS } @@ -431,7 +427,6 @@ const (str:'ABSOLUTE' ;special:false;keyword:m_none;op:NOTOKEN), (str:'ABSTRACT' ;special:false;keyword:m_none;op:NOTOKEN), (str:'BASESYSV' ;special:false;keyword:m_none;op:NOTOKEN), { Syscall variation on MorphOS } - (str:'CONTAINS' ;special:false;keyword:m_none;op:NOTOKEN), (str:'CONTINUE' ;special:false;keyword:m_none;op:NOTOKEN), (str:'CPPCLASS' ;special:false;keyword:m_fpc;op:NOTOKEN), (str:'EXTERNAL' ;special:false;keyword:m_none;op:NOTOKEN), @@ -444,7 +439,6 @@ const (str:'PLATFORM' ;special:false;keyword:m_none;op:NOTOKEN), (str:'PROPERTY' ;special:false;keyword:m_class;op:NOTOKEN), (str:'REGISTER' ;special:false;keyword:m_none;op:NOTOKEN), - (str:'REQUIRES' ;special:false;keyword:m_none;op:NOTOKEN), (str:'RESIDENT' ;special:false;keyword:m_none;op:NOTOKEN), (str:'SAFECALL' ;special:false;keyword:m_none;op:NOTOKEN), (str:'SYSVBASE' ;special:false;keyword:m_none;op:NOTOKEN), { Syscall variation on MorphOS } diff --git a/compiler/utils/mkarmins.pp b/compiler/utils/mkarmins.pp deleted file mode 100644 index bfce0f2e5e..0000000000 --- a/compiler/utils/mkarmins.pp +++ /dev/null @@ -1,432 +0,0 @@ -{ - Copyright (c) 1998-2005 by Peter Vreman and Florian Klaempfl - - Convert i386ins.dat from Nasm to a .inc file for usage with - the Free pascal compiler - - 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. - - **********************************************************************} -program mkarmins; - -const - Version = '0.9'; - -var - s : string; - i : longint; - x86_64 : boolean; - -{$ifndef FPC} - procedure readln(var t:text;var s:string); - var - c : char; - i : longint; - begin - c:=#0; - i:=0; - while (not eof(t)) and (c<>#10) do - begin - read(t,c); - if c<>#10 then - begin - inc(i); - s[i]:=c; - end; - end; - if (i>0) and (s[i]=#13) then - dec(i); - s[0]:=chr(i); - end; -{$endif} - - function lower(const s : string) : string; - { - return lowercased string of s - } - var - i : longint; - begin - for i:=1 to length(s) do - if s[i] in ['A'..'Z'] then - lower[i]:=char(byte(s[i])+32) - else - lower[i]:=s[i]; - lower[0]:=s[0]; - end; - - function Replace(var s:string;const s1,s2:string):boolean; - var - i : longint; - begin - i:=pos(s1,s); - if i>0 then - begin - Delete(s,i,length(s1)); - Insert(s2,s,i); - Replace:=true; - end - else - Replace:=false; - end; - - -function formatop(s:string):string; - const - replaces=19; - replacetab : array[1..replaces,1..2] of string[32]=( - (':',' or ot_colon'), - ('mem8','mem or ot_bits8'), - ('mem16','mem or ot_bits16'), - ('mem32','mem or ot_bits32'), - ('mem64','mem or ot_bits64'), - ('mem80','mem or ot_bits80'), - ('mem','memory'), - ('memory_offs','mem_offs'), - ('imm8','imm or ot_bits8'), - ('imm16','imm or ot_bits16'), - ('imm32','imm or ot_bits32'), - ('imm64','imm or ot_bits64'), - ('imm80','imm or ot_bits80'), - ('imm','immediate'), - ('rm8','regmem or ot_bits8'), - ('rm16','regmem or ot_bits16'), - ('rm32','regmem or ot_bits32'), - ('rm64','regmem or ot_bits64'), - ('rm80','regmem or ot_bits80') - ); - var - i : longint; - begin - for i:=1to replaces do - replace(s,replacetab[i,1],replacetab[i,2]); - formatop:=s; - end; - - -function readnumber : longint; - - var - base : longint; - result : longint; - - begin - result:=0; - if s[i]='\' then - begin - base:=8; - inc(i); - if s[i]='x' then - begin - base:=16; - inc(i); - end; - end - else - base:=10; - s[i]:=upcase(s[i]); - while s[i] in ['0'..'9','A'..'F'] do - begin - case s[i] of - '0'..'9': - result:=result*base+ord(s[i])-ord('0'); - - 'A'..'F': - result:=result*base+ord(s[i])-ord('A')+10; - end; - inc(i); - end; - readnumber:=result; - end; - -function tostr(l : longint) : string; - - var - hs : string; - - begin - str(l,hs); - tostr:=hs; - end; - -function readstr : string; - - var - result : string; - - begin - result:=''; - while (s[i] in ['0'..'9','A'..'Z','a'..'z','_']) and (i<=length(s)) do - begin - result:=result+s[i]; - inc(i); - end; - readstr:=result; - end; - -procedure skipspace; - - begin - while (s[i] in [' ',#9]) do - inc(i); - end; - -procedure openinc(var f:text;const fn:string); -begin - writeln('creating ',fn); - assign(f,fn); - rewrite(f); - writeln(f,'{ don''t edit, this file is generated from armins.dat }'); - writeln(f,'('); -end; - - -procedure closeinc(var f:text); -begin - writeln(f); - writeln(f,');'); - close(f); -end; - - -var - attsuffix, - hs : string; - j : longint; - firstopcode, - first : boolean; - maxinfolen, - code : byte; - insns : longint; - attsuffile,propfile,opfile, - nopfile,attfile, - infile,insfile : text; - { instruction fields } - skip : boolean; - last, - ops : longint; - attopcode, - opcode, - codes, - flags : string; - optypes : array[1..4] of string; -begin - writeln('Narm Instruction Table Converter Version ',Version); - insns:=0; - maxinfolen:=0; - { open dat file } - assign(infile,'../arm/armins.dat'); - { create inc files } - openinc(insfile,'armtab.inc'); - openinc(opfile,'armop.inc'); - assign(nopfile,'armnop.inc'); - openinc(attfile,'armatt.inc'); - openinc(attsuffile,'armatts.inc'); - { - openinc(intfile,'i386int.inc'); - openinc(propfile,'i386prop.inc'); - } - rewrite(nopfile); - writeln(nopfile,'{ don''t edit, this file is generated from armins.dat }'); - reset(infile); - first:=true; - opcode:=''; - firstopcode:=true; - while not(eof(infile)) do - begin - { handle comment } - readln(infile,s); - while (s[1]=' ') do - delete(s,1,1); - if (s='') or (s[1]=';') then - continue; - if (s[1]='[') then - begin - i:=pos(',',s); - j:=pos(']',s); - if i=0 then - begin - opcode:='A_'+Copy(s,2,j-2); - attopcode:=Copy(s,2,j-2); - { Conditional } - if (attopcode[length(attopcode)]='c') and - (attopcode[length(attopcode)-1]='c') then - begin - dec(byte(attopcode[0]),2); - dec(byte(opcode[0]),2); - end; - attsuffix:='attsufNONE'; - end - else - begin - opcode:='A_'+Copy(s,2,i-2); - { intel conditional } - if (opcode[length(attopcode)]='c') and - (opcode[length(attopcode)-1]='c') then - dec(byte(opcode[0]),2); - attopcode:=Copy(s,i+1,j-i-1); - { att Suffix } - case attopcode[length(attopcode)] of - 'X' : - begin - dec(attopcode[0]); - attsuffix:='attsufINT'; - end; - 'F' : - begin - dec(attopcode[0]); - attsuffix:='attsufFPU'; - end; - 'R' : - begin - dec(attopcode[0]); - attsuffix:='attsufFPUint'; - end; - else - attsuffix:='attsufNONE'; - end; - { att Conditional } - if (attopcode[length(attopcode)]='C') and - (attopcode[length(attopcode)-1]='C') then - dec(byte(attopcode[0]),2); - end; - attopcode:=Lower(attopcode); - if firstopcode then - firstopcode:=false - else - begin - writeln(opfile,','); - writeln(attfile,','); - writeln(attsuffile,','); -{ writeln(propfile,','); } - end; - write(opfile,opcode); - write(attfile,'''',attopcode,''''); - write(attsuffile,attsuffix); - { read the next line which contains the Change options } - { - repeat - readln(infile,s); - until eof(infile) or ((s<>'') and (s[1]<>';')); - write(propfile,'(Ch: ',s,')'); - } - continue; - end; - { we must have an opcode } - if opcode='' then - runerror(234); - { clear } - ops:=0; - optypes[1]:=''; - optypes[2]:=''; - optypes[3]:=''; - optypes[4]:=''; - codes:=''; - flags:=''; - skip:=false; - { ops and optypes } - i:=1; - repeat - hs:=readstr; - if (hs='void') or (hs='ignore') then - break; - inc(ops); - optypes[ops]:=optypes[ops]+'ot_'+formatop(hs); -{ if s[i]=':' then - begin - inc(i); - optypes[ops]:=optypes[ops]+' or ot_'+formatop(readstr); - end;} - while s[i]='|' do - begin - inc(i); - optypes[ops]:=optypes[ops]+' or ot_'+formatop(readstr); - end; - if s[i] in [',',':'] then - inc(i) - else - break; - until false; - for j:=1 to 4-ops do - optypes[4-j+1]:='ot_none'; - { codes } - skipspace; - j:=0; - last:=0; - if s[i] in ['\','0'..'9'] then - begin - while not(s[i] in [' ',#9]) do - begin - code:=readnumber; -(* - { for some codes we want also to change the optypes, but not - if the last byte was a 1 then this byte belongs to a direct - copy } - if last<>1 then - begin - case code of - 12,13,14 : - optypes[code-11]:=optypes[code-11]+' or ot_signed'; - end; - end; -*) - codes:=codes+'#'+tostr(code); - last:=code; - inc(j); - end; - end - else - begin - readstr; - codes:='#0'; - end; - if j>maxinfolen then - maxinfolen:=j; - { flags } - skipspace; - while not(s[i] in [' ',#9,#13,#10]) and (i<=length(s)) do - begin - hs:=readstr; - if hs<>'ND' then - begin - if flags<>'' then - flags:=flags+' or '; - flags:=flags+'if_'+lower(hs); - end; - if (s[i]=',') and (i<=length(s)) then - inc(i) - else - break; - end; - { write instruction } - if not skip then - begin - if not(first) then - writeln(insfile,',') - else - first:=false; - writeln(insfile,' ('); - writeln(insfile,' opcode : ',opcode,';'); - writeln(insfile,' ops : ',ops,';'); - writeln(insfile,' optypes : (',optypes[1],',',optypes[2],',',optypes[3],',',optypes[4],');'); - writeln(insfile,' code : ',codes,';'); - writeln(insfile,' flags : ',flags); - write(insfile,' )'); - inc(insns); - end; - end; - close(infile); - closeinc(insfile); - closeinc(attfile); - closeinc(attsuffile); - closeinc(opfile); - writeln(nopfile,insns,';'); - close(nopfile); -{ closeinc(propfile); } - writeln(insns,' nodes procesed (maxinfolen=',maxinfolen,')'); -end. diff --git a/compiler/utils/mkx86reg.pp b/compiler/utils/mkx86reg.pp index 4b0cf7ef6d..886fb5d9ed 100644 --- a/compiler/utils/mkx86reg.pp +++ b/compiler/utils/mkx86reg.pp @@ -343,9 +343,9 @@ begin openinc(numfile,fileprefix+'num.inc'); openinc(stdfile,fileprefix+'std.inc'); openinc(attfile,fileprefix+'att.inc'); - openinc(intfile,fileprefix+'int.inc'); if not(x86_64) then begin + openinc(intfile,fileprefix+'int.inc'); openinc(nasmfile,fileprefix+'nasm.inc'); end; openinc(stabfile,fileprefix+'stab.inc'); @@ -356,10 +356,10 @@ begin openinc(rnifile,fileprefix+'rni.inc'); openinc(srifile,fileprefix+'sri.inc'); openinc(arifile,fileprefix+'ari.inc'); - openinc(irifile,fileprefix+'iri.inc'); if not(x86_64) then begin openinc(nrifile,fileprefix+'nri.inc'); + openinc(irifile,fileprefix+'iri.inc'); end; first:=true; for i:=0 to regcount-1 do @@ -369,9 +369,9 @@ begin writeln(numfile,','); writeln(stdfile,','); writeln(attfile,','); - writeln(intfile,','); if not(x86_64) then begin + writeln(intfile,','); writeln(nasmfile,','); end; writeln(stabfile,','); @@ -381,9 +381,9 @@ begin writeln(rnifile,','); writeln(srifile,','); writeln(arifile,','); - writeln(irifile,','); if not(x86_64) then begin + writeln(irifile,','); writeln(nrifile,','); end; end @@ -393,9 +393,9 @@ begin write(numfile,'tregister(',numbers[i],')'); write(stdfile,'''',stdnames[i],''''); write(attfile,'''',attnames[i],''''); - write(intfile,'''',intnames[i],''''); if not(x86_64) then begin + write(intfile,'''',intnames[i],''''); write(nasmfile,'''',nasmnames[i],''''); end; write(stabfile,stabs[i]); @@ -408,9 +408,10 @@ begin write(rnifile,regnumber_index[i]); write(srifile,std_regname_index[i]); write(arifile,att_regname_index[i]); - write(irifile,int_regname_index[i]); + if not(x86_64) then begin + write(irifile,int_regname_index[i]); write(nrifile,nasm_regname_index[i]); end; end; @@ -419,9 +420,9 @@ begin closeinc(numfile); closeinc(attfile); closeinc(stdfile); - closeinc(intfile); if not(x86_64) then begin + closeinc(intfile); closeinc(nasmfile); end; closeinc(stabfile); @@ -432,10 +433,10 @@ begin closeinc(rnifile); closeinc(srifile); closeinc(arifile); - closeinc(irifile); if not(x86_64) then begin closeinc(nrifile); + closeinc(irifile); end; writeln('Done!'); writeln(regcount,' registers procesed'); diff --git a/compiler/utils/ppudump.pp b/compiler/utils/ppudump.pp index 1d73b79276..da9b653468 100644 --- a/compiler/utils/ppudump.pp +++ b/compiler/utils/ppudump.pp @@ -27,7 +27,7 @@ uses ppu; const - Version = 'Version 2.0.0'; + Version = 'Version 1.9.8'; Title = 'PPU-Analyser'; Copyright = 'Copyright (c) 1998-2005 by the Free Pascal Development Team'; @@ -137,14 +137,7 @@ type target_i386_watcom, { 32 } target_powerpc_MorphOS, { 33 } target_x86_64_freebsd, { 34 } - target_i386_netwlibc, { 35 } - system_powerpc_Amiga, { 36 } - system_x86_64_win64, { 37 } - system_arm_wince, { 38 } - system_ia64_win64, { 39 } - system_i386_wince, { 40 } - system_x86_6432_linux, { 41 } - system_arm_gba { 42 } + target_i386_netwlibc { 35 } ); const Targets : array[ttarget] of string[17]=( @@ -183,14 +176,7 @@ const { 32 } 'Watcom-i386', { 33 } 'MorphOS-powerpc', { 34 } 'FreeBSD-x86-64', - { 35 } 'Netware-i386-libc', - { 36 } 'Amiga-PowerPC', - { 37 } 'Win64-x64', - { 38 } 'WinCE-ARM', - { 39 } 'Win64-iA64', - { 40 } 'WinCE-i386', - { 41 } 'Linux-x64', - { 42 } 'GBA-ARM' + { 35 } 'Netware-i386-libc' ); begin if w<=ord(high(ttarget)) then @@ -452,7 +438,7 @@ Procedure ReadAsmSymbols; type { Copied from aasmbase.pas } TAsmsymbind=(AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL); - TAsmsymtype=(AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION,AT_LABEL); + TAsmsymtype=(AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION); var s, bindstr, @@ -483,8 +469,6 @@ begin typestr:='Data'; AT_SECTION : typestr:='Section'; - AT_LABEL : - typestr:='Label'; else typestr:='<Error !!>' end; @@ -1415,7 +1399,7 @@ type u8bit,u16bit,u32bit,u64bit, s8bit,s16bit,s32bit,s64bit, bool8bit,bool16bit,bool32bit, - uchar,uwidechar,scurrency + uchar,uwidechar ); tobjectdeftype = (odt_none, odt_class, @@ -1486,7 +1470,6 @@ begin bool32bit : writeln('bool32bit'); uchar : writeln('uchar'); uwidechar : writeln('uwidechar'); - scurrency : writeln('ucurrency'); else writeln('!! Warning: Invalid base type ',b); end; writeln(space,' Range : ',getint64,' to ',getint64); @@ -1548,13 +1531,12 @@ begin readdefinitions('parast',false); readsymbols('parast'); { localst } - if (po_has_inlininginfo in procoptions) or - ((ppufile.header.flags and uf_local_browser)<>0) then + if (po_inline in procoptions) then begin readdefinitions('localst',false); readsymbols('localst'); end; - if (po_has_inlininginfo in procoptions) then + if (po_inline in procoptions) then readnodetree; delete(space,1,4); end; diff --git a/compiler/version.pas b/compiler/version.pas index ca5b6f4ab5..4c6acb53ae 100644 --- a/compiler/version.pas +++ b/compiler/version.pas @@ -28,7 +28,7 @@ interface const { version string } version_nr = '2'; - release_nr = '1'; + release_nr = '0'; patch_nr = '1'; minorpatch = ''; @@ -44,12 +44,9 @@ interface {$ifdef cpu86} source_cpu_string = 'i386'; {$endif cpu86} -{$ifdef cpupowerpc32} +{$ifdef cpupowerpc} source_cpu_string = 'powerpc'; -{$endif cpupowerpc32} -{$ifdef cpupowerpc64} - source_cpu_string = 'powerpc64'; -{$endif cpupowerpc64} +{$endif cpupowerpc} {$ifdef cpum68k} source_cpu_string = 'm68k'; {$endif cpum68k} diff --git a/compiler/x86/aasmcpu.pas b/compiler/x86/aasmcpu.pas index 68ebd7238a..f27efe1cc9 100644 --- a/compiler/x86/aasmcpu.pas +++ b/compiler/x86/aasmcpu.pas @@ -238,8 +238,8 @@ interface procedure ResetPass1; procedure ResetPass2; function CheckIfValid:boolean; - function Pass1(offset:longint):longint;override; - procedure Pass2(objdata:TAsmObjectdata);override; + function Pass1(offset:longint):longint;virtual; + procedure Pass2(objdata:TAsmObjectdata);virtual; procedure SetOperandOrder(order:TOperandOrder); function is_same_reg_move(regtype: Tregistertype):boolean;override; { register spilling code } @@ -2039,22 +2039,7 @@ implementation function taicpu.spilling_get_operation_type(opnr: longint): topertype; begin - { the information in the instruction table is made for the string copy - operation MOVSD so hack here (FK) - } - if (opcode=A_MOVSD) and (ops=2) then - begin - case opnr of - 0: - result:=operand_read; - 1: - result:=operand_write; - else - internalerror(200506055); - end - end - else - result:=operation_type_table^[opcode,opnr]; + result:=operation_type_table^[opcode,opnr]; end; @@ -2064,14 +2049,7 @@ implementation R_INTREGISTER : result:=taicpu.op_ref_reg(A_MOV,reg2opsize(r),ref,r); R_MMREGISTER : - case getsubreg(r) of - R_SUBMMD: - result:=taicpu.op_ref_reg(A_MOVSD,reg2opsize(r),ref,r); - R_SUBMMS: - result:=taicpu.op_ref_reg(A_MOVSS,reg2opsize(r),ref,r); - else - internalerror(200506043); - end; + result:=taicpu.op_ref_reg(A_MOVSD,reg2opsize(r),ref,r); else internalerror(200401041); end; @@ -2084,14 +2062,7 @@ implementation R_INTREGISTER : result:=taicpu.op_reg_ref(A_MOV,reg2opsize(r),r,ref); R_MMREGISTER : - case getsubreg(r) of - R_SUBMMD: - result:=taicpu.op_reg_ref(A_MOVSD,reg2opsize(r),r,ref); - R_SUBMMS: - result:=taicpu.op_reg_ref(A_MOVSS,reg2opsize(r),r,ref); - else - internalerror(200506042); - end; + result:=taicpu.op_reg_ref(A_MOVSD,reg2opsize(r),r,ref); else internalerror(200401041); end; diff --git a/compiler/x86/agx86att.pas b/compiler/x86/agx86att.pas index c7ae4f1233..67c34c8e2f 100644 --- a/compiler/x86/agx86att.pas +++ b/compiler/x86/agx86att.pas @@ -70,11 +70,7 @@ interface if assigned(symbol) then AsmWrite(symbol.name); if ref.refaddr=addr_pic then -{$ifdef x86_64} AsmWrite('@GOTPCREL'); -{$else x86_64} - AsmWrite('@GOT'); -{$endif x86_64} if offset<0 then AsmWrite(tostr(offset)) else diff --git a/compiler/x86/cgx86.pas b/compiler/x86/cgx86.pas index e9e20710fa..86eabe6f1c 100644 --- a/compiler/x86/cgx86.pas +++ b/compiler/x86/cgx86.pas @@ -41,7 +41,6 @@ unit cgx86; function getfpuregister(list:Taasmoutput;size:Tcgsize):Tregister;override; function getmmxregister(list:Taasmoutput):Tregister; - function getmmregister(list:Taasmoutput;size:Tcgsize):Tregister;override; procedure getcpuregister(list:Taasmoutput;r:Tregister);override; procedure ungetcpuregister(list:Taasmoutput;r:Tregister);override; @@ -127,6 +126,8 @@ unit cgx86; procedure floatstoreops(t : tcgsize;var op : tasmop;var s : topsize); end; + function use_sse(def : tdef) : boolean; + const {$ifdef x86_64} TCGSize2OpSize: Array[tcgsize] of topsize = @@ -142,9 +143,9 @@ unit cgx86; S_NO,S_NO,S_NO,S_NO,S_T); {$endif x86_64} -{$ifndef NOTARGETWIN} +{$ifndef NOTARGETWIN32} winstackpagesize = 4096; -{$endif NOTARGETWIN} +{$endif NOTARGETWIN32} implementation @@ -162,6 +163,13 @@ unit cgx86; TOpCmp2AsmCond: Array[topcmp] of TAsmCond = (C_NONE, C_E,C_G,C_L,C_GE,C_LE,C_NE,C_BE,C_B,C_AE,C_A); + function use_sse(def : tdef) : boolean; + begin + use_sse:=(is_single(def) and (aktfputype in sse_singlescalar)) or + (is_double(def) and (aktfputype in sse_doublescalar)); + end; + + procedure Tcgx86.done_register_allocators; begin rg[R_INTREGISTER].free; @@ -177,30 +185,13 @@ unit cgx86; result:=rgfpu.getregisterfpu(list); end; - function Tcgx86.getmmxregister(list:Taasmoutput):Tregister; begin if not assigned(rg[R_MMXREGISTER]) then - internalerror(2003121214); + internalerror(200312124); result:=rg[R_MMXREGISTER].getregister(list,R_SUBNONE); end; - - function Tcgx86.getmmregister(list:Taasmoutput;size:Tcgsize):Tregister; - begin - if not assigned(rg[R_MMREGISTER]) then - internalerror(2003121234); - case size of - OS_F64: - result:=rg[R_MMREGISTER].getregister(list,R_SUBMMD); - OS_F32: - result:=rg[R_MMREGISTER].getregister(list,R_SUBMMS); - else - internalerror(200506041); - end; - end; - - procedure Tcgx86.getcpuregister(list:Taasmoutput;r:Tregister); begin if getregtype(r)=R_FPUREGISTER then @@ -333,9 +324,11 @@ unit cgx86; procedure tcgx86.make_simple_ref(list:taasmoutput;var ref: treference); +{$ifdef x86_64} var hreg : tregister; href : treference; +{$endif x86_64} begin {$ifdef x86_64} { Only 32bit is allowed } @@ -391,31 +384,6 @@ unit cgx86; ref.base:=hreg; end; end; -{$else x86_64} - if (cs_create_pic in aktmoduleswitches) and - assigned(ref.symbol) then - begin - reference_reset_symbol(href,ref.symbol,0); - hreg:=getaddressregister(list); - href.refaddr:=addr_pic; - href.base:=current_procinfo.got; - list.concat(taicpu.op_ref_reg(A_MOV,S_L,href,hreg)); - - ref.symbol:=nil; - - if ref.base=NR_NO then - ref.base:=hreg - else if ref.index=NR_NO then - begin - ref.index:=hreg; - ref.scalefactor:=1; - end - else - begin - list.concat(taicpu.op_reg_reg(A_ADD,S_Q,ref.base,hreg)); - ref.base:=hreg; - end; - end; {$endif x86_64} end; @@ -695,58 +663,43 @@ unit cgx86; tmpref : treference; begin with ref do - begin - if (base=NR_NO) and (index=NR_NO) then + if (base=NR_NO) and (index=NR_NO) then + begin if assigned(ref.symbol) then - if cs_create_pic in aktmoduleswitches then - begin + begin + if cs_create_pic in aktmoduleswitches then + begin {$ifdef x86_64} - reference_reset_symbol(tmpref,ref.symbol,0); - tmpref.refaddr:=addr_pic; - tmpref.base:=NR_RIP; - list.concat(taicpu.op_ref_reg(A_MOV,S_Q,tmpref,r)); + reference_reset_symbol(tmpref,ref.symbol,0); + tmpref.refaddr:=addr_pic; + tmpref.base:=NR_RIP; + list.concat(taicpu.op_ref_reg(A_MOV,S_Q,tmpref,r)); {$else x86_64} - reference_reset_symbol(tmpref,ref.symbol,0); - tmpref.refaddr:=addr_pic; - tmpref.base:=current_procinfo.got; - list.concat(taicpu.op_ref_reg(A_MOV,S_L,tmpref,r)); + internalerror(2005042501); {$endif x86_64} - end - else - begin - tmpref:=ref; - tmpref.refaddr:=ADDR_FULL; - list.concat(Taicpu.op_ref_reg(A_MOV,tcgsize2opsize[OS_ADDR],tmpref,r)); - end - else - a_load_const_reg(list,OS_ADDR,offset,r) - else if (base=NR_NO) and (index<>NR_NO) and - (offset=0) and (scalefactor=0) and (symbol=nil) then - a_load_reg_reg(list,OS_ADDR,OS_ADDR,index,r) - else if (base<>NR_NO) and (index=NR_NO) and - (offset=0) and (symbol=nil) then - a_load_reg_reg(list,OS_ADDR,OS_ADDR,base,r) - else - begin - tmpref:=ref; - make_simple_ref(list,tmpref); - list.concat(Taicpu.op_ref_reg(A_LEA,tcgsize2opsize[OS_ADDR],tmpref,r)); - end; - if (segment<>NR_NO) then - if segment=NR_GS then - begin -{$ifdef segment_threadvars} - {Convert thread local address to a process global addres - as we cannot handle far pointers.} - reference_reset_symbol(tmpref,objectlibrary.newasmsymbol( - '___fpc_threadvar_offset',AB_EXTERNAL,AT_DATA),0); - tmpref.segment:=NR_GS; - list.concat(Taicpu.op_ref_reg(A_ADD,tcgsize2opsize[OS_ADDR],tmpref,r)); -{$endif} + end + else + begin + tmpref:=ref; + tmpref.refaddr:=ADDR_FULL; + list.concat(Taicpu.op_ref_reg(A_MOV,tcgsize2opsize[OS_ADDR],tmpref,r)); + end; end - else - cgmessage(cg_e_cant_use_far_pointer_there); - end; + else + a_load_const_reg(list,OS_ADDR,offset,r); + end + else if (base=NR_NO) and (index<>NR_NO) and + (offset=0) and (scalefactor=0) and (symbol=nil) then + a_load_reg_reg(list,OS_ADDR,OS_ADDR,index,r) + else if (base<>NR_NO) and (index=NR_NO) and + (offset=0) and (symbol=nil) then + a_load_reg_reg(list,OS_ADDR,OS_ADDR,base,r) + else + begin + tmpref:=ref; + make_simple_ref(list,tmpref); + list.concat(taicpu.op_ref_reg(A_LEA,tcgsize2opsize[OS_ADDR],tmpref,r)); + end; end; @@ -1668,7 +1621,7 @@ unit cgx86; begin case target_info.system of - {$ifndef NOTARGETWIN} + {$ifndef NOTARGETWIN32} system_i386_win32, {$endif} system_i386_freebsd, @@ -1711,18 +1664,18 @@ unit cgx86; procedure tcgx86.g_stackpointer_alloc(list : taasmoutput;localsize : longint); {$ifdef i386} -{$ifndef NOTARGETWIN} +{$ifndef NOTARGETWIN32} var href : treference; i : integer; again : tasmlabel; -{$endif NOTARGETWIN} +{$endif NOTARGETWIN32} {$endif i386} begin if localsize>0 then begin {$ifdef i386} -{$ifndef NOTARGETWIN} +{$ifndef NOTARGETWIN32} { windows guards only a few pages for stack growing, } { so we have to access every page first } if (target_info.system=system_i386_win32) and @@ -1740,7 +1693,7 @@ unit cgx86; end else begin - objectlibrary.getjumplabel(again); + objectlibrary.getlabel(again); getcpuregister(list,NR_EDI); list.concat(Taicpu.op_const_reg(A_MOV,S_L,localsize div winstackpagesize,NR_EDI)); a_label(list,again); @@ -1753,7 +1706,7 @@ unit cgx86; end end else -{$endif NOTARGETWIN} +{$endif NOTARGETWIN32} {$endif i386} list.concat(Taicpu.Op_const_reg(A_SUB,tcgsize2opsize[OS_ADDR],localsize,NR_STACK_POINTER_REG)); end; @@ -1812,7 +1765,6 @@ unit cgx86; a_call_name(list,'FPC_GETEIPINEBX'); list.concat(taicpu.op_sym_ofs_reg(A_ADD,tcgsize2opsize[OS_ADDR],objectlibrary.newasmsymbol('_GLOBAL_OFFSET_TABLE_',AB_EXTERNAL,AT_DATA),0,NR_PIC_OFFSET_REG)); list.concat(tai_regalloc.alloc(NR_PIC_OFFSET_REG,nil)); - current_procinfo.got:=NR_PIC_OFFSET_REG; end; end; @@ -1826,7 +1778,7 @@ unit cgx86; begin if not(cs_check_overflow in aktlocalswitches) then exit; - objectlibrary.getjumplabel(hl); + objectlibrary.getlabel(hl); if not ((def.deftype=pointerdef) or ((def.deftype=orddef) and (torddef(def).typ in [u64bit,u16bit,u32bit,u8bit,uchar, diff --git a/compiler/x86/cpubase.pas b/compiler/x86/cpubase.pas index 78d0ea11d6..54c89a3de1 100644 --- a/compiler/x86/cpubase.pas +++ b/compiler/x86/cpubase.pas @@ -314,7 +314,7 @@ implementation function reg_cgsize(const reg: tregister): tcgsize; const subreg2cgsize:array[Tsubregister] of Tcgsize = - (OS_NO,OS_8,OS_8,OS_16,OS_32,OS_64,OS_NO,OS_NO,OS_NO,OS_F32,OS_F64); + (OS_NO,OS_8,OS_8,OS_16,OS_32,OS_64,OS_NO,OS_NO,OS_NO); begin case getregtype(reg) of R_INTREGISTER : @@ -324,7 +324,7 @@ implementation R_MMXREGISTER: reg_cgsize:=OS_M64; R_MMREGISTER: - reg_cgsize:=subreg2cgsize[getsubreg(reg)]; + reg_cgsize:=OS_M128; R_SPECIALREGISTER : case reg of NR_CS,NR_DS,NR_ES,NR_SS,NR_FS,NR_GS: @@ -341,7 +341,7 @@ implementation function reg2opsize(r:Tregister):topsize; const subreg2opsize : array[tsubregister] of topsize = - (S_NO,S_B,S_B,S_W,S_L,S_Q,S_NO,S_NO,S_NO,S_NO,S_NO); + (S_NO,S_B,S_B,S_W,S_L,S_Q,S_NO,S_NO,S_NO); begin reg2opsize:=S_L; case getregtype(r) of @@ -418,16 +418,8 @@ implementation function findreg_by_number(r:Tregister):tregisterindex; - var - hr : tregister; begin - { for the name the sub reg doesn't matter } - hr:=r; - case getsubreg(hr) of - R_SUBMMS,R_SUBMMD: - setsubreg(hr,R_SUBNONE); - end; - result:=findreg_by_number_table(hr,regnumber_index); + result:=findreg_by_number_table(r,regnumber_index); end; diff --git a/compiler/x86/itx86int.pas b/compiler/x86/itx86int.pas index 182938678d..5c7ce68905 100644 --- a/compiler/x86/itx86int.pas +++ b/compiler/x86/itx86int.pas @@ -39,15 +39,6 @@ implementation cpubase; const - {$ifdef x86_64} - int_regname_table : array[tregisterindex] of string[7] = ( - {$i r8664int.inc} - ); - - int_regname_index : array[tregisterindex] of tregisterindex = ( - {$i r8664iri.inc} - ); - {$else x86_64} int_regname_table : array[tregisterindex] of string[7] = ( {$i r386int.inc} ); @@ -55,7 +46,6 @@ implementation int_regname_index : array[tregisterindex] of tregisterindex = ( {$i r386iri.inc} ); - {$endif x86_64} function findreg_by_intname(const s:string):byte; diff --git a/compiler/x86/nx86add.pas b/compiler/x86/nx86add.pas index b678fe7c75..f8c1a707da 100644 --- a/compiler/x86/nx86add.pas +++ b/compiler/x86/nx86add.pas @@ -65,7 +65,7 @@ unit nx86add; verbose,cutils, cpuinfo, aasmbase,aasmtai,aasmcpu, - symconst,symdef, + symconst, cgobj,cgx86,cga,cgutils, paramgr,tgobj,ncgutil, ncon,nset, @@ -176,7 +176,7 @@ unit nx86add; begin if cs_check_overflow in aktlocalswitches then begin - objectlibrary.getjumplabel(hl4); + objectlibrary.getlabel(hl4); if unsigned then cg.a_jmp_flags(exprasmlist,F_AE,hl4) else diff --git a/compiler/x86/nx86cnv.pas b/compiler/x86/nx86cnv.pas index 904bcea47b..1c6b5b8e00 100644 --- a/compiler/x86/nx86cnv.pas +++ b/compiler/x86/nx86cnv.pas @@ -102,8 +102,8 @@ implementation begin oldtruelabel:=truelabel; oldfalselabel:=falselabel; - objectlibrary.getjumplabel(truelabel); - objectlibrary.getjumplabel(falselabel); + objectlibrary.getlabel(truelabel); + objectlibrary.getlabel(falselabel); secondpass(left); if codegenerror then exit; @@ -161,7 +161,7 @@ implementation LOC_JUMP : begin hregister:=cg.getintregister(exprasmlist,OS_INT); - objectlibrary.getjumplabel(hlabel); + objectlibrary.getlabel(hlabel); cg.a_label(exprasmlist,truelabel); cg.a_load_const_reg(exprasmlist,OS_INT,1,hregister); cg.a_jmp_always(exprasmlist,hlabel); @@ -198,113 +198,14 @@ implementation hregister : tregister; l1,l2 : tasmlabel; signtested : boolean; - hreg : tregister; - op : tasmop; begin -{$ifdef x86_64} + { if use_sse(resulttype.def) then begin - if is_double(resulttype.def) then - op:=A_CVTSI2SD - else if is_single(resulttype.def) then - op:=A_CVTSI2SS - else - internalerror(200506061); - - location_reset(location,LOC_MMREGISTER,def_cgsize(resulttype.def)); - location.register:=cg.getmmregister(exprasmlist,def_cgsize(resulttype.def)); - if (left.location.loc=LOC_REGISTER) and (torddef(left.resulttype.def).typ=u64bit) then - begin -{$ifdef cpu64bit} - emit_const_reg(A_BT,S_Q,63,left.location.register); -{$else cpu64bit} - emit_const_reg(A_BT,S_L,31,left.location.register64.reghi); -{$endif cpu64bit} - signtested:=true; - end - else - signtested:=false; - - case torddef(left.resulttype.def).typ of - u64bit: - begin - { unsigned 64 bit ints are harder to handle: - we load bits 0..62 and then check bit 63: - if it is 1 then we add $80000000 000000000 - as double } - objectlibrary.getdatalabel(l1); - objectlibrary.getjumplabel(l2); - if not(signtested) then - begin - inc(left.location.reference.offset,4); - emit_const_ref(A_BT,S_L,31,left.location.reference); - dec(left.location.reference.offset,4); - end; - - exprasmlist.concat(taicpu.op_ref_reg(op,S_Q,left.location.reference,location.register)); - - cg.a_jmp_flags(exprasmlist,F_NC,l2); - asmlist[al_typedconsts].concat(Tai_label.Create(l1)); - reference_reset_symbol(href,l1,0); - - { I got these constant from a test program (FK) } - if is_double(resulttype.def) then - begin - { double (2^64) } - asmlist[al_typedconsts].concat(Tai_const.Create_32bit(0)); - asmlist[al_typedconsts].concat(Tai_const.Create_32bit($43f00000)); - exprasmlist.concat(taicpu.op_ref_reg(A_ADDSD,S_NO,href,location.register)); - end - else if is_single(resulttype.def) then - begin - { single(2^64) } - asmlist[al_typedconsts].concat(Tai_const.Create_32bit($5f800000)); - exprasmlist.concat(taicpu.op_ref_reg(A_ADDSS,S_NO,href,location.register)); - end - else - internalerror(200506071); - cg.a_label(exprasmlist,l2); - end - else - begin - if (left.resulttype.def.size=4) and not(torddef(left.resulttype.def).typ=u32bit) then - begin - case left.location.loc of - LOC_CREFERENCE, - LOC_REFERENCE : - exprasmList.concat(Taicpu.op_ref_reg(op,S_L,left.location.reference,location.register)); - LOC_CREGISTER, - LOC_REGISTER : - exprasmList.concat(Taicpu.op_reg_reg(op,S_L,left.location.register,location.register)); - else - internalerror(200506072); - end; - end - else if left.resulttype.def.size=8 then - begin - case left.location.loc of - LOC_CREFERENCE, - LOC_REFERENCE : - exprasmList.concat(Taicpu.op_ref_reg(op,S_Q,left.location.reference,location.register)); - LOC_CREGISTER, - LOC_REGISTER : - exprasmList.concat(Taicpu.op_reg_reg(op,S_Q,left.location.register,location.register)); - else - internalerror(200506073); - end; - end - else - begin - hreg:=cg.getintregister(exprasmlist,OS_64); - cg.a_load_loc_reg(exprasmlist,OS_64,left.location,hreg); - exprasmList.concat(Taicpu.Op_reg_reg(op,S_NO,hreg,location.register)); - end - end; - end; end else -{$endif x86_64} + } begin location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def)); if (left.location.loc=LOC_REGISTER) and (torddef(left.resulttype.def).typ=u64bit) then @@ -348,7 +249,7 @@ implementation if it is 1 then we add $80000000 000000000 as double } objectlibrary.getdatalabel(l1); - objectlibrary.getjumplabel(l2); + objectlibrary.getlabel(l2); if not(signtested) then begin @@ -359,14 +260,14 @@ implementation exprasmlist.concat(taicpu.op_ref(A_FILD,S_IQ,left.location.reference)); cg.a_jmp_flags(exprasmlist,F_NC,l2); - asmlist[al_typedconsts].concat(Tai_label.Create(l1)); + Consts.concat(Tai_label.Create(l1)); { I got this constant from a test program (FK) } - asmlist[al_typedconsts].concat(Tai_const.Create_32bit(0)); - asmlist[al_typedconsts].concat(Tai_const.Create_32bit(longint ($80000000))); - asmlist[al_typedconsts].concat(Tai_const.Create_32bit($0000403f)); + Consts.concat(Tai_const.Create_32bit(0)); + Consts.concat(Tai_const.Create_32bit(longint ($80000000))); + Consts.concat(Tai_const.Create_32bit($0000403f)); reference_reset_symbol(href,l1,0); - exprasmlist.concat(Taicpu.Op_ref(A_FLD,S_FX,href)); - exprasmlist.concat(Taicpu.Op_reg_reg(A_FADDP,S_NO,NR_ST,NR_ST1)); + exprasmList.concat(Taicpu.Op_ref(A_FLD,S_FX,href)); + exprasmList.concat(Taicpu.Op_reg_reg(A_FADDP,S_NO,NR_ST,NR_ST1)); cg.a_label(exprasmlist,l2); end else diff --git a/compiler/x86/nx86inl.pas b/compiler/x86/nx86inl.pas index 31629edf71..e0041e3df6 100644 --- a/compiler/x86/nx86inl.pas +++ b/compiler/x86/nx86inl.pas @@ -64,12 +64,11 @@ implementation systems, globals, cutils,verbose, - symconst, defutil, - aasmbase,aasmtai,aasmcpu, - symdef, + aasmtai,aasmcpu, cgbase,pass_2, cpuinfo,cpubase,paramgr, + symdef,symconst, nbas,ncon,ncal,ncnv,nld,ncgutil, cga,cgutils,cgx86,cgobj; @@ -98,18 +97,10 @@ implementation end; function tx86inlinenode.first_abs_real : tnode; - begin - if use_sse(resulttype.def) then - begin - expectloc:=LOC_MMREGISTER; - registersmm:=max(left.registersmm,1); - end - else - begin - expectloc:=LOC_FPUREGISTER; - registersfpu:=max(left.registersfpu,1); - end; + begin + expectloc:=LOC_FPUREGISTER; registersint:=left.registersint; + registersfpu:=max(left.registersfpu,1); {$ifdef SUPPORT_MMX} registersmmx:=left.registersmmx; {$endif SUPPORT_MMX} @@ -200,8 +191,8 @@ implementation def_cgsize(left.resulttype.def), left.location.reference,location.register); end - else - internalerror(309991); + else + internalerror(309991); end; end; @@ -213,33 +204,10 @@ implementation emit_none(A_FPATAN,S_NO); end; - procedure tx86inlinenode.second_abs_real; - var - href : treference; begin - if use_sse(resulttype.def) then - begin - secondpass(left); - location_force_mmregscalar(exprasmlist,left.location,false); - location:=left.location; - case tfloatdef(resulttype.def).typ of - s32real: - reference_reset_symbol(href, - objectlibrary.newasmsymbol('FPC_ABSMASK_SINGLE',AB_EXTERNAL,AT_DATA),0); - s64real: - reference_reset_symbol(href, - objectlibrary.newasmsymbol('FPC_ABSMASK_DOUBLE',AB_EXTERNAL,AT_DATA),0); - else - internalerror(200506081); - end; - exprasmlist.concat(taicpu.op_ref_reg(A_ANDPS,S_XMM,href,location.register)) - end - else - begin - load_fpu_location; - emit_none(A_FABS,S_NO); - end; + load_fpu_location; + emit_none(A_FABS,S_NO); end; diff --git a/compiler/x86/nx86mat.pas b/compiler/x86/nx86mat.pas index b547bbb3ed..e54d9b0709 100644 --- a/compiler/x86/nx86mat.pas +++ b/compiler/x86/nx86mat.pas @@ -50,8 +50,7 @@ interface globtype, systems, cutils,verbose,globals, - symconst,symdef, - aasmbase,aasmtai,defutil, + symconst,aasmbase,aasmtai,defutil, cgbase,pass_1,pass_2, ncon, cpubase, @@ -171,20 +170,20 @@ interface location_reset(location,LOC_MMREGISTER,def_cgsize(resulttype.def)); { make life of register allocator easier } - location.register:=cg.getmmregister(exprasmlist,def_cgsize(resulttype.def)); + location.register:=cg.getmmregister(exprasmlist,OS_M128); cg.a_loadmm_reg_reg(exprasmlist,def_cgsize(resulttype.def),def_cgsize(resulttype.def),left.location.register,location.register,mms_movescalar); - reg:=cg.getmmregister(exprasmlist,def_cgsize(resulttype.def)); + reg:=cg.getmmregister(exprasmlist,OS_M128); objectlibrary.getdatalabel(l1); - asmlist[al_typedconsts].concat(Tai_label.Create(l1)); + consts.concat(Tai_label.Create(l1)); case def_cgsize(resulttype.def) of OS_F32: - asmlist[al_typedconsts].concat(tai_const.create_32bit(longint(1 shl 31))); + consts.concat(tai_const.create_32bit(longint(1 shl 31))); OS_F64: begin - asmlist[al_typedconsts].concat(tai_const.create_32bit(0)); - asmlist[al_typedconsts].concat(tai_const.create_32bit(-(1 shl 31))); + consts.concat(tai_const.create_32bit(0)); + consts.concat(tai_const.create_32bit(-(1 shl 31))); end else internalerror(2004110215); diff --git a/compiler/x86/nx86set.pas b/compiler/x86/nx86set.pas index 0dda7a697b..a66bdee3f3 100644 --- a/compiler/x86/nx86set.pas +++ b/compiler/x86/nx86set.pas @@ -235,7 +235,7 @@ implementation else location.resflags:=F_E; - objectlibrary.getjumplabel(l); + objectlibrary.getlabel(l); { how much have we already substracted from the x in the } { "x in [y..z]" expression } @@ -377,8 +377,8 @@ implementation if right.location.loc=LOC_CONSTANT then begin location.resflags:=F_C; - objectlibrary.getjumplabel(l); - objectlibrary.getjumplabel(l2); + objectlibrary.getlabel(l); + objectlibrary.getlabel(l2); { load constants to a register } if left.nodetype=ordconstn then diff --git a/compiler/x86/rax86.pas b/compiler/x86/rax86.pas index f176bd5fbd..e76534a5c5 100644 --- a/compiler/x86/rax86.pas +++ b/compiler/x86/rax86.pas @@ -86,6 +86,24 @@ uses cpuinfo,cgbase,cgutils, itcpugas,cgx86; +{$define ATTOP} +{$define INTELOP} + +{$ifdef NORA386INT} + {$ifdef NOAG386NSM} + {$ifdef NOAG386INT} + {$undef INTELOP} + {$endif} + {$endif} +{$endif} + +{$ifdef NORA386ATT} + {$ifdef NOAG386ATT} + {$undef ATTOP} + {$endif} +{$endif} + + {***************************************************************************** Parser Helpers @@ -530,7 +548,15 @@ begin opcode:=A_FDIVP else if opcode=A_FDIVR then opcode:=A_FDIVRP; +{$ifdef ATTOP} + message1(asmr_w_fadd_to_faddp,gas_op2str[opcode]); +{$else} + {$ifdef INTELOP} message1(asmr_w_fadd_to_faddp,std_op2str[opcode]); + {$else} + message1(asmr_w_fadd_to_faddp,'fXX'); + {$endif INTELOP} +{$endif ATTOP} end; {It is valid to specify some instructions without operand size.} @@ -570,7 +596,15 @@ begin (opcode=A_FDIV) or (opcode=A_FDIVR)) then begin +{$ifdef ATTOP} + message1(asmr_w_adding_explicit_args_fXX,gas_op2str[opcode]); +{$else} + {$ifdef INTELOP} message1(asmr_w_adding_explicit_args_fXX,std_op2str[opcode]); + {$else} + message1(asmr_w_adding_explicit_args_fXX,'fXX'); + {$endif INTELOP} +{$endif ATTOP} ops:=2; operands[1].opr.typ:=OPR_REGISTER; operands[2].opr.typ:=OPR_REGISTER; @@ -593,7 +627,15 @@ begin (opcode=A_FMULP) ) then begin +{$ifdef ATTOP} + message1(asmr_w_adding_explicit_first_arg_fXX,gas_op2str[opcode]); +{$else} + {$ifdef INTELOP} message1(asmr_w_adding_explicit_first_arg_fXX,std_op2str[opcode]); + {$else} + message1(asmr_w_adding_explicit_first_arg_fXX,'fXX'); + {$endif INTELOP} +{$endif ATTOP} ops:=2; operands[2].opr.typ:=OPR_REGISTER; operands[2].opr.reg:=operands[1].opr.reg; @@ -616,7 +658,15 @@ begin (opcode=A_FMUL) ) then begin +{$ifdef ATTOP} + message1(asmr_w_adding_explicit_second_arg_fXX,gas_op2str[opcode]); +{$else} + {$ifdef INTELOP} message1(asmr_w_adding_explicit_second_arg_fXX,std_op2str[opcode]); + {$else} + message1(asmr_w_adding_explicit_second_arg_fXX,'fXX'); + {$endif INTELOP} +{$endif ATTOP} ops:=2; operands[2].opr.typ:=OPR_REGISTER; operands[2].opr.reg:=NR_ST0; diff --git a/compiler/x86/x86ins.dat b/compiler/x86/x86ins.dat index 0d5324135b..6279d3e9d3 100644 --- a/compiler/x86/x86ins.dat +++ b/compiler/x86/x86ins.dat @@ -1251,7 +1251,6 @@ xmmreg,mem \301\333\2\x0F\x7E\110 WILLAMETTE,SSE2 void \1\xA4 8086 [MOVSD,movsl] -; Ch_All isn't correct for the sse move, but how can it be solved? (FK) (Ch_All, Ch_None, Ch_None) void \321\1\xA5 386 xmmreg,xmmreg \3\xF2\x0F\x10\110 WILLAMETTE,SSE2 @@ -1379,33 +1378,33 @@ xmmreg,xmmreg \3\x66\x0F\x67\110 WILLAMETTE,SSE2 xmmreg,mem \301\3\x66\x0F\x67\110 WILLAMETTE,SSE2,SM [PADDB] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) mmxreg,mem \301\2\x0F\xFC\110 PENT,MMX,SM mmxreg,mmxreg \2\x0F\xFC\110 PENT,MMX xmmreg,xmmreg \3\x66\x0F\xFC\110 WILLAMETTE,SSE2 xmmreg,mem \301\3\x66\x0F\xFC\110 WILLAMETTE,SSE2,SM [PADDD] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) mmxreg,mem \301\2\x0F\xFE\110 PENT,MMX,SM mmxreg,mmxreg \2\x0F\xFE\110 PENT,MMX xmmreg,xmmreg \3\x66\x0F\xFE\110 WILLAMETTE,SSE2 xmmreg,mem \301\3\x66\x0F\xFE\110 WILLAMETTE,SSE2,SM [PADDSB] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) mmxreg,mem \301\2\x0F\xEC\110 PENT,MMX,SM mmxreg,mmxreg \2\x0F\xEC\110 PENT,MMX xmmreg,mem \301\3\x66\x0F\xEC\110 WILLAMETTE,SSE2,SM xmmreg,xmmreg \3\x66\x0F\xEC\110 WILLAMETTE,SSE2 [PADDSIW] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) mmxreg,mem \301\2\x0F\x51\110 PENT,MMX,SM,CYRIX mmxreg,mmxreg \2\x0F\x51\110 PENT,MMX,CYRIX [PADDSW] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) mmxreg,mem \301\2\x0F\xED\110 PENT,MMX,SM mmxreg,mmxreg \2\x0F\xED\110 PENT,MMX xmmreg,mem \301\3\x66\x0F\xED\110 WILLAMETTE,SSE2,SM @@ -2453,22 +2452,22 @@ reg8 \300\1\x0F\330\x90\200 386 ; [ADDPS] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,mem \301\331\2\x0F\x58\110 KATMAI,SSE xmmreg,xmmreg \331\2\x0F\x58\110 KATMAI,SSE [ADDSS] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,mem \301\333\2\x0F\x58\110 KATMAI,SSE xmmreg,xmmreg \333\2\x0F\x58\110 KATMAI,SSE [ANDNPS] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,mem \301\2\x0F\x55\110 KATMAI,SSE xmmreg,xmmreg \2\x0F\x55\110 KATMAI,SSE [ANDPS] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,mem \301\2\x0F\x54\110 KATMAI,SSE xmmreg,xmmreg \2\x0F\x54\110 KATMAI,SSE @@ -2603,12 +2602,12 @@ reg32,mem \301\333\2\x0F\x2C\110 KATMAI,SSE reg32,xmmreg \333\2\x0F\x2C\110 KATMAI,SSE [DIVPS] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,mem \301\331\2\x0F\x5E\110 KATMAI,SSE xmmreg,xmmreg \331\2\x0F\x5E\110 KATMAI,SSE [DIVSS] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,mem \301\333\2\x0F\x5E\110 KATMAI,SSE xmmreg,xmmreg \333\2\x0F\x5E\110 KATMAI,SSE @@ -2670,7 +2669,7 @@ reg32,xmmreg \2\x0F\x50\110 KATMAI,SSE mem,xmmreg \2\x0F\x2B\101 KATMAI,SSE [MOVSS] -(Ch_Wop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,mem \301\333\2\x0F\x10\110 KATMAI,SSE mem,xmmreg \300\333\2\x0F\x11\101 KATMAI,SSE xmmreg,xmmreg \333\2\x0F\x10\110 KATMAI,SSE @@ -2684,17 +2683,17 @@ xmmreg,xmmreg \331\2\x0F\x10\110 KATMAI,SSE xmmreg,xmmreg \331\2\x0F\x11\101 KATMAI,SSE [MULPS] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,mem \301\2\x0F\x59\110 KATMAI,SSE xmmreg,xmmreg \2\x0F\x59\110 KATMAI,SSE [MULSS] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,mem \301\333\2\x0F\x59\110 KATMAI,SSE xmmreg,xmmreg \333\2\x0F\x59\110 KATMAI,SSE [ORPS] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,mem \301\2\x0F\x56\110 KATMAI,SSE xmmreg,xmmreg \2\x0F\x56\110 KATMAI,SSE @@ -2724,12 +2723,12 @@ xmmreg,mem,imm \301\2\x0F\xC6\110\22 KATMAI,SSE,SB,AR2 xmmreg,xmmreg,imm \2\x0F\xC6\110\22 KATMAI,SSE,SB,AR2 [SQRTPS] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,mem \301\331\2\x0F\x51\110 KATMAI,SSE xmmreg,xmmreg \331\2\x0F\x51\110 KATMAI,SSE [SQRTSS] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,mem \301\333\2\x0F\x51\110 KATMAI,SSE xmmreg,xmmreg \333\2\x0F\x51\110 KATMAI,SSE @@ -2738,12 +2737,12 @@ xmmreg,xmmreg \333\2\x0F\x51\110 KATMAI,SSE mem \300\2\x0F\xAE\203 KATMAI,SSE,SD [SUBPS] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,mem \301\331\2\x0F\x5C\110 KATMAI,SSE xmmreg,xmmreg \331\2\x0F\x5C\110 KATMAI,SSE [SUBSS] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,mem \301\333\2\x0F\x5C\110 KATMAI,SSE xmmreg,xmmreg \333\2\x0F\x5C\110 KATMAI,SSE @@ -3046,22 +3045,22 @@ xmmreg,mem \301\3\x66\x0F\x6C\110 WILLAMETTE,SSE2,SM ; Willamette Streaming SIMD instructions (SSE2) ; [ADDPD] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,xmmreg \331\3\x66\x0F\x58\110 WILLAMETTE,SSE2 xmmreg,mem \301\331\3\x66\x0F\x58\110 WILLAMETTE,SSE2,SM [ADDSD] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,xmmreg \331\3\xF2\x0F\x58\110 WILLAMETTE,SSE2 xmmreg,mem \301\331\3\xF2\x0F\x58\110 WILLAMETTE,SSE2 [ANDNPD] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,xmmreg \331\3\x66\x0F\x55\110 WILLAMETTE,SSE2 xmmreg,mem \301\331\3\x66\x0F\x55\110 WILLAMETTE,SSE2,SM [ANDPD] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,xmmreg \331\3\x66\x0F\x54\110 WILLAMETTE,SSE2 xmmreg,mem \301\331\3\x66\x0F\x54\110 WILLAMETTE,SSE2,SM @@ -3235,12 +3234,12 @@ reg32,xmmreg \3\xF2\x0F\x2C\110 WILLAMETTE,SSE2 reg32,mem \301\3\xF2\x0F\x2C\110 WILLAMETTE,SSE2 [DIVPD] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,xmmreg \3\x66\x0F\x5E\110 WILLAMETTE,SSE2 xmmreg,mem \301\3\x66\x0F\x5E\110 WILLAMETTE,SSE2,SM [DIVSD] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,xmmreg \3\xF2\x0F\x5E\110 WILLAMETTE,SSE2 xmmreg,mem \301\3\xF2\x0F\x5E\110 WILLAMETTE,SSE2 @@ -3293,17 +3292,17 @@ mem,xmmreg \300\3\x66\x0F\x11\101 WILLAMETTE,SSE2,SM xmmreg,mem \301\3\x66\x0F\x10\110 WILLAMETTE,SSE2,SM [MULPD] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,xmmreg \3\x66\x0F\x59\110 WILLAMETTE,SSE2 xmmreg,mem \301\3\x66\x0F\x59\110 WILLAMETTE,SSE2,SM [MULSD] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,xmmreg \3\xF2\x0F\x59\110 WILLAMETTE,SSE2 xmmreg,mem \301\3\xF2\x0F\x59\110 WILLAMETTE,SSE2 [ORPD] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,mem \301\3\x66\x0F\x56\110 WILLAMETTE,SSE2,SM xmmreg,xmmreg \3\x66\x0F\x56\110 WILLAMETTE,SSE2 @@ -3313,22 +3312,22 @@ xmmreg,xmmreg,imm \3\x66\x0F\xC6\110\26 WILLAMETTE,SSE2,SB,AR2 xmmreg,mem,imm \301\3\x66\x0F\xC6\110\26 WILLAMETTE,SSE2,SM,SB,AR2 [SQRTPD] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,xmmreg \3\x66\x0F\x51\110 WILLAMETTE,SSE2 xmmreg,mem \301\3\x66\x0F\x51\110 WILLAMETTE,SSE2,SM [SQRTSD] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,xmmreg \3\xF2\x0F\x51\110 WILLAMETTE,SSE2 xmmreg,mem \301\3\xF2\x0F\x51\110 WILLAMETTE,SSE2 [SUBPD] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,xmmreg \3\x66\x0F\x5C\110 WILLAMETTE,SSE2 xmmreg,mem \301\3\x66\x0F\x5C\110 WILLAMETTE,SSE2,SM [SUBSD] -(Ch_Mop2, Ch_Rop1, Ch_None) +(Ch_All, Ch_None, Ch_None) xmmreg,xmmreg \3\xF2\x0F\x5C\110 WILLAMETTE,SSE2 xmmreg,mem \301\3\xF2\x0F\x5C\110 WILLAMETTE,SSE2 @@ -3416,6 +3415,6 @@ reg32,imm \321\10\xB8\41 X86_64 reg64,mem \321\301\1\x63\110 X86_64 reg64,reg32 \321\301\1\x63\110 X86_64 -[CQO,cqto] +[CDO,cqto] (Ch_MRAX, Ch_WRDX, Ch_None) void \321\1\x99 X86_64 diff --git a/compiler/x86/x86reg.dat b/compiler/x86/x86reg.dat index 38d8fcff95..ea66b548be 100644 --- a/compiler/x86/x86reg.dat +++ b/compiler/x86/x86reg.dat @@ -138,3 +138,43 @@ NR_XMM12,$0400000c,xmm12,%xmm12,xmm12,xmm12,-1,-1,29,OT_XMMREG,4,64 NR_XMM13,$0400000d,xmm13,%xmm13,xmm13,xmm13,-1,-1,30,OT_XMMREG,5,64 NR_XMM14,$0400000e,xmm14,%xmm14,xmm14,xmm14,-1,-1,31,OT_XMMREG,6,64 NR_XMM15,$0400000f,xmm15,%xmm15,xmm15,xmm15,-1,-1,32,OT_XMMREG,7,64 + +; +; $Log: x86reg.dat,v $ +; Revision 1.6 2005/02/06 00:05:56 florian +; + x86_64 pic draft +; +; Revision 1.5 2004/06/16 20:07:11 florian +; * dwarf branch merged +; +; Revision 1.4.2.2 2004/04/20 16:35:58 peter +; * generate dwarf for stackframe entry +; +; Revision 1.4.2.1 2004/04/12 19:34:46 peter +; * basic framework for dwarf CFI +; +; Revision 1.4 2003/09/25 15:00:12 peter +; * %st is st0 in nasm +; +; Revision 1.3 2003/09/24 17:12:36 florian +; * x86-64 adaptions +; +; Revision 1.2 2003/09/03 15:55:02 peter +; * NEWRA branch merged +; +; Revision 1.1.2.5 2003/08/31 16:44:48 peter +; * OT fixed for DX +; +; Revision 1.1.2.4 2003/08/31 16:18:05 peter +; * more fixes +; +; Revision 1.1.2.3 2003/08/29 09:41:25 daniel +; * Further mkx86reg development +; +; Revision 1.1.2.2 2003/08/27 20:31:35 peter +; * make NR_ST unique value +; +; Revision 1.1.2.1 2003/08/27 19:55:54 peter +; * first tregister patch +; +; diff --git a/compiler/x86_64/cgcpu.pas b/compiler/x86_64/cgcpu.pas index bf3116b9cc..862bba39e5 100644 --- a/compiler/x86_64/cgcpu.pas +++ b/compiler/x86_64/cgcpu.pas @@ -53,7 +53,7 @@ unit cgcpu; inherited init_register_allocators; rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_RAX,RS_RDX,RS_RCX,RS_RBX,RS_RSI,RS_RDI, RS_R8,RS_R9,RS_R10,RS_R11,RS_R12,RS_R13,RS_R14,RS_R15],first_int_imreg,[RS_RBP]); - rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBWHOLE,[RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7, + rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE,[RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7, RS_XMM8,RS_XMM9,RS_XMM10,RS_XMM11,RS_XMM12,RS_XMM13,RS_XMM14,RS_XMM15],first_mm_imreg,[]); rgfpu:=Trgx86fpu.create; end; diff --git a/compiler/x86_64/cpuinfo.pas b/compiler/x86_64/cpuinfo.pas index 1100387c80..613e2cc5bf 100644 --- a/compiler/x86_64/cpuinfo.pas +++ b/compiler/x86_64/cpuinfo.pas @@ -59,8 +59,6 @@ Const { calling conventions supported by the code generator } supported_calling_conventions : tproccalloptions = [ pocall_internproc, -{ pocall_compilerproc, - pocall_inline,} pocall_register, pocall_safecall, pocall_stdcall, diff --git a/compiler/x86_64/cpunode.pas b/compiler/x86_64/cpunode.pas index a22ba4eee2..65abf9beed 100644 --- a/compiler/x86_64/cpunode.pas +++ b/compiler/x86_64/cpunode.pas @@ -47,7 +47,6 @@ unit cpunode; { the cpu specific node units must be used after the generic ones to get the correct class pointer } nx86set, - nx86con, nx64add, nx64cal, nx64cnv, diff --git a/compiler/x86_64/cputarg.pas b/compiler/x86_64/cputarg.pas index 6e9c515386..1ec18242f1 100644 --- a/compiler/x86_64/cputarg.pas +++ b/compiler/x86_64/cputarg.pas @@ -42,43 +42,20 @@ implementation {$ifndef NOTARGETFREEBSD} ,t_bsd {$endif} - {$ifndef NOTARGETWIN} - ,t_win + {$ifndef NOTARGETWIN32} + ,t_win32 {$endif} {************************************** Assemblers **************************************} - {$ifndef NOAGX86_64INT} - ,agx86int - {$endif} {$ifndef NOAGX86_64ATT} ,agx86att {$endif} ,ogcoff ,ogelf - -{************************************** - Assembler Readers -**************************************} - - {$ifndef NoRax64att} - ,rax64att - {$endif NoRax64att} - -{************************************** - Debuginfo -**************************************} - - {$ifndef NoDbgStabs} - ,dbgstabs - {$endif NoDbgStabs} - {$ifndef NoDbgDwarf} - ,dbgdwarf - {$endif NoDbgDwarf} - ; end. diff --git a/compiler/x86_64/nx64add.pas b/compiler/x86_64/nx64add.pas index aff2a4ad6a..9fa9555e50 100644 --- a/compiler/x86_64/nx64add.pas +++ b/compiler/x86_64/nx64add.pas @@ -66,7 +66,7 @@ interface emit_reg(A_MUL,S_Q,r); if cs_check_overflow in aktlocalswitches then begin - objectlibrary.getjumplabel(hl4); + objectlibrary.getlabel(hl4); cg.a_jmp_flags(exprasmlist,F_AE,hl4); cg.a_call_name(exprasmlist,'FPC_OVERFLOW'); cg.a_label(exprasmlist,hl4); diff --git a/compiler/x86_64/nx64mat.pas b/compiler/x86_64/nx64mat.pas index 4f0333fff8..f87ff076be 100644 --- a/compiler/x86_64/nx64mat.pas +++ b/compiler/x86_64/nx64mat.pas @@ -113,7 +113,7 @@ implementation if torddef(left.resulttype.def).typ=u64bit then emit_reg_reg(A_XOR,S_Q,NR_RDX,NR_RDX) else - emit_none(A_CQO,S_NO); + emit_none(A_CDO,S_NO); {Division depends on the right type.} if Torddef(right.resulttype.def).typ=u64bit then diff --git a/compiler/x86_64/r8664int.inc b/compiler/x86_64/r8664int.inc deleted file mode 100644 index 55ea578074..0000000000 --- a/compiler/x86_64/r8664int.inc +++ /dev/null @@ -1,126 +0,0 @@ -{ don't edit, this file is generated from x86reg.dat } -'INVALID', -'al', -'ah', -'ax', -'eax', -'rax', -'cl', -'ch', -'cx', -'ecx', -'rcx', -'dl', -'dh', -'dx', -'edx', -'rdx', -'bl', -'bh', -'bx', -'ebx', -'rbx', -'sil', -'si', -'esi', -'rsi', -'dil', -'di', -'edi', -'rdi', -'bpl', -'bp', -'ebp', -'rbp', -'spl', -'sp', -'esp', -'rsp', -'r8', -'r8b', -'r8w', -'r8d', -'r9', -'r9b', -'r9w', -'r9d', -'r10', -'r10b', -'r10w', -'r10d', -'r11', -'r11b', -'r11w', -'r11d', -'r12', -'r12b', -'r12w', -'r12d', -'r13', -'r13b', -'r13w', -'r13d', -'r14', -'r14b', -'r14w', -'r14d', -'r15', -'r15b', -'r15w', -'r15d', -'rip', -'eip', -'cs', -'ds', -'es', -'ss', -'fs', -'gs', -'dr0', -'dr1', -'dr2', -'dr3', -'dr6', -'dr7', -'cr0', -'cr2', -'cr3', -'cr4', -'tr3', -'tr4', -'tr5', -'tr6', -'tr7', -'st(0)', -'st(1)', -'st(2)', -'st(3)', -'st(4)', -'st(5)', -'st(6)', -'st(7)', -'st', -'mm0', -'mm1', -'mm2', -'mm3', -'mm4', -'mm5', -'mm6', -'mm7', -'xmm0', -'xmm1', -'xmm2', -'xmm3', -'xmm4', -'xmm5', -'xmm6', -'xmm7', -'xmm8', -'xmm9', -'xmm10', -'xmm11', -'xmm12', -'xmm13', -'xmm14', -'xmm15' diff --git a/compiler/x86_64/r8664iri.inc b/compiler/x86_64/r8664iri.inc deleted file mode 100644 index 2050f990fd..0000000000 --- a/compiler/x86_64/r8664iri.inc +++ /dev/null @@ -1,126 +0,0 @@ -{ don't edit, this file is generated from x86reg.dat } -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0, -0 diff --git a/compiler/x86_64/x8664int.inc b/compiler/x86_64/x8664int.inc index 428a64f8cf..e3e7264834 100644 --- a/compiler/x86_64/x8664int.inc +++ b/compiler/x86_64/x8664int.inc @@ -565,5 +565,5 @@ 'movsldup', 'movabs', 'movsxd', -'cqo' +'cdo' ); diff --git a/compiler/x86_64/x8664op.inc b/compiler/x86_64/x8664op.inc index 4c011681b0..f4688a72f3 100644 --- a/compiler/x86_64/x8664op.inc +++ b/compiler/x86_64/x8664op.inc @@ -565,5 +565,5 @@ A_MOVSHDUP, A_MOVSLDUP, A_MOVABS, A_MOVSXD, -A_CQO +A_CDO ); diff --git a/compiler/x86_64/x8664pro.inc b/compiler/x86_64/x8664pro.inc index df064ad42e..960f49d380 100644 --- a/compiler/x86_64/x8664pro.inc +++ b/compiler/x86_64/x8664pro.inc @@ -215,11 +215,11 @@ (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), @@ -383,10 +383,10 @@ (Ch: (Ch_ROp1, Ch_WOp2, Ch_RFLAGS)), (Ch: (Ch_None, Ch_None, Ch_None)), (Ch: (Ch_RFLAGS, Ch_WOp1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), @@ -412,8 +412,6 @@ (Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), (Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), (Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), @@ -426,21 +424,23 @@ (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), -(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), @@ -493,10 +493,10 @@ (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), @@ -530,8 +530,6 @@ (Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), (Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), (Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), @@ -541,14 +539,16 @@ (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), -(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), (Ch: (Ch_All, Ch_None, Ch_None)), diff --git a/compiler/x86_64/x8664tab.inc b/compiler/x86_64/x8664tab.inc index 11fcae0ac9..b4309020f4 100644 --- a/compiler/x86_64/x8664tab.inc +++ b/compiler/x86_64/x8664tab.inc @@ -11474,7 +11474,7 @@ flags : if_x86_64 ), ( - opcode : A_CQO; + opcode : A_CDO; ops : 0; optypes : (ot_none,ot_none,ot_none); code : #209#1#153; diff --git a/fcl/Makefile b/fcl/Makefile index d54418befe..b661064a09 100644 --- a/fcl/Makefile +++ b/fcl/Makefile @@ -1326,11 +1326,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/fcl/db/Makefile b/fcl/db/Makefile index da734ca4f2..6a8b4b5822 100644 --- a/fcl/db/Makefile +++ b/fcl/db/Makefile @@ -990,11 +990,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/fcl/db/dbase/fpmake.inc b/fcl/db/dbase/fpmake.inc deleted file mode 100644 index fc7955a615..0000000000 --- a/fcl/db/dbase/fpmake.inc +++ /dev/null @@ -1,82 +0,0 @@ -{ Make DB directory and all subdirectories } -{ FULLDB will be defined if included from db directory } -{ FULLFCL will be defined if included from main FCL directory } - -{ DBase, only for I386} -Targets.ResetDefaults; -Targets.DefaultCPU:=[i386]; -Targets.DefaultOS:=[linux,win32,freebsd]; -Targets.DefaultDir:='db/dbase'; -T:=Targets.AddUnit('dbf'); -T:=Targets.Addexampleunit('testdbf'); -If (Defaults.CPU=i386) and (Defaults.OS in [linux,win32,freebsd]) then - begin - { Install files. } - InstallFiles.add('dbf_common.o'); - InstallFiles.add('dbf_common.ppu'); - InstallFiles.add('dbf_cursor.o'); - InstallFiles.add('dbf_cursor.ppu'); - InstallFiles.add('dbf_dbffile.o'); - InstallFiles.add('dbf_dbffile.ppu'); - InstallFiles.add('dbf_fields.o'); - InstallFiles.add('dbf_fields.ppu'); - InstallFiles.add('dbf_idxcur.o'); - InstallFiles.add('dbf_idxcur.ppu'); - InstallFiles.add('dbf_idxfile.o'); - InstallFiles.add('dbf_idxfile.ppu'); - InstallFiles.add('dbf_lang.o'); - InstallFiles.add('dbf_lang.ppu'); - InstallFiles.add('dbf_memo.o'); - InstallFiles.add('dbf_memo.ppu'); - InstallFiles.add('dbf_parser.o'); - InstallFiles.add('dbf_parser.ppu'); - InstallFiles.add('dbf_pgfile.o'); - InstallFiles.add('dbf_pgfile.ppu'); - InstallFiles.add('dbf_prscore.o'); - InstallFiles.add('dbf_prscore.ppu'); - InstallFiles.add('dbf_prsdef.o'); - InstallFiles.add('dbf_prsdef.ppu'); - InstallFiles.add('dbf_prssupp.o'); - InstallFiles.add('dbf_prssupp.ppu'); - InstallFiles.add('dbf_str.o'); - InstallFiles.add('dbf_str.ppu'); - if (Defaults.OS<>win32) then - begin - InstallFiles.add('dbf_wtil.ppu'); - InstallFiles.add('dbf_wtil.o'); - end; - { Clean files } - CleanFiles.add('dbf_common.o'); - CleanFiles.add('dbf_common.ppu'); - CleanFiles.add('dbf_cursor.o'); - CleanFiles.add('dbf_cursor.ppu'); - CleanFiles.add('dbf_dbffile.o'); - CleanFiles.add('dbf_dbffile.ppu'); - CleanFiles.add('dbf_fields.o'); - CleanFiles.add('dbf_fields.ppu'); - CleanFiles.add('dbf_idxcur.o'); - CleanFiles.add('dbf_idxcur.ppu'); - CleanFiles.add('dbf_idxfile.o'); - CleanFiles.add('dbf_idxfile.ppu'); - CleanFiles.add('dbf_lang.o'); - CleanFiles.add('dbf_lang.ppu'); - CleanFiles.add('dbf_memo.o'); - CleanFiles.add('dbf_memo.ppu'); - CleanFiles.add('dbf_parser.o'); - CleanFiles.add('dbf_parser.ppu'); - CleanFiles.add('dbf_pgfile.o'); - CleanFiles.add('dbf_pgfile.ppu'); - CleanFiles.add('dbf_prscore.o'); - CleanFiles.add('dbf_prscore.ppu'); - CleanFiles.add('dbf_prsdef.o'); - CleanFiles.add('dbf_prsdef.ppu'); - CleanFiles.add('dbf_prssupp.o'); - CleanFiles.add('dbf_prssupp.ppu'); - CleanFiles.add('dbf_str.o'); - CleanFiles.add('dbf_str.ppu'); - if (Defaults.OS<>win32) then - begin - Cleanfiles.add('dbf_wtil.ppu'); - CleanFiles.add('dbf_wtil.o'); - end; - end; diff --git a/fcl/db/dbase/fpmake.pp b/fcl/db/dbase/fpmake.pp deleted file mode 100644 index 8781e3d069..0000000000 --- a/fcl/db/dbase/fpmake.pp +++ /dev/null @@ -1,20 +0,0 @@ -{$mode objfpc} -{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - ChangeDir('../..'); - With Installer do - begin - {$i ../../fclmake.inc} - {$i fpmake.inc} - EndPackage; - Run; - end; -end. - diff --git a/fcl/db/fpmake.inc b/fcl/db/fpmake.inc deleted file mode 100644 index fcfdce9872..0000000000 --- a/fcl/db/fpmake.inc +++ /dev/null @@ -1,37 +0,0 @@ -{ Make DB directory and all subdirectories } -{ FULLDB will be defined if included from db directory } -{ FULLFCL will be defined if included from main FCL directory } - -Targets.DefaultDir:='db'; -T:=Targets.AddUnit('dbconst'); -T.ResourceStrings:=True; -T:=Targets.AddUnit('db'); -T:=Targets.AddUnit('ddg_ds'); -T:=Targets.AddUnit('ddg_rec'); -T:=Targets.AddUnit('dbwhtml'); -T.ResourceStrings:=True; - -{ sdf directory } -{$i sdf/fpmake.inc} - -{ memds directory } -{$i memds/fpmake.inc} - -{ sqldb directory } -{$i sqldb/fpmake.inc} - -{ interbase directory } -{$i interbase/fpmake.inc } - -{ sqlite directory } -{$i sqlite/fpmake.inc} - -{ dbase directory} -{$i dbase/fpmake.inc} - -{ mysql directory} -{$i mysql/fpmake.inc} - -{ directory} -{ $i /fpmake.inc} -
\ No newline at end of file diff --git a/fcl/db/fpmake.pp b/fcl/db/fpmake.pp deleted file mode 100644 index 43ca3fea1e..0000000000 --- a/fcl/db/fpmake.pp +++ /dev/null @@ -1,21 +0,0 @@ -{$mode objfpc} -{$H+} -{$define FULLDB} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - ChangeDir('..'); - With Installer do - begin - {$i ../fclmake.inc} - {$i fpmake.inc} - EndPackage; - Run; - end; -end. - diff --git a/fcl/db/interbase/Makefile b/fcl/db/interbase/Makefile index 9d137ccc9b..b93f9d5564 100644 --- a/fcl/db/interbase/Makefile +++ b/fcl/db/interbase/Makefile @@ -879,11 +879,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/fcl/db/interbase/fpmake.inc b/fcl/db/interbase/fpmake.inc deleted file mode 100644 index 1cd69d597a..0000000000 --- a/fcl/db/interbase/fpmake.inc +++ /dev/null @@ -1,18 +0,0 @@ -{ Make DB directory and all subdirectories } -{ FULLDB will be defined if included from db directory } -{ FULLFCL will be defined if included from main FCL directory } - -{ Interbase directory } -Targets.ResetDefaults; -Targets.DefaultDir:='db/interbase'; -Targets.DefaultCPU:=[i386]; -Targets.DefaultOS:=[win32,openbsd,netbsd,freebsd,linux]; -T:=Targets.AddUnit('interbase'); -T:=Targets.AddExampleUnit('testib'); -if Defaults.OS in Targets.DefaultOS then - begin - CleanFiles.add('ibas40.o'); - CleanFiles.add('ibas40.ppu'); - CleanFiles.add('ibase60.o'); - CleanFiles.add('ibase60.ppu'); - end; diff --git a/fcl/db/interbase/fpmake.pp b/fcl/db/interbase/fpmake.pp deleted file mode 100644 index 8781e3d069..0000000000 --- a/fcl/db/interbase/fpmake.pp +++ /dev/null @@ -1,20 +0,0 @@ -{$mode objfpc} -{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - ChangeDir('../..'); - With Installer do - begin - {$i ../../fclmake.inc} - {$i fpmake.inc} - EndPackage; - Run; - end; -end. - diff --git a/fcl/db/memds/fpmake.inc b/fcl/db/memds/fpmake.inc deleted file mode 100644 index 4046eb14c4..0000000000 --- a/fcl/db/memds/fpmake.inc +++ /dev/null @@ -1,12 +0,0 @@ -{ Make DB directory and all subdirectories } -{ FULLDB will be defined if included from db directory } -{ FULLFCL will be defined if included from main FCL directory } - - Targets.ResetDefaults; - Targets.DefaultDir:='db/memds'; - T:=Targets.AddUnit('memds'); - T.ResourceStrings:=True; - Targets.Addexampleunit('testpop'); - Targets.Addexampleunit('testopen'); - Targets.Addexampleunit('testld'); - Targets.Addexampleunit('testcp'); diff --git a/fcl/db/memds/fpmake.pp b/fcl/db/memds/fpmake.pp deleted file mode 100644 index 8781e3d069..0000000000 --- a/fcl/db/memds/fpmake.pp +++ /dev/null @@ -1,20 +0,0 @@ -{$mode objfpc} -{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - ChangeDir('../..'); - With Installer do - begin - {$i ../../fclmake.inc} - {$i fpmake.inc} - EndPackage; - Run; - end; -end. - diff --git a/fcl/db/mysql/Makefile b/fcl/db/mysql/Makefile index cc1370c55f..b2c3b3239d 100644 --- a/fcl/db/mysql/Makefile +++ b/fcl/db/mysql/Makefile @@ -990,11 +990,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/fcl/db/mysql/fpmake.inc b/fcl/db/mysql/fpmake.inc deleted file mode 100644 index ebd5500cb6..0000000000 --- a/fcl/db/mysql/fpmake.inc +++ /dev/null @@ -1,21 +0,0 @@ -{ Make DB directory and all subdirectories } -{ FULLDB will be defined if included from db directory } -{ FULLFCL will be defined if included from main FCL directory } - -Targets.ResetDefaults; -Targets.DefaultDir:='db/mysql'; -Targets.DefaultOS:=[win32,openbsd,netbsd,freebsd,darwin,linux]; -T:=Targets.AddUnit('mysqldb4'); -T.ResourceStrings:=True; -T:=Targets.AddUnit('mysqldb3'); -T.ResourceStrings:=True; -Targets.Addexampleunit('mtest'); -if Defaults.OS in Targets.DefaultOS then - begin - CleanFiles.add('mysql.o'); - CleanFiles.add('mysql.ppu'); - CleanFiles.add('mysql_com.o'); - CleanFiles.add('mysql_com.ppu'); - CleanFiles.add('mysql_version.o'); - CleanFiles.add('mysql_version.ppu'); - end; diff --git a/fcl/db/mysql/fpmake.pp b/fcl/db/mysql/fpmake.pp deleted file mode 100644 index 8781e3d069..0000000000 --- a/fcl/db/mysql/fpmake.pp +++ /dev/null @@ -1,20 +0,0 @@ -{$mode objfpc} -{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - ChangeDir('../..'); - With Installer do - begin - {$i ../../fclmake.inc} - {$i fpmake.inc} - EndPackage; - Run; - end; -end. - diff --git a/fcl/db/odbc/Makefile b/fcl/db/odbc/Makefile index 16fde813c2..311e7071b5 100644 --- a/fcl/db/odbc/Makefile +++ b/fcl/db/odbc/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/10] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/11] # default: all MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince diff --git a/fcl/db/odbc/fpmake.pp b/fcl/db/odbc/fpmake.pp deleted file mode 100644 index 8781e3d069..0000000000 --- a/fcl/db/odbc/fpmake.pp +++ /dev/null @@ -1,20 +0,0 @@ -{$mode objfpc} -{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - ChangeDir('../..'); - With Installer do - begin - {$i ../../fclmake.inc} - {$i fpmake.inc} - EndPackage; - Run; - end; -end. - diff --git a/fcl/db/sdf/fpmake.inc b/fcl/db/sdf/fpmake.inc deleted file mode 100644 index 29f108d5d9..0000000000 --- a/fcl/db/sdf/fpmake.inc +++ /dev/null @@ -1,11 +0,0 @@ -{ Make DB directory and all subdirectories } -{ FULLDB will be defined if included from db directory } -{ FULLFCL will be defined if included from main FCL directory } - - -{ db/sdf directory } -Targets.ResetDefaults; -Targets.DefaultDir:='db/sdf'; -T:=Targets.AddUnit('sdfdata'); -Targets.AddExampleUnit('testsdf'); -Targets.AddExampleUnit('testfix'); diff --git a/fcl/db/sdf/fpmake.pp b/fcl/db/sdf/fpmake.pp deleted file mode 100644 index 8781e3d069..0000000000 --- a/fcl/db/sdf/fpmake.pp +++ /dev/null @@ -1,20 +0,0 @@ -{$mode objfpc} -{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - ChangeDir('../..'); - With Installer do - begin - {$i ../../fclmake.inc} - {$i fpmake.inc} - EndPackage; - Run; - end; -end. - diff --git a/fcl/db/sqldb/Makefile b/fcl/db/sqldb/Makefile index b52071d130..f16de1b98b 100644 --- a/fcl/db/sqldb/Makefile +++ b/fcl/db/sqldb/Makefile @@ -822,11 +822,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/fcl/db/sqldb/fpmake.inc b/fcl/db/sqldb/fpmake.inc deleted file mode 100644 index 3f5d2d9bf3..0000000000 --- a/fcl/db/sqldb/fpmake.inc +++ /dev/null @@ -1,21 +0,0 @@ -{ Make DB directory and all subdirectories } -{ FULLDB will be defined if included from db directory } -{ FULLFCL will be defined if included from main FCL directory } - - -Targets.ResetDefaults; -Targets.DefaultDir:='db/sqldb'; -T:=Targets.AddUnit('sqldb'); -T.ResourceStrings:=True; - -{ Include connection drivers } - -{ PosGreSQL } -{$i postgres/fpmake.inc} - -{ MySQL } -{$i mysql/fpmake.inc} - -{ Interbase/Firebird } -{$i interbase/fpmake.inc} -
\ No newline at end of file diff --git a/fcl/db/sqldb/fpmake.pp b/fcl/db/sqldb/fpmake.pp deleted file mode 100644 index 1b5754d86a..0000000000 --- a/fcl/db/sqldb/fpmake.pp +++ /dev/null @@ -1,21 +0,0 @@ -{$mode objfpc} -{$H+} -{$define FULLSQLDB} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - ChangeDir('../..'); - With Installer do - begin - {$i ../../fclmake.inc} - {$i fpmake.inc} - EndPackage; - Run; - end; -end. - diff --git a/fcl/db/sqldb/interbase/Makefile b/fcl/db/sqldb/interbase/Makefile index 4a76c22c4e..cc13176583 100644 --- a/fcl/db/sqldb/interbase/Makefile +++ b/fcl/db/sqldb/interbase/Makefile @@ -657,11 +657,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/fcl/db/sqldb/interbase/fpmake.inc b/fcl/db/sqldb/interbase/fpmake.inc deleted file mode 100644 index 51311fd34d..0000000000 --- a/fcl/db/sqldb/interbase/fpmake.inc +++ /dev/null @@ -1,11 +0,0 @@ -{ Make DB directory and all subdirectories } -{ FULLSQLDB will be defined if included from SQLDB directory alone} -{ FULLDB will be defined if included from db directory alone} -{ FULLFCL will be defined if included from main FCL directory } - -Targets.ResetDefaults; -Targets.DefaultDir:='db/sqldb/interbase'; -{ Drivers only for the following OSes } -Targets.DefaultOS:=[win32,openbsd,netbsd,freebsd,darwin,linux]; -T:=Targets.AddUnit('ibconnection'); -T.ResourceStrings:=True;
\ No newline at end of file diff --git a/fcl/db/sqldb/interbase/fpmake.pp b/fcl/db/sqldb/interbase/fpmake.pp deleted file mode 100644 index 224108daa0..0000000000 --- a/fcl/db/sqldb/interbase/fpmake.pp +++ /dev/null @@ -1,20 +0,0 @@ -{$mode objfpc} -{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - ChangeDir('../../..'); - With Installer do - begin - {$i ../../../fclmake.inc} - {$i fpmake.inc} - EndPackage; - Run; - end; -end. - diff --git a/fcl/db/sqldb/mysql/Makefile b/fcl/db/sqldb/mysql/Makefile index ae11898de5..7aa099625d 100644 --- a/fcl/db/sqldb/mysql/Makefile +++ b/fcl/db/sqldb/mysql/Makefile @@ -657,11 +657,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/fcl/db/sqldb/mysql/fpmake.inc b/fcl/db/sqldb/mysql/fpmake.inc deleted file mode 100644 index e484ae4a97..0000000000 --- a/fcl/db/sqldb/mysql/fpmake.inc +++ /dev/null @@ -1,11 +0,0 @@ -{ Make DB directory and all subdirectories } -{ FULLSQLDB will be defined if included from SQLDB directory alone} -{ FULLDB will be defined if included from db directory alone} -{ FULLFCL will be defined if included from main FCL directory } - -Targets.ResetDefaults; -Targets.DefaultDir:='db/sqldb/mysql'; -{ Drivers only for the following OSes } -Targets.DefaultOS:=[win32,openbsd,netbsd,freebsd,darwin,linux]; -T:=Targets.AddUnit('mysql4conn'); -T.ResourceStrings:=True; diff --git a/fcl/db/sqldb/mysql/fpmake.pp b/fcl/db/sqldb/mysql/fpmake.pp deleted file mode 100644 index 224108daa0..0000000000 --- a/fcl/db/sqldb/mysql/fpmake.pp +++ /dev/null @@ -1,20 +0,0 @@ -{$mode objfpc} -{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - ChangeDir('../../..'); - With Installer do - begin - {$i ../../../fclmake.inc} - {$i fpmake.inc} - EndPackage; - Run; - end; -end. - diff --git a/fcl/db/sqldb/postgres/Makefile b/fcl/db/sqldb/postgres/Makefile index 7417db6a1f..ff8378dece 100644 --- a/fcl/db/sqldb/postgres/Makefile +++ b/fcl/db/sqldb/postgres/Makefile @@ -768,11 +768,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/fcl/db/sqldb/postgres/fpmake.inc b/fcl/db/sqldb/postgres/fpmake.inc deleted file mode 100644 index 1d2619cd8c..0000000000 --- a/fcl/db/sqldb/postgres/fpmake.inc +++ /dev/null @@ -1,11 +0,0 @@ -{ Make DB directory and all subdirectories } -{ FULLSQLDB will be defined if included from SQLDB directory alone} -{ FULLDB will be defined if included from db directory alone} -{ FULLFCL will be defined if included from main FCL directory } - -Targets.ResetDefaults; -Targets.DefaultDir:='db/sqldb/postgres'; -{ Drivers only for the following OSes } -Targets.DefaultOS:=[win32,openbsd,netbsd,freebsd,darwin,linux]; -T:=Targets.AddUnit('pqconnection'); -T.ResourceStrings:=True; diff --git a/fcl/db/sqldb/postgres/fpmake.pp b/fcl/db/sqldb/postgres/fpmake.pp deleted file mode 100644 index 224108daa0..0000000000 --- a/fcl/db/sqldb/postgres/fpmake.pp +++ /dev/null @@ -1,20 +0,0 @@ -{$mode objfpc} -{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - ChangeDir('../../..'); - With Installer do - begin - {$i ../../../fclmake.inc} - {$i fpmake.inc} - EndPackage; - Run; - end; -end. - diff --git a/fcl/db/sqlite/fpmake.inc b/fcl/db/sqlite/fpmake.inc deleted file mode 100644 index db08a4ad0f..0000000000 --- a/fcl/db/sqlite/fpmake.inc +++ /dev/null @@ -1,7 +0,0 @@ -{ Make DB directory and all subdirectories } -{ FULLDB will be defined if included from db directory } -{ FULLFCL will be defined if included from main FCL directory } - -Targets.ResetDefaults; -Targets.DefaultDir:='db/sqlite'; -T:=Targets.AddUnit('sqliteds'); diff --git a/fcl/db/sqlite/fpmake.pp b/fcl/db/sqlite/fpmake.pp deleted file mode 100644 index 8781e3d069..0000000000 --- a/fcl/db/sqlite/fpmake.pp +++ /dev/null @@ -1,20 +0,0 @@ -{$mode objfpc} -{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - ChangeDir('../..'); - With Installer do - begin - {$i ../../fclmake.inc} - {$i fpmake.inc} - EndPackage; - Run; - end; -end. - diff --git a/fcl/db/tests/Makefile b/fcl/db/tests/Makefile index 15cd1a2e5f..96f36dd4b6 100644 --- a/fcl/db/tests/Makefile +++ b/fcl/db/tests/Makefile @@ -655,11 +655,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/fcl/db/tests/fpmake.pp b/fcl/db/tests/fpmake.pp deleted file mode 100644 index 8781e3d069..0000000000 --- a/fcl/db/tests/fpmake.pp +++ /dev/null @@ -1,20 +0,0 @@ -{$mode objfpc} -{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - ChangeDir('../..'); - With Installer do - begin - {$i ../../fclmake.inc} - {$i fpmake.inc} - EndPackage; - Run; - end; -end. - diff --git a/fcl/fpcunit/fpmake.inc b/fcl/fpcunit/fpmake.inc deleted file mode 100644 index 93307c6793..0000000000 --- a/fcl/fpcunit/fpmake.inc +++ /dev/null @@ -1,12 +0,0 @@ -{ Make FPCUnit directory and all subdirectories } -{ FULLFCL will be defined if included from main FCL directory } - -Targets.ResetDefaults; -Targets.DefaultDir:='fpcunit'; -T:=Targets.AddUnit('fpcunit'); -T.ResourceStrings:=true; -T:=Targets.AddUnit('testregistry'); -T:=Targets.AddUnit('testreport'); -T:=Targets.AddUnit('testutils'); -T:=Targets.AddUnit('testdecorator'); -T:=Targets.AddUnit('ubmockobject'); diff --git a/fcl/fpcunit/fpmake.pp b/fcl/fpcunit/fpmake.pp deleted file mode 100644 index 071c4869a6..0000000000 --- a/fcl/fpcunit/fpmake.pp +++ /dev/null @@ -1,20 +0,0 @@ -{$mode objfpc} -{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - ChangeDir('..'); - With Installer do - begin - {$i ../fclmake.inc} - {$i fpmake.inc} - EndPackage; - Run; - end; -end. - diff --git a/fcl/fpcunit/tests/Makefile b/fcl/fpcunit/tests/Makefile index 10fac70f62..abf96469f5 100644 --- a/fcl/fpcunit/tests/Makefile +++ b/fcl/fpcunit/tests/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/10] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/11] # default: all MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince diff --git a/fcl/fpmake.pp b/fcl/fpmake.pp deleted file mode 100644 index 17d59b7e83..0000000000 --- a/fcl/fpmake.pp +++ /dev/null @@ -1,49 +0,0 @@ -{$mode objfpc} -{$H+} -{ Define FullFCL, this way we know it's a complete FCL build} -{$DEFINE FULLFCL} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { general definitions } - {$i fclmake.inc} - - { Basic targets. } - {$i inc/fpmake.inc} - - { XML directory } - {$i xml/fpmake.inc} - - { Image directory } - {$i image/fpmake.inc} - - { db directory } - {$i db/fpmake.inc} - - { Shedit directory } - {$i shedit/fpmake.inc} - - { Passrc directory } - {$i passrc/fpmake.inc} - - { Net directory } - {$i net/fpmake.inc} - - { fpcunit directory } - {$i fpcunit/fpmake.inc} - - Targets.ResetDefaults; - - { All done.} - EndPackage; - Run; - end; -end. - diff --git a/fcl/image/fpmake.inc b/fcl/image/fpmake.inc deleted file mode 100644 index 0732d209ee..0000000000 --- a/fcl/image/fpmake.inc +++ /dev/null @@ -1,38 +0,0 @@ -{ Make image directory and all subdirectories } -{ FULLFCL will be defined if included from main FCL directory } - -Targets.ResetDefaults; -Targets.DefaultDir:='image'; -T.ResourceStrings:=True; -T:=Targets.AddUnit('fpimgcmn'); -T:=Targets.AddUnit('fpimage'); -T:=Targets.AddUnit('pngcomn'); -T:=Targets.AddUnit('fpreadpng'); -T:=Targets.AddUnit('fpwritepng'); -T:=Targets.AddUnit('fpreadxpm'); -T:=Targets.AddUnit('fpwritexpm'); -T:=Targets.AddUnit('clipping'); -T:=Targets.AddUnit('fpcanvas'); -T:=Targets.AddUnit('pixtools'); -T:=Targets.AddUnit('fppixlcanv'); -T:=Targets.AddUnit('fpimgcanv'); -T:=Targets.AddUnit('pscanvas'); -T.ResourceStrings:=True; -T:=Targets.AddUnit('fpwritebmp'); -T:=Targets.AddUnit('fpreadbmp'); -T:=Targets.AddUnit('bmpcomn'); -T:=Targets.AddUnit('fpreadpnm'); -T:=Targets.AddUnit('fpwritepnm'); -T:=Targets.AddUnit('fpreadjpeg'); -T:=Targets.AddUnit('fpwritejpeg'); -T:=Targets.AddUnit('targacmn'); -T:=Targets.AddUnit('fpreadtga'); -T:=Targets.AddUnit('fpwritetga'); -T:=Targets.AddUnit('ellipses'); -T:=Targets.AddUnit('freetypeh'); -T.OS:=[win32,linux,freebsd]; -T:=Targets.AddUnit('freetype'); -T.OS:=[win32,linux,freebsd]; -T:=Targets.AddUnit('ftfont'); -T.OS:=[win32,linux,freebsd]; -Targets.AddExampleProgram('imgconv'); diff --git a/fcl/image/fpmake.pp b/fcl/image/fpmake.pp deleted file mode 100644 index 071c4869a6..0000000000 --- a/fcl/image/fpmake.pp +++ /dev/null @@ -1,20 +0,0 @@ -{$mode objfpc} -{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - ChangeDir('..'); - With Installer do - begin - {$i ../fclmake.inc} - {$i fpmake.inc} - EndPackage; - Run; - end; -end. - diff --git a/fcl/image/fpwritebmp.pp b/fcl/image/fpwritebmp.pp index d9eca54dcc..677375be36 100644 --- a/fcl/image/fpwritebmp.pp +++ b/fcl/image/fpwritebmp.pp @@ -262,7 +262,7 @@ begin SwapBMPFileHeader(BFH); SwapBMPInfoHeader(BFI); {$ENDIF} - StartPosition:=Stream.Position; + Stream.seek(0,soFromBeginning); Stream.Write(bfh,sizeof(TBitMapFileHeader)); Stream.Write(bfi,sizeof(TBitMapInfoHeader)); {$IFDEF ENDIAN_BIG} diff --git a/fcl/inc/fpmake.inc b/fcl/inc/fpmake.inc deleted file mode 100644 index 9c2eca35bc..0000000000 --- a/fcl/inc/fpmake.inc +++ /dev/null @@ -1,90 +0,0 @@ -{ Make general directory and all subdirectories } -{ FULLFCL will be defined if included from main FCL directory, } -{ which should always be the case for this file } - -Targets.ResetDefaults; -Targets.DefaultDir:='inc'; -T:=Targets.AddUnit('contnrs'); -T:=Targets.AddUnit('inifiles'); -T:=Targets.AddUnit('ezcgi'); -T:=Targets.AddUnit('pipes'); -T:=Targets.AddUnit('rtfpars'); -T:=Targets.AddUnit('idea'); -T:=Targets.AddUnit('base64'); -T:=Targets.AddUnit('gettext'); -T:=Targets.AddUnit('iostream'); -T:=Targets.AddUnit('zstream'); -T:=Targets.AddUnit('cachecls'); -T.ResourceStrings:=True; -T:=Targets.AddUnit('avl_tree'); -T:=Targets.AddUnit('xmlreg'); -T:=Targets.AddUnit('registry'); -T.ResourceStrings:=True; -T:=Targets.AddUnit('eventlog'); -T.ResourceStrings:=True; -T:=Targets.AddUnit('custapp'); -T.ResourceStrings:=True; -T:=Targets.AddUnit('cgiapp'); -T.ResourceStrings:=True; -T:=Targets.AddUnit('wformat'); -T:=Targets.AddUnit('whtml'); -T:=Targets.AddUnit('wtex'); -T:=Targets.AddUnit('rttiutils'); -T:=Targets.AddUnit('bufstream'); -T.ResourceStrings:=True; -T:=Targets.AddUnit('streamex'); -T:=Targets.AddUnit('process'); -T.OS:=[freebsd,darwin,netbsd,openbsd,linux,win32]; -T:=Targets.AddUnit('ssockets'); -T.OS:=[freebsd,darwin,netbsd,openbsd,linux,win32,os2,emx,netware,netwlibc]; -T.ResourceStrings:=True; -T:=Targets.AddUnit('resolve'); -T.OS:=[freebsd,darwin,netbsd,openbsd,linux,win32,os2,emx,netware,netwlibc]; -T.ResourceStrings:=True; -T:=Targets.AddUnit('fpasync'); -T.OS:=[freebsd,darwin,netbsd,openbsd,linux]; -T:=Targets.AddUnit('syncobjs'); -T.OS:=[freebsd,darwin,linux,win32,netwlibc]; -T.Directory:=OSToString(Defaults.OS); -T:=Targets.AddUnit('win32/fileinfo'); -T.OS:=[win32]; - -{ Clean files. } -CleanFiles.add('adler.o'); -CleanFiles.add('adler.ppu'); -CleanFiles.add('gzcrc.o'); -CleanFiles.add('gzcrc.ppu'); -CleanFiles.add('gzio.o'); -CleanFiles.add('gzio.ppu'); -CleanFiles.add('infblock.o'); -CleanFiles.add('infblock.ppu'); -CleanFiles.add('infcodes.o'); -CleanFiles.add('infcodes.ppu'); -CleanFiles.add('inffast.o'); -CleanFiles.add('inffast.ppu'); -CleanFiles.add('inftrees.o'); -CleanFiles.add('inftrees.ppu'); -CleanFiles.add('infutil.o'); -CleanFiles.add('infutil.ppu'); -CleanFiles.add('minigzip.o'); -CleanFiles.add('minigzip.ppu'); -CleanFiles.add('paszlib.o'); -CleanFiles.add('paszlib.ppu'); -CleanFiles.add('trees.o'); -CleanFiles.add('trees.ppu'); -CleanFiles.add('zbase.o'); -CleanFiles.add('zbase.ppu'); -CleanFiles.add('zcompres.o'); -CleanFiles.add('zcompres.ppu'); -CleanFiles.add('zdeflate.o'); -CleanFiles.add('zdeflate.ppu'); -CleanFiles.add('zinflate.o'); -CleanFiles.add('zinflate.ppu'); -CleanFiles.add('zuncompr.o'); -CleanFiles.add('zuncompr.ppu'); -CleanFiles.add('zutil.o'); -CleanFiles.add('zutil.ppu'); -CleanFiles.add('pthreads.o'); -CleanFiles.add('pthreads.ppu'); -CleanFiles.add('streamio.o'); -CleanFiles.add('streamio.ppu'); diff --git a/fcl/inc/fpmake.pp b/fcl/inc/fpmake.pp deleted file mode 100644 index 071c4869a6..0000000000 --- a/fcl/inc/fpmake.pp +++ /dev/null @@ -1,20 +0,0 @@ -{$mode objfpc} -{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - ChangeDir('..'); - With Installer do - begin - {$i ../fclmake.inc} - {$i fpmake.inc} - EndPackage; - Run; - end; -end. - diff --git a/fcl/net/fpmake.inc b/fcl/net/fpmake.inc deleted file mode 100644 index e80bb07ae1..0000000000 --- a/fcl/net/fpmake.inc +++ /dev/null @@ -1,16 +0,0 @@ -{ Make net directory and all subdirectories } -{ FULLFCL will be defined if included from main FCL directory } - -Targets.ResetDefaults; -Targets.DefaultDir:='net'; -Targets.DefaultOS:=[linux,freebsd,netbsd,openbsd]; -T:=Targets.AddUnit('servlets'); -T:=Targets.AddUnit('fpsock'); -T.ResourceStrings:=True; -T:=Targets.AddUnit('httpbase'); -T:=Targets.AddUnit('httpclient'); -T:=Targets.AddUnit('httpsvlt'); -T.ResourceStrings:=True; -T:=Targets.AddUnit('xmlrpc'); -Targets.AddProgram('mkxmlrpc'); -T.ResourceStrings:=True; diff --git a/fcl/net/fpmake.pp b/fcl/net/fpmake.pp deleted file mode 100644 index 071c4869a6..0000000000 --- a/fcl/net/fpmake.pp +++ /dev/null @@ -1,20 +0,0 @@ -{$mode objfpc} -{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - ChangeDir('..'); - With Installer do - begin - {$i ../fclmake.inc} - {$i fpmake.inc} - EndPackage; - Run; - end; -end. - diff --git a/fcl/net/tests/Makefile b/fcl/net/tests/Makefile index b975d9612b..8c19eb1b17 100644 --- a/fcl/net/tests/Makefile +++ b/fcl/net/tests/Makefile @@ -766,11 +766,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/fcl/passrc/fpmake.inc b/fcl/passrc/fpmake.inc deleted file mode 100644 index 517e5f3a4f..0000000000 --- a/fcl/passrc/fpmake.inc +++ /dev/null @@ -1,12 +0,0 @@ -{ Make passrc directory and all subdirectories } -{ FULLFCL will be defined if included from main FCL directory } - -Targets.ResetDefaults; -Targets.DefaultDir:='passrc'; -T:=Targets.AddUnit('pastree'); -T.ResourceStrings:=True; -T:=Targets.AddUnit('pscanner'); -T.ResourceStrings:=True; -T:=Targets.AddUnit('pparser'); -T.ResourceStrings:=True; -T:=Targets.AddUnit('paswrite'); diff --git a/fcl/passrc/fpmake.pp b/fcl/passrc/fpmake.pp deleted file mode 100644 index 071c4869a6..0000000000 --- a/fcl/passrc/fpmake.pp +++ /dev/null @@ -1,20 +0,0 @@ -{$mode objfpc} -{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - ChangeDir('..'); - With Installer do - begin - {$i ../fclmake.inc} - {$i fpmake.inc} - EndPackage; - Run; - end; -end. - diff --git a/fcl/shedit/fpmake.inc b/fcl/shedit/fpmake.inc deleted file mode 100644 index 7a92dc82aa..0000000000 --- a/fcl/shedit/fpmake.inc +++ /dev/null @@ -1,9 +0,0 @@ -{ Make shedit directory and all subdirectories } -{ FULLFCL will be defined if included from fcl directory } - -Targets.ResetDefaults; -Targets.DefaultDir:='shedit'; -T:=Targets.AddUnit('doc_text'); -T:=Targets.AddUnit('shedit'); -T:=Targets.AddUnit('sh_xml'); -T:=Targets.AddUnit('sh_pas'); diff --git a/fcl/shedit/fpmake.pp b/fcl/shedit/fpmake.pp deleted file mode 100644 index 071c4869a6..0000000000 --- a/fcl/shedit/fpmake.pp +++ /dev/null @@ -1,20 +0,0 @@ -{$mode objfpc} -{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - ChangeDir('..'); - With Installer do - begin - {$i ../fclmake.inc} - {$i fpmake.inc} - EndPackage; - Run; - end; -end. - diff --git a/fcl/shedit/gtk/Makefile b/fcl/shedit/gtk/Makefile index f9a3d5fb5b..1d5c7948ed 100644 --- a/fcl/shedit/gtk/Makefile +++ b/fcl/shedit/gtk/Makefile @@ -655,11 +655,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/fcl/tests/Makefile b/fcl/tests/Makefile index 382c267775..45b0cb8df6 100644 --- a/fcl/tests/Makefile +++ b/fcl/tests/Makefile @@ -655,11 +655,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/fcl/xml/fpmake.inc b/fcl/xml/fpmake.inc deleted file mode 100644 index 45a38e0731..0000000000 --- a/fcl/xml/fpmake.inc +++ /dev/null @@ -1,18 +0,0 @@ -{ Make XML directory and all subdirectories } -{ FULLFCL will be defined if included from main FCL directory } - -Targets.ResetDefaults; -Targets.DefaultDir:='xml'; -T:=Targets.AddUnit('sax'); -T.ResourceStrings:=True; -T:=Targets.AddUnit('dom'); -T:=Targets.AddUnit('sax_html'); -T:=Targets.AddUnit('dom_html'); -T:=Targets.AddUnit('xmlcfg'); -T:=Targets.AddUnit('xmlread'); -T:=Targets.AddUnit('xmlstreaming'); -T:=Targets.AddUnit('xmlwrite'); -T:=Targets.AddUnit('xhtml'); -T:=Targets.AddUnit('htmldefs'); -T:=Targets.AddUnit('htmwrite'); -T:=Targets.AddUnit('xpath'); diff --git a/fcl/xml/fpmake.pp b/fcl/xml/fpmake.pp deleted file mode 100644 index 071c4869a6..0000000000 --- a/fcl/xml/fpmake.pp +++ /dev/null @@ -1,20 +0,0 @@ -{$mode objfpc} -{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - ChangeDir('..'); - With Installer do - begin - {$i ../fclmake.inc} - {$i fpmake.inc} - EndPackage; - Run; - end; -end. - diff --git a/ide/Makefile b/ide/Makefile index 2e1724c09f..bec2f68a4e 100644 --- a/ide/Makefile +++ b/ide/Makefile @@ -791,11 +791,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/ide/fakegdb/Makefile b/ide/fakegdb/Makefile index e0bff008db..ee9f6b29bd 100644 --- a/ide/fakegdb/Makefile +++ b/ide/fakegdb/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/10] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/11] # default: all MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince diff --git a/ide/fpviews.pas b/ide/fpviews.pas index 9d6c290a43..fd89e2b481 100644 --- a/ide/fpviews.pas +++ b/ide/fpviews.pas @@ -867,7 +867,6 @@ begin GetAsmReservedWordCount:=ord(lastop) - ord(firstop) {$ifndef x86_64} {$ifndef powerpc} -{$ifndef powerpc64} {$ifndef arm} + CondAsmOps*(ord(high(TasmCond))-ord(low(TasmCond))); {$else arm} @@ -875,9 +874,6 @@ begin we've to solve this different } ; {$endif arm} -{$else powerpc64} - + CondAsmOps*(ord(high(TAsmCondFlag))-ord(low(TAsmCondFlag))); -{$endif powerpc64} {$else powerpc} + CondAsmOps*(ord(high(TAsmCondFlag))-ord(low(TAsmCondFlag))); {$endif powerpc} diff --git a/ide/wconsts.pas b/ide/wconsts.pas index 6ed147407e..42e1d56b15 100644 --- a/ide/wconsts.pas +++ b/ide/wconsts.pas @@ -10,8 +10,6 @@ **********************************************************************} {$i globdir.inc} - -{$mode objfpc} unit wconsts; interface diff --git a/ide/wconstse.inc b/ide/wconstse.inc index 516213f356..c9979da930 100644 --- a/ide/wconstse.inc +++ b/ide/wconstse.inc @@ -10,7 +10,7 @@ **********************************************************************} -{ $undef USERESSTRINGS} { this doesn't compile under FP!!! why? } +{$undef USERESSTRINGS} { this doesn't compile under FP!!! why? } {$ifdef USERESSTRINGS} resourcestring @@ -38,22 +38,22 @@ label_find_entirescope = '~E~ntire scope'; dialog_replace = 'Replace'; - label_replace_texttofind = '~T~ext to find'; + label_replace_texttofind = label_find_texttofind; label_replace_newtext = ' ~N~ew text'; - label_replace_options = 'Options'; - label_replace_casesensitive = '~C~ase sensitive'; - label_replace_useregexp = '~U~se regular expr.'; - label_replace_wholewordsonly = '~W~hole words only'; + label_replace_options = label_find_options; + label_replace_casesensitive = label_find_casesensitive; + label_replace_useregexp = label_find_useregexp; + label_replace_wholewordsonly = label_find_wholewordsonly; label_replace_promptonreplace = '~P~rompt on replace'; - label_replace_direction = 'Direction'; - label_replace_forward = 'Forwar~d~'; - label_replace_backward = '~B~ackward'; - label_replace_scope = 'Scope'; - label_replace_global = '~G~lobal'; - label_replace_selectedtext = '~S~elected text'; - label_replace_origin = 'Origin'; - label_replace_fromcursor = '~F~rom cursor'; - label_replace_entirescope = '~E~ntire scope'; + label_replace_direction = label_find_direction; + label_replace_forward = label_find_forward; + label_replace_backward = label_find_backward; + label_replace_scope = label_find_scope; + label_replace_global = label_find_global; + label_replace_selectedtext = label_find_selectedtext; + label_replace_origin = label_find_origin; + label_replace_fromcursor = label_find_fromcursor; + label_replace_entirescope = label_find_entirescope; btn_replace_changeall = 'Change ~a~ll'; dialog_gotoline = 'Goto line'; diff --git a/ide/wconstsh.inc b/ide/wconstsh.inc index 3f66b79b28..7ab34615fc 100644 --- a/ide/wconstsh.inc +++ b/ide/wconstsh.inc @@ -10,7 +10,7 @@ **********************************************************************} -{ $undef USERESSTRINGS} { this doesn't compile under FP!!! why? } +{$undef USERESSTRINGS} { this doesn't compile under FP!!! why? } {$ifdef USERESSTRINGS} resourcestring diff --git a/packages/base/fpmake.inc b/packages/base/fpmake.inc deleted file mode 100644 index d7b018cd59..0000000000 --- a/packages/base/fpmake.inc +++ /dev/null @@ -1,48 +0,0 @@ -{ All base packages. Each package is included in it's own dir } -{ If this file is included from the main packages dir, ALLPACKAGES is defined. } -{ If this file is included from the base packages dir, BASEPACKAGES is defined. } - -{ paszlib } -{$i paszlib/fpmake.inc} - -{ pasjpeg } -{$i pasjpeg/fpmake.inc} - -{ regexpr } -{$i regexpr/fpmake.inc} - -{ netdb } -{$i netdb/fpmake.inc} - -{ md5 } -{$i md5/fpmake.inc} - -{ gdbint } -{$i gdbint/fpmake.inc} - -{ libasync } -{$i libasync/fpmake.inc} - -{ mysql } -{$i mysql/fpmake.inc} - -{ ibase } -{$i ibase/fpmake.inc} - -{ postgres } -{$i postgres/fpmake.inc} - -{ oracle } -{$i oracle/fpmake.inc} - -{ odbc } -{$i odbc/fpmake.inc} - -{ pthreads } -{$i pthreads/fpmake.inc} - -{ sqlite } -{$i sqlite/fpmake.inc} - -{ libc } -{$i libc/fpmake.inc} diff --git a/packages/base/fpmake.pp b/packages/base/fpmake.pp deleted file mode 100644 index 8092d648cd..0000000000 --- a/packages/base/fpmake.pp +++ /dev/null @@ -1,18 +0,0 @@ -{$mode objfpc}{$H+} -{$DEFINE BASEPACKAGES} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/base/gdbint/Makefile b/packages/base/gdbint/Makefile index 81a26b9395..35512fa2c0 100644 --- a/packages/base/gdbint/Makefile +++ b/packages/base/gdbint/Makefile @@ -899,11 +899,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/base/gdbint/fpmake.inc b/packages/base/gdbint/fpmake.inc deleted file mode 100644 index 52bdb09138..0000000000 --- a/packages/base/gdbint/fpmake.inc +++ /dev/null @@ -1,12 +0,0 @@ - StartPackage('gdbint'); - {$IF defined(ALLPACKAGES)} - Directory:='base/gdbint'; - {$ELSEIF defined(BASEPACKAGES)} - Directory:='gdbint'; - {$ENDIF} - OS:=[linux,win32,go32v2,netbsd,openbsd,freebsd]; - T:=Targets.AddUnit('gdbint'); - T:=Targets.AddUnit('gdbcon'); - T:=Targets.AddExampleunit('testgdb'); - T:=Targets.AddExampleunit('symify'); - EndPackage; diff --git a/packages/base/gdbint/fpmake.pp b/packages/base/gdbint/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/base/gdbint/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/base/gdbint/gdbint.pp b/packages/base/gdbint/gdbint.pp index 9908da943d..ba220ce8b9 100644 --- a/packages/base/gdbint/gdbint.pp +++ b/packages/base/gdbint/gdbint.pp @@ -1037,7 +1037,7 @@ var interpreter_p : pchar;cvar; { we need also to declare some vars } - watchdog : longint;cvar;external; + watchdog : longint;cvar;public; gdb_error : longint;cvar;public; display_time : longbool;cvar;public; display_space : longbool;cvar;public; diff --git a/packages/base/ibase/Makefile b/packages/base/ibase/Makefile index 8a81d4aa0b..14e492de1d 100644 --- a/packages/base/ibase/Makefile +++ b/packages/base/ibase/Makefile @@ -657,11 +657,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/base/ibase/fpmake.inc b/packages/base/ibase/fpmake.inc deleted file mode 100644 index 71fd8258f8..0000000000 --- a/packages/base/ibase/fpmake.inc +++ /dev/null @@ -1,13 +0,0 @@ - StartPackage('ibase'); - {$IF defined(ALLPACKAGES)} - Directory:='base/ibase'; - {$ELSEIF defined(BASEPACKAGES)} - Directory:='ibase'; - {$ENDIF} - OS:=[linux,win32,netbsd,openbsd,freebsd,darwin]; - T:=Targets.AddUnit('ibase40'); - T:=Targets.AddUnit('ibase60'); - T:=Targets.AddUnit('ibase60dyn'); - T:=Targets.AddExampleunit('testib40'); - T:=Targets.AddExampleunit('testib60'); - EndPackage; diff --git a/packages/base/ibase/fpmake.pp b/packages/base/ibase/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/base/ibase/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/base/libasync/fpmake.inc b/packages/base/libasync/fpmake.inc deleted file mode 100644 index d81ed4b50a..0000000000 --- a/packages/base/libasync/fpmake.inc +++ /dev/null @@ -1,19 +0,0 @@ - StartPackage('libasync'); - {$IF defined(ALLPACKAGES)} - Directory:='base/libasync'; - {$ELSEIF defined(BASEPACKAGES)} - Directory:='libasync'; - {$ENDIF} - OS:=[linux,netbsd,openbsd,freebsd,darwin]; - T:=Targets.AddUnit('libasync'); - if (Defaults.OS=linux) then - T.Directory:='unix'; - if (Defaults.OS=freebsd) then - T.Directory:='unix'; - if (Defaults.OS=darwin) then - T.Directory:='unix'; - if (Defaults.OS=netbsd) then - T.Directory:='unix'; - if (Defaults.OS=openbsd) then - T.Directory:='unix'; - EndPackage; diff --git a/packages/base/libasync/fpmake.pp b/packages/base/libasync/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/base/libasync/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/base/libc/Makefile b/packages/base/libc/Makefile index ea8953e2d5..583469b0fe 100644 --- a/packages/base/libc/Makefile +++ b/packages/base/libc/Makefile @@ -546,11 +546,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/base/libc/fpmake.inc b/packages/base/libc/fpmake.inc deleted file mode 100644 index dff916e8c7..0000000000 --- a/packages/base/libc/fpmake.inc +++ /dev/null @@ -1,11 +0,0 @@ - StartPackage('libc'); - {$IF defined(ALLPACKAGES)} - Directory:='base/libc'; - {$ELSEIF defined(BASEPACKAGES)} - Directory:='libc'; - {$ENDIF} - OS:=[linux]; - T:=Targets.AddUnit('kerneldefs'); - T:=Targets.AddUnit('kernelioctl'); - T:=Targets.AddUnit('libc'); - EndPackage; diff --git a/packages/base/libc/fpmake.pp b/packages/base/libc/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/base/libc/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/base/md5/fpmake.inc b/packages/base/md5/fpmake.inc deleted file mode 100644 index e5ad955eb0..0000000000 --- a/packages/base/md5/fpmake.inc +++ /dev/null @@ -1,10 +0,0 @@ - StartPackage('md5'); - {$IF defined(ALLPACKAGES)} - Directory:='base/md5'; - {$ELSEIF defined(BASEPACKAGES)} - Directory:='md5'; - {$ENDIF} - Version:='2.0.0'; - T:=Targets.AddUnit('md5'); - T:=Targets.AddExampleunit('md5test'); - EndPackage; diff --git a/packages/base/md5/fpmake.pp b/packages/base/md5/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/base/md5/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/base/mysql/Makefile b/packages/base/mysql/Makefile index cd1f8ceb72..ff123b4ec1 100644 --- a/packages/base/mysql/Makefile +++ b/packages/base/mysql/Makefile @@ -657,11 +657,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/base/mysql/fpmake.inc b/packages/base/mysql/fpmake.inc deleted file mode 100644 index 00b4675145..0000000000 --- a/packages/base/mysql/fpmake.inc +++ /dev/null @@ -1,20 +0,0 @@ - StartPackage('mysql'); - {$IF defined(ALLPACKAGES)} - Directory:='base/mysql'; - {$ELSEIF defined(BASEPACKAGES)} - Directory:='mysql'; - {$ENDIF} - OS:=[linux,win32,netbsd,openbsd,freebsd,darwin]; - T:=Targets.AddUnit('mysql4_com'); - T:=Targets.AddUnit('mysql4_version'); - T:=Targets.AddUnit('mysql4'); - T:=Targets.AddUnit('mysql4dyn'); - T:=Targets.AddUnit('mysql4_comdyn'); - T:=Targets.AddUnit('mysql3_com'); - T:=Targets.AddUnit('mysql3_version'); - T:=Targets.AddUnit('mysql3'); - T:=Targets.AddUnit('mysql3_comdyn'); - T:=Targets.AddUnit('mysql3dyn'); - T:=Targets.AddExampleunit('testdb4'); - T:=Targets.AddExampleunit('testdb3'); - EndPackage; diff --git a/packages/base/mysql/fpmake.pp b/packages/base/mysql/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/base/mysql/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/base/netdb/fpmake.inc b/packages/base/netdb/fpmake.inc deleted file mode 100644 index f4e7ce2245..0000000000 --- a/packages/base/netdb/fpmake.inc +++ /dev/null @@ -1,19 +0,0 @@ - StartPackage('netdb'); - {$IF defined(ALLPACKAGES)} - Directory:='base/netdb'; - {$ELSEIF defined(BASEPACKAGES)} - Directory:='netdb'; - {$ENDIF} - T:=Targets.AddUnit('uriparser'); - T:=Targets.AddUnit('netdb'); - T.OS:=[linux,freebsd,openbsd,netbsd,darwin]; - T:=Targets.AddExampleunit('testdns'); - T.OS:=[linux,freebsd,openbsd,netbsd,darwin]; - T:=Targets.AddExampleunit('testhst'); - T.OS:=[linux,freebsd,openbsd,netbsd,darwin]; - T:=Targets.AddExampleunit('testsvc'); - T.OS:=[linux,freebsd,openbsd,netbsd,darwin]; - T:=Targets.AddExampleunit('testnet'); - T.OS:=[linux,freebsd,openbsd,netbsd,darwin]; - T:=Targets.AddExampleunit('testuri'); - EndPackage; diff --git a/packages/base/netdb/fpmake.pp b/packages/base/netdb/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/base/netdb/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/base/odbc/Makefile b/packages/base/odbc/Makefile index 67f21d7400..285fb7b249 100644 --- a/packages/base/odbc/Makefile +++ b/packages/base/odbc/Makefile @@ -657,11 +657,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/base/odbc/fpmake.inc b/packages/base/odbc/fpmake.inc deleted file mode 100644 index e3f4f688c4..0000000000 --- a/packages/base/odbc/fpmake.inc +++ /dev/null @@ -1,10 +0,0 @@ - StartPackage('odbc'); - {$IF defined(ALLPACKAGES)} - Directory:='base/odbc'; - {$ELSEIF defined(BASEPACKAGES)} - Directory:='odbc'; - {$ENDIF} - OS:=[linux,win32,netbsd,openbsd,freebsd,darwin]; - T:=Targets.AddUnit('odbcsql'); - T:=Targets.AddExampleunit('testodbc'); - EndPackage; diff --git a/packages/base/odbc/fpmake.pp b/packages/base/odbc/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/base/odbc/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/base/oracle/Makefile b/packages/base/oracle/Makefile index 7140c30919..750d7e1cb8 100644 --- a/packages/base/oracle/Makefile +++ b/packages/base/oracle/Makefile @@ -657,11 +657,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/base/oracle/example/Makefile b/packages/base/oracle/example/Makefile index 573201119f..a7660dd6fb 100644 --- a/packages/base/oracle/example/Makefile +++ b/packages/base/oracle/example/Makefile @@ -655,11 +655,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/base/oracle/fpmake.inc b/packages/base/oracle/fpmake.inc deleted file mode 100644 index b224a38848..0000000000 --- a/packages/base/oracle/fpmake.inc +++ /dev/null @@ -1,9 +0,0 @@ - StartPackage('oracle'); - {$IF defined(ALLPACKAGES)} - Directory:='base/oracle'; - {$ELSEIF defined(BASEPACKAGES)} - Directory:='oracle'; - {$ENDIF} - OS:=[linux,netbsd,openbsd,freebsd,darwin]; - T:=Targets.AddUnit('oraoci'); - EndPackage; diff --git a/packages/base/oracle/fpmake.pp b/packages/base/oracle/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/base/oracle/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/base/pasjpeg/fpmake.inc b/packages/base/pasjpeg/fpmake.inc deleted file mode 100644 index ce8e937885..0000000000 --- a/packages/base/pasjpeg/fpmake.inc +++ /dev/null @@ -1,62 +0,0 @@ - StartPackage('pasjpeg'); - {$IF defined(ALLPACKAGES)} - Directory:='base/pasjpeg'; - {$ELSEIF defined(BASEPACKAGES)} - Directory:='pasjpeg'; - {$ENDIF} - Version:='2.0.0'; - T:=Targets.AddUnit('jcapimin'); - T:=Targets.AddUnit('jcapistd'); - T:=Targets.AddUnit('jccoefct'); - T:=Targets.AddUnit('jccolor'); - T:=Targets.AddUnit('jcdctmgr'); - T:=Targets.AddUnit('jchuff'); - T:=Targets.AddUnit('jcinit'); - T:=Targets.AddUnit('jcmainct'); - T:=Targets.AddUnit('jcmarker'); - T:=Targets.AddUnit('jcmaster'); - T:=Targets.AddUnit('jcomapi'); - T:=Targets.AddUnit('jcparam'); - T:=Targets.AddUnit('jcphuff'); - T:=Targets.AddUnit('jcprepct'); - T:=Targets.AddUnit('jcsample'); - T:=Targets.AddUnit('jdapimin'); - T:=Targets.AddUnit('jdapistd'); - T:=Targets.AddUnit('jdatadst'); - T:=Targets.AddUnit('jdatasrc'); - T:=Targets.AddUnit('jdcoefct'); - T:=Targets.AddUnit('jdcolor'); - T:=Targets.AddUnit('jdct'); - T:=Targets.AddUnit('jddctmgr'); - T:=Targets.AddUnit('jdeferr'); - T:=Targets.AddUnit('jdhuff'); - T:=Targets.AddUnit('jdinput'); - T:=Targets.AddUnit('jdmainct'); - T:=Targets.AddUnit('jdmarker'); - T:=Targets.AddUnit('jdmaster'); - T:=Targets.AddUnit('jdmerge'); - T:=Targets.AddUnit('jdphuff'); - T:=Targets.AddUnit('jdpostct'); - T:=Targets.AddUnit('jdsample'); - T:=Targets.AddUnit('jerror'); - T:=Targets.AddUnit('jfdctflt'); - T:=Targets.AddUnit('jfdctfst'); - T:=Targets.AddUnit('jfdctint'); - T:=Targets.AddUnit('jidctflt'); - T:=Targets.AddUnit('jidctfst'); - T:=Targets.AddUnit('jidctint'); - T:=Targets.AddUnit('jidctred'); - T:=Targets.AddUnit('jinclude'); - T:=Targets.AddUnit('jmemmgr'); - T:=Targets.AddUnit('jmemnobs'); - T:=Targets.AddUnit('jmorecfg'); - T:=Targets.AddUnit('jpeglib'); - T:=Targets.AddUnit('jquant1'); - T:=Targets.AddUnit('jquant2'); - T:=Targets.AddUnit('jutils'); - T:=Targets.AddExampleunit('cjpeg'); - T:=Targets.AddExampleunit('demo'); - T:=Targets.AddExampleunit('djpeg'); - T:=Targets.AddExampleunit('jpegtran'); - T:=Targets.AddExampleunit('rdjpgcom'); - EndPackage; diff --git a/packages/base/pasjpeg/fpmake.pp b/packages/base/pasjpeg/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/base/pasjpeg/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/base/pasjpeg/jidct2d.pas b/packages/base/pasjpeg/jidct2d.pas index bd277502af..68547d3e49 100644 --- a/packages/base/pasjpeg/jidct2d.pas +++ b/packages/base/pasjpeg/jidct2d.pas @@ -442,607 +442,3 @@ begin end; end. ----------------------------------------------------------- -type - matasm = array[0..DCTSIZE2-1] of integer; - bmatrix = array[0..DCTSIZE2-1] of byte; - bmatrixptr = ^bmatrix; -procedure ANN_IDCT(var coef_block :matasm; - var outptr :bmatrix); - - var coeffs :matasm; = coef_block - var outptr :bmatrix); output_buf - -Const - CONST_IC4 = 1.414213562; { 1/0.707106781; } - FP_IC4 = FIX_1_414213562; - FP_I_C4_2 = FP_IC4; - - Function Descale(x : integer):byte; - var y : integer; - begin - y := (x + (1 shl (16-1))+ (4 shl PASS_BITS)) div (8 shl PASS_BITS); - { DeScale := x sar (3 + PASS_BITS); - Borland Pascal SHR is unsigned } - if y < 0 then - descale := 0 - else - if y > $ff then - descale := $ff - else - descale := y; - end; - - function Multiply(X, Y: Integer): integer; assembler; - asm - mov ax, X - imul Y - mov al, ah - mov ah, dl - end; - - -Const - RowSize = 8; -var - a, b : integer; - - inptr : JCOEFPTR; - - outptr : bmatrixptr; - - num : integer; -begin -{ Each IDCT routine is responsible for range-limiting its results and - converting them to unsigned form (0..MAXJSAMPLE). The raw outputs could - be quite far out of range if the input data is corrupt, so a bulletproof - range-limiting step is required. We use a mask-and-table-lookup method - to do the combined operations quickly. See the comments with - prepare_range_limit_table (in jdmaster.c) for more info. } - - range_limit := JSAMPROW(@(cinfo^.sample_range_limit^[CENTERJSAMPLE])); - { Pass 1: process columns from input, store into work array. } - - inptr := @coef_block; + ctr*RowSize - quantptr := IFAST_MULT_TYPE_FIELD_PTR(compptr^.dct_table); - - for ctr := pred(DCTSIZE) downto 0 do - BEGIN - tmp5 := inptr^[1]; - - inptr^[1] := inptr^[4]; - - tmp7 := inptr^[3]; - - a := inptr^[2]; - b := inptr^[6]; - inptr^[2] := a - b; - inptr^[3] := a + b; - - a := inptr^[5]; - inptr^[+ 4] := a - tmp7; - z13 := a + tmp7; - - b := inptr^[7]; - inptr^[6] := tmp5 - b; - z11 := tmp5 + b; - - inptr^[5] := z11 - z13; - inptr^[7] := z11 + z13; - END; - - { M x M tensor } - for row := 0 to 7 do - Case row of - 0,1,3,7: { M1 } - begin - inptr^[row*RowSize + 2] := Multiply(inptr^[row*RowSize + 2], FP_IC4); { 2/c4 } - inptr^[row*RowSize + 5] := Multiply(inptr^[row*RowSize + 5], FP_IC4); { 2/c4 } - - N1(inptr^[row*RowSize + 4], inptr^[row*RowSize + 6]); - end; - 2,5: { M2 } - begin - inptr^[row*RowSize + 0] := Multiply(inptr^[row*RowSize + 0], FP_IC4); - inptr^[row*RowSize + 1] := Multiply(inptr^[row*RowSize + 1], FP_IC4); - inptr^[row*RowSize + 3] := Multiply(inptr^[row*RowSize + 3], FP_IC4); - inptr^[row*RowSize + 7] := Multiply(inptr^[row*RowSize + 7], FP_IC4); - - inptr^[row*RowSize + 2] := inptr^[row*RowSize + 2] * 2; { shift } - inptr^[row*RowSize + 5] := inptr^[row*RowSize + 5] * 2; - - N2(inptr^[row*RowSize + 4], inptr^[row*RowSize + 6]); - end; - end; { Case } - - { M x N tensor } - { rows 4,6 } - begin - N1(inptr^[4*RowSize + 0], inptr^[6*RowSize + 0]); - N1(inptr^[4*RowSize + 1], inptr^[6*RowSize + 1]); - N1(inptr^[4*RowSize + 3], inptr^[6*RowSize + 3]); - N1(inptr^[4*RowSize + 7], inptr^[6*RowSize + 7]); - - N2(inptr^[4*RowSize + 2], inptr^[6*RowSize + 2]); - N2(inptr^[4*RowSize + 5], inptr^[6*RowSize + 5]); - - { N3 } - { two inverse matrices => same as FDCT } - tmp0 := inptr^[4*RowSize + 4]; - tmp3 := inptr^[6*RowSize + 6]; - tmp12 := (tmp0 + tmp3) * 2; - z10 := tmp0 - tmp3; - - tmp1 := inptr^[6*RowSize + 4]; - tmp2 := inptr^[4*RowSize + 6]; - tmp13 :=-(tmp1 - tmp2)*2; - z11 := tmp1 + tmp2; - - tmp0 := Multiply(z10 + z11, FP_I_C4_2); - tmp1 := Multiply(z10 - z11, FP_I_C4_2); - - - inptr^[4*RowSize + 4] := tmp12 + tmp0; - inptr^[6*RowSize + 4] := tmp1 + tmp13; - - inptr^[4*RowSize + 6] := tmp1 - tmp13; - inptr^[6*RowSize + 6] := tmp12 - tmp0; - end; - - { R2 x R2 } - - for row := 0 to 7 do - BEGIN - { Odd part } - tmp7 := inptr^[row*RowSize + 7]; - tmp6 := inptr^[row*RowSize + 6] - tmp7; - tmp5 := inptr^[row*RowSize + 5] - tmp6; - tmp4 :=-inptr^[row*RowSize + 4] - tmp5; - - { even part } - tmp0 := inptr^[row*RowSize + 0]; - tmp1 := inptr^[row*RowSize + 1]; - tmp10 := tmp0 + tmp1; - tmp11 := tmp0 - tmp1; - - tmp2 := inptr^[row*RowSize + 2]; - tmp13 := inptr^[row*RowSize + 3]; - tmp12 := tmp2 - tmp13; - - tmp0 := tmp10 + tmp13; - tmp3 := tmp10 - tmp13; - inptr^[row*RowSize + 0] := (tmp0 + tmp7); - inptr^[row*RowSize + 7] := (tmp0 - tmp7); - - inptr^[row*RowSize + 3] := (tmp3 + tmp4); - inptr^[row*RowSize + 4] := (tmp3 - tmp4); - - tmp1 := tmp11 + tmp12; - tmp2 := tmp11 - tmp12; - - inptr^[row*RowSize + 1] := (tmp1 + tmp6); - inptr^[row*RowSize + 6] := (tmp1 - tmp6); - - inptr^[row*RowSize + 2] := (tmp2 + tmp5); - inptr^[row*RowSize + 5] := (tmp2 - tmp5); - END; - - for ctr := 0 to pred(DCTSIZE) do - BEGIN - outptr := JSAMPROW(@output_buf^[ctr]^[output_col]); - { even part } - tmp0 := inptr^[0*RowSize + ctr]; - tmp1 := inptr^[1*RowSize + ctr]; - tmp2 := inptr^[2*RowSize + ctr]; - tmp3 := inptr^[3*RowSize + ctr]; - - tmp10 := tmp0 + tmp1; - tmp11 := tmp0 - tmp1; - - tmp13 := tmp3; - tmp12 := tmp2 - tmp3; - - tmp0 := tmp10 + tmp13; - tmp3 := tmp10 - tmp13; - - tmp1 := tmp11 + tmp12; - tmp2 := tmp11 - tmp12; - - { Odd part } - tmp4 := inptr^[4*RowSize + ctr]; - tmp5 := inptr^[5*RowSize + ctr]; - tmp6 := inptr^[6*RowSize + ctr]; - tmp7 := inptr^[7*RowSize + ctr]; - - tmp6 := tmp6 - tmp7; - tmp5 := tmp5 - tmp6; - tmp4 :=-tmp4 - tmp5; - - outptr^[0*RowSize + ctr] := DeScale(tmp0 + tmp7); - outptr^[7*RowSize + ctr] := DeScale(tmp0 - tmp7); - - outptr^[1*RowSize + ctr] := DeScale(tmp1 + tmp6); - outptr^[6*RowSize + ctr] := DeScale(tmp1 - tmp6); - - outptr^[2*RowSize + ctr] := DeScale(tmp2 + tmp5); - outptr^[5*RowSize + ctr] := DeScale(tmp2 - tmp5); - - outptr^[3*RowSize + ctr] := DeScale(tmp3 + tmp4); - outptr^[4*RowSize + ctr] := DeScale(tmp3 - tmp4); - - - { Final output stage: scale down by a factor of 8 and range-limit } - - outptr^[0] := range_limit^[IDESCALE(tmp0 + tmp7, PASS1_BITS+3) - and RANGE_MASK]; - outptr^[7] := range_limit^[IDESCALE(tmp0 - tmp7, PASS1_BITS+3) - and RANGE_MASK]; - outptr^[1] := range_limit^[IDESCALE(tmp1 + tmp6, PASS1_BITS+3) - and RANGE_MASK]; - outptr^[6] := range_limit^[IDESCALE(tmp1 - tmp6, PASS1_BITS+3) - and RANGE_MASK]; - outptr^[2] := range_limit^[IDESCALE(tmp2 + tmp5, PASS1_BITS+3) - and RANGE_MASK]; - outptr^[5] := range_limit^[IDESCALE(tmp2 - tmp5, PASS1_BITS+3) - and RANGE_MASK]; - outptr^[4] := range_limit^[IDESCALE(tmp3 + tmp4, PASS1_BITS+3) - and RANGE_MASK]; - outptr^[3] := range_limit^[IDESCALE(tmp3 - tmp4, PASS1_BITS+3) - and RANGE_MASK]; - END; - - Inc(bbo); - Inc(inptr); - End; -End; {----------------------------------------} - - -{GLOBAL} -procedure jpeg_idct_i2d (cinfo : j_decompress_ptr; - compptr : jpeg_component_info_ptr; - coef_block : JCOEFPTR; - output_buf : JSAMPARRAY; - output_col : JDIMENSION); - -procedure Feig_2D_IDCT(coef_block :imatrix; - output_buf : JSAMPARRAY); -Const - CONST_IC4 = 1.414213562; { 1/0.707106781; } - FP_IC4 = Integer(Round(IFX_CONST*CONST_IC4)); - FP_I_C4_2 = FP_IC4; - - Function Descale(x : integer):integer; - begin - DeScale := (x+ (4 shl PASS_BITS)) div (8 shl PASS_BITS); - { DeScale := x sar (3 + PASS_BITS); - Borland Pascal SHR is unsigned } - end; - { - function Multiply(X, Y: Integer): integer; - begin - Multiply := Integer( X*LongInt(Y) div IFX_CONST); - end; - } - function Multiply(X, Y: Integer): integer; assembler; - asm - mov ax, X - imul Y - mov al, ah - mov ah, dl - end; - - -var - z10, z11, z12, z13, - tmp0,tmp1,tmp2,tmp3, - tmp4,tmp5,tmp6,tmp7, - tmp10,tmp11, - tmp12,tmp13 : integer; - column, row : byte; - - Procedure N1(var x, y : integer); { rotator 1 } - Const - FP_a5 = Integer(Round(IFX_CONST*1.847759065)); - FP_a4 = Integer(Round(IFX_CONST*2.613125930)); - FP_a2 = Integer(Round(IFX_CONST*1.082392200)); - var - z5, tmp : integer; - begin - tmp := x; - - z5 := Multiply(tmp + y, FP_a5); { c6 } - x := Multiply(y, FP_a2) - z5; { c2-c6 } - y := Multiply(tmp, -FP_a4) + z5; { c2+c6 } - end; - - Procedure N2(var x, y : integer); { N1 scaled by c4 } - Const - FP_b5 = Integer(Round(IFX_CONST*1.847759065*CONST_IC4)); - FP_b4 = Integer(Round(IFX_CONST*2.613125930*CONST_IC4)); - FP_b2 = Integer(Round(IFX_CONST*1.082392200*CONST_IC4)); - var - z5, tmp : integer; - begin - tmp := x; - - z5 := Multiply(tmp + y, FP_b5); - x := Multiply(y, FP_b2) - z5; - y := Multiply(tmp,-FP_b4) + z5; - end; - -var - tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, tmp6, tmp7 : DCTELEM; - tmp10, tmp11, tmp12, tmp13 : DCTELEM; - z10, z11, z12, z13 : DCTELEM; - inptr : JCOEFPTR; - - quantptr : IFAST_MULT_TYPE_FIELD_PTR; - wsptr : PWorkspace; - outptr : JSAMPROW; - range_limit : JSAMPROW; - ctr : int; - workspace : TWorkspace; { buffers data between passes } - {SHIFT_TEMPS { for DESCALE } - {ISHIFT_TEMPS { for IDESCALE } -var - dcval : int; -var - dcval_ : JSAMPLE; -begin -{ Each IDCT routine is responsible for range-limiting its results and - converting them to unsigned form (0..MAXJSAMPLE). The raw outputs could - be quite far out of range if the input data is corrupt, so a bulletproof - range-limiting step is required. We use a mask-and-table-lookup method - to do the combined operations quickly. See the comments with - prepare_range_limit_table (in jdmaster.c) for more info. } - - range_limit := JSAMPROW(@(cinfo^.sample_range_limit^[CENTERJSAMPLE])); - { Pass 1: process columns from input, store into work array. } - - inptr := coef_block; - quantptr := IFAST_MULT_TYPE_FIELD_PTR(compptr^.dct_table); - wsptr := @workspace; - - { R1 x R1 } - for ctr := pred(DCTSIZE) downto 0 do - BEGIN - { even part } - tmp1 := DEQUANTIZE(inptr^[DCTSIZE*2], quantptr^[DCTSIZE*2]); - tmp3 := DEQUANTIZE(inptr^[DCTSIZE*6], quantptr^[DCTSIZE*6]); - - wsptr^[DCTSIZE*0] := int (DEQUANTIZE(inptr^[DCTSIZE*0], quantptr^[DCTSIZE*0])); - wsptr^[DCTSIZE*1] := int (DEQUANTIZE(inptr^[DCTSIZE*4], quantptr^[DCTSIZE*4]); - - { Odd part } - - tmp6 := DEQUANTIZE(inptr^[DCTSIZE*5], quantptr^[DCTSIZE*5]); - tmp4 := DEQUANTIZE(inptr^[DCTSIZE*1], quantptr^[DCTSIZE*1]); - tmp7 := DEQUANTIZE(inptr^[DCTSIZE*7], quantptr^[DCTSIZE*7]); - tmp5 := DEQUANTIZE(inptr^[DCTSIZE*3], quantptr^[DCTSIZE*3]); - - - z13 := tmp6 + tmp5; - wsptr^[DCTSIZE*4] := int (tmp6 - tmp5); - - z11 := tmp4 + tmp7; - wsptr^[DCTSIZE*6] := int (tmp4 - tmp7); - - wsptr^[DCTSIZE*7] := int (z11 + z13); - wsptr^[DCTSIZE*5] := int (z11 - z13); - - wsptr^[DCTSIZE*3] := int (tmp1 + tmp3); - wsptr^[DCTSIZE*2] := int (tmp1 - tmp3); - - Inc(JCOEF_PTR(inptr)); { advance pointers to next column } - Inc(IFAST_MULT_TYPE_PTR(quantptr)); - Inc(int_ptr(wsptr)); - END; - - wsptr := @workspace[DCTSIZE*pred(DCTSIZE)]; - for row := pred(DCTSIZE) downto 0 do - BEGIN - { Odd part } - tmp5 := DCTELEM(wsptr^[1]); - tmp7 := DCTELEM(wsptr^[3]); - - { even part } - - {noop: - tmp0 := DCTELEM(wsptr^[0]); - wsptr^[0] := DCTELEM(tmp0);} - - {tmp2 := DCTELEM(wsptr^[4]);} - wsptr^[1] := wsptr^[4]; - - tmp1 := DCTELEM(wsptr^[2]); - tmp3 := DCTELEM(wsptr^[6]); - - wsptr^[2] := DCTELEM(tmp1 - tmp3); - wsptr^[3] := DCTELEM(tmp1 + tmp3); - - { Odd part } - tmp4 := DCTELEM(wsptr^[5]); - tmp6 := DCTELEM(wsptr^[7]); - - z13 := tmp4 + tmp7; - wsptr^[4] := DCTELEM(tmp4 - tmp7); - - z11 := tmp5 + tmp6; - wsptr^[6] := DCTELEM(tmp5 - tmp6); - - wsptr^[7] := DCTELEM(z11 + z13); - wsptr^[5] := DCTELEM(z11 - z13); - Dec(int_ptr(wsptr), DCTSIZE); { advance pointer to previous row } - END; - - { M x M tensor } - wsptr := @workspace[DCTSIZE*0]; - for row := 0 to pred(DCTSIZE) do - begin - Case row of - 0,1,3,7: { M1 } - begin - wsptr^[2] := Multiply(wsptr^[2], FP_IC4); { 2/c4 } - wsptr^[5] := Multiply(wsptr^[5], FP_IC4); { 2/c4 } - - N1(wsptr^[ 4], wsptr^[ 6]); - end; - 2,5: { M2 } - begin - wsptr^[0] := Multiply(wsptr^[0], FP_IC4); - wsptr^[1] := Multiply(wsptr^[1], FP_IC4); - wsptr^[3] := Multiply(wsptr^[3], FP_IC4); - wsptr^[7] := Multiply(wsptr^[7], FP_IC4); - - wsptr^[2] := wsptr^[2] * 2; { shift } - wsptr^[5] := wsptr^[5] * 2; - - N2(wsptr^[4], wsptr^[6]); - end; - end; { Case } - Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } - end; - - { M x N tensor } - { rows 4,6 } - begin - N1(workspace[DCTSIZE*4+0], workspace[DCTSIZE*6+0]); - N1(workspace[DCTSIZE*4+1], workspace[DCTSIZE*6+1]); - N1(workspace[DCTSIZE*4+3], workspace[DCTSIZE*6+3]); - N1(workspace[DCTSIZE*4+7], workspace[DCTSIZE*6+7]); - - N2(workspace[DCTSIZE*4+2], workspace[DCTSIZE*6+2]); - N2(workspace[DCTSIZE*4+5], workspace[DCTSIZE*6+5]); - - { N3 } - tmp0 := workspace[DCTSIZE*4,4]; - tmp1 := workspace[DCTSIZE*6,4]; - tmp2 := workspace[DCTSIZE*4,6]; - tmp3 := workspace[DCTSIZE*6,6]; - - { two inverse matrices => same as FDCT } - z10 := tmp0 - tmp3; - z11 := tmp1 + tmp2; - - z12 := tmp0 + tmp3; - z13 := tmp1 - tmp2; - - tmp0 := Multiply(z10 + z11, FP_I_C4_2); - tmp1 := Multiply(z10 - z11, FP_I_C4_2); - - tmp2 := z12 * 2; { shifts } - tmp3 := z13 * (-2); - - - workspace[DCTSIZE*4,4] := tmp2 + tmp0; - workspace[DCTSIZE*6,4] := tmp1 + tmp3; - - workspace[DCTSIZE*4,6] := tmp1 - tmp3; - workspace[DCTSIZE*6,6] := tmp2 - tmp0; - end; - - { R2 x R2 } - - wsptr := @workspace; - for row := 0 to pred(DCTSIZE) do - BEGIN - { even part } - tmp0 := wsptr^[0]; - tmp2 := wsptr^[1]; - tmp1 := wsptr^[2]; - tmp3 := wsptr^[3]; - - tmp10 := tmp0 + tmp2; - tmp11 := tmp0 - tmp2; - - tmp12 := tmp1 - tmp3; - tmp13 := tmp3; - - tmp0 := tmp10 + tmp13; - tmp3 := tmp10 - tmp13; - - tmp2 := tmp11 + tmp12; - tmp1 := tmp11 - tmp12; - - { Odd part } - tmp4 := wsptr^[4]; - tmp5 := wsptr^[5]; - tmp6 := wsptr^[6]; - tmp7 := wsptr^[7]; - - tmp6 := tmp6 - tmp7; - tmp5 := tmp5 - tmp6; - tmp4 :=-tmp4 - tmp5; - - wsptr^[0] := (tmp0 + tmp7); - wsptr^[7] := (tmp0 - tmp7); - - wsptr^[1] := (tmp2 + tmp6); - wsptr^[6] := (tmp2 - tmp6); - - wsptr^[2] := (tmp1 + tmp5); - wsptr^[5] := (tmp1 - tmp5); - - wsptr^[3] := (tmp3 + tmp4); - wsptr^[4] := (tmp3 - tmp4); - - Inc(int_ptr(wsptr), DCTSIZE); { advance pointer to next row } - END; - - wsptr := @workspace; - for ctr := 0 to pred(DCTSIZE) do - BEGIN - outptr := JSAMPROW(@output_buf^[ctr]^[output_col]); - { even part } - tmp0 := wsptr[0]; - tmp1 := wsptr[1]; - tmp2 := wsptr[2]; - tmp3 := wsptr[3]; - - tmp10 := tmp0 + tmp1; - tmp11 := tmp0 - tmp1; - - tmp13 := tmp3; - tmp12 := tmp2 - tmp3; - - tmp0 := tmp10 + tmp13; - tmp3 := tmp10 - tmp13; - - tmp1 := tmp11 + tmp12; - tmp2 := tmp11 - tmp12; - - { Odd part } - tmp4 := wsptr[4]; - tmp5 := wsptr[5]; - tmp6 := wsptr[6]; - tmp7 := wsptr[7]; - - tmp6 := tmp6 - tmp7; - tmp5 := tmp5 - tmp6; - tmp4 :=-tmp4 - tmp5; - - { Final output stage: scale down by a factor of 8 and range-limit } - - outptr^[0] := range_limit^[IDESCALE(tmp0 + tmp7, PASS1_BITS+3) - and RANGE_MASK]; - outptr^[7] := range_limit^[IDESCALE(tmp0 - tmp7, PASS1_BITS+3) - and RANGE_MASK]; - outptr^[1] := range_limit^[IDESCALE(tmp1 + tmp6, PASS1_BITS+3) - and RANGE_MASK]; - outptr^[6] := range_limit^[IDESCALE(tmp1 - tmp6, PASS1_BITS+3) - and RANGE_MASK]; - outptr^[2] := range_limit^[IDESCALE(tmp2 + tmp5, PASS1_BITS+3) - and RANGE_MASK]; - outptr^[5] := range_limit^[IDESCALE(tmp2 - tmp5, PASS1_BITS+3) - and RANGE_MASK]; - outptr^[4] := range_limit^[IDESCALE(tmp3 + tmp4, PASS1_BITS+3) - and RANGE_MASK]; - outptr^[3] := range_limit^[IDESCALE(tmp3 - tmp4, PASS1_BITS+3) - and RANGE_MASK]; - Inc(int_ptr(wsptr)); - END; -End; {----------------------------------------} - - -{----------------------------------------------------------------------} - diff --git a/packages/base/paszlib/fpmake.inc b/packages/base/paszlib/fpmake.inc deleted file mode 100644 index cdfcb03e72..0000000000 --- a/packages/base/paszlib/fpmake.inc +++ /dev/null @@ -1,26 +0,0 @@ - StartPackage('paszlib'); - {$IF defined(ALLPACKAGES)} - Directory:='base/paszlib'; - {$ELSEIF defined(BASEPACKAGES)} - Directory:='paszlib'; - {$ENDIF} - Version:={$i %FPCVERSION%}; - T:=Targets.AddUnit('paszlib'); - T:=Targets.AddUnit('adler'); - T:=Targets.AddUnit('gzcrc'); - T:=Targets.AddUnit('gzio'); - T:=Targets.AddUnit('infblock'); - T:=Targets.AddUnit('infcodes'); - T:=Targets.AddUnit('inffast'); - T:=Targets.AddUnit('inftrees'); - T:=Targets.AddUnit('infutil'); - T:=Targets.AddUnit('trees'); - T:=Targets.AddUnit('zcompres'); - T:=Targets.AddUnit('zdeflate'); - T:=Targets.AddUnit('zinflate'); - T:=Targets.AddUnit('zbase'); - T:=Targets.AddUnit('zuncompr'); - T:=Targets.AddUnit('zutil'); - T:=Targets.AddExampleunit('example'); - T:=Targets.AddExampleunit('minigzip'); - EndPackage; diff --git a/packages/base/paszlib/fpmake.pp b/packages/base/paszlib/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/base/paszlib/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/base/postgres/Makefile b/packages/base/postgres/Makefile index 95ba424cf1..b57553fa70 100644 --- a/packages/base/postgres/Makefile +++ b/packages/base/postgres/Makefile @@ -657,11 +657,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/base/postgres/fpmake.inc b/packages/base/postgres/fpmake.inc deleted file mode 100644 index 968c84064c..0000000000 --- a/packages/base/postgres/fpmake.inc +++ /dev/null @@ -1,15 +0,0 @@ - StartPackage('postgres'); - {$IF defined(ALLPACKAGES)} - Directory:='base/postgres'; - {$ELSEIF defined(BASEPACKAGES)} - Directory:='postgres'; - {$ENDIF} - OS:=[linux,win32,netbsd,openbsd,freebsd,darwin]; - T:=Targets.AddUnit('dllist'); - T:=Targets.AddUnit('dllistdyn'); - T:=Targets.AddUnit('postgres'); - T:=Targets.AddUnit('postgres3'); - T:=Targets.AddUnit('postgres3dyn'); - T:=Targets.AddExampleunit('testpg1'); - T:=Targets.AddExampleunit('testpg2'); - EndPackage; diff --git a/packages/base/postgres/fpmake.pp b/packages/base/postgres/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/base/postgres/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/base/pthreads/fpmake.inc b/packages/base/pthreads/fpmake.inc deleted file mode 100644 index b0e79cc633..0000000000 --- a/packages/base/pthreads/fpmake.inc +++ /dev/null @@ -1,9 +0,0 @@ - StartPackage('pthreads'); - {$IF defined(ALLPACKAGES)} - Directory:='base/pthreads'; - {$ELSEIF defined(BASEPACKAGES)} - Directory:='pthreads'; - {$ENDIF} - OS:=[linux,freebsd,darwin]; - T:=Targets.AddUnit('pthreads'); - EndPackage; diff --git a/packages/base/pthreads/fpmake.pp b/packages/base/pthreads/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/base/pthreads/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/base/regexpr/fpmake.inc b/packages/base/regexpr/fpmake.inc deleted file mode 100644 index b8a03cdf82..0000000000 --- a/packages/base/regexpr/fpmake.inc +++ /dev/null @@ -1,11 +0,0 @@ - StartPackage('regexpr'); - {$IF defined(ALLPACKAGES)} - Directory:='base/regexpr'; - {$ELSEIF defined(BASEPACKAGES)} - Directory:='regexpr'; - {$ENDIF} - Version:='2.0.0'; - Options:='-S2'; - T:=Targets.AddUnit('regexpr'); - T:=Targets.AddExampleunit('testreg1'); - EndPackage; diff --git a/packages/base/regexpr/fpmake.pp b/packages/base/regexpr/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/base/regexpr/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/base/sqlite/fpmake.inc b/packages/base/sqlite/fpmake.inc deleted file mode 100644 index 3c66e8a586..0000000000 --- a/packages/base/sqlite/fpmake.inc +++ /dev/null @@ -1,9 +0,0 @@ - StartPackage('sqlite'); - {$IF defined(ALLPACKAGES)} - Directory:='base/sqlite'; - {$ELSEIF defined(BASEPACKAGES)} - Directory:='sqlite'; - {$ENDIF} - OS:=[linux,win32,freebsd,darwin]; - T:=Targets.AddUnit('sqlite'); - EndPackage; diff --git a/packages/base/sqlite/fpmake.pp b/packages/base/sqlite/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/base/sqlite/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/amunits/fpmake.inc b/packages/extra/amunits/fpmake.inc deleted file mode 100644 index 84efd8d346..0000000000 --- a/packages/extra/amunits/fpmake.inc +++ /dev/null @@ -1,79 +0,0 @@ - StartPackage('amunits'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/amunits/units'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='amunits/units'; - {$ENDIF} - OS:=[amiga]; - Options:='-Fi../inc'; - T:=Targets.AddUnit('amigados'); - T:=Targets.AddUnit('amigaguide'); - T:=Targets.AddUnit('amigalib'); - T:=Targets.AddUnit('amigaprinter'); - T:=Targets.AddUnit('asl'); - T:=Targets.AddUnit('audio'); - T:=Targets.AddUnit('bootblock'); - T:=Targets.AddUnit('bullet'); - T:=Targets.AddUnit('cd'); - T:=Targets.AddUnit('clipboard'); - T:=Targets.AddUnit('colorwheel'); - T:=Targets.AddUnit('commodities'); - T:=Targets.AddUnit('configregs'); - T:=Targets.AddUnit('configvars'); - T:=Targets.AddUnit('console'); - T:=Targets.AddUnit('conunit'); - T:=Targets.AddUnit('datatypes'); - T:=Targets.AddUnit('diskfont'); - T:=Targets.AddUnit('expansion'); - T:=Targets.AddUnit('expansionbase'); - T:=Targets.AddUnit('gadtools'); - T:=Targets.AddUnit('gameport'); - T:=Targets.AddUnit('gradientslider'); - T:=Targets.AddUnit('graphics'); - T:=Targets.AddUnit('hardblocks'); - T:=Targets.AddUnit('hardware'); - T:=Targets.AddUnit('icon'); - T:=Targets.AddUnit('iffparse'); - T:=Targets.AddUnit('input'); - T:=Targets.AddUnit('inputevent'); - T:=Targets.AddUnit('intuition'); - T:=Targets.AddUnit('keyboard'); - T:=Targets.AddUnit('keymap'); - T:=Targets.AddUnit('layers'); - T:=Targets.AddUnit('locale'); - T:=Targets.AddUnit('lowlevel'); - T:=Targets.AddUnit('nonvolatile'); - T:=Targets.AddUnit('parallel'); - T:=Targets.AddUnit('prefs'); - T:=Targets.AddUnit('prtbase'); - T:=Targets.AddUnit('prtgfx'); - T:=Targets.AddUnit('realtime'); - T:=Targets.AddUnit('rexx'); - T:=Targets.AddUnit('romboot_base'); - T:=Targets.AddUnit('scsidisk'); - T:=Targets.AddUnit('serial'); - T:=Targets.AddUnit('tapedeck'); - T:=Targets.AddUnit('timer'); - T:=Targets.AddUnit('trackdisk'); - T:=Targets.AddUnit('translator'); - T:=Targets.AddUnit('utility'); - T:=Targets.AddUnit('workbench'); - T:=Targets.AddUnit('exec'); - Targets.DefaultDir:='utilunits'; - T:=Targets.AddUnit('amigautils'); - T:=Targets.AddUnit('consoleio'); - T:=Targets.AddUnit('deadkeys'); - T:=Targets.AddUnit('doublebuffer'); - T:=Targets.AddUnit('easyasl'); - T:=Targets.AddUnit('hisoft'); - T:=Targets.AddUnit('linklist'); - T:=Targets.AddUnit('longarray'); - T:=Targets.AddUnit('msgbox'); - T:=Targets.AddUnit('pastoc'); - T:=Targets.AddUnit('pcq'); - T:=Targets.AddUnit('systemvartags'); - T:=Targets.AddUnit('tagsarray'); - T:=Targets.AddUnit('timerutils'); - T:=Targets.AddUnit('vartags'); - T:=Targets.AddUnit('wbargs'); - EndPackage; diff --git a/packages/extra/amunits/fpmake.pp b/packages/extra/amunits/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/amunits/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/bfd/fpmake.inc b/packages/extra/bfd/fpmake.inc deleted file mode 100644 index 5df131cdde..0000000000 --- a/packages/extra/bfd/fpmake.inc +++ /dev/null @@ -1,9 +0,0 @@ - StartPackage('bfd'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/bfd'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='bfd'; - {$ENDIF} - OS:=[linux,netbsd,freebsd,openbsd,darwin]; - T:=Targets.AddUnit('bfd'); - EndPackage; diff --git a/packages/extra/bfd/fpmake.pp b/packages/extra/bfd/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/bfd/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/bzip2/fpmake.pp b/packages/extra/bzip2/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/bzip2/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/cdrom/fpmake.inc b/packages/extra/cdrom/fpmake.inc deleted file mode 100644 index eb301620eb..0000000000 --- a/packages/extra/cdrom/fpmake.inc +++ /dev/null @@ -1,24 +0,0 @@ - StartPackage('cdrom'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/cdrom'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='cdrom'; - {$ENDIF} - OS:=[linux,win32]; - T:=Targets.AddUnit('cdrom'); - T:=Targets.AddUnit('discid'); - T:=Targets.AddUnit('scsidefs'); - T.OS:=[win32]; - T:=Targets.AddUnit('wnaspi32'); - T.OS:=[win32]; - T:=Targets.AddUnit('cdromioctl'); - T.OS:=[win32]; - T:=Targets.AddUnit('wincd'); - T.OS:=[win32]; - T:=Targets.AddUnit('major'); - T.OS:=[linux]; - T:=Targets.AddUnit('lincd'); - T.OS:=[linux]; - T:=Targets.AddExampleunit('showcds'); - T:=Targets.AddExampleunit('getdiscid'); - EndPackage; diff --git a/packages/extra/cdrom/fpmake.pp b/packages/extra/cdrom/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/cdrom/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/forms/Makefile b/packages/extra/forms/Makefile index 516a0357b4..ec4de76fd5 100644 --- a/packages/extra/forms/Makefile +++ b/packages/extra/forms/Makefile @@ -768,11 +768,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/forms/demo/Makefile b/packages/extra/forms/demo/Makefile index d0bdedcafb..6fda9620e5 100644 --- a/packages/extra/forms/demo/Makefile +++ b/packages/extra/forms/demo/Makefile @@ -544,11 +544,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/forms/fpmake.inc b/packages/extra/forms/fpmake.inc deleted file mode 100644 index 1604972f7d..0000000000 --- a/packages/extra/forms/fpmake.inc +++ /dev/null @@ -1,11 +0,0 @@ - StartPackage('forms'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/forms'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='forms'; - {$ENDIF} - OS:=[linux,netbsd,freebsd,openbsd,darwin]; - Dependencies.Add('x11'); - T:=Targets.AddUnit('xforms'); - T:=Targets.AddProgram('fd2pascal'); - EndPackage; diff --git a/packages/extra/forms/fpmake.pp b/packages/extra/forms/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/forms/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/fpgtk/Makefile b/packages/extra/fpgtk/Makefile index da8c5d8770..653411841b 100644 --- a/packages/extra/fpgtk/Makefile +++ b/packages/extra/fpgtk/Makefile @@ -657,11 +657,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/fpgtk/demo/Makefile b/packages/extra/fpgtk/demo/Makefile index 2d751145e8..4ba913125d 100644 --- a/packages/extra/fpgtk/demo/Makefile +++ b/packages/extra/fpgtk/demo/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/10] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/11] # default: all MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince diff --git a/packages/extra/fpgtk/fpmake.inc b/packages/extra/fpgtk/fpmake.inc deleted file mode 100644 index 4033d46205..0000000000 --- a/packages/extra/fpgtk/fpmake.inc +++ /dev/null @@ -1,15 +0,0 @@ - StartPackage('fpgtk'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/fpgtk'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='fpgtk'; - {$ENDIF} - OS:=[linux,netbsd,freebsd,openbsd,win32,os2,emx,darwin]; - Dependencies.Add('fcl'); - Dependencies.Add('gtk'); - T:=Targets.AddUnit('fpglib'); - T:=Targets.AddUnit('fpgtk'); - T.ResourceStrings:=True; - T:=Targets.AddUnit('fpgtkext'); - T.ResourceStrings:=True; - EndPackage; diff --git a/packages/extra/fpgtk/fpmake.pp b/packages/extra/fpgtk/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/fpgtk/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/fpmake.inc b/packages/extra/fpmake.inc deleted file mode 100644 index b223121822..0000000000 --- a/packages/extra/fpmake.inc +++ /dev/null @@ -1,109 +0,0 @@ -{ All extra packages. Each package is included in it's own dir } -{ If this file is included from the main packages dir, ALLPACKAGES is defined. } -{ If this file is included from the base packages dir, EXTRAPACKAGES is defined. } - - -{ unzip } -{$i unzip/fpmake.inc} - -{ zlib } -{$i zlib/fpmake.inc} - -{ x11 } -{$i x11/fpmake.inc} - -{ opengl } -{$i opengl/fpmake.inc} - -{ gtk } -{$i gtk/fpmake.inc} - -{ gtk2 } -{$i gtk2/fpmake.inc} - -{ syslog } -{$i syslog/fpmake.inc} - -{ forms } -{$i forms/fpmake.inc} - -{ svgalib } -{$i svgalib/fpmake.inc} - -{ ggi } -{$i ggi/fpmake.inc} - -{ libpng } -{$i libpng/fpmake.inc} - -{ libgd } -{$i libgd/fpmake.inc} - -{ utmp } -{$i utmp/fpmake.inc} - -{ bfd } -{$i bfd/fpmake.inc} - -{ gdbm } -{$i gdbm/fpmake.inc} - -{ ncurses } -{$i ncurses/fpmake.inc} - -{ tcl } -{$i tcl/fpmake.inc} - -{ cdrom } -{$i cdrom/fpmake.inc} - -{ imlib } -{$i imlib/fpmake.inc} - -{ gnome } -{$i gnome1/gnome/fpmake.inc} - -{ gconf } -{$i gnome1/gconf/fpmake.inc} - -{ zvt } -{$i gnome1/zvt/fpmake.inc} - -{ fpgtk } -{$i fpgtk/fpmake.inc} - -{ unixutil } -{$i unixutil/fpmake.inc} - -{ newt } -{$i newt/fpmake.inc} - -{ uuid } -{$i uuid/fpmake.inc} - -{ winunits } -{$i winunits/fpmake.inc} - -{ ftpapi } -{$i os2units/ftpapi/fpmake.inc} - -{ mmtk } -{$i os2units/mmtk/fpmake.inc} - -{ hwvideo } -{$i os2units/hwvideo/fpmake.inc} - -{ lvm } -{$i os2units/lvm/fpmake.inc} - -{ clkdll } -{$i os2units/clkdll/fpmake.inc} - -{ rexx } -{$i rexx/fpmake.inc} - -{ amunits } -{$i amunits/fpmake.inc} - -{ palmunits } -{$i palmunits/fpmake.inc} diff --git a/packages/extra/fpmake.pp b/packages/extra/fpmake.pp deleted file mode 100644 index 2c6fdf3253..0000000000 --- a/packages/extra/fpmake.pp +++ /dev/null @@ -1,18 +0,0 @@ -{$mode objfpc}{$H+} -{$DEFINE EXTRAPACKAGES} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/gdbm/fpmake.inc b/packages/extra/gdbm/fpmake.inc deleted file mode 100644 index 4ea02e9386..0000000000 --- a/packages/extra/gdbm/fpmake.inc +++ /dev/null @@ -1,11 +0,0 @@ - StartPackage('gdbm'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/gdbm'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='gdbm'; - {$ENDIF} - OS:=[linux,netbsd,freebsd,openbsd,darwin]; - T:=Targets.AddUnit('gdbm'); - T:=Targets.AddExampleunit('testgdbm'); - T:=Targets.AddExampleunit('testgdbm2'); - EndPackage; diff --git a/packages/extra/gdbm/fpmake.pp b/packages/extra/gdbm/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/gdbm/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/ggi/Makefile b/packages/extra/ggi/Makefile index 5dde940ce4..ce4b6757da 100644 --- a/packages/extra/ggi/Makefile +++ b/packages/extra/ggi/Makefile @@ -657,11 +657,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/ggi/fpmake.inc b/packages/extra/ggi/fpmake.inc deleted file mode 100644 index e36a1e290f..0000000000 --- a/packages/extra/ggi/fpmake.inc +++ /dev/null @@ -1,12 +0,0 @@ - StartPackage('ggi'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/ggi'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='ggi'; - {$ENDIF} - OS:=[linux,netbsd,freebsd,openbsd,darwin]; - T:=Targets.AddUnit('gii'); - T:=Targets.AddUnit('ggi'); - T:=Targets.AddUnit('ggi2d'); - T:=Targets.AddExampleunit('ggi1'); - EndPackage; diff --git a/packages/extra/ggi/fpmake.pp b/packages/extra/ggi/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/ggi/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/gnome1/fpmake.pp b/packages/extra/gnome1/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/gnome1/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/gnome1/gconf/Makefile b/packages/extra/gnome1/gconf/Makefile index 1eefe9acf1..c552b7f852 100644 --- a/packages/extra/gnome1/gconf/Makefile +++ b/packages/extra/gnome1/gconf/Makefile @@ -768,11 +768,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/gnome1/gconf/examples/Makefile b/packages/extra/gnome1/gconf/examples/Makefile index 0466a6bcd2..2f4e45bd01 100644 --- a/packages/extra/gnome1/gconf/examples/Makefile +++ b/packages/extra/gnome1/gconf/examples/Makefile @@ -655,11 +655,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/gnome1/gconf/fpmake.inc b/packages/extra/gnome1/gconf/fpmake.inc deleted file mode 100644 index ecb5f8ba58..0000000000 --- a/packages/extra/gnome1/gconf/fpmake.inc +++ /dev/null @@ -1,11 +0,0 @@ - StartPackage('gconf'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/gnome1/gconf'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='gnome1/gconf'; - {$ENDIF} - OS:=[linux,netbsd,freebsd,openbsd,darwin]; - Dependencies.Add('gtk'); - T:=Targets.AddUnit('gconf/gconf'); - T:=Targets.AddUnit('gconfclient/gconfclient'); - EndPackage; diff --git a/packages/extra/gnome1/gconf/fpmake.pp b/packages/extra/gnome1/gconf/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/gnome1/gconf/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/gnome1/gnome/Makefile b/packages/extra/gnome1/gnome/Makefile index 7420fd2af4..cb5b846b39 100644 --- a/packages/extra/gnome1/gnome/Makefile +++ b/packages/extra/gnome1/gnome/Makefile @@ -657,11 +657,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/gnome1/gnome/fpmake.inc b/packages/extra/gnome1/gnome/fpmake.inc deleted file mode 100644 index cf77409076..0000000000 --- a/packages/extra/gnome1/gnome/fpmake.inc +++ /dev/null @@ -1,15 +0,0 @@ - - StartPackage('gnome'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/gnome1/gnome'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='gnome1/gnome'; - {$ENDIF} - OS:=[linux,netbsd,freebsd,openbsd,darwin]; - Dependencies.Add('gtk'); - Dependencies.Add('imlib'); - T:=Targets.AddUnit('libart_lgpl/libart'); - T:=Targets.AddUnit('libgnome/libgnome'); - T:=Targets.AddUnit('libgnomeui/libgnomeui'); - EndPackage; - diff --git a/packages/extra/gnome1/gnome/fpmake.pp b/packages/extra/gnome1/gnome/fpmake.pp deleted file mode 100644 index 2ebb027e49..0000000000 --- a/packages/extra/gnome1/gnome/fpmake.pp +++ /dev/null @@ -1,16 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/gnome1/zvt/Makefile b/packages/extra/gnome1/zvt/Makefile index 447294d126..8a117256ac 100644 --- a/packages/extra/gnome1/zvt/Makefile +++ b/packages/extra/gnome1/zvt/Makefile @@ -768,11 +768,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/gnome1/zvt/examples/Makefile b/packages/extra/gnome1/zvt/examples/Makefile index 3759d0261e..50f34cb1d6 100644 --- a/packages/extra/gnome1/zvt/examples/Makefile +++ b/packages/extra/gnome1/zvt/examples/Makefile @@ -655,11 +655,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/gnome1/zvt/fpmake.inc b/packages/extra/gnome1/zvt/fpmake.inc deleted file mode 100644 index f7e44cfaad..0000000000 --- a/packages/extra/gnome1/zvt/fpmake.inc +++ /dev/null @@ -1,11 +0,0 @@ - StartPackage('zvt'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/gnome1/zvt'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='gnome1/zvt'; - {$ENDIF} - OS:=[linux,netbsd,freebsd,openbsd,darwin]; - Dependencies.Add('gtk'); - Dependencies.Add('imlib'); - T:=Targets.AddUnit('zvt/libzvt'); - EndPackage; diff --git a/packages/extra/gnome1/zvt/fpmake.pp b/packages/extra/gnome1/zvt/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/gnome1/zvt/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/gtk/Makefile b/packages/extra/gtk/Makefile index afe1512c80..1c3b25ce2a 100644 --- a/packages/extra/gtk/Makefile +++ b/packages/extra/gtk/Makefile @@ -879,11 +879,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/gtk/examples/Makefile b/packages/extra/gtk/examples/Makefile index a06c963eef..4bfbea904d 100644 --- a/packages/extra/gtk/examples/Makefile +++ b/packages/extra/gtk/examples/Makefile @@ -766,11 +766,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/gtk/examples/tutorial/Makefile b/packages/extra/gtk/examples/tutorial/Makefile index ed9e8e6340..e88124dc45 100644 --- a/packages/extra/gtk/examples/tutorial/Makefile +++ b/packages/extra/gtk/examples/tutorial/Makefile @@ -433,11 +433,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/gtk/fpmake.inc b/packages/extra/gtk/fpmake.inc deleted file mode 100644 index 21e2072a81..0000000000 --- a/packages/extra/gtk/fpmake.inc +++ /dev/null @@ -1,15 +0,0 @@ - StartPackage('gtk'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/gtk'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='gtk'; - {$ENDIF} - OS:=[linux,netbsd,freebsd,openbsd,win32,os2,emx,darwin]; - T:=Targets.AddUnit('glib/glib'); - T:=Targets.AddUnit('glib/gmodule'); - T:=Targets.AddUnit('gdk/gdk'); - T:=Targets.AddUnit('gtk/gtk'); - T:=Targets.AddUnit('gdk/gdkpixbuf'); - T:=Targets.AddUnit('gtkgl/gtkglarea'); - T:=Targets.AddExampleUnit('gtkgl/gtkgldemo'); - EndPackage; diff --git a/packages/extra/gtk/fpmake.pp b/packages/extra/gtk/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/gtk/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/gtk/gtkgl/Makefile b/packages/extra/gtk/gtkgl/Makefile index e638f4d699..98b264597a 100644 --- a/packages/extra/gtk/gtkgl/Makefile +++ b/packages/extra/gtk/gtkgl/Makefile @@ -657,11 +657,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/gtk2/Makefile b/packages/extra/gtk2/Makefile index 341b8afbc4..f07b915682 100644 --- a/packages/extra/gtk2/Makefile +++ b/packages/extra/gtk2/Makefile @@ -880,11 +880,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/gtk2/examples/Makefile b/packages/extra/gtk2/examples/Makefile index 16fa5a4921..63220e3bd7 100644 --- a/packages/extra/gtk2/examples/Makefile +++ b/packages/extra/gtk2/examples/Makefile @@ -544,11 +544,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/gtk2/examples/filechooser/Makefile b/packages/extra/gtk2/examples/filechooser/Makefile index 64c92c94a4..79a28813e7 100644 --- a/packages/extra/gtk2/examples/filechooser/Makefile +++ b/packages/extra/gtk2/examples/filechooser/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/10] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/11] # default: all MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince diff --git a/packages/extra/gtk2/examples/gettingstarted/Makefile b/packages/extra/gtk2/examples/gettingstarted/Makefile index 6dd5d3a36a..8ffe04f32c 100644 --- a/packages/extra/gtk2/examples/gettingstarted/Makefile +++ b/packages/extra/gtk2/examples/gettingstarted/Makefile @@ -544,11 +544,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/gtk2/examples/gtk_demo/Makefile b/packages/extra/gtk2/examples/gtk_demo/Makefile index 381cd3a8c9..1016e14455 100644 --- a/packages/extra/gtk2/examples/gtk_demo/Makefile +++ b/packages/extra/gtk2/examples/gtk_demo/Makefile @@ -544,11 +544,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/gtk2/examples/gtkglext/Makefile b/packages/extra/gtk2/examples/gtkglext/Makefile index f1d8585f16..982954cf21 100644 --- a/packages/extra/gtk2/examples/gtkglext/Makefile +++ b/packages/extra/gtk2/examples/gtkglext/Makefile @@ -544,11 +544,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/gtk2/examples/helloworld/Makefile b/packages/extra/gtk2/examples/helloworld/Makefile index 1c962ff630..39e6dbdcbe 100644 --- a/packages/extra/gtk2/examples/helloworld/Makefile +++ b/packages/extra/gtk2/examples/helloworld/Makefile @@ -544,11 +544,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/gtk2/examples/helloworld2/Makefile b/packages/extra/gtk2/examples/helloworld2/Makefile index 99c992fcb0..b201f4ded5 100644 --- a/packages/extra/gtk2/examples/helloworld2/Makefile +++ b/packages/extra/gtk2/examples/helloworld2/Makefile @@ -544,11 +544,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/gtk2/examples/plugins/Makefile b/packages/extra/gtk2/examples/plugins/Makefile index 16e0ac5eac..759ed7ca7d 100644 --- a/packages/extra/gtk2/examples/plugins/Makefile +++ b/packages/extra/gtk2/examples/plugins/Makefile @@ -544,11 +544,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/gtk2/examples/scribble_simple/Makefile b/packages/extra/gtk2/examples/scribble_simple/Makefile index 69a6ea93e1..5263565956 100644 --- a/packages/extra/gtk2/examples/scribble_simple/Makefile +++ b/packages/extra/gtk2/examples/scribble_simple/Makefile @@ -544,11 +544,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/gtk2/fpmake.inc b/packages/extra/gtk2/fpmake.inc deleted file mode 100644 index a1338b65bb..0000000000 --- a/packages/extra/gtk2/fpmake.inc +++ /dev/null @@ -1,19 +0,0 @@ - StartPackage('gtk2'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/gtk2'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='gtk2'; - {$ENDIF} - OS:=[linux,freebsd,win32]; - T:=Targets.AddUnit('buildgtk2'); - T.Install:=False; - T:=Targets.AddUnit('glib/glib2'); - T:=Targets.AddUnit('atk/atk'); - T:=Targets.AddUnit('pango/pango'); - T:=Targets.AddUnit('gtk+/gdk-pixbuf/gdk2pixbuf'); - T:=Targets.AddUnit('gtk+/gdk/gdk2'); - T:=Targets.AddUnit('gtk+/gtk/gtk2'); - T:=Targets.AddUnit('libglade/libglade2'); - T:=Targets.AddUnit('gtkglext/gtkglext'); - T:=Targets.AddUnit('gtkglext/gdkglext'); - EndPackage; diff --git a/packages/extra/gtk2/fpmake.pp b/packages/extra/gtk2/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/gtk2/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/imlib/Makefile b/packages/extra/imlib/Makefile index 11e10502ba..25650c9e56 100644 --- a/packages/extra/imlib/Makefile +++ b/packages/extra/imlib/Makefile @@ -658,11 +658,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/imlib/fpmake.inc b/packages/extra/imlib/fpmake.inc deleted file mode 100644 index 1a3c09d8ae..0000000000 --- a/packages/extra/imlib/fpmake.inc +++ /dev/null @@ -1,14 +0,0 @@ - StartPackage('imlib'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/imlib'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='imlib'; - {$ENDIF} - OS:=[linux,netbsd,freebsd,openbsd,os2,emx,darwin]; - Dependencies.Add('gtk'); - Dependencies.Add('x11'); - T:=Targets.AddUnit('gdk_imlib'); - T.Directory:='gdk_imlib'; - T:=Targets.AddUnit('imlib'); - T.Directory:='imlib'; - EndPackage; diff --git a/packages/extra/imlib/fpmake.pp b/packages/extra/imlib/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/imlib/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/libgd/Makefile b/packages/extra/libgd/Makefile index 069d6a168a..3ea26463f5 100644 --- a/packages/extra/libgd/Makefile +++ b/packages/extra/libgd/Makefile @@ -657,11 +657,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/libgd/fpmake.inc b/packages/extra/libgd/fpmake.inc deleted file mode 100644 index 7f51e7277f..0000000000 --- a/packages/extra/libgd/fpmake.inc +++ /dev/null @@ -1,10 +0,0 @@ - StartPackage('libgd'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/libgd'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='libgd'; - {$ENDIF} - OS:=[linux,netbsd,freebsd,openbsd,darwin]; - T:=Targets.AddUnit('gd'); - T:=Targets.AddExampleunit('gdtest'); - EndPackage; diff --git a/packages/extra/libgd/fpmake.pp b/packages/extra/libgd/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/libgd/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/libpng/Makefile b/packages/extra/libpng/Makefile index 6b5fc17ed2..53500379e3 100644 --- a/packages/extra/libpng/Makefile +++ b/packages/extra/libpng/Makefile @@ -546,11 +546,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/libpng/fpmake.inc b/packages/extra/libpng/fpmake.inc deleted file mode 100644 index d829fe0c61..0000000000 --- a/packages/extra/libpng/fpmake.inc +++ /dev/null @@ -1,10 +0,0 @@ - StartPackage('libpng'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/libpng'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='libpng'; - {$ENDIF} - OS:=[linux,netbsd,freebsd,openbsd,os2,emx,darwin]; - Dependencies.Add('zlib'); - T:=Targets.AddUnit('png'); - EndPackage; diff --git a/packages/extra/libpng/fpmake.pp b/packages/extra/libpng/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/libpng/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/ncurses/Makefile b/packages/extra/ncurses/Makefile index 653343ab28..0893a38f24 100644 --- a/packages/extra/ncurses/Makefile +++ b/packages/extra/ncurses/Makefile @@ -657,11 +657,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/ncurses/fpmake.inc b/packages/extra/ncurses/fpmake.inc deleted file mode 100644 index 98027d2645..0000000000 --- a/packages/extra/ncurses/fpmake.inc +++ /dev/null @@ -1,19 +0,0 @@ - StartPackage('ncurses'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/ncurses'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='ncurses'; - {$ENDIF} - OS:=[linux,netbsd,freebsd,openbsd,darwin]; - T:=Targets.AddUnit('ncurses'); - T:=Targets.AddUnit('panel'); - T:=Targets.AddUnit('ncrt'); - T:=Targets.AddUnit('ocrt'); - T:=Targets.AddUnit('menu'); - T:=Targets.AddExampleunit('firework'); - T:=Targets.AddExampleunit('testn'); - T:=Targets.AddExampleunit('ocrt_demo'); - T:=Targets.AddExampleunit('edit_demo'); - T:=Targets.AddExampleunit('db_demo'); - T:=Targets.AddExampleunit('screen_demo'); - EndPackage; diff --git a/packages/extra/ncurses/fpmake.pp b/packages/extra/ncurses/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/ncurses/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/newt/Makefile b/packages/extra/newt/Makefile index e0740400ea..fbdb768d75 100644 --- a/packages/extra/newt/Makefile +++ b/packages/extra/newt/Makefile @@ -657,11 +657,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/newt/fpmake.inc b/packages/extra/newt/fpmake.inc deleted file mode 100644 index 9d2e5082a3..0000000000 --- a/packages/extra/newt/fpmake.inc +++ /dev/null @@ -1,12 +0,0 @@ - StartPackage('newt'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/newt'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='newt'; - {$ENDIF} - OS:=[linux]; - T:=Targets.AddUnit('newt'); - T:=Targets.AddExampleunit('newt1'); - T:=Targets.AddExampleunit('newt2'); - T:=Targets.AddExampleunit('newt3'); - EndPackage; diff --git a/packages/extra/newt/fpmake.pp b/packages/extra/newt/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/newt/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/numlib/Makefile b/packages/extra/numlib/Makefile index 9d31965921..7918a9f3e5 100644 --- a/packages/extra/numlib/Makefile +++ b/packages/extra/numlib/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/10] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/11] # default: all MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince diff --git a/packages/extra/numlib/fpmake.pp b/packages/extra/numlib/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/numlib/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/opengl/Makefile b/packages/extra/opengl/Makefile index 071ccac619..ac0b3a12f3 100644 --- a/packages/extra/opengl/Makefile +++ b/packages/extra/opengl/Makefile @@ -657,11 +657,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/opengl/examples/Makefile b/packages/extra/opengl/examples/Makefile index 5c7905f694..901e67eca2 100644 --- a/packages/extra/opengl/examples/Makefile +++ b/packages/extra/opengl/examples/Makefile @@ -655,11 +655,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/opengl/fpmake.inc b/packages/extra/opengl/fpmake.inc deleted file mode 100644 index b223954846..0000000000 --- a/packages/extra/opengl/fpmake.inc +++ /dev/null @@ -1,17 +0,0 @@ - StartPackage('opengl'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/opengl'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='opengl'; - {$ENDIF} - OS:=[linux,netbsd,freebsd,openbsd,win32,darwin]; - Dependencies.Add('x11'); - T:=Targets.AddUnit('gl'); - T:=Targets.AddUnit('glu'); - T:=Targets.AddUnit('glut'); - T:=Targets.AddUnit('glext'); - T:=Targets.AddUnit('dllfuncs'); - T.OS:=[linux,freebsd,netbsd,openbsd,darwin]; - T:=Targets.AddUnit('glx'); - T.OS:=[linux,freebsd,netbsd,openbsd,darwin]; - EndPackage; diff --git a/packages/extra/opengl/fpmake.pp b/packages/extra/opengl/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/opengl/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/os2units/clkdll/fpmake.inc b/packages/extra/os2units/clkdll/fpmake.inc deleted file mode 100644 index 25f1682cda..0000000000 --- a/packages/extra/os2units/clkdll/fpmake.inc +++ /dev/null @@ -1,10 +0,0 @@ - StartPackage('clkdll'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/os2units/clkdll'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='os2units/clkdll'; - {$ENDIF} - OS:=[os2,emx]; - T:=Targets.AddUnit('clkdll'); - T:=Targets.AddExampleunit('clktest'); - EndPackage; diff --git a/packages/extra/os2units/fpmake.pp b/packages/extra/os2units/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/os2units/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/os2units/ftpapi/fpmake.inc b/packages/extra/os2units/ftpapi/fpmake.inc deleted file mode 100644 index e545f89c67..0000000000 --- a/packages/extra/os2units/ftpapi/fpmake.inc +++ /dev/null @@ -1,10 +0,0 @@ - StartPackage('ftpapi'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/os2units/ftpapi'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='os2units/ftpapi'; - {$ENDIF} - OS:=[os2,emx]; - T:=Targets.AddUnit('ftpapi'); - T:=Targets.AddExampleunit('ftptest'); - EndPackage; diff --git a/packages/extra/os2units/hwvideo/fpmake.inc b/packages/extra/os2units/hwvideo/fpmake.inc deleted file mode 100644 index 5669fc7aa7..0000000000 --- a/packages/extra/os2units/hwvideo/fpmake.inc +++ /dev/null @@ -1,9 +0,0 @@ - StartPackage('hwvideo'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/os2units/hwvideo'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='os2units/hwvideo'; - {$ENDIF} - OS:=[os2,emx]; - T:=Targets.AddUnit('hwvideo'); - EndPackage; diff --git a/packages/extra/os2units/lvm/fpmake.inc b/packages/extra/os2units/lvm/fpmake.inc deleted file mode 100644 index 0c932b7ef2..0000000000 --- a/packages/extra/os2units/lvm/fpmake.inc +++ /dev/null @@ -1,9 +0,0 @@ - StartPackage('lvm'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/os2units/lvm'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='os2units/lvm'; - {$ENDIF} - OS:=[os2,emx]; - T:=Targets.AddUnit('lvm'); - EndPackage; diff --git a/packages/extra/os2units/mmtk/fpmake.inc b/packages/extra/os2units/mmtk/fpmake.inc deleted file mode 100644 index c08b81ce0a..0000000000 --- a/packages/extra/os2units/mmtk/fpmake.inc +++ /dev/null @@ -1,15 +0,0 @@ - StartPackage('mmtk'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/os2units/mmtk'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='os2units/mmtk'; - {$ENDIF} - OS:=[os2,emx]; - T:=Targets.AddUnit('mmbase'); - T:=Targets.AddUnit('sw'); - T:=Targets.AddUnit('dive'); - T:=Targets.AddUnit('mci'); - T:=Targets.AddUnit('mciapi'); - T:=Targets.AddUnit('mcidrv'); - T:=Targets.AddUnit('mmio'); - EndPackage; diff --git a/packages/extra/os2units/som/som.pas b/packages/extra/os2units/som/som.pas index e9db651961..7ea586acea 100644 --- a/packages/extra/os2units/som/som.pas +++ b/packages/extra/os2units/som/som.pas @@ -1520,4 +1520,3 @@ End. ³ 00135 ³ somIdMarshal // not found ³ 00361 ³ somMakeUserRdStub // Not found *) - diff --git a/packages/extra/palmunits/fpmake.inc b/packages/extra/palmunits/fpmake.inc deleted file mode 100644 index 67a9cd1519..0000000000 --- a/packages/extra/palmunits/fpmake.inc +++ /dev/null @@ -1,110 +0,0 @@ - StartPackage('palmunits'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/palmunits'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='palmunits'; - {$ENDIF} - OS:=[palmos]; - T:=Targets.AddUnit('aboutbox'); - T:=Targets.AddUnit('alarmmgr'); - T:=Targets.AddUnit('applaunchcmd'); - T:=Targets.AddUnit('attentionmgr'); - T:=Targets.AddUnit('bitmap'); - T:=Targets.AddUnit('category'); - T:=Targets.AddUnit('chars'); - T:=Targets.AddUnit('clipboard'); - T:=Targets.AddUnit('connectionmgr'); - T:=Targets.AddUnit('consolemgr'); - T:=Targets.AddUnit('control'); - T:=Targets.AddUnit('coretraps'); - T:=Targets.AddUnit('crc'); - T:=Targets.AddUnit('datamgr'); - T:=Targets.AddUnit('datetime'); - T:=Targets.AddUnit('day'); - T:=Targets.AddUnit('dlserver'); - T:=Targets.AddUnit('encrypt'); - T:=Targets.AddUnit('errorbase'); - T:=Targets.AddUnit('event_'); - T:=Targets.AddUnit('exglib'); - T:=Targets.AddUnit('exgmgr'); - T:=Targets.AddUnit('expansionmgr'); - T:=Targets.AddUnit('fatalalert'); - T:=Targets.AddUnit('featuremgr'); - T:=Targets.AddUnit('field'); - T:=Targets.AddUnit('filestream'); - T:=Targets.AddUnit('find_'); - T:=Targets.AddUnit('floatmgr'); - T:=Targets.AddUnit('font'); - T:=Targets.AddUnit('fontselect_'); - T:=Targets.AddUnit('form'); - T:=Targets.AddUnit('fslib'); - T:=Targets.AddUnit('graffiti'); - T:=Targets.AddUnit('graffitireference'); - T:=Targets.AddUnit('graffitishift'); - T:=Targets.AddUnit('hal'); - T:=Targets.AddUnit('helper'); - T:=Targets.AddUnit('helperserviceclass'); - T:=Targets.AddUnit('hwrmiscflags'); - T:=Targets.AddUnit('imcutils'); - T:=Targets.AddUnit('inetmgr'); - T:=Targets.AddUnit('inspoint'); - T:=Targets.AddUnit('intlmgr'); - T:=Targets.AddUnit('irlib'); - T:=Targets.AddUnit('keyboard'); - T:=Targets.AddUnit('keymgr'); - T:=Targets.AddUnit('launcher'); - T:=Targets.AddUnit('libtraps'); - T:=Targets.AddUnit('list'); - T:=Targets.AddUnit('localemgr'); - T:=Targets.AddUnit('localize'); - T:=Targets.AddUnit('lz77mgr'); - T:=Targets.AddUnit('m68khwr'); - T:=Targets.AddUnit('memorymgr'); - T:=Targets.AddUnit('menu_'); - T:=Targets.AddUnit('modemmgr'); - T:=Targets.AddUnit('netbitutils'); - T:=Targets.AddUnit('netmgr'); - T:=Targets.AddUnit('notifymgr'); - T:=Targets.AddUnit('overlaymgr'); - T:=Targets.AddUnit('palmcompatibility'); - T:=Targets.AddUnit('palmlocale'); - T:=Targets.AddUnit('palmos'); - T:=Targets.AddUnit('password'); - T:=Targets.AddUnit('pdiconst'); - T:=Targets.AddUnit('pdilib'); - T:=Targets.AddUnit('penmgr'); - T:=Targets.AddUnit('phonelookup'); - T:=Targets.AddUnit('preferences'); - T:=Targets.AddUnit('privaterecords'); - T:=Targets.AddUnit('progress'); - T:=Targets.AddUnit('rect'); - T:=Targets.AddUnit('scrollbar'); - T:=Targets.AddUnit('selday'); - T:=Targets.AddUnit('seltime'); - T:=Targets.AddUnit('seltimezone'); - T:=Targets.AddUnit('seriallinkmgr'); - T:=Targets.AddUnit('serialmgr'); - T:=Targets.AddUnit('serialmgrold'); - T:=Targets.AddUnit('slotdrvrlib'); - T:=Targets.AddUnit('smslib'); - T:=Targets.AddUnit('soundmgr'); - T:=Targets.AddUnit('stringmgr'); - T:=Targets.AddUnit('sysevent'); - T:=Targets.AddUnit('sysevtmgr'); - T:=Targets.AddUnit('systemmgr'); - T:=Targets.AddUnit('systemresources'); - T:=Targets.AddUnit('sysutil'); - T:=Targets.AddUnit('table'); - T:=Targets.AddUnit('telephonymgr'); - T:=Targets.AddUnit('telephonymgrtypes'); - T:=Targets.AddUnit('telephonymgrui'); - T:=Targets.AddUnit('textmgr'); - T:=Targets.AddUnit('textservicesmgr'); - T:=Targets.AddUnit('timemgr'); - T:=Targets.AddUnit('udamgr'); - T:=Targets.AddUnit('uicolor'); - T:=Targets.AddUnit('uicontrols'); - T:=Targets.AddUnit('uiresources'); - T:=Targets.AddUnit('vfsmgr'); - T:=Targets.AddUnit('window'); - EndPackage; diff --git a/packages/extra/palmunits/fpmake.pp b/packages/extra/palmunits/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/palmunits/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/rexx/fpmake.inc b/packages/extra/rexx/fpmake.inc deleted file mode 100644 index 2720966430..0000000000 --- a/packages/extra/rexx/fpmake.inc +++ /dev/null @@ -1,9 +0,0 @@ - StartPackage('rexx'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/rexx'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='rexx'; - {$ENDIF} - OS:=[os2,emx]; - T:=Targets.AddUnit('rexxsaa'); - EndPackage; diff --git a/packages/extra/rexx/fpmake.pp b/packages/extra/rexx/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/rexx/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/sndfile/Makefile b/packages/extra/sndfile/Makefile index 078b10949b..5e6d7589df 100644 --- a/packages/extra/sndfile/Makefile +++ b/packages/extra/sndfile/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/10] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/11] # default: all MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince diff --git a/packages/extra/sndfile/fpmake.pp b/packages/extra/sndfile/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/sndfile/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/svgalib/Makefile b/packages/extra/svgalib/Makefile index 05c1d1afd7..ccc90cbda4 100644 --- a/packages/extra/svgalib/Makefile +++ b/packages/extra/svgalib/Makefile @@ -657,11 +657,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/svgalib/fpmake.inc b/packages/extra/svgalib/fpmake.inc deleted file mode 100644 index 66f1619809..0000000000 --- a/packages/extra/svgalib/fpmake.inc +++ /dev/null @@ -1,12 +0,0 @@ - StartPackage('svgalib'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/svgalib'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='svgalib'; - {$ENDIF} - OS:=[linux,netbsd,freebsd,openbsd,darwin]; - T:=Targets.AddUnit('svgalib'); - T:=Targets.AddUnit('vgamouse'); - T:=Targets.AddExampleunit('testvga'); - T:=Targets.AddExampleunit('vgatest'); - EndPackage; diff --git a/packages/extra/svgalib/fpmake.pp b/packages/extra/svgalib/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/svgalib/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/syslog/Makefile b/packages/extra/syslog/Makefile index a0df8a2d90..613164cabb 100644 --- a/packages/extra/syslog/Makefile +++ b/packages/extra/syslog/Makefile @@ -657,11 +657,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/syslog/fpmake.inc b/packages/extra/syslog/fpmake.inc deleted file mode 100644 index 45b9f9488e..0000000000 --- a/packages/extra/syslog/fpmake.inc +++ /dev/null @@ -1,10 +0,0 @@ - StartPackage('syslog'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/syslog'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='syslog'; - {$ENDIF} - OS:=[linux,netbsd,freebsd,openbsd,darwin]; - T:=Targets.AddUnit('systemlog'); - T:=Targets.AddExampleunit('testlog'); - EndPackage; diff --git a/packages/extra/syslog/fpmake.pp b/packages/extra/syslog/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/syslog/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/tcl/Makefile b/packages/extra/tcl/Makefile index bc2451dba4..6ed4ca8208 100644 --- a/packages/extra/tcl/Makefile +++ b/packages/extra/tcl/Makefile @@ -657,11 +657,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/tcl/fpmake.inc b/packages/extra/tcl/fpmake.inc deleted file mode 100644 index 72f69dde79..0000000000 --- a/packages/extra/tcl/fpmake.inc +++ /dev/null @@ -1,11 +0,0 @@ - StartPackage('tcl'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/tcl'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='tcl'; - {$ENDIF} - OS:=[linux,netbsd,freebsd,openbsd,win32,os2,emx,darwin]; - Dependencies.Add('fcl'); - T:=Targets.AddUnit('tcl80'); - T:=Targets.AddExampleunit('tcl_demo'); - EndPackage; diff --git a/packages/extra/tcl/fpmake.pp b/packages/extra/tcl/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/tcl/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/unixutil/Makefile b/packages/extra/unixutil/Makefile index ea56ea545b..09f59c939c 100644 --- a/packages/extra/unixutil/Makefile +++ b/packages/extra/unixutil/Makefile @@ -657,11 +657,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/unixutil/fpmake.inc b/packages/extra/unixutil/fpmake.inc deleted file mode 100644 index 4ce1927d92..0000000000 --- a/packages/extra/unixutil/fpmake.inc +++ /dev/null @@ -1,12 +0,0 @@ - StartPackage('unixutil'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/unixutil'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='unixutil'; - {$ENDIF} - OS:=[linux]; - Dependencies.Add('libc'); - Dependencies.Add('fcl'); - T:=Targets.AddUnit('unixutils'); - T.ResourceStrings:=True; - EndPackage; diff --git a/packages/extra/unixutil/fpmake.pp b/packages/extra/unixutil/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/unixutil/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/unzip/fpmake.inc b/packages/extra/unzip/fpmake.inc deleted file mode 100644 index cfea0703aa..0000000000 --- a/packages/extra/unzip/fpmake.inc +++ /dev/null @@ -1,12 +0,0 @@ - StartPackage('unzip'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/unzip'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='unzip'; - {$ENDIF} - OS:=[linux,netbsd,freebsd,openbsd,win32,os2,emx,go32v2,netware,netwlibc,darwin]; - T:=Targets.AddUnit('ziptypes'); - T:=Targets.AddUnit('unzip'); - T:=Targets.AddUnit('unzipdll'); - T.OS:=[emx,os2]; - EndPackage; diff --git a/packages/extra/unzip/fpmake.pp b/packages/extra/unzip/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/unzip/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/users/fpmake.pp b/packages/extra/users/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/users/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/utmp/fpmake.inc b/packages/extra/utmp/fpmake.inc deleted file mode 100644 index 62a86b15da..0000000000 --- a/packages/extra/utmp/fpmake.inc +++ /dev/null @@ -1,10 +0,0 @@ - StartPackage('utmp'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/utmp'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='utmp'; - {$ENDIF} - OS:=[linux,netbsd,freebsd,openbsd,darwin]; - T:=Targets.AddUnit('utmp'); - T:=Targets.AddExampleunit('testutmp'); - EndPackage; diff --git a/packages/extra/utmp/fpmake.pp b/packages/extra/utmp/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/utmp/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/uuid/README b/packages/extra/uuid/README index 1e2cf4cf72..b9253a2f61 100644 --- a/packages/extra/uuid/README +++ b/packages/extra/uuid/README @@ -16,4 +16,4 @@ The test programs show the usage, tested on SuSE 9.2. Enjoy, -Michael. +Michael.
\ No newline at end of file diff --git a/packages/extra/uuid/fpmake.inc b/packages/extra/uuid/fpmake.inc deleted file mode 100644 index 44a48949ee..0000000000 --- a/packages/extra/uuid/fpmake.inc +++ /dev/null @@ -1,12 +0,0 @@ - StartPackage('uuid'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/uuid'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='uuid'; - {$ENDIF} - OS:=[linux]; - T:=Targets.AddUnit('uuid'); - T:=Targets.AddUnit('libuuid'); - T:=Targets.AddExampleunit('testuid'); - T:=Targets.AddExampleunit('testlibuid'); - EndPackage; diff --git a/packages/extra/uuid/fpmake.pp b/packages/extra/uuid/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/uuid/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/uuid/libuuid.pp b/packages/extra/uuid/libuuid.pp index ac3297a7ca..fc7c62a1f9 100644 --- a/packages/extra/uuid/libuuid.pp +++ b/packages/extra/uuid/libuuid.pp @@ -57,4 +57,4 @@ initialization Finalization if (Handle<>NilHandle) then UnLoadLibrary(Handle) -end. +end.
\ No newline at end of file diff --git a/packages/extra/uuid/testlibuid.pp b/packages/extra/uuid/testlibuid.pp index 58d3566b52..9bf46d240e 100644 --- a/packages/extra/uuid/testlibuid.pp +++ b/packages/extra/uuid/testlibuid.pp @@ -11,4 +11,4 @@ begin // GetURandomBytes(T,SizeOf(T)); CreateGUID(T); Writeln(GUIDToString(T)); -end. +end.
\ No newline at end of file diff --git a/packages/extra/uuid/testuid.pp b/packages/extra/uuid/testuid.pp index 6ff2729815..7be86b504c 100644 --- a/packages/extra/uuid/testuid.pp +++ b/packages/extra/uuid/testuid.pp @@ -11,4 +11,4 @@ begin // GetURandomBytes(T,SizeOf(T)); CreateGUID(T); Writeln(GUIDToString(T)); -end. +end.
\ No newline at end of file diff --git a/packages/extra/uuid/uuid.pp b/packages/extra/uuid/uuid.pp index 50cf045183..8979bce31f 100644 --- a/packages/extra/uuid/uuid.pp +++ b/packages/extra/uuid/uuid.pp @@ -254,4 +254,4 @@ end; initialization OnCreateGUID:=@CreateMacGUID; -end. +end.
\ No newline at end of file diff --git a/packages/extra/winunits/fpmake.inc b/packages/extra/winunits/fpmake.inc deleted file mode 100644 index f690a12549..0000000000 --- a/packages/extra/winunits/fpmake.inc +++ /dev/null @@ -1,234 +0,0 @@ - StartPackage('winunits'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/winunits'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='winunits'; - {$ENDIF} - OS:=[win32]; - T:=Targets.AddUnit('buildjwa'); - T.Install:=False; - T:=Targets.AddUnit('winver'); - T:=Targets.AddUnit('mmsystem'); - T:=Targets.AddUnit('comobj'); - T:=Targets.AddUnit('ole2'); - T:=Targets.AddUnit('activex'); - T:=Targets.AddUnit('shellapi'); - T:=Targets.AddUnit('shlobj'); - T:=Targets.AddUnit('jwawintype'); - T.ResourceStrings:=True; - T:=Targets.AddUnit('jwawinbase'); - T:=Targets.AddUnit('jwawinnt'); - T:=Targets.AddUnit('jwalmerr'); - T:=Targets.AddUnit('jwalmmsg'); - T:=Targets.AddUnit('jwaaclui'); - T:=Targets.AddUnit('jwaadsdb'); - T:=Targets.AddUnit('jwalmerrlog'); - T:=Targets.AddUnit('jwalmjoin'); - T:=Targets.AddUnit('jwaauthz'); - T:=Targets.AddUnit('jwabits'); - T:=Targets.AddUnit('jwalmremutl'); - T:=Targets.AddUnit('jwalmrepl'); - T:=Targets.AddUnit('jwalmserver'); - T:=Targets.AddUnit('jwalmshare'); - T:=Targets.AddUnit('jwalmsname'); - T:=Targets.AddUnit('jwalmstats'); - T:=Targets.AddUnit('jwaaccctrl'); - T:=Targets.AddUnit('jwaaclapi'); - T:=Targets.AddUnit('jwacderr'); - T:=Targets.AddUnit('jwacpl'); - T:=Targets.AddUnit('jwaactiveds'); - T:=Targets.AddUnit('jwadbt'); - T:=Targets.AddUnit('jwadde'); - T:=Targets.AddUnit('jwaadserr'); - T:=Targets.AddUnit('jwaadshlp'); - T:=Targets.AddUnit('jwaadsnms'); - T:=Targets.AddUnit('jwaadsprop'); - T:=Targets.AddUnit('jwaadssts'); - T:=Targets.AddUnit('jwaadtgen'); - T:=Targets.AddUnit('jwaaf_irda'); - T:=Targets.AddUnit('jwaatalkwsh'); - T:=Targets.AddUnit('jwaauthif'); - T:=Targets.AddUnit('jwadlgs'); - T:=Targets.AddUnit('jwadssec'); - T:=Targets.AddUnit('jwabatclass'); - T:=Targets.AddUnit('jwaexcpt'); - T:=Targets.AddUnit('jwaime'); - T:=Targets.AddUnit('jwabits1_5'); - T:=Targets.AddUnit('jwabitscfg'); - T:=Targets.AddUnit('jwabitsmsg'); - T:=Targets.AddUnit('jwablberr'); - T:=Targets.AddUnit('jwabluetoothapis'); - T:=Targets.AddUnit('jwabthdef'); - T:=Targets.AddUnit('jwabthsdpdef'); - T:=Targets.AddUnit('jwabugcodes'); - T:=Targets.AddUnit('jwalmat'); - T:=Targets.AddUnit('jwalmsvc'); - T:=Targets.AddUnit('jwacmnquery'); - T:=Targets.AddUnit('jwacolordlg'); - T:=Targets.AddUnit('jwalmuse'); - T:=Targets.AddUnit('jwamsi'); - T:=Targets.AddUnit('jwacplext'); - T:=Targets.AddUnit('jwacryptuiapi'); - T:=Targets.AddUnit('jwanb30'); - T:=Targets.AddUnit('jwanetsh'); - T:=Targets.AddUnit('jwapbt'); - T:=Targets.AddUnit('jwapdh'); - T:=Targets.AddUnit('jwadhcpcsdk'); - T:=Targets.AddUnit('jwadhcpsapi'); - T:=Targets.AddUnit('jwadhcpssdk'); - T:=Targets.AddUnit('jwaprsht'); - T:=Targets.AddUnit('jwapsapi'); - T:=Targets.AddUnit('jwadsadmin'); - T:=Targets.AddUnit('jwadsclient'); - T:=Targets.AddUnit('jwadsgetdc'); - T:=Targets.AddUnit('jwadskquota'); - T:=Targets.AddUnit('jwadsquery'); - T:=Targets.AddUnit('jwadsrole'); - T:=Targets.AddUnit('jwaqos'); - T:=Targets.AddUnit('jwaqossp'); - T:=Targets.AddUnit('jwaerrorrep'); - T:=Targets.AddUnit('jwarpc'); - T:=Targets.AddUnit('jwasddl'); - T:=Targets.AddUnit('jwafaxdev'); - T:=Targets.AddUnit('jwafaxext'); - T:=Targets.AddUnit('jwafaxmmc'); - T:=Targets.AddUnit('jwafaxroute'); - T:=Targets.AddUnit('jwagpedit'); - T:=Targets.AddUnit('jwahherror'); - T:=Targets.AddUnit('jwahtmlGuid'); - T:=Targets.AddUnit('jwahtmlhelp'); - T:=Targets.AddUnit('jwaiaccess'); - T:=Targets.AddUnit('jwaiadmext'); - T:=Targets.AddUnit('jwaicmpapi'); - T:=Targets.AddUnit('jwaiiscnfg'); - T:=Targets.AddUnit('jwaimagehlp'); - T:=Targets.AddUnit('jwalmdfs'); - T:=Targets.AddUnit('jwaimapierror'); - T:=Targets.AddUnit('jwasens'); - T:=Targets.AddUnit('jwasfc'); - T:=Targets.AddUnit('jwaioevent'); - T:=Targets.AddUnit('jwaipexport'); - T:=Targets.AddUnit('jwaiphlpapi'); - T:=Targets.AddUnit('jwaipifcons'); - T:=Targets.AddUnit('jwaipinfoid'); - T:=Targets.AddUnit('jwaiprtrmib'); - T:=Targets.AddUnit('jwaiptypes'); - T:=Targets.AddUnit('jwaisguids'); - T:=Targets.AddUnit('jwaissper16'); - T:=Targets.AddUnit('jwalmaccess'); - T:=Targets.AddUnit('jwalmalert'); - T:=Targets.AddUnit('jwalmapibuf'); - T:=Targets.AddUnit('jwasnmp'); - T:=Targets.AddUnit('jwasspi'); - T:=Targets.AddUnit('jwalmaudit'); - T:=Targets.AddUnit('jwalmconfig'); - T:=Targets.AddUnit('jwalmcons'); - T:=Targets.AddUnit('jwawpapi'); - T:=Targets.AddUnit('jwawsipx'); - T:=Targets.AddUnit('jwawsrm'); - T:=Targets.AddUnit('jwalmuseflg'); - T:=Targets.AddUnit('jwalmwksta'); - T:=Targets.AddUnit('jwaloadperf'); - T:=Targets.AddUnit('jwalpmapi'); - T:=Targets.AddUnit('jwamciavi'); - T:=Targets.AddUnit('jwamprerror'); - T:=Targets.AddUnit('jwawsvns'); - T:=Targets.AddUnit('jwaimapi'); - T:=Targets.AddUnit('jwamsidefs'); - T:=Targets.AddUnit('jwamsiquery'); - T:=Targets.AddUnit('jwamstask'); - T:=Targets.AddUnit('jwamstcpip'); - T:=Targets.AddUnit('jwamswsock'); - T:=Targets.AddUnit('jwanspapi'); - T:=Targets.AddUnit('jwantddpar'); - T:=Targets.AddUnit('jwantdsapi'); - T:=Targets.AddUnit('jwantdsbcli'); - T:=Targets.AddUnit('jwantdsbmsg'); - T:=Targets.AddUnit('jwantldap'); - T:=Targets.AddUnit('jwantquery'); - T:=Targets.AddUnit('jwantsecapi'); - T:=Targets.AddUnit('jwantstatus'); - T:=Targets.AddUnit('jwaObjsel'); - T:=Targets.AddUnit('jwapatchapi'); - T:=Targets.AddUnit('jwapatchwiz'); - T:=Targets.AddUnit('jwapdhmsg'); - T:=Targets.AddUnit('jwapowrprof'); - T:=Targets.AddUnit('jwaprofinfo'); - T:=Targets.AddUnit('jwaprotocol'); - T:=Targets.AddUnit('jwaqosname'); - T:=Targets.AddUnit('jwaqospol'); - T:=Targets.AddUnit('jwareason'); - T:=Targets.AddUnit('jwaregstr'); - T:=Targets.AddUnit('jwarpcasync'); - T:=Targets.AddUnit('jwarpcdce'); - T:=Targets.AddUnit('jwarpcnsi'); - T:=Targets.AddUnit('jwarpcnterr'); - T:=Targets.AddUnit('jwarpcssl'); - T:=Targets.AddUnit('jwascesvc'); - T:=Targets.AddUnit('jwaschedule'); - T:=Targets.AddUnit('jwaschemadef'); - T:=Targets.AddUnit('jwasecext'); - T:=Targets.AddUnit('jwasecurity'); - T:=Targets.AddUnit('jwasensapi'); - T:=Targets.AddUnit('jwashlguid'); - T:=Targets.AddUnit('jwasisbkup'); - T:=Targets.AddUnit('jwasporder'); - T:=Targets.AddUnit('jwasrrestoreptapi'); - T:=Targets.AddUnit('jwasubauth'); - T:=Targets.AddUnit('jwasvcguid'); - T:=Targets.AddUnit('jwatlhelp32'); - T:=Targets.AddUnit('jwatmschema'); - T:=Targets.AddUnit('jwatraffic'); - T:=Targets.AddUnit('jwauserenv'); - T:=Targets.AddUnit('jwauxtheme'); - T:=Targets.AddUnit('jwawbemcli'); - T:=Targets.AddUnit('jwawinable'); - T:=Targets.AddUnit('jwawinber'); - T:=Targets.AddUnit('jwawincon'); - T:=Targets.AddUnit('jwawincpl'); - T:=Targets.AddUnit('jwawincred'); - T:=Targets.AddUnit('jwawincrypt'); - T:=Targets.AddUnit('jwawindns'); - T:=Targets.AddUnit('jwawinefs'); - T:=Targets.AddUnit('jwawinerror'); - T:=Targets.AddUnit('jwawinfax'); - T:=Targets.AddUnit('jwawingdi'); - T:=Targets.AddUnit('jwawinioctl'); - T:=Targets.AddUnit('jwawinldap'); - T:=Targets.AddUnit('jwawinnetwk'); - T:=Targets.AddUnit('jwawinnls'); - T:=Targets.AddUnit('jwawinperf'); - T:=Targets.AddUnit('jwawinreg'); - T:=Targets.AddUnit('jwawinresrc'); - T:=Targets.AddUnit('jwawinsafer'); - T:=Targets.AddUnit('jwawinsock'); - T:=Targets.AddUnit('jwawinsock2'); - T:=Targets.AddUnit('jwawinsvc'); - T:=Targets.AddUnit('jwawinuser'); - T:=Targets.AddUnit('jwawinver'); - T:=Targets.AddUnit('jwawinwlx'); - T:=Targets.AddUnit('jwawmistr'); - T:=Targets.AddUnit('jwawownt16'); - T:=Targets.AddUnit('jwawownt32'); - T:=Targets.AddUnit('jwawpapimsg'); - T:=Targets.AddUnit('jwawpcrsmsg'); - T:=Targets.AddUnit('jwawpftpmsg'); - T:=Targets.AddUnit('jwawppstmsg'); - T:=Targets.AddUnit('jwawpspihlp'); - T:=Targets.AddUnit('jwawptypes'); - T:=Targets.AddUnit('jwawpwizmsg'); - T:=Targets.AddUnit('jwaws2atm'); - T:=Targets.AddUnit('jwaws2bth'); - T:=Targets.AddUnit('jwaws2dnet'); - T:=Targets.AddUnit('jwaws2spi'); - T:=Targets.AddUnit('jwaws2tcpip'); - T:=Targets.AddUnit('jwawshisotp'); - T:=Targets.AddUnit('jwawsnetbs'); - T:=Targets.AddUnit('jwawsnwlink'); - T:=Targets.AddUnit('jwawtsapi32'); - T:=Targets.AddUnit('jwazmouse'); - T:=Targets.AddUnit('jwasensevts'); - T:=Targets.AddUnit('jwaadstlb'); - T:=Targets.AddUnit('jwanative'); - T:=Targets.AddExampleunit('examples'); - EndPackage; diff --git a/packages/extra/winunits/fpmake.pp b/packages/extra/winunits/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/winunits/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/winunits/jwaqossp.pas b/packages/extra/winunits/jwaqossp.pas index f5c58aa519..7bd5b88865 100644 --- a/packages/extra/winunits/jwaqossp.pas +++ b/packages/extra/winunits/jwaqossp.pas @@ -1014,10 +1014,3 @@ const implementation end. - - - - - - - diff --git a/packages/extra/x11/Makefile b/packages/extra/x11/Makefile index 98a117f17e..ca3bae48aa 100644 --- a/packages/extra/x11/Makefile +++ b/packages/extra/x11/Makefile @@ -546,11 +546,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/x11/fpmake.inc b/packages/extra/x11/fpmake.inc deleted file mode 100644 index ef38a6e4f0..0000000000 --- a/packages/extra/x11/fpmake.inc +++ /dev/null @@ -1,21 +0,0 @@ - StartPackage('x11'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/x11'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='x11'; - {$ENDIF} - OS:=[linux,netbsd,freebsd,openbsd,os2,emx,darwin]; - T:=Targets.AddUnit('x'); - T:=Targets.AddUnit('xlib'); - T:=Targets.AddUnit('xutil'); - T:=Targets.AddUnit('xresource'); - T:=Targets.AddUnit('xcms'); - T:=Targets.AddUnit('xshm'); - T:=Targets.AddUnit('xrender'); - T:=Targets.AddUnit('keysym'); - T:=Targets.AddUnit('xi'); - T:=Targets.AddUnit('xkb'); - T:=Targets.AddUnit('xkblib'); - T:=Targets.AddUnit('xatom'); - T:=Targets.AddUnit('xinerama'); - EndPackage; diff --git a/packages/extra/x11/fpmake.pp b/packages/extra/x11/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/x11/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/extra/zlib/Makefile b/packages/extra/zlib/Makefile index 006d9d7d8e..ec15b85673 100644 --- a/packages/extra/zlib/Makefile +++ b/packages/extra/zlib/Makefile @@ -546,11 +546,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/packages/extra/zlib/fpmake.inc b/packages/extra/zlib/fpmake.inc deleted file mode 100644 index 97296d4eae..0000000000 --- a/packages/extra/zlib/fpmake.inc +++ /dev/null @@ -1,9 +0,0 @@ - StartPackage('zlib'); - {$IF defined(ALLPACKAGES)} - Directory:='extra/zlib'; - {$ELSEIF defined(EXTRAPACKAGES)} - Directory:='zlib'; - {$ENDIF} - OS:=[linux,netbsd,freebsd,openbsd,win32,os2,emx,netware,netwlibc,darwin]; - T:=Targets.AddUnit('zlib'); - EndPackage; diff --git a/packages/extra/zlib/fpmake.pp b/packages/extra/zlib/fpmake.pp deleted file mode 100644 index d4b6178682..0000000000 --- a/packages/extra/zlib/fpmake.pp +++ /dev/null @@ -1,17 +0,0 @@ -{$mode objfpc}{$H+} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i fpmake.inc} - Run; - end; -end. - diff --git a/packages/fpmake.pp b/packages/fpmake.pp deleted file mode 100644 index 2434b80d5b..0000000000 --- a/packages/fpmake.pp +++ /dev/null @@ -1,21 +0,0 @@ -{$mode objfpc}{$H+} -{$define allpackages} -program fpmake; - -uses fpmkunit; - -Var - T : TTarget; - -begin - With Installer do - begin - { Base packages } - {$i base/fpmake.inc} - - { Extra packages} - {$i extra/fpmake.inc} - Run; - end; -end. - diff --git a/rtl/Makefile b/rtl/Makefile index 660d4964e8..92e2676b21 100644 --- a/rtl/Makefile +++ b/rtl/Makefile @@ -262,9 +262,6 @@ endif ifeq ($(FULL_TARGET),i386-netwlibc) override TARGET_DIRS+=netwlibc endif -ifeq ($(FULL_TARGET),i386-wince) -override TARGET_DIRS+=wince -endif ifeq ($(FULL_TARGET),m68k-linux) override TARGET_DIRS+=linux endif @@ -304,15 +301,9 @@ endif ifeq ($(FULL_TARGET),x86_64-freebsd) override TARGET_DIRS+=freebsd endif -ifeq ($(FULL_TARGET),x86_64-win64) -override TARGET_DIRS+=win64 -endif ifeq ($(FULL_TARGET),arm-linux) override TARGET_DIRS+=linux endif -ifeq ($(FULL_TARGET),arm-wince) -override TARGET_DIRS+=wince -endif ifeq ($(FULL_TARGET),powerpc64-linux) override TARGET_DIRS+=linux endif @@ -1534,9 +1525,6 @@ endif ifeq ($(FULL_TARGET),i386-netwlibc) TARGET_DIRS_NETWLIBC=1 endif -ifeq ($(FULL_TARGET),i386-wince) -TARGET_DIRS_WINCE=1 -endif ifeq ($(FULL_TARGET),m68k-linux) TARGET_DIRS_LINUX=1 endif @@ -1576,15 +1564,9 @@ endif ifeq ($(FULL_TARGET),x86_64-freebsd) TARGET_DIRS_FREEBSD=1 endif -ifeq ($(FULL_TARGET),x86_64-win64) -TARGET_DIRS_WIN64=1 -endif ifeq ($(FULL_TARGET),arm-linux) TARGET_DIRS_LINUX=1 endif -ifeq ($(FULL_TARGET),arm-wince) -TARGET_DIRS_WINCE=1 -endif ifeq ($(FULL_TARGET),powerpc64-linux) TARGET_DIRS_LINUX=1 endif @@ -2038,51 +2020,6 @@ netwlibc: $(MAKE) -C netwlibc all .PHONY: netwlibc_all netwlibc_debug netwlibc_smart netwlibc_release netwlibc_units netwlibc_examples netwlibc_shared netwlibc_install netwlibc_sourceinstall netwlibc_exampleinstall netwlibc_distinstall netwlibc_zipinstall netwlibc_zipsourceinstall netwlibc_zipexampleinstall netwlibc_zipdistinstall netwlibc_clean netwlibc_distclean netwlibc_cleanall netwlibc_info netwlibc_makefiles netwlibc endif -ifdef TARGET_DIRS_WINCE -wince_all: - $(MAKE) -C wince all -wince_debug: - $(MAKE) -C wince debug -wince_smart: - $(MAKE) -C wince smart -wince_release: - $(MAKE) -C wince release -wince_units: - $(MAKE) -C wince units -wince_examples: - $(MAKE) -C wince examples -wince_shared: - $(MAKE) -C wince shared -wince_install: - $(MAKE) -C wince install -wince_sourceinstall: - $(MAKE) -C wince sourceinstall -wince_exampleinstall: - $(MAKE) -C wince exampleinstall -wince_distinstall: - $(MAKE) -C wince distinstall -wince_zipinstall: - $(MAKE) -C wince zipinstall -wince_zipsourceinstall: - $(MAKE) -C wince zipsourceinstall -wince_zipexampleinstall: - $(MAKE) -C wince zipexampleinstall -wince_zipdistinstall: - $(MAKE) -C wince zipdistinstall -wince_clean: - $(MAKE) -C wince clean -wince_distclean: - $(MAKE) -C wince distclean -wince_cleanall: - $(MAKE) -C wince cleanall -wince_info: - $(MAKE) -C wince info -wince_makefiles: - $(MAKE) -C wince makefiles -wince: - $(MAKE) -C wince all -.PHONY: wince_all wince_debug wince_smart wince_release wince_units wince_examples wince_shared wince_install wince_sourceinstall wince_exampleinstall wince_distinstall wince_zipinstall wince_zipsourceinstall wince_zipexampleinstall wince_zipdistinstall wince_clean wince_distclean wince_cleanall wince_info wince_makefiles wince -endif ifdef TARGET_DIRS_AMIGA amiga_all: $(MAKE) -C amiga all @@ -2263,51 +2200,6 @@ morphos: $(MAKE) -C morphos all .PHONY: morphos_all morphos_debug morphos_smart morphos_release morphos_units morphos_examples morphos_shared morphos_install morphos_sourceinstall morphos_exampleinstall morphos_distinstall morphos_zipinstall morphos_zipsourceinstall morphos_zipexampleinstall morphos_zipdistinstall morphos_clean morphos_distclean morphos_cleanall morphos_info morphos_makefiles morphos endif -ifdef TARGET_DIRS_WIN64 -win64_all: - $(MAKE) -C win64 all -win64_debug: - $(MAKE) -C win64 debug -win64_smart: - $(MAKE) -C win64 smart -win64_release: - $(MAKE) -C win64 release -win64_units: - $(MAKE) -C win64 units -win64_examples: - $(MAKE) -C win64 examples -win64_shared: - $(MAKE) -C win64 shared -win64_install: - $(MAKE) -C win64 install -win64_sourceinstall: - $(MAKE) -C win64 sourceinstall -win64_exampleinstall: - $(MAKE) -C win64 exampleinstall -win64_distinstall: - $(MAKE) -C win64 distinstall -win64_zipinstall: - $(MAKE) -C win64 zipinstall -win64_zipsourceinstall: - $(MAKE) -C win64 zipsourceinstall -win64_zipexampleinstall: - $(MAKE) -C win64 zipexampleinstall -win64_zipdistinstall: - $(MAKE) -C win64 zipdistinstall -win64_clean: - $(MAKE) -C win64 clean -win64_distclean: - $(MAKE) -C win64 distclean -win64_cleanall: - $(MAKE) -C win64 cleanall -win64_info: - $(MAKE) -C win64 info -win64_makefiles: - $(MAKE) -C win64 makefiles -win64: - $(MAKE) -C win64 all -.PHONY: win64_all win64_debug win64_smart win64_release win64_units win64_examples win64_shared win64_install win64_sourceinstall win64_exampleinstall win64_distinstall win64_zipinstall win64_zipsourceinstall win64_zipexampleinstall win64_zipdistinstall win64_clean win64_distclean win64_cleanall win64_info win64_makefiles win64 -endif all: $(addsuffix _all,$(TARGET_DIRS)) debug: $(addsuffix _debug,$(TARGET_DIRS)) smart: $(addsuffix _smart,$(TARGET_DIRS)) diff --git a/rtl/Makefile.fpc b/rtl/Makefile.fpc index c4905c6773..a4da422daa 100644 --- a/rtl/Makefile.fpc +++ b/rtl/Makefile.fpc @@ -9,8 +9,6 @@ version=2.0.0 [target] dirs_linux=linux dirs_win32=win32 -dirs_wince=wince -dirs_win64=win64 dirs_go32v2=go32v2 dirs_go32v1=go32v1 dirs_os2=os2 diff --git a/rtl/arm/arm.inc b/rtl/arm/arm.inc index a40f0abc27..c8639aa528 100644 --- a/rtl/arm/arm.inc +++ b/rtl/arm/arm.inc @@ -19,14 +19,12 @@ procedure fpc_cpuinit; begin -{$IFNDEF WINCE} asm rfs r0 and r0,r0,#0xffe0ffff orr r0,r0,#0x00020000 wfs r0 end; -{$ENDIF} end; {**************************************************************************** diff --git a/rtl/bsd/suuid.inc b/rtl/bsd/suuid.inc index 18edf12545..46fdad83c5 100644 --- a/rtl/bsd/suuid.inc +++ b/rtl/bsd/suuid.inc @@ -77,4 +77,4 @@ begin GetRandomBytes(GUID,SizeOf(Guid)); Result:=0; end; -{$ENDIF} +{$ENDIF}
\ No newline at end of file diff --git a/rtl/common/fpmake.lpi b/rtl/common/fpmake.lpi new file mode 100644 index 0000000000..3fc322fb14 --- /dev/null +++ b/rtl/common/fpmake.lpi @@ -0,0 +1,227 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <PathDelim Value="/"/> + <Version Value="5"/> + <General> + <Flags> + <MainUnitHasUsesSectionForAllUnits Value="False"/> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <MainUnit Value="0"/> + <ActiveEditorIndexAtStart Value="1"/> + <IconPath Value="./"/> + <TargetFileExt Value=""/> + </General> + <JumpHistory Count="30" HistoryIndex="29"> + <Position1> + <Filename Value="fpmkunit.pp"/> + <Caret Line="1668" Column="1" TopLine="1650"/> + </Position1> + <Position2> + <Filename Value="fpmkunit.pp"/> + <Caret Line="2842" Column="5" TopLine="2793"/> + </Position2> + <Position3> + <Filename Value="fpmkunit.pp"/> + <Caret Line="2860" Column="1" TopLine="2834"/> + </Position3> + <Position4> + <Filename Value="fpmkunit.pp"/> + <Caret Line="2846" Column="55" TopLine="2824"/> + </Position4> + <Position5> + <Filename Value="fpmkunit.pp"/> + <Caret Line="2867" Column="1" TopLine="2845"/> + </Position5> + <Position6> + <Filename Value="fpmkunit.pp"/> + <Caret Line="2849" Column="29" TopLine="2827"/> + </Position6> + <Position7> + <Filename Value="fpmkunit.pp"/> + <Caret Line="2861" Column="31" TopLine="2827"/> + </Position7> + <Position8> + <Filename Value="fpmkunit.pp"/> + <Caret Line="2851" Column="26" TopLine="2829"/> + </Position8> + <Position9> + <Filename Value="fpmkunit.pp"/> + <Caret Line="289" Column="1" TopLine="267"/> + </Position9> + <Position10> + <Filename Value="fpmkunit.pp"/> + <Caret Line="2890" Column="46" TopLine="2868"/> + </Position10> + <Position11> + <Filename Value="fpmkunit.pp"/> + <Caret Line="2420" Column="27" TopLine="2406"/> + </Position11> + <Position12> + <Filename Value="fpmkunit.pp"/> + <Caret Line="2405" Column="11" TopLine="2383"/> + </Position12> + <Position13> + <Filename Value="fpmkunit.pp"/> + <Caret Line="2426" Column="20" TopLine="2417"/> + </Position13> + <Position14> + <Filename Value="fpmkunit.pp"/> + <Caret Line="762" Column="1" TopLine="721"/> + </Position14> + <Position15> + <Filename Value="fpmkunit.pp"/> + <Caret Line="2558" Column="21" TopLine="2558"/> + </Position15> + <Position16> + <Filename Value="fpmkunit.pp"/> + <Caret Line="140" Column="1" TopLine="111"/> + </Position16> + <Position17> + <Filename Value="fpmkunit.pp"/> + <Caret Line="1038" Column="1" TopLine="1038"/> + </Position17> + <Position18> + <Filename Value="/home/michael/source/shrink.pp"/> + <Caret Line="152" Column="3" TopLine="149"/> + </Position18> + <Position19> + <Filename Value="/home/michael/source/shrink.pp"/> + <Caret Line="248" Column="3" TopLine="246"/> + </Position19> + <Position20> + <Filename Value="/home/michael/source/shrink.pp"/> + <Caret Line="330" Column="11" TopLine="287"/> + </Position20> + <Position21> + <Filename Value="/home/michael/source/shrink.pp"/> + <Caret Line="452" Column="33" TopLine="448"/> + </Position21> + <Position22> + <Filename Value="/home/michael/source/shrink.pp"/> + <Caret Line="188" Column="1" TopLine="177"/> + </Position22> + <Position23> + <Filename Value="/home/michael/source/shrink.pp"/> + <Caret Line="792" Column="18" TopLine="783"/> + </Position23> + <Position24> + <Filename Value="/home/michael/source/shrink.pp"/> + <Caret Line="793" Column="3" TopLine="771"/> + </Position24> + <Position25> + <Filename Value="/home/michael/source/shrink.pp"/> + <Caret Line="772" Column="1" TopLine="763"/> + </Position25> + <Position26> + <Filename Value="/home/michael/source/shrink.pp"/> + <Caret Line="236" Column="1" TopLine="221"/> + </Position26> + <Position27> + <Filename Value="/home/michael/source/shrink.pp"/> + <Caret Line="134" Column="1" TopLine="133"/> + </Position27> + <Position28> + <Filename Value="/home/michael/source/shrink.pp"/> + <Caret Line="848" Column="1" TopLine="837"/> + </Position28> + <Position29> + <Filename Value="/home/michael/source/shrink.pp"/> + <Caret Line="258" Column="1" TopLine="257"/> + </Position29> + <Position30> + <Filename Value="/home/michael/source/shrink.pp"/> + <Caret Line="837" Column="3" TopLine="815"/> + </Position30> + </JumpHistory> + <Units Count="7"> + <Unit0> + <CursorPos X="11" Y="6"/> + <EditorIndex Value="2"/> + <Filename Value="fpmake.pp"/> + <IsPartOfProject Value="True"/> + <Loaded Value="True"/> + <TopLine Value="1"/> + <UnitName Value="fpmake"/> + <UsageCount Value="77"/> + </Unit0> + <Unit1> + <CursorPos X="53" Y="82"/> + <EditorIndex Value="0"/> + <Filename Value="fpmkunit.pp"/> + <IsPartOfProject Value="True"/> + <Loaded Value="True"/> + <TopLine Value="78"/> + <UnitName Value="fpmkunit"/> + <UsageCount Value="77"/> + </Unit1> + <Unit2> + <CursorPos X="23" Y="27"/> + <Filename Value="fpc/rtl/objpas/sysutils/osutilsh.inc"/> + <TopLine Value="8"/> + <UsageCount Value="8"/> + </Unit2> + <Unit3> + <CursorPos X="3" Y="931"/> + <Filename Value="fpc/rtl/unix/sysutils.pp"/> + <TopLine Value="908"/> + <UnitName Value="sysutils"/> + <UsageCount Value="8"/> + </Unit3> + <Unit4> + <CursorPos X="18" Y="610"/> + <Filename Value="fpc/rtl/objpas/classes/classesh.inc"/> + <TopLine Value="590"/> + <UsageCount Value="7"/> + </Unit4> + <Unit5> + <CursorPos X="7" Y="159"/> + <Filename Value="fpc/rtl/objpas/classes/streams.inc"/> + <TopLine Value="152"/> + <UsageCount Value="7"/> + </Unit5> + <Unit6> + <CursorPos X="1" Y="837"/> + <EditorIndex Value="1"/> + <Filename Value="/home/michael/source/shrink.pp"/> + <Loaded Value="True"/> + <TopLine Value="815"/> + <UnitName Value="shrink"/> + <UsageCount Value="11"/> + </Unit6> + </Units> + <PublishOptions> + <Version Value="2"/> + <IgnoreBinaries Value="False"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + </ProjectOptions> + <CompilerOptions> + <Version Value="5"/> + <CodeGeneration> + <Generate Value="Faster"/> + </CodeGeneration> + <Other> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="2"> + <Item1> + <Name Value="ECodetoolError"/> + </Item1> + <Item2> + <Name Value="EFOpenError"/> + </Item2> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/rtl/common/fpmake.pp b/rtl/common/fpmake.pp new file mode 100644 index 0000000000..f11ea1abad --- /dev/null +++ b/rtl/common/fpmake.pp @@ -0,0 +1,24 @@ +program fpmake; + +{$mode objfpc}{$H+} + +uses + fpmkunit + { add your units here }; + +begin + With Installer Do + begin + StartPackage('Mypackage'); + Version:='1.0'; + URL:='http://www.freepascal.org/'; + Targets.AddUnit('myunit'); + Targets['myunit'].OS:=[Win32,Linux]; + Targets['myunit'].Resourcestrings:=True; + Targets.AddUnit('testbuild/myotherunit').OS:=[Linux]; + Targets.AddProgram('myprog'); + EndPackage; + Run; + end; +end. + diff --git a/rtl/common/fpmkpkg.lpi b/rtl/common/fpmkpkg.lpi new file mode 100644 index 0000000000..f32f29bef7 --- /dev/null +++ b/rtl/common/fpmkpkg.lpi @@ -0,0 +1,198 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <PathDelim Value="/"/> + <Version Value="5"/> + <General> + <Flags> + <MainUnitHasUsesSectionForAllUnits Value="False"/> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <MainUnit Value="0"/> + <ActiveEditorIndexAtStart Value="1"/> + <IconPath Value="./"/> + <TargetFileExt Value=""/> + </General> + <JumpHistory Count="30" HistoryIndex="29"> + <Position1> + <Filename Value="fpmkpkg.pp"/> + <Caret Line="566" Column="3" TopLine="546"/> + </Position1> + <Position2> + <Filename Value="fpmkpkg.pp"/> + <Caret Line="565" Column="9" TopLine="546"/> + </Position2> + <Position3> + <Filename Value="fpmkpkg.pp"/> + <Caret Line="581" Column="18" TopLine="561"/> + </Position3> + <Position4> + <Filename Value="fpmkunit.pp"/> + <Caret Line="677" Column="13" TopLine="667"/> + </Position4> + <Position5> + <Filename Value="fpmkunit.pp"/> + <Caret Line="157" Column="88" TopLine="121"/> + </Position5> + <Position6> + <Filename Value="fpmkunit.pp"/> + <Caret Line="2577" Column="53" TopLine="2565"/> + </Position6> + <Position7> + <Filename Value="fpmkpkg.pp"/> + <Caret Line="929" Column="20" TopLine="906"/> + </Position7> + <Position8> + <Filename Value="fpmkunit.pp"/> + <Caret Line="585" Column="25" TopLine="578"/> + </Position8> + <Position9> + <Filename Value="fpmkunit.pp"/> + <Caret Line="173" Column="51" TopLine="172"/> + </Position9> + <Position10> + <Filename Value="fpmkunit.pp"/> + <Caret Line="670" Column="11" TopLine="667"/> + </Position10> + <Position11> + <Filename Value="fpmkunit.pp"/> + <Caret Line="170" Column="25" TopLine="169"/> + </Position11> + <Position12> + <Filename Value="fpmkunit.pp"/> + <Caret Line="921" Column="22" TopLine="919"/> + </Position12> + <Position13> + <Filename Value="fpmkunit.pp"/> + <Caret Line="931" Column="5" TopLine="882"/> + </Position13> + <Position14> + <Filename Value="fpmkunit.pp"/> + <Caret Line="195" Column="80" TopLine="158"/> + </Position14> + <Position15> + <Filename Value="fpmkunit.pp"/> + <Caret Line="908" Column="1" TopLine="908"/> + </Position15> + <Position16> + <Filename Value="fpmkunit.pp"/> + <Caret Line="1098" Column="1" TopLine="1057"/> + </Position16> + <Position17> + <Filename Value="fpmkunit.pp"/> + <Caret Line="851" Column="5" TopLine="802"/> + </Position17> + <Position18> + <Filename Value="fpmkunit.pp"/> + <Caret Line="636" Column="15" TopLine="636"/> + </Position18> + <Position19> + <Filename Value="fpmkunit.pp"/> + <Caret Line="2700" Column="1" TopLine="2680"/> + </Position19> + <Position20> + <Filename Value="fpmkunit.pp"/> + <Caret Line="858" Column="27" TopLine="856"/> + </Position20> + <Position21> + <Filename Value="fpmkunit.pp"/> + <Caret Line="2702" Column="5" TopLine="2702"/> + </Position21> + <Position22> + <Filename Value="fpmkunit.pp"/> + <Caret Line="932" Column="47" TopLine="932"/> + </Position22> + <Position23> + <Filename Value="fpmkunit.pp"/> + <Caret Line="2715" Column="17" TopLine="2706"/> + </Position23> + <Position24> + <Filename Value="fpmkunit.pp"/> + <Caret Line="1" Column="1" TopLine="1"/> + </Position24> + <Position25> + <Filename Value="fpmkunit.pp"/> + <Caret Line="313" Column="25" TopLine="290"/> + </Position25> + <Position26> + <Filename Value="fpmkunit.pp"/> + <Caret Line="347" Column="48" TopLine="325"/> + </Position26> + <Position27> + <Filename Value="fpmkunit.pp"/> + <Caret Line="394" Column="25" TopLine="372"/> + </Position27> + <Position28> + <Filename Value="fpmkunit.pp"/> + <Caret Line="408" Column="26" TopLine="386"/> + </Position28> + <Position29> + <Filename Value="fpmkunit.pp"/> + <Caret Line="1049" Column="19" TopLine="1019"/> + </Position29> + <Position30> + <Filename Value="fpmkunit.pp"/> + <Caret Line="2162" Column="34" TopLine="2139"/> + </Position30> + </JumpHistory> + <Units Count="2"> + <Unit0> + <CursorPos X="21" Y="738"/> + <EditorIndex Value="0"/> + <Filename Value="fpmkpkg.pp"/> + <IsPartOfProject Value="True"/> + <Loaded Value="True"/> + <TopLine Value="733"/> + <UnitName Value="fpmkpkg"/> + <UsageCount Value="87"/> + </Unit0> + <Unit1> + <CursorPos X="1" Y="2210"/> + <EditorIndex Value="1"/> + <Filename Value="fpmkunit.pp"/> + <Loaded Value="True"/> + <TopLine Value="2204"/> + <UnitName Value="fpmkunit"/> + <UsageCount Value="43"/> + </Unit1> + </Units> + <PublishOptions> + <Version Value="2"/> + <IgnoreBinaries Value="False"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + </ProjectOptions> + <CompilerOptions> + <Version Value="5"/> + <CodeGeneration> + <Generate Value="Faster"/> + </CodeGeneration> + <Other> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + <Debugging> + <BreakPoints Count="1"> + <Item1> + <Source Value="fpmkpkg.pp"/> + <Line Value="662"/> + </Item1> + </BreakPoints> + <Exceptions Count="2"> + <Item1> + <Name Value="ECodetoolError"/> + </Item1> + <Item2> + <Name Value="EFOpenError"/> + </Item2> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/rtl/common/fpmkpkg.pp b/rtl/common/fpmkpkg.pp new file mode 100644 index 0000000000..ee68d7367b --- /dev/null +++ b/rtl/common/fpmkpkg.pp @@ -0,0 +1,961 @@ +program fpmkpkg; + +{$mode objfpc}{$H+} + +uses + Classes, SysUtils, TypInfo + { add your units here }; + +Resourcestring + // SErrInValidArgument = 'Invalid command-line argument at position %d : %s'; + SErrNeedArgument = 'Option at position %d (%s) needs an argument'; + SErrMissingConfig = 'Missing configuration Makefile.fpc or fpmake.pp'; + SErrRunning = 'The FPC make tool encountered the following error: %s'; + SErrFailedToCompileFPCMake = 'Could not compile fpmake driver program'; + SLogGeneratingFPMake = 'Generating fpmake.pp'; + SLogCompilingFPMake = 'Compiling fpmake.pp: '; + SLogRunningFPMake = 'Running fpmake'; + +Type + + TRunMode = (rmHelp,rmCompile,rmBuild,rmInstall,rmArchive,rmClean,rmDownload); + + { TMakeTool } + + TMakeTool = Class(TObject) + Private + FConvertOnly, + FLogging : Boolean; + FCompiler : String; + FRunMode : TRunMode; + FHaveMakefile : Boolean; + FHaveFpmake : Boolean; + FFPMakeSrc : String; + FFPMakeBin : String; + Procedure Log(Msg : String); + Procedure Error(Msg : String); + Procedure Error(Fmt : String; Args : Array of const); + Function GetCompiler : String; + Public + Procedure ProcessCommandLine; + procedure CreateFPMake; + procedure CompileFPMake(Extra : Boolean); + Function RunFPMake : Integer; + Procedure Run; + end; + + EMakeToolError = Class(Exception); + + + { TMakeFileConverter } + TSectionType = (stNone,stPackage,stTarget,stclean,stinstall,stCompiler, + stDefault,stRequire,stRules,stPrerules); + + TMakeFileConverter = Class(TObject) + FSection : TSectionType; + FPackageName, + FpackageDir, + FPackageOptions, + FPackageDeps, + FBuilDUnit, + FSubName, + FPackageVersion : String; + // Reading; + procedure DoPackageLine(Const S : String); + Procedure DoTargetLine(Line : String; Var T,R,D : TStrings); + Procedure DoInstallLine(Line : String; Var IFL : TStrings); + procedure DoCleanLine(Line : String; Var CFL : TStrings); + procedure DoRequireLine(Line : String); + procedure DoCompilerLine(Line : String;Var SD : TStrings); + // Writing; + procedure WriteOSCPUCheck(Src: TStrings;OS,CPU : String); + procedure StartPackage(Src : TStrings; Dir,OS : String); + procedure EndPackage(Src : TStrings; Dir,OS : String); + procedure DoTargets(Src,T,R,SD : TStrings; Dir,Prefix : String); + procedure DoCleans(Src,CFL : TStrings); + procedure DoInstalls(Src,IFL : TStrings); + Procedure StartInstaller(Src : TStrings); + Procedure EndInstaller(Src : TStrings); + Function GetLine (L : TStrings; Var I : Integer) : String; + Public + procedure ConvertFile(const AFileName: String; Src: TStrings; Dir,OS : String); + Procedure ConvertFile(Const Source,Dest: String); + end; + +{ Auxiliary functions } + +Function GetWord(var S : String; Sep : Char) : String; + +Var + L : Integer; + +begin + L:=Pos(Sep,S); + If (L=0) then + L:=Length(S)+1; + Result:=Copy(S,1,L-1); + Delete(S,1,L); + S:=Trim(S); +end; + +Function GetWord(var S : String) : String; + +begin + Result:=GetWord(S,' '); +end; + + +Function IsCPU (S: String) : Boolean; + +begin + Result:=Pos(lowercase(S)+',','i386,powerpc,arm,alpha,sparc,')<>0 +end; + +Function GetOSCPU(L : String; var OS,CPU : String) : String; + + Procedure Add(Var A : String; ad : String); + + begin + If (A<>'') then + A:=A+','; + A:=A+ad; + end; + + +Var + S : String; + +begin + OS:=''; + CPU:=''; + S:=GetWord(L,','); + While (S<>'') do + begin + If (S<>'all') then + If IsCPU(S) then + Add(CPU,S) + else + Add(OS,S); + S:=GetWord(L,','); + end; +end; + + +{ TMakeFileConverter } + +procedure TMakeFileConverter.StartInstaller(Src: TStrings); + +begin + With Src do + begin + Add('{$mode objfpc}{$H+}'); + Add('program fpmake;'); + + Add(''); + Add(' { Generated automatically by '+ExtractFileName(Paramstr(0))+' on '+DateToStr(Sysutils.Date)+' }'); + Add(''); + Add('uses fpmkunit;'); + Add(''); + Add('Var'); + Add(' T : TTarget;'); + Add(''); + Add('begin'); + Add(' With Installer do '); + Add(' begin'); + end; +end; + +procedure TMakeFileConverter.EndInstaller(Src: TStrings); +begin + With Src do + begin + Add(' Run;'); + Add(' end;'); + Add('end.'); + Add(''); + end; +end; + +Function TMakeFileConverter.GetLine (L : TStrings; Var I : Integer) : String; + +Var + P : Integer; + OK : Boolean; + +begin + OK:=False; + Result:=''; + Repeat + Result:=Result+L[i]; + P:=Pos('#',Result); + If (P>0) then + Result:=Copy(Result,1,P-1); + Result:=Trim(Result); + P:=Length(Result); + If (P>0) and (Result[P]='\') then + Result:=Copy(Result,1,P-1) + else + OK:=(Result<>''); + if Not OK then + Inc(I); + Until OK or (I>L.Count-1); +end; + +Function SplitNamevalue(Const S : String; Var AName,AValue : String) : boolean; + +var + L : Integer; + +begin + L:=Pos('=',S); + Result:=(L<>0); + If Result then + begin + AName:=LowerCase(trim(Copy(S,1,L-1))); + AValue:=S; + Delete(AValue,1,L); + AValue:=Trim(Avalue); + end + else + begin + AName:=''; + AValue:=''; + end; +end; + + +procedure TMakeFileConverter.StartPackage(Src : TStrings; Dir,OS : String); + +Var + S : String; + +begin + With Src do + begin + Add(' { '); + Add(' '+FPackageName); + Add(' } '); + Add(' StartPackage('''+FPackageName+''');'); + If (Dir<>'') then + Add(' Directory:='''+ExcludeTrailingPathDelimiter(Dir)+''';'); + If (OS<>'') and (OS<>'all') then + Add(' OS:=['+OS+'];'); + If (FPackageVersion<>'') then + Add(' Version:='''+FPackageVersion+''';'); + If (FPackageOptions<>'') then + Add(' Options:='''+FPackageOptions+''';'); + If (FPackageDeps<>'') then + begin + S:=GetWord(FPackageDeps); + While S<>'' do + begin + Add(' Dependencies.Add('''+S+''');'); + S:=GetWord(FPackageDeps); + end; + end; + end; +end; + +procedure TMakeFileConverter.EndPackage(Src : TStrings; Dir,OS : String); + +begin + Src.add(' EndPackage;'); + FPackageName:=''; + FPackageVersion:=''; + FPackageOptions:=''; + FBuilDUnit:=''; + FPackageDeps:=''; +end; + + +procedure TMakeFileConverter.DoPackageLine(Const S : String); + +Var V,N : String; + +begin + SplitNameValue(S,N,V); + If (N='name') then + FPackageName:=V + else If (N='version') then + FPackageVersion:=V + else If (N='main') then + begin + FPackageName:='sub'; + FSubName:=V; + end + else + Writeln(StdErr,'Unknown name/value pair in package section :',N); +end; + + +{ + Convert various entries of type + XXYY_OSN=words + to entries of type + prefix_word=OS1,OS2,OS3 + OS is never empty, 'all' is default. + } +Procedure AddStrings(Var L : TStrings; Values,Prefix,OS : String) ; + +Var + S,O : String; + i : integer; + +begin + If (L=Nil) then + L:=TstringList.Create; + If prefix<>'' then + prefix:=prefix+'_'; + S:=GetWord(Values); + While (S<>'') do + begin + S:=Prefix+S; + I:=L.IndexOfName(S); + If (I<>-1) then + begin + O:=L.Values[S]; + If (O='all') then + O:=''; + If (O<>'') then + O:=O+','; + O:=O+OS; + L.Values[S]:=O; + end + else + L.Add(S+'='+OS); + S:=GetWord(Values); + end; +end; + + +procedure TMakeFileConverter.DoTargetLine(Line : String; Var T,R,D : TStrings); + +Var + V,N,OS : String; + P : Integer; + +begin + SplitNameValue(Line,N,V); + P:=Pos('_',N); + If (P=0) then + OS:='all' + else + begin + OS:=N; + Delete(OS,1,P); + N:=Copy(N,1,P-1); + end; + If (N='dirs') then + AddStrings(D,V,'',OS) + else If (N='units') then + AddStrings(T,V,'unit',OS) + else If (N='implicitunits') then + AddStrings(T,V,'unit',OS) + else If (N='programs') then + AddStrings(T,V,'program',OS) + else If (N='examples') then + AddStrings(T,V,'exampleunit',OS) + else If (N='rsts') then + AddStrings(R,V,'',OS) + else + Writeln(StdErr,'Unknown name/value pair in target section : ',Line); +end; + +procedure TMakeFileConverter.DoInstallLine(Line : String; Var IFL : TStrings); + +Var + S,V,N,OS : String; + P : Integer; + +begin + SplitNameValue(Line,N,V); + P:=Pos('_',N); + If (P=0) then + OS:='all' + else + begin + OS:=N; + Delete(OS,1,P); + N:=Copy(N,1,P-1); + end; + If (N='fpcpackage') then + P:=0 // temporary, needs fixing. + else If (N='buildunit') then + FBuildUnit:=V // temporary, needs fixing. + else If (N='units') then + begin + S:=GetWord(V); + While (S<>'') do + begin + AddStrings(IFL,S+'.o','',OS); + AddStrings(IFL,S+'.ppu','',OS); + S:=GetWord(V); + end; + end + else + Writeln(StdErr,'Unknown name/value pair in install section : ',N); +end; + +procedure TMakeFileConverter.DoCleanLine(Line : String; Var CFL : TStrings); + +Var + V,N,S,OS : String; + P : Integer; + +begin + SplitNameValue(Line,N,V); + P:=Pos('_',N); + If (P=0) then + OS:='all' + else + begin + OS:=N; + Delete(OS,1,P); + N:=Copy(N,1,P-1); + end; + If (N='fpcpackage') then + P:=0 // temporary, needs fixing. + else If (N='units') then + begin + S:=GetWord(V); + While (S<>'') do + begin + AddStrings(CFL,S+'.o','',OS); + AddStrings(CFL,S+'.ppu','',OS); + S:=GetWord(V); + end; + end + else + Writeln(StdErr,'Unknown name/value pair in clean section : ',N); +end; + +procedure TMakeFileConverter.DoRequireLine(Line : String); + +Var + V,N,OS : String; + P : Integer; + +begin + SplitNameValue(Line,N,V); + P:=Pos('_',N); + If (P=0) then + OS:='all' + else + begin + OS:=N; + Delete(OS,1,P); + N:=Copy(N,1,P-1); + end; + if (N='packages') then + FPackageDeps:=V + else If (N='libc') and (Upcase(V)='Y') then + P:=0 // Set options ? + else + Writeln(StdErr,'Unknown name/value pair in require section : ',N); +end; + + +procedure TMakeFileConverter.DoCompilerLine(Line : String;Var SD : TStrings); + +Var + V,N,OS : String; + P : Integer; + +begin + SplitNameValue(Line,N,V); + P:=Pos('_',N); + If (P=0) then + OS:='all' + else + begin + OS:=N; + Delete(OS,1,P); + N:=Copy(N,1,P-1); + end; + If (N='includedir') then + FPackageOptions:=Trim(FPackageOptions+' -Fi'+V) + else If (N='options') then + FPackageOptions:=Trim(FPackageOptions+' '+V) + else If (N='targetdir') then + P:=0 // Ignore + else if (N='sourcedir') or (N='unitdir') then + begin + If (SD=Nil) then + SD:=TStringList.Create; + SD.Add(OS+'='+V); + end + else + Writeln(StdErr,'Unknown name/value pair in compiler section : ',N); +end; + +Function SearchInDirs(Prefix,AName, Dirs : String) : string; + +Var + D,S : String; + +begin + S:=GetWord(Dirs); + Result:=''; + While (Result='') and (S<>'') do + begin + D:=Prefix+S+PathDelim; + If FileExists(D+AName+'.pp') or FileExists(D+AName+'.pas') then + Result:=S; + S:=GetWord(Dirs); + end; +end; + +procedure TMakeFileConverter.DoTargets(Src,T,R,SD : TStrings; Dir,Prefix : String); + +Var + I,J,P : Integer; + Pre,N,V,D,DOS,OS,CPU : String; + Res : Boolean; + +begin + If (Dir<>'') then + Dir:=IncludeTrailingPathDelimiter(Dir); + If (Prefix<>'') then + Prefix:=IncludeTrailingPathDelimiter(Prefix); + Dir:=Prefix+Dir; + Res:=False; + If Assigned(T) then + For I:=0 to T.Count-1 do + begin + T.GetNamevalue(I,N,V); + P:=Pos('_',N); + If (P<>0) then + begin + Pre:=Copy(N,1,P-1); + Delete(N,1,P); + end; + If Assigned(R) then + Res:=R.IndexOfName(N)<>-1; + GetOSCPU(V,OS,CPU); + Pre[1]:=Upcase(Pre[1]); + Src.Add(' T:=Targets.Add'+Pre+'('''+Prefix+N+''');'); + If (CPU<>'') then + Src.Add(' T.CPU:=['+CPU+'];'); + If (OS<>'') then + Src.Add(' T.OS:=['+OS+'];'); + If res then + Src.add(' T.ResourceStrings:=True;'); + If (CompareText(FBuildUnit,N)=0) then + Src.add(' T.Install:=False;'); + if Assigned(SD) then + for J:=0 to SD.Count-1 do + begin + SD.GetNameValue(J,DOS,D); + If (DOS<>'all') then + Src.Add(' if (Defaults.OS='+DOS+') then'); + Src.add(' T.Directory:='''+SearchInDirs(Dir,N,D)+''';'); + end; + end; +end; + +procedure TMakeFileConverter.WriteOSCPUCheck(Src: TStrings;OS,CPU : String); + +Var + S : String; + +begin + If (CPU<>'') then + S:='(Defaults.CPU='+CPU+')'; + If (OS<>'') then + begin + IF (S<>'') then + S:=S+' OR '; + S:=S+'(Defaults.OS='+CPU+')'; + end; + If (S<>'') then + Src.Add(' If '+S+' then'); +end; + +procedure TMakeFileConverter.DoInstalls(Src,IFL : TStrings); + +Var + I,J,P : Integer; + Pre,N,V,D,DOS,OS,CPU : String; + +begin + If Assigned(IFL) then + For I:=0 to IFL.Count-1 do + begin + IFL.GetNamevalue(I,N,V); + GetOSCPU(V,OS,CPU); + WriteOSCPUCheck(Src,OS,CPU); + Src.add(' InstallFiles.Add('''+N+''');'); + end; +end; + +procedure TMakeFileConverter.DoCleans(Src,CFL : TStrings); + +Var + I,J,P : Integer; + N,V,DOS,OS,CPU : String; + + +begin + If Assigned(CFL) then + For I:=0 to CFL.Count-1 do + begin + CFL.GetNamevalue(I,N,V); + GetOSCPU(V,OS,CPU); + WriteOSCPUCheck(Src,OS,CPU); + Src.add(' CleanFiles.Add('''+N+''');'); + end; +end; + + + +procedure TMakeFileConverter.ConvertFile(const AFileName: String; Src: TStrings; Dir,OS : String); + + Function IsSection(var S : String) : Boolean; + + Var + L : Integer; + + begin + L:=Length(S); + Result:=(L>0) and (S[1]='[') and (S[L]=']'); + If Result then + S:=trim(Copy(S,2,L-2)); + end; + +Var + R,L,T,D,S,SD,IFL,CFL : TStrings; + I,J : Integer; + Prefix,Line,DN : String; + B : Boolean; + +begin + Writeln('Converting '+AFileName); + T:=Nil; + D:=Nil; + S:=Nil; + SD:=Nil; + R:=Nil; + IFL:=Nil; + CFL:=Nil; + FPackageOptions:=''; + FPackageDir:=''; + L:=TStringList.Create; + try + L.LoadFromFile(AFileName); + I:=0; + While (I<L.Count) do + begin + Line:=GetLine(L,I); + If IsSection(Line) then + begin + J:=GetEnumValue(TypeInfo(TSectionType),'st'+Line); + If (J=-1) then + begin + FSection:=stNone; + Writeln(stdErr,'Unsupported section: ',Line); + end + else + FSection:=TSectiontype(J); + end + else + case FSection of + stPackage : DoPackageLine(Line); + stTarget : DoTargetLine(Line,T,R,D); + stInstall : DoInstallLine(Line,IFL); + stClean : DoCleanLine(Line,CFL); + stCompiler : DoCompilerLine(Line,SD); + strequire : DoRequireLine(Line); + end; + inc(I); + end; + // If there are only 'dir' entries, then there is no package name. + B:=False; + if (FPackageName<>'') then + begin + Prefix:=''; + B:=FPackageName<>'sub'; + If B then + StartPackage(Src,Dir,OS) + else + Prefix:=Dir; + DoTargets(Src,T,R,SD,Dir,Prefix); + DoInstalls(Src,IFL); + DoCleans(Src,CFL); + end; + If Assigned(D) then + begin + If (Dir<>'') then + Dir:=IncludeTrailingPathDelimiter(Dir); + For I:=0 to D.Count-1 do + begin + D.GetNameValue(I,DN,Line); + If (Line<>'all') and (Line<>'') then + OS:=Line; + DN:=Dir+DN+PathDelim; + If FileExists(DN+'Makefile.fpc') then + ConvertFile(DN+'Makefile.fpc',Src,DN,OS); + end; + end; + If B then + EndPackage(Src,Dir,OS); + Finally + S.Free; + IFL.Free; + CFL.Free; + D.Free; + SD.Free; + T.Free; + L.Free; + end; +end; + +procedure TMakeFileConverter.ConvertFile(const Source, Dest: String); + +Var + L : TStrings; + +begin + L:=TStringList.Create; + Try + StartInstaller(L); + ConvertFile(Source,L,'',''); + EndInstaller(L); + L.SaveToFile(Dest); + Finally + L.Free; + end; +end; + +{ TMakeTool } + +procedure TMakeTool.CompileFPMake(Extra: Boolean); + +Var + O,C : String; + +begin + C:=GetCompiler; + O:=FFPmakeSrc; + If Extra then + O:='-Fafpmakeex '+O; + Log(SLogCompilingFPMake+C+' '+O); + If ExecuteProcess(C,O)<>0 then + Error(SErrFailedToCompileFPCMake) +end; + +procedure TMakeTool.CreateFPMake; +begin + Log(SLogGeneratingFPMake); + With TMakeFileConverter.Create do + try + ConvertFile('Makefile.fpc','fpmake.pp'); + finally + Free; + end; +end; + + +Function TMakeTool.RunFPMake : Integer; + + Function MaybeQuote(Const S : String) : String; + + begin + If Pos(' ',S)=0 then + Result:=S + else + Result:='"'+S+'"'; + end; + + +Var + I : integer; + D,O : String; + +begin + Log(SLogRunningFPMake); + D:=IncludeTrailingPathDelimiter(GetCurrentDir); + O:=''; + For I:=1 to ParamCount do + begin + If (O<>'') then + O:=O+' '; + O:=O+MaybeQuote(ParamStr(I)); + end; + Result:=ExecuteProcess(D+FFPMakeBin,O); +end; + +procedure TMakeTool.Log(Msg: String); +begin + If FLogging then + Writeln(stdErr,Msg); +end; + +procedure TMakeTool.Error(Msg: String); +begin + Raise EMakeToolError.Create(Msg); +end; + +procedure TMakeTool.Error(Fmt: String; Args: array of const); +begin + Raise EMakeToolError.CreateFmt(Fmt,Args); +end; + +function TMakeTool.GetCompiler: String; +begin + If (FCompiler='') then + begin + {$if defined(cpui386)} + FCompiler:='ppc386'; + {$elseif defined(cpuAlpha)} + FCompiler:='ppcaxp'; + {$elseif defined(cpusparc)} + FCompiler:='ppcsparc'; + {$elseif defined(cpuarm)} + FCompiler:='ppcarm'; + {$elseif defined(cpum68k)} + FCompiler:='ppcm68k'; + {$elseif defined(cpupowerpc)} + FCompiler:='ppcppc'; + {$else} + {$Fatal Unknown architecture} + {$endif} + end; + If (ExtractFilePath(FCompiler)<>'') then + Result:=FCompiler + else + begin + Result:=FileSearch(FCompiler,GetEnvironmentVariable('PATH')); + If (Result='') then + Result:=FCompiler; + end; +end; + + +procedure TMakeTool.ProcessCommandLine; + + Function CheckOption(Index : Integer;Short,Long : String): Boolean; + + var + O : String; + + begin + O:=Paramstr(Index); + Result:=(O='-'+short) or (O='--'+long) or (copy(O,1,Length(Long)+3)=('--'+long+'=')); + end; + + Function OptionArg(Var Index : Integer) : String; + + Var + P : Integer; + + begin + if (Length(ParamStr(Index))>1) and (Paramstr(Index)[2]<>'-') then + begin + If Index<ParamCount then + begin + Inc(Index); + Result:=Paramstr(Index); + end + else + Error(SErrNeedArgument,[Index,ParamStr(Index)]); + end + else If length(ParamStr(Index))>2 then + begin + P:=Pos('=',Paramstr(Index)); + If (P=0) then + Error(SErrNeedArgument,[Index,ParamStr(Index)]) + else + begin + Result:=Paramstr(Index); + Delete(Result,1,P); + end; + end; + end; + +Var + I : Integer; + +begin + I:=0; + FLogging:=False; + FRunMode:=rmhelp; + FConvertOnly:=False; + While (I<ParamCount) do + begin + Inc(I); + if Checkoption(I,'n','convert') then + FConvertOnly:=True + else if Checkoption(I,'m','compile') then + FRunMode:=rmCompile + else if Checkoption(I,'b','build') then + FRunMode:=rmBuild + else if CheckOption(I,'i','install') then + FRunMode:=rmInstall + else if CheckOption(I,'c','clean') then + FRunMode:=rmClean + else if CheckOption(I,'a','archive') then + FRunMode:=rmarchive + else if CheckOption(I,'d','download') then + FRunMode:=rmDownload + else if CheckOption(I,'h','help') then + FRunMode:=rmhelp + // Check. + else if CheckOption(I,'r','compiler') then + FCompiler:=OptionArg(I) + else if CheckOption(I,'v','verbose') then + Flogging:=Pos('info',Lowercase(OptionArg(I)))<>0; + end; +end; + + +procedure TMakeTool.Run; + + +begin + Try + ProcessCommandLine; + If FConvertOnly then + CreateFPMake + else + begin + FHaveMakefile:=FileExists('Makefile.fpc'); + FFPMakeSrc:='fpmake.pp'; + FHaveFpmake:=FileExists(FFPMakeSrc); + If Not FHaveFPMake then + begin + FHaveFPMake:=FileExists('fpmake.pas'); + If FHaveFPMake then + FFPMakeSrc:='fpmake.pas'; + end; + if Not (FHaveFPMake or FHaveMakeFile) then + Error(SErrMissingConfig); + If (Not FHaveFPMake) or (FileAge(FFPMakeSrc)<FileAge('Makefile.fpc')) then + CreateFPMake; + {$ifndef unix} + FFPMakeBin:='fpmake.exe'; + {$else} + FFPMakeBin:='fpmake'; + {$endif} + if FileAge(FFPMakeBin)<FileAge(FFPMakeSrc) then + CompileFPMake(FRunMode in [rmArchive,rmDownload]); + Halt(RunFPMake); + end; + except + On E : Exception do + begin + Writeln(StdErr,Format(SErrRunning,[E.Message])); + Halt(1); + end; + end; +end; + + +begin + With TMakeTool.Create do + try + run; + finally + Free; + end; +end. + diff --git a/rtl/fpmake.inc b/rtl/fpmake.inc deleted file mode 100644 index 324fc99279..0000000000 --- a/rtl/fpmake.inc +++ /dev/null @@ -1,293 +0,0 @@ - -Const - GraphDir = 'inc/graph/'; - SysUtilsDir = 'objpas/sysutils/'; - Unixes = [darwin,freebsd,linux,netbsd,openbsd]; - - -Function CurrentOS : String; - -begin - Result:=OSToString(Defaults.OS); -end; - -Function CurrentCPU : String; - -begin - Result:=CPUToString(Defaults.CPU); -end; - -Function OSDir(CorrectUnix : Boolean = True) : String; - -begin - If CorrectUnix and (Defaults.OS in Unixes) then - Result:='unix/' - else - Result:=IncludeTrailingPathDelimiter(CurrentOS); -end; - - -Function CPUDir : String; - -begin - Result:=IncludeTrailingPathDelimiter(CurrentCPU); -end; - -Procedure InitRTL(Installer : TInstaller); - -Var - O : String; - - -begin - With Installer Do - begin - StartPackage('rtl'); - Version:={$i %FPCVERSION%}; - Author:='The FPC team'; - O:='-Fi'+OSDir(false)+' -Fiinc -Fi'+CurrentCPU; - If Defaults.OS in Unixes then - O:=O+' -Fiunix'; - DefaultPackage.Options:=O; - end; -end; - -Procedure AddSystemDependencies(Targets : TTargets); - -Var - I : Integer; - -begin - With Targets do - For I:=0 to Count-1 do - if (TargetItems[i].Name<>'system') then - TargetItems[i].Dependencies.Add('system'); -end; - -Procedure AddCurrentOS(T : TTarget = Nil); - -Var - I : Integer; - O : TOSes; - -begin - If (T<>Nil) then - begin - O:=T.OS; - If (O<>[]) then - Include(O,Defaults.OS) - else - // Don't do anything. If empty, all will be compiled. - T.OS:=O; - end - else - With Installer.Targets do - For I:=0 to Count-1 do - AddCurrentOS(TargetItems[i]); -end; - -Procedure ExcludeCurrentOS(T : TTarget = Nil); - -Var - I : Integer; - O : TOSes; - -begin - If (T<>Nil) then - begin - O:=T.OS; - If (O=[]) then - O:=AllOSs; - Exclude(O,Defaults.OS); - T.OS:=O; - end - else - With Installer.Targets do - For I:=0 to Count-1 do - AddCurrentOS(TargetItems[i]); -end; - -Procedure AddDefaultTargets(Installer : TInstaller); - -Var - T : TTarget; - -begin - With Installer.Targets do - begin - DefaultOS:=AllOSs; - DefaultCPU:=AllCPUs; - { System unit. For all platforms. } - T:=AddUnit(OSDIR(False)+'system.pp'); - With T.Dependencies do - begin - // Headers - Add(CPUDir+'setjumph.inc'); - Add('inc/systemh.inc'); - Add('inc/objpash.inc'); - Add('inc/dynarrh.inc'); - Add('inc/compproc.inc'); - Add('inc/heaph.inc'); - Add('inc/threadh.inc'); - Add('inc/varianth.inc'); - // Implementations - Add(CPUDir+CurrentCPU+'.inc'); - Add(CPUDir+'set.inc'); - Add(CPUDir+'math.inc'); - Add(CPUDir+'int64p.inc'); - Add(CPUDir+'setjump.inc'); - Add(OSDir+'systhrd.inc'); - Add(OSDir(False)+'sysos.inc'); - Add(OSDir+'sysheap.inc'); - Add(OSDir+'sysdir.inc'); - Add('inc/filerec.inc'); - Add('inc/textrec.inc'); - Add('inc/generic.inc'); - Add('inc/genset.inc'); - Add('inc/genmath.inc'); - Add('inc/sstrings.inc'); - Add('inc/int64.inc'); - Add('inc/astrings.inc'); - Add('inc/wstrings.inc'); - Add('inc/aliases.inc'); - Add('inc/dynarr.inc'); - Add('inc/objpas.inc'); - Add('inc/variant.inc'); - Add('inc/rtti.inc'); - Add('inc/heap.inc'); - Add('inc/thread.inc'); - Add('inc/text.inc'); - Add('inc/file.inc'); - Add('inc/typefile.inc'); - end; - T:=AddUnit('objpas/objpas.pp'); - T:=AddUnit('inc/macpas.pp'); - - { Turbo Pascal RTL units } - T:=AddUnit(OSDir+'dos.pp'); - T.Dependencies.Add('inc/dosh.inc'); - T:=AddUnit(OSDir+'crt.pp'); - T.Directory:=OSDir; - T.Dependencies.Add('inc/crth.inc'); - T:=AddUnit(OSDir+'graph.pp'); - T.IncludePath.Add(GraphDir); - With T.Dependencies do - begin - Add(GraphDir+'clip.inc'); - Add(GraphDir+'fontdata.inc'); - Add(GraphDir+'graph.inc'); - Add(GraphDir+'gtext.inc'); - Add(GraphDir+'modes.inc'); - Add(GraphDir+'fills.inc'); - Add(GraphDir+'graphh.inc'); - Add(GraphDir+'palette.inc'); - end; - T:=AddUnit('inc/strings.pp'); - With T.Dependencies do - begin - Add(CPUDir+'strings.inc'); - Add(CPUDir+'stringss.inc'); - Add('inc/genstr.inc'); - Add('inc/genstrs.inc'); - Add('inc/stringsi.inc'); - end; - { Delphi RTL units } - T:=AddUnit('objpas/rtlconsts.pp'); - T.Resourcestrings:=True; - T.Dependencies.Add('objpas/rtlconst.inc'); - T:=AddUnit(OSDir+'sysutils.pp'); - T.IncludePath.Add(SysUtilsDir); - With T.Dependencies do - begin - Add(SysUtilsDir+'datih.inc'); - Add(SysUtilsDir+'finah.inc'); - Add(SysUtilsDir+'osutilsh.inc'); - Add(SysUtilsDir+'sysansi.inc'); - Add(SysUtilsDir+'syspchh.inc'); - Add(SysUtilsDir+'systhrdh.inc'); - Add(SysUtilsDir+'syswideh.inc'); - Add(SysUtilsDir+'dati.inc'); - Add(SysUtilsDir+'fina.inc'); - Add(SysUtilsDir+'stre.inc'); - Add(SysUtilsDir+'sysformt.inc'); - Add(SysUtilsDir+'syspch.inc'); - Add(SysUtilsDir+'sysuintf.inc'); - Add(SysUtilsDir+'syswide.inc'); - Add(SysUtilsDir+'diskh.inc'); - Add(SysUtilsDir+'intfh.inc'); - Add(SysUtilsDir+'strg.inc'); - Add(SysUtilsDir+'sysinth.inc'); - Add(SysUtilsDir+'sysstrh.inc'); - Add(SysUtilsDir+'sysutilh.inc'); - Add(SysUtilsDir+'filutilh.inc'); - Add(SysUtilsDir+'osutil.inc'); - Add(SysUtilsDir+'sysansih.inc'); - Add(SysUtilsDir+'sysint.inc'); - Add(SysUtilsDir+'sysstr.inc'); - Add(SysUtilsDir+'sysutils.inc'); - end; - T:=AddUnit(OSDIR+'varutils.pp'); - T.ResourceStrings:=True; - T.IncludePath.Add('objpas'); - T:=AddUnit('inc/variants.pp'); - With T.Dependencies do - begin - Add('math'); - Add('varutils'); - end; - T.ResourceStrings:=True; - T:=AddUnit('objpas/convutils.pp'); - T.Dependencies.Add('objpas/convutil.inc'); - T.ResourceStrings:=True; - T:=AddUnit('objpas/dateutils.pp'); - T.Dependencies.Add('objpas/dateutil.inc'); - T:=AddUnit('objpas/strutils.pp'); - T.Dependencies.Add('sysutils'); - T:=AddUnit('objpas/math.pp'); - T.Dependencies.Add('sysutils'); - T.Dependencies.Add(CPUDir+'mathuh.inc'); - T.Dependencies.Add(CPUDir+'mathu.inc'); - T.ResourceStrings:=True; - T:=AddUnit('objpas/sysconst.pp'); - T.Resourcestrings:=true; - T:=AddUnit('objpas/types.pp'); - T:=AddUnit('objpas/typinfo.pp'); - T.Dependencies.Add('sysutils'); - T.Dependencies.Add('rtlconsts'); - T:=AddUnit('objpas/utf8bidi.pp'); - { Free Pascal additions} - T:=AddUnit(OSDir+'keyboard.pp'); - With T.Dependencies do - begin - Add('inc/keybrdh.inc'); - Add('inc/keyboard.inc'); - Add('inc/keyscan.inc'); - end; - T:=AddUnit(OSDir+'mouse.pp'); - With T.Dependencies do - begin - Add('inc/mouseh.inc'); - Add('inc/mouse.inc'); - end; - T:=AddUnit(OSDir+'video.pp'); - With T.Dependencies do - begin - Add('inc/video.inc'); - Add('inc/videoh.inc'); - end; - T:=AddUnit('inc/matrix.pp'); - T.Dependencies.Add('inc/mmatimp.inc'); - T:=AddUnit('inc/dynlibs.pp'); - T.Dependencies.Add(OSDir+'dynlibs.inc'); - T:=AddUnit('inc/getopts.pp'); - T:=AddUnit('inc/cmem.pp'); - T:=AddUnit('inc/ctypes.pp'); - T:=AddUnit('inc/softfpu.pp'); - T:=AddUnit('inc/ucomplex.pp'); - T:=AddUnit('inc/heaptrc.pp'); - T:=AddUnit('inc/lineinfo.pp'); - T:=AddUnit('inc/charset.pp'); - // T:=AddUnit('inc/pagemem.pp'); - end; - AddSystemDependencies(Installer.Targets); -end;
\ No newline at end of file diff --git a/rtl/fpmake.pp b/rtl/fpmake.pp deleted file mode 100644 index 3101bcec92..0000000000 --- a/rtl/fpmake.pp +++ /dev/null @@ -1,50 +0,0 @@ -{$mode objfpc}{$H+} -{$define allpackages} -program fpmake; - -uses sysutils,fpmkunit; - -{ Read RTL definitions. } -{$i fpmake.inc} - -{ Unix/Posix defines } -{$i unix/fpmake.inc} - -{ Load OS-specific targets and corrections } -{$i linux/fpmake.inc} -(* - {$i amiga/fpmake.inc} - {$i darwin/fpmake.inc} - {$i freebsd/fpmake.inc} - {$i palmos/fpmake.inc} - {$i emx/fpmake.inc} - {$i go32v2/fpmake.inc} - {$i morphos/fpmake.inc} - {$i atari/fpmake.inc} - {$i macos/fpmake.inc} - {$i netbsd/fpmake.inc} - {$i openbsd/fpmake.inc} - {$i win32/fpmake.inc} - {$i beos/fpmake.inc} - {$i netware/fpmake.inc} - {$i os2/fpmake.inc} - {$i solaris/fpmake.inc} -*) - -Var - T : TTarget; - -begin - InitRTL(Installer); // Define RTL package. - AddDefaultTargets(Installer); // Add all cross-platform units. - // A line must be added here when adding support for a new OS. - Case Installer.Defaults.OS of - linux : ApplyLinuxTargets(Installer); - - else - Raise EInstallerError.Create('OS not yet supported by makefile: '+OsToString(Defaults.OS)); - end; - Installer.EndPackage; - Installer.Run; // Go. -end. - diff --git a/rtl/gba/Makefile.fpc b/rtl/gba/Makefile.fpc deleted file mode 100644 index ece5dd5199..0000000000 --- a/rtl/gba/Makefile.fpc +++ /dev/null @@ -1,279 +0,0 @@ -# -# Makefile.fpc for Free Pascal GBA RTL -# - -[package] -main=rtl - -[target] -loaders=prt0 -units=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil \ - heaptrc lineinfo \ - sysutils typinfo math \ - charset getopts \ - errors \ - types dateutils sysconst \ - cthreads classes strutils rtlconsts dos objects - -rsts=math typinfo sysconst rtlconsts - -[require] -nortl=y - -[clean] -units=sysgba gba - -[install] -fpcpackage=y - -[default] -fpcdir=../.. -target=gba - -[compiler] -includedir=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET) -sourcedir=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET) -targetdir=. - -[lib] -libname=libfprtl.so -libversion=2.0.0 -libunits=$(SYSTEMUNIT) objpas strings \ - unix ports \ - dos crt objects printer \ - sysutils typinfo math \ - cpu mmx getopts heaptrc \ - errors - -[prerules] -RTL=.. -INC=$(RTL)/inc -PROCINC=$(RTL)/$(CPU_TARGET) -UNIXINC=$(RTL)/unix - -ifeq ($(CPU_TARGET),i386) -CRT21=cprt21 gprt21 -CPU_UNITS=x86 ports cpu mmx graph -else -CPU_UNITS= -endif - -UNITPREFIX=rtl - -ifeq ($(findstring 1.0.,$(FPC_VERSION)),) -SYSTEMUNIT=system -LINUXUNIT1= -ifeq ($(CPU_TARGET),i386) -CPU_UNITS+=oldlinux -endif -LINUXUNIT2=linux -else -SYSTEMUNIT=sysgba -LINUXUNIT1=gba -LINUXUNIT2= -override FPCOPT+=-dUNIX -endif - -# Use new feature from 1.0.5 version -# that generates release PPU files -# which will not be recompiled -ifdef RELEASE -override FPCOPT+=-Ur -endif - -# Paths -OBJPASDIR=$(RTL)/objpas -#GRAPHDIR=$(INC)/graph - -# Use new graph unit ? -# NEWGRAPH=YES -# Use LibGGI ? -# Use -# -ifndef USELIBGGI -USELIBGGI=NO -endif - -[rules] -# Get the $(SYSTEMUNIT) independent include file names. -# This will set the following variables : -# SYSINCNAMES -include $(INC)/makefile.inc -SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES)) - -# Get the processor dependent include file names. -# This will set the following variables : -# CPUINCNAMES -include $(PROCINC)/makefile.cpu -SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES)) - -# Put $(SYSTEMUNIT) unit dependencies together. -SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS) - - -# -# Loaders -# - -prt0$(OEXT) : $(CPU_TARGET)/prt0.as - $(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/prt0.as - - -# -# $(SYSTEMUNIT) Units ($(SYSTEMUNIT), Objpas, Strings) -# - -$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS) - $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp - -objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp - -dateutils$(PPUEXT): $(OBJPASDIR)/dateutils.pp $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp - -strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\ - $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\ - $(SYSTEMUNIT)$(PPUEXT) - -# -# $(SYSTEMUNIT) Dependent Units -# - -#unix$(PPUEXT) : unix.pp strings$(PPUEXT) baseunix$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \ -# unxconst.inc $(UNIXINC)/timezone.inc $(SYSTEMUNIT)$(PPUEXT) \ -# unxfunc.inc - -unixtype$(PPUEXT) : $(UNIXINC)/unixtype.pp ptypes.inc $(UNIXINC)/ctypes.inc $(SYSTEMUNIT)$(PPUEXT) - -baseunix$(PPUEXT) : errno.inc ptypes.inc $(UNIXINC)/ctypes.inc \ - $(UNIXINC)/bunxh.inc \ - bunxsysc.inc $(CPU_TARGET)/syscallh.inc $(CPU_TARGET)/sysnr.inc \ - ostypes.inc osmacro.inc $(UNIXINC)/gensigset.inc \ - $(UNIXINC)/genfuncs.inc $(SYSTEMUNIT)$(PPUEXT) - -ports$(PPUEXT) : ports.pp unix$(PPUEXT) objpas$(PPUEXT) - -#dl$(PPUEXT) : $(UNIXINC)/dl.pp $(SYSTEMUNIT)$(PPUEXT) - -#dynlibs$(PPUEXT) : $(INC)/dynlibs.pp $(UNIXINC)/dynlibs.inc dl$(PPUEXT) objpas$(PPUEXT) - -# -# TP7 Compatible RTL Units -# - -dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \ - unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - -#crt$(PPUEXT) : crt.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - -objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT) - -#printer$(PPUEXT) : printer.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - -# -# Graph -# -#include $(GRAPHDIR)/makefile.inc -#GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES)) - -#graph$(PPUEXT) : graph.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \ -# $(GRAPHINCDEPS) $(UNIXINC)/graph16.inc -# $(COMPILER) -I$(GRAPHDIR) $(UNIXINC)/graph.pp - -#ggigraph$(PPUEXT) : $(UNIXINC)/ggigraph.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \ -# $(GRAPHINCDEPS) -# $(COMPILER) -I$(GRAPHDIR) $(UNIXINC)/ggigraph.pp - -# -# Delphi Compatible Units -# - -sysutils$(PPUEXT) : $(UNIXINC)/sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \ - objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT) - $(COMPILER) -Fi$(OBJPASDIR)/sysutils $(UNIXINC)/sysutils.pp - -classes$(PPUEXT) : $(UNIXINC)/classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \ - sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) - $(COMPILER) -Fi$(OBJPASDIR)/classes $(UNIXINC)/classes.pp - -typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) sysutils$(PPUEXT) rtlconsts$(PPUEXT) - $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp - -math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT) - $(COMPILER) $(OBJPASDIR)/math.pp - -gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT) - $(COMPILER) $(OBJPASDIR)/gettext.pp - -#varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \ -# $(OBJPASDIR)/varutilh.inc varutils.pp sysutils$(PPUEXT) -# $(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp - -#variants$(PPUEXT) : $(INC)/variants.pp sysutils$(PPUEXT) sysconst$(PPUEXT) varutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) -# $(COMPILER) -Fi$(INC) $(INC)/variants.pp - -types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) $(OBJPASDIR)/types.pp - -sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) $(OBJPASDIR)/sysconst.pp - -rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) $(OBJPASDIR)/rtlconsts.pp - -strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \ - sysutils$(PPUEXT) - $(COMPILER) $(OBJPASDIR)/strutils.pp - -# -# Mac Pascal Model -# - -#macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT) -# $(COMPILER) $(INC)/macpas.pp $(REDIR) - -# -# Other $(SYSTEMUNIT)-independent RTL Units -# - -cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT) - -#mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - -getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT) - -heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) -Sg $(INC)/heaptrc.pp - -lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) - -charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT) - -#ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - -# -# Other $(SYSTEMUNIT)-dependent RTL Units -# - -#sockets$(PPUEXT) : sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \ -# unixsock.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - -errors$(PPUEXT) : errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - -#ipc$(PPUEXT) : ipc.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - -#terminfo$(PPUEXT) : terminfo.pp unix$(PPUEXT) - -callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT) - -cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT) - -cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp $(SYSTEMUNIT)$(PPUEXT) - -#cwstring$(PPUEXT) : $(UNIXINC)/cwstring.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) baseunix$(PPUEXT) unix$(PPUEXT) unixtype$(PPUEXT) ctypes$(PPUEXT) - -#gpm$(PPUEXT): gpm.pp unix$(PPUEXT) baseunix$(PPUEXT) sockets$(PPUEXT) - -ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT) - diff --git a/rtl/gba/fpc4gba.txt b/rtl/gba/fpc4gba.txt deleted file mode 100644 index a02d714c46..0000000000 --- a/rtl/gba/fpc4gba.txt +++ /dev/null @@ -1,159 +0,0 @@ -+-------------------------------------+ -| Let's build a gba compiler with fpc | -+-------------------------------------+ -| Author: Francesco Lombardi | -| Release date: 2005.08.09 | -+-------------------------------------+ - - -Tools needed ------------- --FPC compiler for your platform, ver 2.0.0 (http://www.freepascal.org/) --FPC sources, ver 2.0.0 (http://www.freepascal.org/) --MSYS (http://www.mingw.org/msys.shtml) --An emulator with integrated debugger or, at least, a memory viewer, like -Boycott Advance (http://www.ngemu.com/gba/bca.php main site does not work) -or Visual Boy Advance Development version (http://vba.ngemu.com/) - - -Foreword --------- -I'l use MSYS, because I'm confortable with POSIX-like ambient. It is a fork of -cygwin, but more friendly for win32 users. However, feel free to use dos prompt -if you like it. Remember that MSYS includes GNU Make utility, that is needed in -order to build freepascal. -In the source files provided with this package, you can find occasionally some -comments, that explain the changes made. - - -Preparing all things --------------------- -Install fpc compiler as usual in a directory of your choice (eg. c:\fpc); -extract fpc sources in fpc binaries directory (eg. c:\fpc\source). If you -decided for MSYS, install it. - - -Compiler modification ---------------------- -Copy the files you found in "Compiler" directory of this package, following this -scheme: - - t_gba.pas in %FreePascal%\source\compiler\systems - - i_gba.pas in %FreePascal%\source\compiler\systems - - cputarg.pas in %FreePascal%\source\compiler\arm - - compiler.pas in %FreePascal%\source\compiler - - systems.pas in %FreePascal%\source\compiler -Now open msys (or a dos prompt), go to %FreePascal%\source\compiler and run -"make PPC_TARGET=arm". -Go to %FreePascal%\bin\i386-win32, make a new directory 'arm-gba' and copy here -the new generated file ppcarm.exe. Extract and copy here the files in -win32_arm_binutils.zip (ls.exe, ld.exe, objcopy.exe and cygwin1.dll). Now add -'%FreePascal%\bin\i386-win32\arm-gba' in the search path. - - -FPCMake modification --------------------- -Copy the files you found in "FPCMake" directory of this package in the directory - - %FreePascal%\source\utils\fpcm - -In msys (or a dos prompt), go to %FreePascal%\source\utils\fpcm and run -"make". Go to %FreePascal%\bin\i386-win32 and copy here the new generated file -fpcmake.exe. This utility is useful when you try to build the rtl, because it -generates all makefiles starting from a smuch more simple makefile.fpc. - - -RTL Modification ----------------- -Go in %FreePascal%\source\rtl, make a copy of 'linux' directory and rename it -'gba'. Go in the new created 'gba' and delete all subdirectories, except 'arm'. -Delete the files system.pp, syslinux.pp, makefile and makefile.fpc. Go in 'arm' -subdirectory and delete all .as files. -Copy the files you found in "RTL" directory of this package, following this -scheme: - - system.pp in %FreePascal%\source\rtl\gba - - sysgba.pp in %FreePascal%\source\rtl\gba - - makefile.fpc in %FreePascal%\source\rtl\gba - - prt0.as in %FreePascal%\source\rtl\gba\arm - - unix.pp in %FreePascal%\source\rtl\unix - -Go to %FreePascal%\source\rtl, open makefile.fpc and add a new target: - - ... - ... - [target] - ... - dirs_gba=gba - -In msys (or a dos prompt), go to %FreePascal%\source\rtl and run -"fpcmake -Tall -r -w": this command rebuild all makefiles. Now do a "make -distclean", then run 'make CPU_TARGET=arm OS_TARGET=gba PP=ppcarm OPT="-Tgba"' -At the end of the compiling, you can find a new directory: - - %FreePascal%\source\rtl\units\arm-gba - -Copy the directory 'arm-gba' and all its content in - - %FreePascal%\units - - -Ending ------- -Now you can try to compile some pascal code, like the examples in the package: - - ppcarm -Tgba -n -Fuc:\fpc\units\arm-gba gba.pp - -Look at compile.bat. It produces a gba.gba file, but if you try to run on a gba -emu, it does not work (you must see if 0x04000000 address contains 0x0403). - -At this point you can try a trick: remove from gba.s the following lines: - -line Asm Code ----- -------- -... -[22] bl FPC_INITIALIZEUNITS -... -[40] bl FPC_DO_EXIT -... -[57] .globl THREADVARLIST_P$GBA -[58] THREADVARLIST_P$GBA: -[59] .long 0 -[60] .Le1: -[61] .size THREADVARLIST_P$GBA, .Le1 - THREADVARLIST_P$GBA -[62] .balign 4 -[63] .globl FPC_THREADVARTABLES -[64] FPC_THREADVARTABLES: -[65] .long 2 -[66] .long THREADVARLIST_SYSTEM -[67] .long THREADVARLIST_P$GBA -[68] .Le2: -[69] .size FPC_THREADVARTABLES, .Le2 - FPC_THREADVARTABLES -[70] .balign 4 -[71] .globl FPC_RESOURCESTRINGTABLES -[72] FPC_RESOURCESTRINGTABLES: -[73] .long 0 -[74] .Le3: -[75] .size FPC_RESOURCESTRINGTABLES, .Le3 - FPC_RESOURCESTRINGTABLES -[76] .balign 4 -[77] .globl INITFINAL -[78] INITFINAL: -[79] .long 1,0 -[80] .long INIT$_SYSTEM -[81] .long FINALIZE$_SYSTEM -[82] .Le4: -[83] .size INITFINAL, .Le4 - INITFINAL -[84] .balign 4 - -This 'garbage' (sorry fpk ^_^) is initialization code added from fpc compiler, -but interferes with our initialization code. -Now run compile2.bat; the gba.gba file runs fine in the emu (flags correctly -set, rom header good). - - -Next steps? ------------ -Well, we need some further rtl hacking to handle fpc initialization code, that's -beyond my knowledge. You can try to download a pdf with fpc internals -(comparch.pdf) for more infos, but I think that an help from fpk & friends could -be better ^_^ -About prt0.s: the file provided works fine for our initial purposes, but someday -we must use a startup file more advanced for handle all gba capabilities.
\ No newline at end of file diff --git a/rtl/gba/prt0.as b/rtl/gba/prt0.as deleted file mode 100644 index 1be331fd37..0000000000 --- a/rtl/gba/prt0.as +++ /dev/null @@ -1,101 +0,0 @@ -@******************************************************************** -@* crt0.s * -@ This file is a hack. It is not meant for serious work. * -@******************************************************************** - .TEXT - - .GLOBAL _start -_start: - .ALIGN - .CODE 32 - @ Start Vector -rom_header: b rom_header_end - - @ Nintendo Logo Character Data (8000004h) - .byte 0x24,0xff,0xae,0x51,0x69,0x9a,0xa2,0x21 - .byte 0x3d,0x84,0x82,0x0a,0x84,0xe4,0x09,0xad - .byte 0x11,0x24,0x8b,0x98,0xc0,0x81,0x7f,0x21 - .byte 0xa3,0x52,0xbe,0x19,0x93,0x09,0xce,0x20 - .byte 0x10,0x46,0x4a,0x4a,0xf8,0x27,0x31,0xec - .byte 0x58,0xc7,0xe8,0x33,0x82,0xe3,0xce,0xbf - .byte 0x85,0xf4,0xdf,0x94,0xce,0x4b,0x09,0xc1 - .byte 0x94,0x56,0x8a,0xc0,0x13,0x72,0xa7,0xfc - .byte 0x9f,0x84,0x4d,0x73,0xa3,0xca,0x9a,0x61 - .byte 0x58,0x97,0xa3,0x27,0xfc,0x03,0x98,0x76 - .byte 0x23,0x1d,0xc7,0x61,0x03,0x04,0xae,0x56 - .byte 0xbf,0x38,0x84,0x00,0x40,0xa7,0x0e,0xfd - .byte 0xff,0x52,0xfe,0x03,0x6f,0x95,0x30,0xf1 - .byte 0x97,0xfb,0xc0,0x85,0x60,0xd6,0x80,0x25 - .byte 0xa9,0x63,0xbe,0x03,0x01,0x4e,0x38,0xe2 - .byte 0xf9,0xa2,0x34,0xff,0xbb,0x3e,0x03,0x44 - .byte 0x78,0x00,0x90,0xcb,0x88,0x11,0x3a,0x94 - .byte 0x65,0xc0,0x7c,0x63,0x87,0xf0,0x3c,0xaf - .byte 0xd6,0x25,0xe4,0x8b,0x38,0x0a,0xac,0x72 - .byte 0x21,0xd4,0xf8,0x07 - - @ Software Titles (80000A0h) - .byte 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00 - .byte 0x00,0x00,0x00,0x00 - - @ Initial Code (80000ACh) - .byte 0x00,0x00,0x00,0x00 - - @ Maker Code (80000B0h) - .byte 0x30,0x31 - - @ Fixed Value (80000B2h) - .byte 0x96 - - @ Main Unit Code (80000B3h) - .byte 0x00 - - @ Device Type (80000B4h) - .byte 0x00 - - @ Unused Data (7Byte) (80000B5h) - .byte 0x00,0x00,0x00,0x00,0x00,0x00,0x00 - - @ Software Version No (80000BCh) - .byte 0x00 - - @ Complement Check (80000BDh) - .byte 0xf0 - - @ Check Sum (80000BEh) - .byte 0x00,0x00 - -rom_header_end: - -@-------------------------------------------------------------------- -@- Reset - -@-------------------------------------------------------------------- - .EXTERN PASCALMAIN - .GLOBAL start_vector - .CODE 32 - .ALIGN -start_vector: - mov r0, #0x12 @ Switch to IRQ Mode - msr cpsr, r0 - - ldr sp, sp_irq @ Set SP_irq - - mov r0, #0x1f @ Switch to System Mode - msr cpsr, r0 - - ldr sp, sp_usr @ Set SP_usr - str r0, [r1] - - ldr r1, =PASCALMAIN @ Start & Switch to 16bit Code - mov lr, pc - bx r1 - - b start_vector @ Reset - - .ALIGN -sp_usr: .word 0x3008000 - 0x100 -sp_irq: .word 0x3008000 - 0x60 - - .ALIGN - .CODE 32 - - .END diff --git a/rtl/gba/sysgba.pp b/rtl/gba/sysgba.pp deleted file mode 100644 index 4d342eaddd..0000000000 --- a/rtl/gba/sysgba.pp +++ /dev/null @@ -1 +0,0 @@ -{$i system.pp} diff --git a/rtl/gba/system.pp b/rtl/gba/system.pp deleted file mode 100644 index 778f5cd283..0000000000 --- a/rtl/gba/system.pp +++ /dev/null @@ -1,295 +0,0 @@ -{ - $Id: system.pp,v 1.25 2005/04/24 21:19:22 peter Exp $ - This file is part of the Free Pascal run time librar~y. - Copyright (c) 2000 by Marco van de Voort - member of the Free Pascal development team. - - System unit for Linux. - - 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. - - **********************************************************************} - -{ These things are set in the makefile, } -{ But you can override them here.} - - -{ If you use an aout system, set the conditional AOUT} -{.$Define AOUT} - -Unit {$ifdef VER1_0}Sysgba{$else}System{$endif}; - -Interface - -{$define FPC_IS_SYSTEM} - -{$i osdefs.inc} - -{$I sysunixh.inc} - -Implementation - - -{$I system.inc} - - -{***************************************************************************** - Misc. System Dependent Functions -*****************************************************************************} - -//procedure fpc_initializeunits;[public,alias:'FPC_INITIALIZEUNITS']; -//begin -// { dummy } -//end; - -//procedure fpc_do_exit;[public,alias:'FPC_DO_EXIT']; -//begin -// { dummy } -//end; - -//procedure halt; [public,alias:'FPC_HALT_ZERO']; -//begin -// fpc_do_exit; -//end; - - - -///-F-/// procedure haltproc(e:longint);cdecl;external name '_haltproc'; - -procedure System_exit; -begin -///-F-/// haltproc(ExitCode); -End; - - -Function ParamCount: Longint; -Begin -///-F-/// Paramcount:=argc-1 -End; - - -function BackPos(c:char; const s: shortstring): integer; -var - i: integer; -Begin - for i:=length(s) downto 0 do - if s[i] = c then break; - if i=0 then - BackPos := 0 - else - BackPos := i; -end; - - - { variable where full path and filename and executable is stored } - { is setup by the startup of the system unit. } -var - execpathstr : shortstring; - -function paramstr(l: longint) : string; - begin - { stricly conforming POSIX applications } - { have the executing filename as argv[0] } -///-F-/// if l=0 then -///-F-/// begin -///-F-/// paramstr := execpathstr; -///-F-/// end -///-F-/// else -///-F-/// paramstr:=strpas(argv[l]); - end; - -Procedure Randomize; -Begin - randseed:=longint(Fptime(nil)); -End; - - -{***************************************************************************** - SystemUnit Initialization -*****************************************************************************} - -function reenable_signal(sig : longint) : boolean; -var - e : TSigSet; - i,j : byte; -begin - fillchar(e,sizeof(e),#0); - { set is 1 based PM } - dec(sig); - i:=sig mod 32; - j:=sig div 32; - e[j]:=1 shl i; - fpsigprocmask(SIG_UNBLOCK,@e,nil); - reenable_signal:=geterrno=0; -end; - - -// signal handler is arch dependant due to processorexception to language -// exception translation - -{$i sighnd.inc} - -var - act: SigActionRec; - -Procedure InstallSignals; -begin - { Initialize the sigaction structure } - { all flags and information set to zero } - FillChar(act, sizeof(SigActionRec),0); - { initialize handler } - act.sa_handler := SigActionHandler(@SignalToRunError); - act.sa_flags:=SA_SIGINFO -{$ifdef cpux86_64} - or $4000000 -{$endif cpux86_64} - ; - FpSigAction(SIGFPE,@act,nil); - FpSigAction(SIGSEGV,@act,nil); - FpSigAction(SIGBUS,@act,nil); - FpSigAction(SIGILL,@act,nil); -end; - -procedure SetupCmdLine; -var - bufsize, - len,j, - size,i : longint; - found : boolean; - buf : pchar; - - procedure AddBuf; - begin - reallocmem(cmdline,size+bufsize); - move(buf^,cmdline[size],bufsize); - inc(size,bufsize); - bufsize:=0; - end; - -begin -///-F-/// -{ - GetMem(buf,ARG_MAX); - size:=0; - bufsize:=0; - i:=0; - while (i<argc) do - begin - len:=strlen(argv[i]); - if len>ARG_MAX-2 then - len:=ARG_MAX-2; - found:=false; - for j:=1 to len do - if argv[i][j]=' ' then - begin - found:=true; - break; - end; - if bufsize+len>=ARG_MAX-2 then - AddBuf; - if found then - begin - buf[bufsize]:='"'; - inc(bufsize); - end; - move(argv[i]^,buf[bufsize],len); - inc(bufsize,len); - if found then - begin - buf[bufsize]:='"'; - inc(bufsize); - end; - if i<argc then - buf[bufsize]:=' ' - else - buf[bufsize]:=#0; - inc(bufsize); - inc(i); - end; - AddBuf; - FreeMem(buf,ARG_MAX); -///-F-/// -} -end; - - -procedure SysInitStdIO; -begin - OpenStdIO(Input,fmInput,StdInputHandle); - OpenStdIO(Output,fmOutput,StdOutputHandle); - OpenStdIO(ErrOutput,fmOutput,StdErrorHandle); - OpenStdIO(StdOut,fmOutput,StdOutputHandle); - OpenStdIO(StdErr,fmOutput,StdErrorHandle); -end; - - -procedure SysInitExecPath; -var - i : longint; -begin - execpathstr[0]:=#0; - i:=Fpreadlink('/proc/self/exe',@execpathstr[1],high(execpathstr)); - { it must also be an absolute filename, linux 2.0 points to a memory - location so this will skip that } - if (i>0) and (execpathstr[1]='/') then - execpathstr[0]:=char(i); -end; - -function GetProcessID: SizeUInt; -begin - GetProcessID := SizeUInt (fpGetPID); -end; - - -Begin -///-F-/// IsConsole := TRUE; -///-F-/// IsLibrary := FALSE; - StackLength := InitialStkLen; - StackBottom := Sptr - StackLength; - { Set up signals handlers } - InstallSignals; - { Setup heap } - InitHeap; - SysInitExceptions; - { Arguments } -///-F-/// SetupCmdLine; - SysInitExecPath; - { Setup stdin, stdout and stderr } - SysInitStdIO; - { Reset IO Error } - InOutRes:=0; - { threading } - InitSystemThreads; -{$ifdef HASVARIANT} -///-F-/// initvariantmanager; -{$endif HASVARIANT} -{$ifdef HASWIDESTRING} -///-F-/// initwidestringmanager; -{$endif HASWIDESTRING} -End. - -{ - $Log: system.pp,v $ - Revision 1.25 2005/04/24 21:19:22 peter - * unblock signal in signalhandler, remove the sigprocmask call - from setjmp - - Revision 1.24 2005/02/14 17:13:30 peter - * truncate log - - Revision 1.23 2005/02/13 21:47:56 peter - * include file cleanup part 2 - - Revision 1.22 2005/02/06 11:20:52 peter - * threading in system unit - * removed systhrds unit - - Revision 1.21 2005/02/01 20:22:49 florian - * improved widestring infrastructure manager - -} diff --git a/rtl/gba/unix.pp b/rtl/gba/unix.pp deleted file mode 100644 index 73a0794848..0000000000 --- a/rtl/gba/unix.pp +++ /dev/null @@ -1,1250 +0,0 @@ -{ - $Id: unix.pp,v 1.85 2005/03/25 22:53:39 jonas Exp $ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by Michael Van Canneyt, - BSD parts (c) 2000 by Marco van de Voort - members of the Free Pascal development team. - - 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 Unix; -Interface - -Uses BaseUnix,UnixType; - -{$i aliasptp.inc} - -{ Get Types and Constants only exported in this unit } -{$i unxconst.inc} - -// We init to zero to be able to put timezone stuff under IFDEF, and still -// keep the code working. - -var - Tzseconds : Longint {$ifndef ver1_0} = 0 {$endif}; - - -{******************** - File -********************} - -Const - P_IN = 1; // pipes (?) - P_OUT = 2; - -Const - LOCK_SH = 1; // flock constants ? - LOCK_EX = 2; - LOCK_UN = 8; - LOCK_NB = 4; - -Type - Tpipe = baseunix.tfildes; // compability. - -{****************************************************************************** - Procedure/Functions -******************************************************************************} - -{************************** - Time/Date Handling -***************************} - -var - tzdaylight : boolean; - tzname : array[boolean] of pchar; - -{$IFNDEF DONT_READ_TIMEZONE} // allows to disable linking in and trying for platforms - // it doesn't (yet) work for. - -{ timezone support } -procedure GetLocalTimezone(timer:cint;var leap_correct,leap_hit:cint); -procedure GetLocalTimezone(timer:cint); -procedure ReadTimezoneFile(fn:string); -function GetTimezoneFile:string; -{$ENDIF} - -{************************** - Process Handling -***************************} - -// -// These are much better, in nearly all ways. -// - -function FpExecLE (Const PathName:AnsiString;const S:Array Of AnsiString;MyEnv:ppchar):cint; -function FpExecL(Const PathName:AnsiString;const S:Array Of AnsiString):cint; -function FpExecLP(Const PathName:AnsiString;const S:Array Of AnsiString):cint; -function FpExecV(Const PathName:AnsiString;args:ppchar):cint; -function FpExecVP(Const PathName:AnsiString;args:ppchar):cint; -function FpExecVPE(Const PathName:AnsiString;args,env:ppchar):cint; - -Function Shell (const Command:String):cint; -Function Shell (const Command:AnsiString):cint; -Function fpSystem(const Command:AnsiString):cint; - -Function WaitProcess (Pid:cint):cint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated} - -Function WIFSTOPPED (Status: Integer): Boolean; -Function W_EXITCODE (ReturnCode, Signal: Integer): Integer; -Function W_STOPCODE (Signal: Integer): Integer; - -{************************** - File Handling -***************************} - -{$ifndef FPC_USE_LIBC} // defined using cdecl for libc. -Function fsync (fd : cint) : cint; -Function fpFlock (fd,mode : cint) : cint ; -Function fStatFS (Fd: cint;Var Info:tstatfs):cint; -Function StatFS (Path:pchar;Var Info:tstatfs):cint; -{$endif} - -Function fpFlock (var T : text;mode : cint) : cint; -Function fpFlock (var F : File;mode : cint) : cint; - - -Function SelectText (var T:Text;TimeOut :PTimeVal):cint; -Function SelectText (var T:Text;TimeOut :cint):cint; - -{************************** - Directory Handling -***************************} - -procedure SeekDir(p:pdir;loc:clong); -function TellDir(p:pdir):clong; - -{************************** - Pipe/Fifo/Stream -***************************} - -Function AssignPipe (var pipe_in,pipe_out:cint):cint; -Function AssignPipe (var pipe_in,pipe_out:text):cint; -Function AssignPipe (var pipe_in,pipe_out:file):cint; -//Function PClose (Var F:text) : cint; -//Function PClose (Var F:file) : cint; -Function POpen (var F:text;const Prog:String;rw:char):cint; -Function POpen (var F:file;const Prog:String;rw:char):cint; -Function AssignStream(Var StreamIn,Streamout:text;Const Prog:ansiString;const args : array of ansistring) : cint; -Function AssignStream(Var StreamIn,Streamout,streamerr:text;Const Prog:ansiString;const args : array of ansistring) : cint; - -{$ifdef linux} -Function GetDomainName:String; -{$endif} -Function GetHostName:String; - - -{************************** - Memory functions -***************************} - -const - PROT_READ = $1; { page can be read } - PROT_WRITE = $2; { page can be written } - PROT_EXEC = $4; { page can be executed } - PROT_NONE = $0; { page can not be accessed } - - MAP_SHARED = $1; { Share changes } -// MAP_PRIVATE = $2; { Changes are private } - MAP_TYPE = $f; { Mask for type of mapping } - MAP_FIXED = $10; { Interpret addr exactly } -// MAP_ANONYMOUS = $20; { don't use a file } - -{$ifdef Linux} - MAP_GROWSDOWN = $100; { stack-like segment } - MAP_DENYWRITE = $800; { ETXTBSY } - MAP_EXECUTABLE = $1000; { mark it as an executable } - MAP_LOCKED = $2000; { pages are locked } - MAP_NORESERVE = $4000; { don't check for reservations } -{$else} - {$ifdef FreeBSD} - // FreeBSD defines MAP_COPY=MAP_PRIVATE=$2; - MAP_FILE = $0000; { map from file (default) } - MAP_ANON = $1000; { allocated from memory, swap space } - - MAP_RENAME = $0020; { Sun: rename private pages to file } - MAP_NORESERVE = $0040; { Sun: don't reserve needed swap area } - MAP_INHERIT = $0080; { region is retained after exec } - MAP_NOEXTEND = $0100; { for MAP_FILE, don't change file size } - MAP_HASSEMAPHORE = $0200; { region may contain semaphores } - MAP_STACK = $0400; { region grows down, like a stack } - MAP_NOSYNC = $0800; { page to but do not sync underlying file} - MAP_NOCORE = $20000;{ dont include these pages in a coredump} - {$endif} -{$endif} -{************************** - Utility functions -***************************} - -Type - TFSearchOption = (NoCurrentDirectory, - CurrentDirectoryFirst, - CurrentDirectoryLast); - -Function FSearch (const path:AnsiString;dirlist:Ansistring;CurrentDirStrategy:TFSearchOption):AnsiString; -Function FSearch (const path:AnsiString;dirlist:AnsiString):AnsiString; - -procedure SigRaise (sig:integer); - -{$ifdef FPC_USE_LIBC} - const clib = 'c'; - {$i unxdeclh.inc} -{$else} - {$i unxsysch.inc} // calls used in system and not reexported from baseunix -{$endif} - -{****************************************************************************** - Implementation -******************************************************************************} - -{$i unxovlh.inc} - -Implementation - -Uses Strings{$ifndef FPC_USE_LIBC},Syscall{$endif}; - -{$i unxovl.inc} - -{$ifndef FPC_USE_LIBC} - {$i syscallh.inc} - {$i unxsysc.inc} -{$endif} - -{ Get the definitions of textrec and filerec } -{$i textrec.inc} -{$i filerec.inc} - -{$i unxfunc.inc} { Platform specific implementations } - -Function getenv(name:string):Pchar; external name 'FPC_SYSC_FPGETENV'; - -{****************************************************************************** - Process related calls -******************************************************************************} - -{ Most calls of WaitPID do not handle the result correctly, this funktion treats errors more correctly } -Function WaitProcess(Pid:cint):cint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated} -var - r,s : cint; -begin - s:=$7F00; - - repeat - r:=fpWaitPid(Pid,@s,0); - if (r=-1) and (fpgeterrno=ESysEIntr) Then - r:=0; - until (r<>0); - if (r=-1) or (r=0) then // 0 is not a valid return and should never occur (it means status invalid when using WNOHANG) - WaitProcess:=-1 // return -1 to indicate an error. fpwaitpid updated it. - else - begin - if wifexited(s) then - WaitProcess:=wexitstatus(s) - else if (s>0) then // Until now there is not use of the highest bit , but check this for the future - WaitProcess:=-s // normal case - else - WaitProcess:=s; // s<0 should not occur, but wie return also a negativ value - end; -end; - -function intFpExecVEMaybeP (Const PathName:AnsiString;Args,MyEnv:ppchar;SearchPath:Boolean):cint; -// does an ExecVE, but still has to handle P -// execv variants call this directly, execl variants indirectly via -// intfpexecl - -Var - NewCmd : ansistring; - ThePath : AnsiString; - -Begin - If SearchPath and (pos('/',pathname)=0) Then - Begin - // The above could be better. (check if not escaped/quoted '/'s) ? - // (Jilles says this is ok) - // Stevens says only search if newcmd contains no '/' - // fsearch is not ansistring clean yet. - ThePath:=fpgetenv('PATH'); - if thepath='' then - thepath:='.'; // FreeBSD uses _PATH_DEFPATH = /usr/bin:/bin - // but a quick check showed that _PATH_DEFPATH - // varied from OS to OS - - newcmd:=FSearch(pathname,thepath,NoCurrentDirectory); - // FreeBSD libc keeps on trying till a file is successfully run. - // Stevens says "try each path prefix" - - // execp puts newcmd here. - args^:=pchar(newcmd); - End else - newcmd:=pathname; - // repeat -// if searchpath then args^:=pchar(commandtorun) - - IntFpExecVEMaybeP:=fpExecVE(newcmd,Args,MyEnv); -{ -// Code that if exec fails due to permissions, tries to run it with sh -// Should we deallocate p on fail? -> no fpexit is run no matter what -// -} -// if intfpexecvemaybep=-1 then zoekvolgende file. -// until (Goexit) or SearchExit; - - -{ - If IntFpExec=-1 Then - Begin - Error:=fpGetErrno - Case Error of - ESysE2Big : Exit(-1); - ESysELoop, - : Exit(-1); - -} -end; - -function intFpExecl (Const PathName:AnsiString;const s:array of ansistring;MyEnv:ppchar;SearchPath:Boolean):cint; -{ Handles the array of ansistring -> ppchar conversion. - Base for the the "l" variants. -} -var p:ppchar; - -begin - If PathName='' Then - Begin - fpsetErrno(ESysEnoEnt); - Exit(-1); // Errno? - End; - p:=ArrayStringToPPchar(s,1); - if p=NIL Then - Begin - GetMem(p,2*sizeof(pchar)); - if p=nil then - begin - {$ifdef xunix} - fpseterrno(ESysEnoMem); - {$endif} - fpseterrno(ESysEnoEnt); - exit(-1); - end; - p[1]:=nil; - End; - p^:=pchar(PathName); - IntFPExecL:=intFpExecVEMaybeP(PathName,p,MyEnv,SearchPath); - // If we come here, no attempts were executed successfully. - Freemem(p); -end; - -function FpExecLE (Const PathName:AnsiString;const S:Array Of AnsiString;MyEnv:ppchar):cint; - -Begin - FpExecLE:=intFPExecl(PathName,s,MyEnv,false); -End; - -function FpExecL(Const PathName:AnsiString;const S:Array Of AnsiString):cint; - -Begin - FpExecL:=intFPExecl(PathName,S,EnvP,false); -End; - -function FpExecLP(Const PathName:AnsiString;const S:Array Of AnsiString):cint; - -Begin - FpExecLP:=intFPExecl(PathName,S,EnvP,True); -End; - -function FpExecV(Const PathName:AnsiString;args:ppchar):cint; - -Begin - fpexecV:=intFpExecVEMaybeP (PathName,args,envp,false); -End; - -function FpExecVP(Const PathName:AnsiString;args:ppchar):cint; - -Begin - fpexecVP:=intFpExecVEMaybeP (PathName,args,envp,true); -End; - -function FpExecVPE(Const PathName:AnsiString;args,env:ppchar):cint; - -Begin - fpexecVPE:=intFpExecVEMaybeP (PathName,args,env,true); -End; - -// exect and execvP (ExecCapitalP) are not implement -// Non POSIX anyway. -// Exect turns on tracing for the process -// execvP has the searchpath as array of ansistring ( const char *search_path) - -{$define FPC_USE_FPEXEC} -Function Shell(const Command:String):cint; -{ - Executes the shell, and passes it the string Command. (Through /bin/sh -c) - The current environment is passed to the shell. - It waits for the shell to exit, and returns its exit status. - If the Exec call failed exit status 127 is reported. -} -{ Changed the structure: -- the previous version returns an undefinied value if fork fails -- it returns the status of Waitpid instead of the Process returnvalue (see the doc to Shell) -- it uses exit(127) not ExitProc (The Result in pp386: going on Compiling in 2 processes!) -- ShellArgs are now released -- The Old CreateShellArg gives back pointers to a local var -} -var -{$ifndef FPC_USE_FPEXEC} - p : ppchar; -{$endif} - pid : cint; -begin - {$ifndef FPC_USE_FPEXEC} - p:=CreateShellArgv(command); -{$endif} - pid:=fpfork; - if pid=0 then // We are in the Child - begin - {This is the child.} - {$ifndef FPC_USE_FPEXEC} - fpExecve(p^,p,envp); - {$else} - fpexecl('/bin/sh',['-c',Command]); - {$endif} - fpExit(127); // was Exit(127) - end - else if (pid<>-1) then // Successfull started - Shell:=WaitProcess(pid) - else // no success - Shell:=-1; // indicate an error - {$ifndef FPC_USE_FPEXEC} - FreeShellArgV(p); - {$endif} -end; - -Function Shell(const Command:AnsiString):cint; -{ - AnsiString version of Shell -} -var -{$ifndef FPC_USE_FPEXEC} - p : ppchar; -{$endif} - pid : cint; -begin { Changes as above } -{$ifndef FPC_USE_FPEXEC} - p:=CreateShellArgv(command); -{$endif} - pid:=fpfork; - if pid=0 then // We are in the Child - begin - {$ifdef FPC_USE_FPEXEC} - fpexecl('/bin/sh',['-c',Command]); - {$else} - fpExecve(p^,p,envp); - {$endif} - fpExit(127); // was exit(127)!! We must exit the Process, not the function - end - else if (pid<>-1) then // Successfull started - Shell:=WaitProcess(pid) - else // no success - Shell:=-1; - {$ifndef FPC_USE_FPEXEC} - FreeShellArgV(p); - {$ENDIF} -end; - - -{$ifdef FPC_USE_LIBC} -function xfpsystem(p:pchar):cint; cdecl; external clib name 'system'; - -Function fpSystem(const Command:AnsiString):cint; -begin - fpsystem:=xfpsystem(pchar(command)); -end; -{$else} -Function fpSystem(const Command:AnsiString):cint; -{ - AnsiString version of Shell -} -var - pid,savedpid : cint; - pstat : cint; - ign,intact, - quitact : SigactionRec; - newsigblock, - oldsigblock : tsigset; - -begin { Changes as above } - if command='' then exit(1); - ign.sa_handler:=SigActionHandler(SIG_IGN); - fpsigemptyset(ign.sa_mask); - ign.sa_flags:=0; - fpsigaction(SIGINT, @ign, @intact); - fpsigaction(SIGQUIT, @ign, @quitact); - fpsigemptyset(newsigblock); - fpsigaddset(newsigblock,SIGCHLD); - fpsigprocmask(SIG_BLOCK,{$ifdef ver1_0}@{$endif}newsigblock,{$ifdef ver1_0}@{$endif}oldsigblock); - pid:=fpfork; - if pid=0 then // We are in the Child - begin - fpsigaction(SIGINT,@intact,NIL); - fpsigaction(SIGQUIT,@quitact,NIL); - fpsigprocmask(SIG_SETMASK,@oldsigblock,NIL); - fpexecl('/bin/sh',['-c',Command]); - fpExit(127); // was exit(127)!! We must exit the Process, not the function - end - else if (pid<>-1) then // Successfull started - begin - savedpid:=pid; - repeat - pid:=fpwaitpid(savedpid,@pstat,0); - until (pid<>-1) and (fpgeterrno()<>ESysEintr); - if pid=-1 Then - fpsystem:=-1 - else - fpsystem:=pstat; - end - else // no success - fpsystem:=-1; - fpsigaction(SIGINT,@intact,NIL); - fpsigaction(SIGQUIT,@quitact,NIL); - fpsigprocmask(SIG_SETMASK,@oldsigblock,NIL); -end; -{$endif} - -Function WIFSTOPPED(Status: Integer): Boolean; -begin - WIFSTOPPED:=((Status and $FF)=$7F); -end; - -Function W_EXITCODE(ReturnCode, Signal: Integer): Integer; -begin - W_EXITCODE:=(ReturnCode shl 8) or Signal; -end; - -Function W_STOPCODE(Signal: Integer): Integer; - -begin - W_STOPCODE:=(Signal shl 8) or $7F; -end; - - -{$IFNDEF DONT_READ_TIMEZONE} -{ Include timezone handling routines which use /usr/share/timezone info } -{$i timezone.inc} -{$endif} -{****************************************************************************** - FileSystem calls -******************************************************************************} - -Function fpFlock (var T : text;mode : cint) : cint; -begin - fpFlock:=fpFlock(TextRec(T).Handle,mode); -end; - - -Function fpFlock (var F : File;mode : cint) :cint; -begin - fpFlock:=fpFlock(FileRec(F).Handle,mode); -end; - -Function SelectText(var T:Text;TimeOut :PTimeval):cint; -Var - F:TfdSet; -begin - if textrec(t).mode=fmclosed then - begin - fpseterrno(ESysEBADF); - exit(-1); - end; - FpFD_ZERO(f); - fpFD_SET(textrec(T).handle,f); - if textrec(T).mode=fminput then - SelectText:=fpselect(textrec(T).handle+1,@f,nil,nil,TimeOut) - else - SelectText:=fpselect(textrec(T).handle+1,nil,@f,nil,TimeOut); -end; - -Function SelectText(var T:Text;TimeOut :cint):cint; -var - p : PTimeVal; - tv : TimeVal; -begin - if TimeOut=-1 then - p:=nil - else - begin - tv.tv_Sec:=Timeout div 1000; - tv.tv_Usec:=(Timeout mod 1000)*1000; - p:=@tv; - end; - SelectText:=SelectText(T,p); -end; - -{****************************************************************************** - Directory -******************************************************************************} - -procedure SeekDir(p:pdir;loc:clong); -begin - if p=nil then - begin - fpseterrno(ESysEBADF); - exit; - end; - {$ifndef bsd} - p^.dd_nextoff:=fplseek(p^.dd_fd,loc,seek_set); - {$endif} - p^.dd_size:=0; - p^.dd_loc:=0; -end; - -function TellDir(p:pdir):clong; -begin - if p=nil then - begin - fpseterrno(ESysEBADF); - telldir:=-1; - exit; - end; - telldir:=fplseek(p^.dd_fd,0,seek_cur) - { We could try to use the nextoff field here, but on my 1.2.13 - kernel, this gives nothing... This may have to do with - the readdir implementation of libc... I also didn't find any trace of - the field in the kernel code itself, So I suspect it is an artifact of libc. - Michael. } -end; - -{****************************************************************************** - Pipes/Fifo -******************************************************************************} - -Procedure OpenPipe(var F:Text); -begin - case textrec(f).mode of - fmoutput : - if textrec(f).userdata[1]<>P_OUT then - textrec(f).mode:=fmclosed; - fminput : - if textrec(f).userdata[1]<>P_IN then - textrec(f).mode:=fmclosed; - else - textrec(f).mode:=fmclosed; - end; -end; - -Function IOPipe(var F:text):cint; -begin - IOPipe:=0; - case textrec(f).mode of - fmoutput : - begin - { first check if we need something to write, else we may - get a SigPipe when Close() is called (PFV) } - if textrec(f).bufpos>0 then - IOPipe:=fpwrite(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufpos); - end; - fminput : Begin - textrec(f).bufend:=fpread(textrec(f).handle,pchar(textrec(f).bufptr),textrec(f).bufsize); - IOPipe:=textrec(f).bufend; - End; - end; - textrec(f).bufpos:=0; -end; - -Function FlushPipe(var F:Text):cint; -begin - FlushPipe:=0; - if (textrec(f).mode=fmoutput) and (textrec(f).bufpos<>0) then - FlushPipe:=IOPipe(f); - textrec(f).bufpos:=0; -end; - -Function ClosePipe(var F:text):cint; -begin - textrec(f).mode:=fmclosed; - ClosePipe:=fpclose(textrec(f).handle); -end; - - -Function AssignPipe(var pipe_in,pipe_out:text):cint; -{ - Sets up a pair of file variables, which act as a pipe. The first one can - be read from, the second one can be written to. -} -var - f_in,f_out : cint; -begin - if AssignPipe(f_in,f_out)=-1 then - exit(-1); -{ Set up input } - Assign(Pipe_in,''); - Textrec(Pipe_in).Handle:=f_in; - Textrec(Pipe_in).Mode:=fmInput; - Textrec(Pipe_in).userdata[1]:=P_IN; - TextRec(Pipe_in).OpenFunc:=@OpenPipe; - TextRec(Pipe_in).InOutFunc:=@IOPipe; - TextRec(Pipe_in).FlushFunc:=@FlushPipe; - TextRec(Pipe_in).CloseFunc:=@ClosePipe; -{ Set up output } - Assign(Pipe_out,''); - Textrec(Pipe_out).Handle:=f_out; - Textrec(Pipe_out).Mode:=fmOutput; - Textrec(Pipe_out).userdata[1]:=P_OUT; - TextRec(Pipe_out).OpenFunc:=@OpenPipe; - TextRec(Pipe_out).InOutFunc:=@IOPipe; - TextRec(Pipe_out).FlushFunc:=@FlushPipe; - TextRec(Pipe_out).CloseFunc:=@ClosePipe; - AssignPipe:=0; -end; - -Function AssignPipe(var pipe_in,pipe_out:file):cint; -{ - Sets up a pair of file variables, which act as a pipe. The first one can - be read from, the second one can be written to. - If the operation was unsuccesful, -} -var - f_in,f_out : cint; -begin - if AssignPipe(f_in,f_out)=-1 then - exit(-1); -{ Set up input } - Assign(Pipe_in,''); - Filerec(Pipe_in).Handle:=f_in; - Filerec(Pipe_in).Mode:=fmInput; - Filerec(Pipe_in).recsize:=1; - Filerec(Pipe_in).userdata[1]:=P_IN; -{ Set up output } - Assign(Pipe_out,''); - Filerec(Pipe_out).Handle:=f_out; - Filerec(Pipe_out).Mode:=fmoutput; - Filerec(Pipe_out).recsize:=1; - Filerec(Pipe_out).userdata[1]:=P_OUT; - AssignPipe:=0; -end; - - -Function PCloseText(Var F:text):cint; -{ - May not use @PClose due overloading -} -begin - PCloseText:=PClose(f); -end; - - -function POpen(var F:text;const Prog:String;rw:char):cint; -{ - Starts the program in 'Prog' and makes it's input or out put the - other end of a pipe. If rw is 'w' or 'W', then whatever is written to - F, will be read from stdin by the program in 'Prog'. The inverse is true - for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be - read from 'f'. -} -var - pipi, - pipo : text; - pid : pid_t; - pl : ^cint; -{$ifndef FPC_USE_FPEXEC} - pp : ppchar; -{$endif not FPC_USE_FPEXEC} - ret : cint; -begin - rw:=upcase(rw); - if not (rw in ['R','W']) then - begin - FpSetErrno(ESysEnoent); - exit(-1); - end; - if AssignPipe(pipi,pipo)=-1 Then - Exit(-1); - pid:=fpfork; // vfork in FreeBSD. - if pid=-1 then - begin - close(pipi); - close(pipo); - exit(-1); - end; - if pid=0 then - begin - { We're in the child } - if rw='W' then - begin - close(pipo); - ret:=fpdup2(pipi,input); - close(pipi); - if ret=-1 then - halt(127); - end - else - begin - close(pipi); - ret:=fpdup2(pipo,output); - close(pipo); - if ret=-1 then - halt(127); - end; - {$ifdef FPC_USE_FPEXEC} - fpexecl('/bin/sh',['-c',Prog]); - {$else} - pp:=createshellargv(prog); - fpExecve(pp^,pp,envp); - {$endif} - halt(127); - end - else - begin - { We're in the parent } - if rw='W' then - begin - close(pipi); - f:=pipo; - textrec(f).bufptr:=@textrec(f).buffer; - end - else - begin - close(pipo); - f:=pipi; - textrec(f).bufptr:=@textrec(f).buffer; - end; - {Save the process ID - needed when closing } - pl:=@(textrec(f).userdata[2]); - pl^:=pid; - textrec(f).closefunc:=@PCloseText; - end; - ret:=0; -end; - -Function POpen(var F:file;const Prog:String;rw:char):cint; -{ - Starts the program in 'Prog' and makes it's input or out put the - other end of a pipe. If rw is 'w' or 'W', then whatever is written to - F, will be read from stdin by the program in 'Prog'. The inverse is true - for 'r' or 'R' : whatever the program in 'Prog' writes to stdout, can be - read from 'f'. -} -var - pipi, - pipo : file; - pid : cint; - pl : ^cint; -{$ifndef FPC_USE_FPEXEC} - p,pp : ppchar; - temp : string[255]; -{$endif not FPC_USE_FPEXEC} - ret : cint; -begin - rw:=upcase(rw); - if not (rw in ['R','W']) then - begin - FpSetErrno(ESysEnoent); - exit(-1); - end; - ret:=AssignPipe(pipi,pipo); - if ret=-1 then - exit(-1); - pid:=fpfork; - if pid=-1 then - begin - close(pipi); - close(pipo); - exit(-1); - end; - if pid=0 then - begin - { We're in the child } - if rw='W' then - begin - close(pipo); - ret:=fpdup2(filerec(pipi).handle,stdinputhandle); - close(pipi); - if ret=-1 then - halt(127); - end - else - begin - close(pipi); - ret:=fpdup2(filerec(pipo).handle,stdoutputhandle); - close(pipo); - if ret=1 then - halt(127); - end; - {$ifdef FPC_USE_FPEXEC} - fpexecl('/bin/sh',['-c',Prog]); - {$else} - getmem(pp,sizeof(pchar)*4); - temp:='/bin/sh'#0'-c'#0+prog+#0; - p:=pp; - p^:=@temp[1]; - inc(p); - p^:=@temp[9]; - inc(p); - p^:=@temp[12]; - inc(p); - p^:=Nil; - fpExecve(ansistring('/bin/sh'),pp,envp); - {$endif} - halt(127); - end - else - begin - { We're in the parent } - if rw='W' then - begin - close(pipi); - f:=pipo; - end - else - begin - close(pipo); - f:=pipi; - end; - {Save the process ID - needed when closing } - pl:=@(filerec(f).userdata[2]); - pl^:=pid; - end; - POpen:=0; -end; - -Function AssignStream(Var StreamIn,Streamout:text;Const Prog:ansiString;const args : array of ansistring) : cint; -{ - Starts the program in 'Prog' and makes its input and output the - other end of two pipes, which are the stdin and stdout of a program - specified in 'Prog'. - streamout can be used to write to the program, streamin can be used to read - the output of the program. See the following diagram : - Parent Child - STreamout --> Input - Streamin <-- Output - Return value is the process ID of the process being spawned, or -1 in case of failure. -} -var - pipi, - pipo : text; - pid : cint; - pl : ^cint; -begin - AssignStream:=-1; - if AssignPipe(streamin,pipo)=-1 Then - exit(-1); - if AssignPipe(pipi,streamout)=-1 Then // shouldn't this close streamin and pipo? - exit(-1); - pid:=fpfork; - if pid=-1 then - begin - close(pipi); - close(pipo); - close (streamin); - close (streamout); - exit; - end; - if pid=0 then - begin - { We're in the child } - { Close what we don't need } - close(streamout); - close(streamin); - if fpdup2(pipi,input)=-1 Then - halt(127); - close(pipi); - If fpdup2(pipo,output)=-1 Then - halt (127); - close(pipo); - fpExecl(Prog,args); - halt(127); - end - else - begin - { we're in the parent} - close(pipo); - close(pipi); - {Save the process ID - needed when closing } - pl:=@(textrec(StreamIn).userdata[2]); - pl^:=pid; - textrec(StreamIn).closefunc:=@PCloseText; - {Save the process ID - needed when closing } - pl:=@(textrec(StreamOut).userdata[2]); - pl^:=pid; - textrec(StreamOut).closefunc:=@PCloseText; - AssignStream:=Pid; - end; -end; - -Function AssignStream(Var StreamIn,Streamout,streamerr:text;Const Prog:ansiString;const args : array of ansistring) : cint; - -{ - Starts the program in 'prog' and makes its input, output and error output the - other end of three pipes, which are the stdin, stdout and stderr of a program - specified in 'prog'. - StreamOut can be used to write to the program, StreamIn can be used to read - the output of the program, StreamErr reads the error output of the program. - See the following diagram : - Parent Child - StreamOut --> StdIn (input) - StreamIn <-- StdOut (output) - StreamErr <-- StdErr (error output) -} -var - PipeIn, PipeOut, PipeErr: text; - pid: cint; - pl: ^cint; -begin - AssignStream := -1; - - // Assign pipes - if AssignPipe(StreamIn, PipeOut)=-1 Then - Exit(-1); - - If AssignPipe(StreamErr, PipeErr)=-1 Then - begin - Close(StreamIn); - Close(PipeOut); - exit(-1); - end; - - if AssignPipe(PipeIn, StreamOut)=-1 Then - begin - Close(StreamIn); - Close(PipeOut); - Close(StreamErr); - Close(PipeErr); - exit(-1); - end; - - // Fork - - pid := fpFork; - if pid=-1 then begin - Close(StreamIn); - Close(PipeOut); - Close(StreamErr); - Close(PipeErr); - Close(PipeIn); - Close(StreamOut); - exit(-1); - end; - - if pid = 0 then begin - // *** We are in the child *** - // Close what we don not need - Close(StreamOut); - Close(StreamIn); - Close(StreamErr); - // Connect pipes - if fpdup2(PipeIn, Input)=-1 Then - Halt(127); - Close(PipeIn); - if fpdup2(PipeOut, Output)=-1 Then - Halt(127); - Close(PipeOut); - if fpdup2(PipeErr, StdErr)=-1 Then - Halt(127); - Close(PipeErr); - // Execute program - fpExecl(Prog,args); - Halt(127); - end else begin - // *** We are in the parent *** - Close(PipeErr); - Close(PipeOut); - Close(PipeIn); - // Save the process ID - needed when closing - pl := @(TextRec(StreamIn).userdata[2]); - pl^ := pid; - TextRec(StreamIn).closefunc := @PCloseText; - // Save the process ID - needed when closing - pl := @(TextRec(StreamOut).userdata[2]); - pl^ := pid; - TextRec(StreamOut).closefunc := @PCloseText; - // Save the process ID - needed when closing - pl := @(TextRec(StreamErr).userdata[2]); - pl^ := pid; - TextRec(StreamErr).closefunc := @PCloseText; - AssignStream := pid; - end; -end; - -{****************************************************************************** - General information calls -******************************************************************************} - -{$ifdef Linux} -Function GetDomainName:String; { linux only!} -// domainname is a glibc extension. - -{ - Get machines domain name. Returns empty string if not set. -} -Var - Sysn : utsname; -begin - If fpUname(sysn)<>0 then - getdomainname:='' - else - getdomainname:=strpas(@Sysn.domain[0]); -end; -{$endif} - -{$ifdef BSD} - -function intGetDomainName(Name:PChar; NameLen:Cint):cint; -{$ifndef FPC_USE_LIBC} - external name 'FPC_SYSC_GETDOMAINNAME'; -{$else FPC_USE_LIBC} - cdecl; external clib name 'getdomainname'; -{$endif FPC_USE_LIBC} - -Function GetDomainName:String; { linux only!} -// domainname is a glibc extension. - -{ - Get machines domain name. Returns empty string if not set. -} - -begin - if intGetDomainName(@getdomainname[1],255)=-1 then - getdomainname:='' - else - getdomainname[0]:=chr(strlen(@getdomainname[1])); -end; -{$endif} - - -Function GetHostName:String; -{ - Get machines name. Returns empty string if not set. -} -Var - Sysn : utsname; -begin - If fpuname(sysn)=-1 then - gethostname:='' - else - gethostname:=strpas(@Sysn.nodename[0]); -end; - -{****************************************************************************** - Signal handling calls -******************************************************************************} - -procedure SigRaise(sig:integer); -begin - fpKill(fpGetPid,Sig); -end; - - -{****************************************************************************** - Utility calls -******************************************************************************} - -Function FSearch(const path:AnsiString;dirlist:Ansistring;CurrentDirStrategy:TFSearchOption):AnsiString; -{ - Searches for a file 'path' in the list of direcories in 'dirlist'. - returns an empty string if not found. Wildcards are NOT allowed. - If dirlist is empty, it is set to '.' - -This function tries to make FSearch use ansistrings, and decrease -stringhandling overhead at the same time. - -} -Var - mydir,NewDir : ansistring; - p1 : cint; - Info : Stat; - i,j : cint; - p : pchar; -Begin - - if CurrentDirStrategy=CurrentDirectoryFirst Then - Dirlist:='.:'+dirlist; {Make sure current dir is first to be searched.} - if CurrentDirStrategy=CurrentDirectoryLast Then - Dirlist:=dirlist+':.'; {Make sure current dir is last to be searched.} - -{Replace ':' and ';' with #0} - - for p1:=1 to length(dirlist) do - if (dirlist[p1]=':') or (dirlist[p1]=';') then - dirlist[p1]:=#0; - -{Check for WildCards} - If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then - FSearch:='' {No wildcards allowed in these things.} - Else - Begin - p:=pchar(dirlist); - i:=length(dirlist); - j:=1; - Repeat - mydir:=ansistring(p); - if (length(mydir)>0) and (mydir[length(mydir)]<>'/') then - mydir:=mydir+'/'; - NewDir:=mydir+Path; - if (FpStat(NewDir,Info)>=0) and - (not fpS_ISDIR(Info.st_Mode)) then - Begin - If Pos('./',NewDir)=1 Then - Delete(NewDir,1,2); - {DOS strips off an initial .\} - End - Else - NewDir:=''; - while (j<=i) and (p^<>#0) do begin inc(j); inc(p); end; - if p^=#0 then inc(p); - Until (j>=i) or (Length(NewDir) > 0); - FSearch:=NewDir; - End; -End; - -Function FSearch(const path:AnsiString;dirlist:Ansistring):AnsiString; - -Begin - FSearch:=FSearch(path,dirlist,CurrentDirectoryFirst); -End; - -{-------------------------------- - Stat.Mode Macro's ---------------------------------} - -Initialization -{$IFNDEF DONT_READ_TIMEZONE} - InitLocalTime; -{$endif} -finalization -{$IFNDEF DONT_READ_TIMEZONE} - DoneLocalTime; -{$endif} -End. - -{ - $Log: unix.pp,v $ - Revision 1.85 2005/03/25 22:53:39 jonas - * fixed several warnings and notes about unused variables (mainly) or - uninitialised use of variables/function results (a few) - - Revision 1.84 2005/02/14 17:13:31 peter - * truncate log - - Revision 1.83 2005/02/13 21:47:56 peter - * include file cleanup part 2 - - Revision 1.82 2005/02/13 20:01:38 peter - * include file cleanup - - Revision 1.81 2005/02/06 11:20:52 peter - * threading in system unit - * removed systhrds unit - - Revision 1.80 2005/01/30 18:01:15 peter - * signal cleanup for linux - * sigactionhandler instead of tsigaction for bsds - * sigcontext moved to cpu dir - - Revision 1.79 2005/01/22 20:56:11 michael - + Patch for intFpExecVEMaybeP to use the right path (From Colin Western) - -} diff --git a/rtl/i386/i386.inc b/rtl/i386/i386.inc index 41dd1a5591..4cfe5123c7 100644 --- a/rtl/i386/i386.inc +++ b/rtl/i386/i386.inc @@ -1073,7 +1073,7 @@ end; { do a thread save inc/dec } {$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT} -function cpudeclocked(var l : longint) : boolean;assembler; +function declocked(var l : longint) : boolean;assembler; asm {$ifndef REGCALL} @@ -1081,46 +1081,36 @@ function cpudeclocked(var l : longint) : boolean;assembler; {$endif} { this check should be done because a lock takes a lot } { of time! } + cmpb $0,IsMultithread + jz .Ldeclockednolock lock decl (%eax) + jmp .Ldeclockedend +.Ldeclockednolock: + decl (%eax); +.Ldeclockedend: setzb %al end; {$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT} -procedure cpuinclocked(var l : longint);assembler; +procedure inclocked(var l : longint);assembler; asm {$ifndef REGCALL} movl l,%eax {$endif} + { this check should be done because a lock takes a lot } + { of time! } + cmpb $0,IsMultithread + jz .Linclockednolock lock incl (%eax) + jmp .Linclockedend +.Linclockednolock: + incl (%eax) +.Linclockedend: end; -// inline SMP check and normal lock. -// the locked one is so slow, inlining doesn't matter. -function declocked(var l : longint) : boolean; inline; - -begin - if not ismultithread then - begin - dec(l); - declocked:=l=0; - end - else - declocked:=cpudeclocked(l); -end; - -procedure inclocked(var l : longint); inline; - -begin - if not ismultithread then - inc(l) - else - cpuinclocked(l); -end; - - {**************************************************************************** FPU ****************************************************************************} diff --git a/rtl/inc/astrings.inc b/rtl/inc/astrings.inc index e1c74e7022..0b28755070 100644 --- a/rtl/inc/astrings.inc +++ b/rtl/inc/astrings.inc @@ -73,7 +73,7 @@ begin end; -Procedure DisposeAnsiString(Var S : Pointer); {$IFNDEF VER2_0} Inline; {$ENDIF} +Procedure DisposeAnsiString(Var S : Pointer); { Deallocates a AnsiString From the heap. } @@ -85,6 +85,7 @@ begin S:=Nil; end; + Procedure fpc_AnsiStr_Decr_Ref (Var S : Pointer); [Public,Alias:'FPC_ANSISTR_DECR_REF']; compilerproc; { Decreases the ReferenceCount of a non constant ansistring; @@ -100,6 +101,7 @@ Begin { check for constant strings ...} l:=@PAnsiRec(S-FirstOff)^.Ref; If l^<0 then exit; + { declocked does a MT safe dec and returns true, if the counter is 0 } If declocked(l^) then { Ref count dropped to zero } @@ -109,7 +111,7 @@ end; { also define alias for internal use in the system unit } Procedure fpc_AnsiStr_Decr_Ref (Var S : Pointer); [external name 'FPC_ANSISTR_DECR_REF']; -Procedure fpc_AnsiStr_Incr_Ref (S : Pointer); [Public,Alias:'FPC_ANSISTR_INCR_REF']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF} +Procedure fpc_AnsiStr_Incr_Ref (S : Pointer); [Public,Alias:'FPC_ANSISTR_INCR_REF']; compilerproc; Begin If S=Nil then exit; @@ -410,35 +412,29 @@ end; Public functions, In interface. *****************************************************************************} -function fpc_truely_ansistr_unique(Var S : Pointer): Pointer; - -Var - SNew : Pointer; - L : SizeInt; - -begin - L:=PAnsiRec(Pointer(S)-FirstOff)^.len; - SNew:=NewAnsiString (L); - Move (Pointer(S)^,SNew^,L+1); - PAnsiRec(SNew-FirstOff)^.len:=L; - fpc_ansistr_decr_ref (Pointer(S)); { Thread safe } - pointer(S):=SNew; - pointer(result):=SNew; -end; -// MV: inline the basic checks for case that S is already unique. -// Rest is too complex to inline, so factor that out as a call. -Function fpc_ansistr_Unique(Var S : Pointer): Pointer; [Public,Alias : 'FPC_ANSISTR_UNIQUE']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF} +Function fpc_ansistr_Unique(Var S : Pointer): Pointer; [Public,Alias : 'FPC_ANSISTR_UNIQUE']; compilerproc; { Make sure reference count of S is 1, using copy-on-write semantics. } +Var + SNew : Pointer; + L : SizeInt; begin pointer(result) := pointer(s); If Pointer(S)=Nil then exit; if PAnsiRec(Pointer(S)-Firstoff)^.Ref<>1 then - result:=fpc_truely_ansistr_unique(s); + begin + L:=PAnsiRec(Pointer(S)-FirstOff)^.len; + SNew:=NewAnsiString (L); + Move (Pointer(S)^,SNew^,L+1); + PAnsiRec(SNew-FirstOff)^.len:=L; + fpc_ansistr_decr_ref (Pointer(S)); { Thread safe } + pointer(S):=SNew; + pointer(result):=SNew; + end; end; Procedure fpc_ansistr_append_char(Var S : AnsiString;c : char); [Public,Alias : 'FPC_ANSISTR_APPEND_CHAR']; compilerproc; @@ -655,7 +651,7 @@ end; {$endif CPU64} -procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : SizeInt;var s : ansistring);[public,alias:'FPC_ANSISTR_FLOAT']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF} +procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : SizeInt;var s : ansistring);[public,alias:'FPC_ANSISTR_FLOAT']; compilerproc; var ss: ShortString; begin @@ -664,7 +660,7 @@ begin end; -Procedure fpc_AnsiStr_UInt(v : ValUInt;Len : SizeInt; Var S : AnsiString);[Public,Alias : 'FPC_ANSISTR_VALUINT']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF} +Procedure fpc_AnsiStr_UInt(v : ValUInt;Len : SizeInt; Var S : AnsiString);[Public,Alias : 'FPC_ANSISTR_VALUINT']; compilerproc; Var SS : ShortString; begin @@ -674,7 +670,7 @@ end; -Procedure fpc_AnsiStr_SInt(v : ValSInt;Len : SizeInt; Var S : AnsiString);[Public,Alias : 'FPC_ANSISTR_VALSINT']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF} +Procedure fpc_AnsiStr_SInt(v : ValSInt;Len : SizeInt; Var S : AnsiString);[Public,Alias : 'FPC_ANSISTR_VALSINT']; compilerproc; Var SS : ShortString; begin @@ -685,7 +681,7 @@ end; {$ifndef CPU64} -Procedure fpc_AnsiStr_QWord(v : QWord;Len : SizeInt; Var S : AnsiString);[Public,Alias : 'FPC_ANSISTR_QWORD']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF} +Procedure fpc_AnsiStr_QWord(v : QWord;Len : SizeInt; Var S : AnsiString);[Public,Alias : 'FPC_ANSISTR_QWORD']; compilerproc; Var SS : ShortString; begin @@ -693,7 +689,9 @@ begin S:=SS; end; -Procedure fpc_AnsiStr_Int64(v : Int64; Len : SizeInt; Var S : AnsiString);[Public,Alias : 'FPC_ANSISTR_INT64']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF} + + +Procedure fpc_AnsiStr_Int64(v : Int64; Len : SizeInt; Var S : AnsiString);[Public,Alias : 'FPC_ANSISTR_INT64']; compilerproc; Var SS : ShortString; begin @@ -703,6 +701,7 @@ end; {$endif CPU64} + Procedure Delete (Var S : AnsiString; Index,Size: SizeInt); Var LS : SizeInt; @@ -715,8 +714,8 @@ begin Size:=LS-Index+1; If (Size<=LS-Index) then begin - Dec(Index); - Move(PByte(Pointer(S))[Index+Size],PByte(Pointer(S))[Index],LS-Index-Size+1); + Dec(Index); + Move(PByte(Pointer(S))[Index+Size],PByte(Pointer(S))[Index],LS-Index-Size+1); end; Setlength(S,LS-Size); end; @@ -752,7 +751,7 @@ begin FillChar(Pointer(StringOfChar)^,Length(StringOfChar),c); end; -Procedure SetString (Var S : AnsiString; Buf : PChar; Len : SizeInt); {$IFNDEF VER2_0} Inline; {$ENDIF} +Procedure SetString (Var S : AnsiString; Buf : PChar; Len : SizeInt); begin SetLength(S,Len); If (Buf<>Nil) then @@ -780,3 +779,5 @@ begin for i := 1 to length (s) do result[i] := lowercase(s[i]); end; + + diff --git a/rtl/inc/cgeneric.inc b/rtl/inc/cgeneric.inc index 12a89b9717..55e0147852 100644 --- a/rtl/inc/cgeneric.inc +++ b/rtl/inc/cgeneric.inc @@ -21,10 +21,10 @@ {$ifndef FPC_SYSTEM_HAS_MOVE} {$define FPC_SYSTEM_HAS_MOVE} -procedure bcopy(const source;var dest;count:sizeuint); cdecl; external 'c' name 'bcopy'; +procedure bcopy(const source;var dest;count:cardinal); cdecl; external 'c' name 'bcopy'; { we need this separate move declaration because we can't add a "public, alias" to the above } -procedure Move(const source;var dest;count:sizeint); [public, alias: 'FPC_MOVE'];{$ifdef SYSTEMINLINE}inline;{$endif} +procedure Move(const source;var dest;count:longint); [public, alias: 'FPC_MOVE'];{$ifdef SYSTEMINLINE}inline;{$endif} begin if count <= 0 then exit; @@ -35,9 +35,9 @@ end; {$ifndef FPC_SYSTEM_HAS_FILLCHAR} {$define FPC_SYSTEM_HAS_FILLCHAR} -procedure memset(var x; value: byte; count: sizeuint); cdecl; external 'c'; +procedure memset(var x; value: byte; count: cardinal); cdecl; external 'c'; -Procedure FillChar(var x;count: sizeint;value:byte);{$ifdef SYSTEMINLINE}inline;{$endif} +Procedure FillChar(var x;count: longint;value:byte);{$ifdef SYSTEMINLINE}inline;{$endif} begin if count <= 0 then exit; @@ -48,7 +48,7 @@ end; {$ifndef FPC_SYSTEM_HAS_FILLBYTE} {$define FPC_SYSTEM_HAS_FILLBYTE} -procedure FillByte (var x;count : sizeint;value : byte );{$ifdef SYSTEMINLINE}inline;{$endif} +procedure FillByte (var x;count : longint;value : byte );{$ifdef SYSTEMINLINE}inline;{$endif} begin if count <= 0 then exit; @@ -60,9 +60,9 @@ end; {$ifndef FPC_SYSTEM_HAS_INDEXCHAR} {$define FPC_SYSTEM_HAS_INDEXCHAR} -function memchr(const buf; b: sizeuint; len: cardinal): pointer; cdecl; external 'c'; +function memchr(const buf; b: longint; len: cardinal): pointer; cdecl; external 'c'; -function IndexChar(Const buf;len:sizeint;b:char):sizeint; +function IndexChar(Const buf;len:longint;b:char):longint; var res: pointer; begin @@ -82,7 +82,7 @@ end; {$ifndef FPC_SYSTEM_HAS_INDEXBYTE} {$define FPC_SYSTEM_HAS_INDEXBYTE} -function IndexByte(Const buf;len:sizeint;b:byte):sizeint;{$ifdef SYSTEMINLINE}inline;{$endif} +function IndexByte(Const buf;len:longint;b:byte):longint;{$ifdef SYSTEMINLINE}inline;{$endif} begin IndexByte:=IndexChar(buf,len,char(b)); end; @@ -91,9 +91,9 @@ end; {$ifndef FPC_SYSTEM_HAS_COMPARECHAR} {$define FPC_SYSTEM_HAS_COMPARECHAR} -function memcmp_comparechar(Const buf1,buf2;len:sizeuint):longint; cdecl; external 'c' name 'memcmp'; +function memcmp_comparechar(Const buf1,buf2;len:cardinal):longint; cdecl; external 'c' name 'memcmp'; -function CompareChar(Const buf1,buf2;len:sizeint):sizeint; +function CompareChar(Const buf1,buf2;len:longint):longint; var res: longint; begin @@ -112,7 +112,7 @@ end; {$ifndef FPC_SYSTEM_HAS_COMPAREBYTE} {$define FPC_SYSTEM_HAS_COMPAREBYTE} -function CompareByte(Const buf1,buf2;len:sizeint):sizeint;{$ifdef SYSTEMINLINE}inline;{$endif} +function CompareByte(Const buf1,buf2;len:longint):longint;{$ifdef SYSTEMINLINE}inline;{$endif} begin CompareByte := CompareChar(buf1,buf2,len); end; @@ -121,9 +121,9 @@ end; {$ifndef FPC_SYSTEM_HAS_COMPARECHAR0} {$define FPC_SYSTEM_HAS_COMPARECHAR0} -function strncmp_comparechar0(Const buf1,buf2;len:sizeuint):longint; cdecl; external 'c' name 'strncmp'; +function strncmp_comparechar0(Const buf1,buf2;len:cardinal):longint; cdecl; external 'c' name 'strncmp'; -function CompareChar0(Const buf1,buf2;len:sizeint):sizeint;{$ifdef SYSTEMINLINE}inline;{$endif} +function CompareChar0(Const buf1,buf2;len:longint):longint;{$ifdef SYSTEMINLINE}inline;{$endif} begin if len <= 0 then exit(0); @@ -137,7 +137,7 @@ end; {$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH} {$define FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH} -function libc_pchar_length(p:pchar):sizeuint; cdecl; external 'c' name 'strlen'; +function libc_pchar_length(p:pchar):cardinal; cdecl; external 'c' name 'strlen'; function fpc_pchar_length(p:pchar):longint;[public,alias:'FPC_PCHAR_LENGTH']; compilerproc; begin diff --git a/rtl/inc/heaptrc.pp b/rtl/inc/heaptrc.pp index 4541cea715..fe470c8917 100644 --- a/rtl/inc/heaptrc.pp +++ b/rtl/inc/heaptrc.pp @@ -17,10 +17,6 @@ interface {$goto on} -{$if defined(win32) or defined(wince)} - {$define windows} -{$endif} - Procedure DumpHeap; Procedure MarkHeap; @@ -351,11 +347,7 @@ begin inc(getmem_size,size); inc(getmem8_size,((size+7) div 8)*8); { Do the real GetMem, but alloc also for the info block } -{$ifdef cpuarm} - allocsize:=(size + 3) and not 3+sizeof(theap_mem_info)+extra_info_size; -{$else cpuarm} allocsize:=size+sizeof(theap_mem_info)+extra_info_size; -{$endif cpuarm} if add_tail then inc(allocsize,sizeof(ptrint)); p:=SysGetMem(allocsize); @@ -649,11 +641,7 @@ begin old_display_extra_info_proc:=pp^.extra_info^.displayproc; end; { Do the real ReAllocMem, but alloc also for the info block } -{$ifdef cpuarm} - allocsize:=(size + 3) and not 3+sizeof(theap_mem_info)+pp^.extra_info_size; -{$else cpuarm} allocsize:=size+sizeof(theap_mem_info)+pp^.extra_info_size; -{$endif cpuarm} if add_tail then inc(allocsize,sizeof(ptrint)); { Try to resize the block, if not possible we need to do a @@ -747,7 +735,7 @@ var eend : ptruint; external name '_end'; {$endif} -{$ifdef windows} +{$ifdef win32} var sdata : ptruint; external name '__data_start__'; edata : ptruint; external name '__data_end__'; @@ -791,7 +779,7 @@ begin {$endif go32v2} { I don't know where the stack is in other OS !! } -{$ifdef windows} +{$ifdef win32} { inside stack ? } if (ptruint(p)>ptruint(get_frame)) and (ptruint(p)<Win32StackTop) then @@ -803,7 +791,7 @@ begin { inside bss ? } if (ptruint(p)>=ptruint(@sbss)) and (ptruint(p)<ptruint(@ebss)) then goto _exit; -{$endif windows} +{$endif win32} {$ifdef linux} { inside stack ? } @@ -1114,17 +1102,7 @@ begin end; FreeEnvironmentStrings(p); end; -{$else win32} - -{$ifdef wince} -Function GetEnv(P:string):Pchar; -begin - { WinCE does not have environment strings. - Add some way to specify heaptrc options? } - GetEnv:=nil; -end; -{$else wince} - +{$else} Function GetEnv(P:string):Pchar; { Searches the environment for a string with name p and @@ -1159,8 +1137,7 @@ Begin else getenv:=nil; end; -{$endif wince} -{$endif win32} +{$endif} procedure LoadEnvironment; var diff --git a/rtl/inc/objpas.inc b/rtl/inc/objpas.inc index d1561f552d..bca9e65223 100644 --- a/rtl/inc/objpas.inc +++ b/rtl/inc/objpas.inc @@ -413,9 +413,9 @@ begin // See if we have messages at all in this class. p:=pointer(vmt)+vmtDynamicTable; - If assigned(PPointer(p)^) then + If Assigned(p) and (Pdword(p)^<>0) then begin - msgtable:=pmsgtable(Pointer(p^)+4); + msgtable:=pmsgtable(PtrInt(p^)+4); count:=pdword(p^)^; end else diff --git a/rtl/inc/objpash.inc b/rtl/inc/objpash.inc index ff522d91bb..89406f7858 100644 --- a/rtl/inc/objpash.inc +++ b/rtl/inc/objpash.inc @@ -275,13 +275,12 @@ PVarRec = ^TVarRec; TVarRec = record case VType : Ptrint of + vtInteger : (VInteger: Longint); {$ifdef ENDIAN_BIG} - vtInteger : ({$IFDEF CPU64}integerdummy1 : Longint;{$ENDIF CPU64}VInteger: Longint); - vtBoolean : ({$IFDEF CPU64}booldummy : Longint;{$ENDIF CPU64}booldummy1,booldummy2,booldummy3: byte; VBoolean: Boolean); - vtChar : ({$IFDEF CPU64}chardummy : Longint;{$ENDIF CPU64}chardummy1,chardummy2,chardummy3: byte; VChar: Char); - vtWideChar : ({$IFDEF CPU64}widechardummy : Longint;{$ENDIF CPU64}wchardummy1,VWideChar: WideChar); + vtBoolean : (booldummy1,booldummy2,booldummy3: byte; VBoolean: Boolean); + vtChar : (chardummy1,chardummy2,chardummy3: byte; VChar: Char); + vtWideChar : (wchardummy1,VWideChar: WideChar); {$else ENDIAN_BIG} - vtInteger : (VInteger: Longint); vtBoolean : (VBoolean: Boolean); vtChar : (VChar: Char); vtWideChar : (VWideChar: WideChar); diff --git a/rtl/inc/system.inc b/rtl/inc/system.inc index db7d3ae2f4..e615eb841a 100644 --- a/rtl/inc/system.inc +++ b/rtl/inc/system.inc @@ -81,21 +81,13 @@ var {$define SYSPROCDEFINED} {$endif cpux86_64} -{$ifdef cpupowerpc32} +{$ifdef cpupowerpc} {$ifdef SYSPROCDEFINED} {$Error Can't determine processor type !} {$endif} {$i powerpc.inc} { Case dependent, don't change } {$define SYSPROCDEFINED} -{$endif cpupowerpc32} - -{$ifdef cpupowerpc64} - {$ifdef SYSPROCDEFINED} - {$Error Can't determine processor type !} - {$endif} - {$i powerpc64.inc} { Case dependent, don't change } - {$define SYSPROCDEFINED} -{$endif cpupowerpc64} +{$endif cpupowerpc} {$ifdef cpualpha} {$ifdef SYSPROCDEFINED} diff --git a/rtl/linux/Makefile b/rtl/linux/Makefile index 3de413ab7f..44dd82ad1d 100644 --- a/rtl/linux/Makefile +++ b/rtl/linux/Makefile @@ -238,11 +238,6 @@ INC=$(RTL)/inc COMMON=$(RTL)/common PROCINC=$(RTL)/$(CPU_TARGET) UNIXINC=$(RTL)/unix -ifneq ($(CPU_TARGET),powerpc64) -GGIGRAPH_UNIT=ggigraph -else -GGIGRAPH_UNIT= -endif ifeq ($(CPU_TARGET),i386) CRT21=cprt21 gprt21 CPU_UNITS=x86 ports cpu mmx graph @@ -272,115 +267,115 @@ ifndef USELIBGGI USELIBGGI=NO endif ifeq ($(FULL_TARGET),i386-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),i386-go32v2) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),i386-win32) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),i386-os2) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),i386-freebsd) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),i386-beos) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),i386-netbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),i386-solaris) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),i386-qnx) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),i386-netware) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),i386-openbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),i386-wdosx) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),i386-emx) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),i386-watcom) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),i386-netwlibc) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),i386-wince) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),m68k-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),m68k-freebsd) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),m68k-netbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),m68k-amiga) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),m68k-atari) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),m68k-openbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),m68k-palmos) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),powerpc-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),powerpc-netbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),powerpc-macos) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),powerpc-darwin) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),powerpc-morphos) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),sparc-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),sparc-netbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),sparc-solaris) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),x86_64-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),x86_64-freebsd) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),x86_64-win64) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),arm-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),arm-wince) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),powerpc64-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer $(GGIGRAPH_UNIT) sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit +override TARGET_UNITS+=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) crt printer ggigraph sysutils typinfo math matrix varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconsts dos objects cwstring fpcylix fpmkunit endif ifeq ($(FULL_TARGET),i386-linux) override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21) @@ -2259,27 +2254,18 @@ SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES)) include $(PROCINC)/makefile.cpu SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES)) SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS) -ifeq ($(CPU_TARGET),i386) - ASTARGET=--32 -endif -ifeq ($(CPU_TARGET),x86_64) - ASTARGET=--64 -endif -ifeq ($(CPU_TARGET),powerpc64) - ASTARGET=-a64 -endif prt0$(OEXT) : $(CPU_TARGET)/prt0.as - $(AS) $(ASTARGET) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/prt0.as + $(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/prt0.as dllprt0$(OEXT) : $(CPU_TARGET)/dllprt0.as - $(AS) $(ASTARGET) -o $(UNITTARGETDIRPREFIX)dllprt0$(OEXT) $(CPU_TARGET)/dllprt0.as + $(AS) -o $(UNITTARGETDIRPREFIX)dllprt0$(OEXT) $(CPU_TARGET)/dllprt0.as gprt0$(OEXT) : $(CPU_TARGET)/gprt0.as - $(AS) $(ASTARGET) -o $(UNITTARGETDIRPREFIX)gprt0$(OEXT) $(CPU_TARGET)/gprt0.as + $(AS) -o $(UNITTARGETDIRPREFIX)gprt0$(OEXT) $(CPU_TARGET)/gprt0.as cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as - $(AS) $(ASTARGET) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as + $(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as cprt21$(OEXT) : $(CPU_TARGET)/cprt21.as - $(AS) $(ASTARGET) -o $(UNITTARGETDIRPREFIX)cprt21$(OEXT) $(CPU_TARGET)/cprt21.as + $(AS) -o $(UNITTARGETDIRPREFIX)cprt21$(OEXT) $(CPU_TARGET)/cprt21.as gprt21$(OEXT) : $(CPU_TARGET)/gprt21.as - $(AS) $(ASTARGET) -o $(UNITTARGETDIRPREFIX)gprt21$(OEXT) $(CPU_TARGET)/gprt21.as + $(AS) -o $(UNITTARGETDIRPREFIX)gprt21$(OEXT) $(CPU_TARGET)/gprt21.as $(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS) $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT) diff --git a/rtl/linux/Makefile.fpc b/rtl/linux/Makefile.fpc index a051af32f7..f1abd38556 100644 --- a/rtl/linux/Makefile.fpc +++ b/rtl/linux/Makefile.fpc @@ -10,7 +10,7 @@ loaders=prt0 dllprt0 cprt0 gprt0 $(CRT21) units=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil \ heaptrc lineinfo \ $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) \ - crt printer $(GGIGRAPH_UNIT) \ + crt printer ggigraph \ sysutils typinfo math matrix varutils \ charset ucomplex getopts \ errors sockets gpm ipc serial terminfo dl dynlibs \ @@ -54,12 +54,6 @@ COMMON=$(RTL)/common PROCINC=$(RTL)/$(CPU_TARGET) UNIXINC=$(RTL)/unix -ifneq ($(CPU_TARGET),powerpc64) -GGIGRAPH_UNIT=ggigraph -else -GGIGRAPH_UNIT= -endif - ifeq ($(CPU_TARGET),i386) CRT21=cprt21 gprt21 CPU_UNITS=x86 ports cpu mmx graph @@ -119,38 +113,28 @@ SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES)) # Put $(SYSTEMUNIT) unit dependencies together. SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS) -# Select 32/64 mode -ifeq ($(CPU_TARGET),i386) - ASTARGET=--32 -endif -ifeq ($(CPU_TARGET),x86_64) - ASTARGET=--64 -endif -ifeq ($(CPU_TARGET),powerpc64) - ASTARGET=-a64 -endif # # Loaders # prt0$(OEXT) : $(CPU_TARGET)/prt0.as - $(AS) $(ASTARGET) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/prt0.as + $(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/prt0.as dllprt0$(OEXT) : $(CPU_TARGET)/dllprt0.as - $(AS) $(ASTARGET) -o $(UNITTARGETDIRPREFIX)dllprt0$(OEXT) $(CPU_TARGET)/dllprt0.as + $(AS) -o $(UNITTARGETDIRPREFIX)dllprt0$(OEXT) $(CPU_TARGET)/dllprt0.as gprt0$(OEXT) : $(CPU_TARGET)/gprt0.as - $(AS) $(ASTARGET) -o $(UNITTARGETDIRPREFIX)gprt0$(OEXT) $(CPU_TARGET)/gprt0.as + $(AS) -o $(UNITTARGETDIRPREFIX)gprt0$(OEXT) $(CPU_TARGET)/gprt0.as cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as - $(AS) $(ASTARGET) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as + $(AS) -o $(UNITTARGETDIRPREFIX)cprt0$(OEXT) $(CPU_TARGET)/cprt0.as cprt21$(OEXT) : $(CPU_TARGET)/cprt21.as - $(AS) $(ASTARGET) -o $(UNITTARGETDIRPREFIX)cprt21$(OEXT) $(CPU_TARGET)/cprt21.as + $(AS) -o $(UNITTARGETDIRPREFIX)cprt21$(OEXT) $(CPU_TARGET)/cprt21.as gprt21$(OEXT) : $(CPU_TARGET)/gprt21.as - $(AS) $(ASTARGET) -o $(UNITTARGETDIRPREFIX)gprt21$(OEXT) $(CPU_TARGET)/gprt21.as + $(AS) -o $(UNITTARGETDIRPREFIX)gprt21$(OEXT) $(CPU_TARGET)/gprt21.as # @@ -215,7 +199,6 @@ graph$(PPUEXT) : graph.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \ $(GRAPHINCDEPS) $(UNIXINC)/graph16.inc $(COMPILER) -I$(GRAPHDIR) $(UNIXINC)/graph.pp - ggigraph$(PPUEXT) : $(UNIXINC)/ggigraph.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \ $(GRAPHINCDEPS) $(COMPILER) -I$(GRAPHDIR) $(UNIXINC)/ggigraph.pp diff --git a/rtl/linux/fpmake.inc b/rtl/linux/fpmake.inc deleted file mode 100644 index db0077dfc3..0000000000 --- a/rtl/linux/fpmake.inc +++ /dev/null @@ -1,39 +0,0 @@ -Procedure ApplyLinuxTargets(Installer : TInstaller); - -Var - C : String; - - Procedure AddLoader (Loader : String); - - Const - asbin = 'as'; - asopt = '-o $(OUTPUTDIR)/$(DEST) $(SOURCE)'; - - begin - With Installer.DefaultPackage.Commands do - AddCommand(asbin,asopt,loader+'.o',c+loader+'.as'); - end; - -begin - ApplyUnixTargets(Installer); - with Installer do - begin - DefaultPackage.Options:=DefaultPackage.Options+' -Filinux/'+CurrentCPU; - ExcludeCurrentOS(Targets['utf8bidi']); - end; - C:=IncludeTrailingPathDelimiter('linux/'+CPUToString(Defaults.CPU)); - AddLoader('prt0'); - If (Defaults.CPU<>m68k) then - begin - AddLoader('cprt0'); - AddLoader('dllprt0'); - AddLoader('gprt0'); - end - else - AddLoader('prt1'); - If (Defaults.CPU=i386) Then - begin - AddLoader('cprt21'); - AddLoader('gprt21'); - end; -end;
\ No newline at end of file diff --git a/rtl/linux/i386/prt0.as b/rtl/linux/i386/prt0.as index 400d17a651..50829e4946 100644 --- a/rtl/linux/i386/prt0.as +++ b/rtl/linux/i386/prt0.as @@ -44,25 +44,21 @@ _start: /* First locate the start of the environment variables */ popl %ecx /* Get argc in ecx */ movl %esp,%ebx /* Esp now points to the arguments */ - leal 4(%esp,%ecx,4),%eax /* The start of the environment is: esp+4*eax+4 */ + leal 4(%esp,%ecx,4),%eax /* The start of the environment is: esp+4*eax+4 */ andl $0xfffffff8,%esp /* Align stack */ - leal operatingsystem_parameters,%edi - stosl /* Move the environment pointer */ - xchg %ecx,%eax - stosl /* Move the argument counter */ - xchg %ebx,%eax - stosl /* Move the argument pointer */ + leal operatingsystem_parameters,%edi + stosl /* Move the environment pointer */ + xchg %ecx,%eax + stosl /* Move the argument counter */ + xchg %ebx,%eax + stosl /* Move the argument pointer */ fninit /* initialize fpu */ fwait fldcw ___fpucw -# /* Initialize gs for thread local storage */ -# movw %ds,%ax -# movw %ax,%gs - xorl %ebp,%ebp call PASCALMAIN @@ -85,18 +81,14 @@ ___fpucw: .bss .type ___fpc_brk_addr,@object - .comm ___fpc_brk_addr,4 /* heap management */ - + .comm ___fpc_brk_addr,4 /* heap management */ operatingsystem_parameters: - .skip 3*4 - - .global operatingsystem_parameter_envp - .global operatingsystem_parameter_argc - .global operatingsystem_parameter_argv - .set operatingsystem_parameter_envp,operatingsystem_parameters+0 - .set operatingsystem_parameter_argc,operatingsystem_parameters+4 - .set operatingsystem_parameter_argv,operatingsystem_parameters+8 + .skip 3*4 -//.section .threadvar,"aw",@nobits - .comm ___fpc_threadvar_offset,4 + .global operatingsystem_parameter_envp + .global operatingsystem_parameter_argc + .global operatingsystem_parameter_argv + .set operatingsystem_parameter_envp,operatingsystem_parameters+0 + .set operatingsystem_parameter_argc,operatingsystem_parameters+4 + .set operatingsystem_parameter_argv,operatingsystem_parameters+8 diff --git a/rtl/linux/ipccall.inc b/rtl/linux/ipccall.inc index 776d80aeec..fe2345c814 100644 --- a/rtl/linux/ipccall.inc +++ b/rtl/linux/ipccall.inc @@ -40,9 +40,9 @@ Const { generic call that handles all IPC calls } -function ipccall(Call,First,Second,Third : cint; P : Pointer) : ptrint; +function ipccall(Call,First,Second,Third : cint; P : Pointer) : cint; begin - ipccall:=do_syscall(syscall_nr_ipc,call,first,second,third,ptrint(P)); + ipccall:=do_syscall(syscall_nr_ipc,call,first,second,third,cint(P)); // ipcerror:=fpgetErrno; end; @@ -53,7 +53,7 @@ end; Function shmat (shmid:cint; shmaddr:pointer; shmflg:cint):pointer; Var raddr : pchar; - error : ptrint; + error : cint; begin error:=ipccall(CALL_SHMAT,shmid,shmflg,cint(@raddr),shmaddr); If Error<0 then diff --git a/rtl/linux/osdefs.inc b/rtl/linux/osdefs.inc index b198250df8..03d4be5940 100644 --- a/rtl/linux/osdefs.inc +++ b/rtl/linux/osdefs.inc @@ -28,9 +28,6 @@ // (which is a GNU extension) {$ifdef FPC_USE_LIBC} {$define usegetcwd} - {$if not defined(cpux86) and not defined(cpux86_64)} - {$linklib m} - {$endif} {$endif} diff --git a/rtl/linux/ostypes.inc b/rtl/linux/ostypes.inc index 6d2214130c..ac6b179623 100644 --- a/rtl/linux/ostypes.inc +++ b/rtl/linux/ostypes.inc @@ -31,16 +31,10 @@ CONST {$endif} FD_MAXFDSET = 1024; - BITSINWORD = 8*sizeof(cuLong); + BITSINWORD = 8*sizeof(longint); wordsinsigset = SIG_MAXSIG DIV BITSINWORD; // words in sigset_t wordsinfdset = FD_MAXFDSET DIV BITSINWORD; // words in fdset_t - {$ifdef cpu32} - ln2bitsinword = 5; { 32bit : ln(32)/ln(2)=5 } - {$else cpu32} - {$ifdef cpu64} - ln2bitsinword = 6; { 64bit : ln(64)/ln(2)=6 } - {$endif cpu64} - {$endif cpu32} + ln2bitsinword = 5; { 32bit : ln(32)/ln(2)=5 } ln2bitmask = 1 shl ln2bitsinword - 1; diff --git a/rtl/linux/powerpc64/bsyscall.inc b/rtl/linux/powerpc64/bsyscall.inc deleted file mode 100644 index 624654ec57..0000000000 --- a/rtl/linux/powerpc64/bsyscall.inc +++ /dev/null @@ -1,14 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - Copyright (c) 2005 by Michael Van Canneyt, - member of the Free Pascal development team. - - 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. - - **********************************************************************} - diff --git a/rtl/linux/powerpc64/cprt0.as b/rtl/linux/powerpc64/cprt0.as deleted file mode 100644 index d87f41429c..0000000000 --- a/rtl/linux/powerpc64/cprt0.as +++ /dev/null @@ -1,137 +0,0 @@ -/* Startup code for programs linked with GNU libc. - Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. - This file is part of the GNU C Library. - - The GNU C Library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - The GNU C Library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with the GNU C Library; if not, write to the Free - Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - 02111-1307 USA. */ - -.macro LOAD_64BIT_VAL ra, value - addis \ra, 0, \value@highest - ori \ra,\ra,\value@higher - sldi \ra,\ra,32 - oris \ra,\ra,\value@h - ori \ra,\ra,\value@l -.endm - -.macro FUNCTION_PROLOG fn - .section ".text" - .align 2 - .globl \fn - .section ".opd", "aw" - .align 3 - \fn: - .quad .\fn, .TOC.@tocbase, 0 - .previous - .size \fn, 24 - .type \fn, @function - .globl .\fn -.\fn: -.endm - -.macro FUNCTION_EPILOG fn - .long 0 - .byte 0, 12, 0, 0, 0, 0, 0, 0 - .type .\fn, @function - .size .\fn,.-.\fn -.endm - -.macro PRINTMSG msg len - lis 4, \msg@highest - ori 4, 4, \msg@higher - sldi 4, 4, 32 - oris 4, 4, \msg@h - ori 4, 4, \msg@l - li 5, \len - li 0,4 - li 3,1 - sc -.endm - /* - cprt0 pascal entry - */ -FUNCTION_PROLOG _start - - mr 26, 1 - /* Set up an initial stack frame, and clear the LR */ - clrrdi 1, 1, 5 /* align r1 */ - li 0, 0 - stdu 1,-48(1) - mtlr 0 - std 0, 0(1) /* r1 = pointer to NULL value */ - - /* store argument count (= 0(r1) )*/ - ld 3, 0(26) - LOAD_64BIT_VAL 10, operatingsystem_parameter_argc - stw 3, 0(10) - /* calculate argument vector address and store (= 8(r1) + 8 ) */ - addi 4, 26, 8 - LOAD_64BIT_VAL 10, operatingsystem_parameter_argv - std 4, 0(10) - /* store environment pointer (= argv + (argc+1)* 8 ) */ - addi 5, 3, 1 - sldi 5, 5, 3 - add 5, 4, 5 - LOAD_64BIT_VAL 10, operatingsystem_parameter_envp - std 5, 0(10) - - bl .__libc_init_first - nop - - lis 3, _dl_fini@highest - ori 3, 3, _dl_fini@higher - sldi 3,3,32 - oris 3, 3, _dl_fini@h - ori 3, 3, _dl_fini@l - - bl .PASCALMAIN - nop - ori 0, 0, 0 - - /* directly jump to exit procedure, not via the function pointer */ - b _haltproc - - .align 3 - - .global ._haltproc - .section ".opd", "aw" - .align 3 -._haltproc: - .quad _haltproc, .TOC.@tocbase, 0 - .previous - .size ._haltproc, 24 - .global _haltproc - -_haltproc: - /* exit call */ - li 0, 1 - sc - b _haltproc - - /* Define a symbol for the first piece of initialized data. */ - .section ".data" - .globl __data_start -__data_start: -data_start: - .globl ___fpc_brk_addr /* heap management */ - .type ___fpc_brk_addr, @object - .size ___fpc_brk_addr, 4 -___fpc_brk_addr: - .long 0 - -.text - .comm operatingsystem_parameter_argc, 4 - .comm operatingsystem_parameter_argv, 8 - .comm operatingsystem_parameter_envp, 8 - diff --git a/rtl/linux/powerpc64/dllprt0.as b/rtl/linux/powerpc64/dllprt0.as deleted file mode 100644 index 099137f01d..0000000000 --- a/rtl/linux/powerpc64/dllprt0.as +++ /dev/null @@ -1,4 +0,0 @@ -/* -*/ - -/* empty */ diff --git a/rtl/linux/powerpc64/gprt0.as b/rtl/linux/powerpc64/gprt0.as deleted file mode 100644 index 099137f01d..0000000000 --- a/rtl/linux/powerpc64/gprt0.as +++ /dev/null @@ -1,4 +0,0 @@ -/* -*/ - -/* empty */ diff --git a/rtl/linux/powerpc64/prt0.as b/rtl/linux/powerpc64/prt0.as deleted file mode 100644 index 2ebf78b440..0000000000 --- a/rtl/linux/powerpc64/prt0.as +++ /dev/null @@ -1,145 +0,0 @@ -/* -*/ -/* Startup code for programs linked with GNU libc. - Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. - This file is part of the GNU C Library. - - The GNU C Library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - The GNU C Library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with the GNU C Library; if not, write to the Free - Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA - 02111-1307 USA. */ - -.macro LOAD_64BIT_VAL ra, value - lis \ra,\value@highest - ori \ra,\ra,\value@higher - sldi \ra,\ra,32 - oris \ra,\ra,\value@h - ori \ra,\ra,\value@l -.endm - -.macro FUNCTION_PROLOG fn - .section ".text" - .align 2 - .globl \fn - .section ".opd", "aw" - .align 3 - \fn: - .quad .\fn, .TOC.@tocbase, 0 - .previous - .size \fn, 24 - .type \fn, @function - .globl .\fn -.\fn: -.endm - -.macro FUNCTION_EPILOG fn - .long 0 - .byte 0, 12, 0, 0, 0, 0, 0, 0 - .type .\fn, @function - .size .\fn,.-.\fn -.endm - -.macro PRINTMSG msg len - lis 4, \msg@highest - ori 4, 4, \msg@higher - sldi 4, 4, 32 - oris 4, 4, \msg@h - ori 4, 4, \msg@l - li 5, \len - li 0,4 - li 3,1 - sc -.endm - -.section ".text" -.align 3 -.globl .ptrgl -.ptrgl: - ld 0, 0(11) - std 2, 40(1) - mtctr 0 - ld 2, 8(11) - ld 11, 8(11) - bctr - .long 0 - .byte 0, 12, 0, 0, 0, 0, 0, 0 - .type .ptrgl, @function - .size .ptrgl, . - .ptrgl - - /* - Main Pascal entry point label (function) - */ -FUNCTION_PROLOG _start - - mr 26, 1 - /* Set up an initial stack frame, and clear the LR */ - clrrdi 1, 1, 5 /* align r1 */ - li 0, 0 - stdu 1,-128(1) - mtlr 0 - std 0, 0(1) /* r1 = pointer to NULL value */ - - /* store argument count (= 0(r1) )*/ - ld 3, 0(26) - LOAD_64BIT_VAL 10, operatingsystem_parameter_argc - stw 3, 0(10) - /* calculate argument vector address and store (= 8(r1) + 8 ) */ - addi 4, 26, 8 - LOAD_64BIT_VAL 10, operatingsystem_parameter_argv - std 4, 0(10) - /* store environment pointer (= argv + (argc+1)* 8 ) */ - addi 5, 3, 1 - sldi 5, 5, 3 - add 5, 4, 5 - LOAD_64BIT_VAL 10, operatingsystem_parameter_envp - std 5, 0(10) - - bl .PASCALMAIN - ori 0, 0, 0 - - /* directly jump to exit procedure, not via the function pointer */ - b ._haltproc - - .align 3 - - .global _haltproc - .section ".opd", "aw" - .align 3 -_haltproc: - .quad ._haltproc, .TOC.@tocbase, 0 - .previous - .size _haltproc, 24 - .global ._haltproc - -._haltproc: - /* exit call */ - li 0, 1 - sc - b ._haltproc - - /* Define a symbol for the first piece of initialized data. */ - .section ".data" - .globl __data_start -__data_start: -data_start: - .globl ___fpc_brk_addr /* heap management */ - .type ___fpc_brk_addr, @object - .size ___fpc_brk_addr, 4 -___fpc_brk_addr: - .long 0 - -.text - .comm operatingsystem_parameter_argc, 4 - .comm operatingsystem_parameter_argv, 8 - .comm operatingsystem_parameter_envp, 8 - diff --git a/rtl/linux/powerpc64/sighnd.inc b/rtl/linux/powerpc64/sighnd.inc deleted file mode 100644 index 6f88dd132f..0000000000 --- a/rtl/linux/powerpc64/sighnd.inc +++ /dev/null @@ -1,93 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by Michael Van Canneyt, - member of the Free Pascal development team. - - Signal handler is arch dependant due to processor to language - exception conversion. - - 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. - - **********************************************************************} - - -procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);cdecl; -var - res : word; - fpustate : dword; - {$IFDEF EXCDEBUG} - p : pbyte; - i, j : integer; - {$ENDIF} -begin - res:=0; - {$IFDEF EXCDEBUG} - writeln('signaltorunerror'); - { dump SigContext } - p := pbyte(SigContext); - for j := 0 to sizeof(TSigContext) div 8 do begin - for i := 0 to 7 do begin - write(hexstr(p^, 2)); - inc(p); - end; - write(' '); - end; - writeln; - {$ENDIF} - - { SigContext is actally a pointer to a ucontext structure. - So we do some ugly pointer casting to get it right again. - - See also in the *kernel* sources arch/ppc64/kernel/signal.c, - function setup_rt_sigframe() } - - SigContext := @(PUContext(SigContext)^.uc_mcontext); - - { exception flags are turned off by kernel } - fpc_enable_ppc_fpu_exceptions; - case sig of - SIGFPE : - begin - { ugly typecast to get the FPSCR register contents } - fpustate := DWord(PDWord(@SigContext^.fp_regs[PT_FPSCR])^); - {$IFDEF EXCDEBUG} - writeln('fpustate = ', hexstr(fpustate, sizeof(fpustate)*2)); - {$ENDIF} - { distinguish between the different FPU exceptions } - if (fpustate and ppc_fpu_underflow) <> 0 then - res := 206 - else if (fpustate and ppc_fpu_overflow) <> 0 then - res := 205 - else if (fpustate and ppc_fpu_divbyzero) <> 0 then - res := 200 - else - res := 207; - end; - SIGBUS : - res:=214; - SIGILL, - SIGSEGV : - res:=216; - end; - {$IFDEF EXCDEBUG} - writeln('sig = ', sig); - writeln('siginfo = ', hexstr(ptrint(siginfo), sizeof(siginfo)*2)); - writeln('sigcontext = ', hexstr(ptrint(sigcontext), sizeof(sigcontext)*2)); - - writeln('sigcontext...signal = ', hexstr(sigcontext^.signal, 16)); - - writeln('sigcontext^...regs = ', hexstr(ptrint(sigcontext^.regs), 16)); - {$ENDIF} - { reenable signal } - reenable_signal(sig); - - { handle error } - if res<>0 then - HandleErrorAddrFrame(res, Pointer(SigContext^.gp_regs[PT_NIP]), Pointer(SigContext^.gp_regs[PT_R1])); -end; - diff --git a/rtl/linux/powerpc64/sighndh.inc b/rtl/linux/powerpc64/sighndh.inc deleted file mode 100644 index 8c8d94c5df..0000000000 --- a/rtl/linux/powerpc64/sighndh.inc +++ /dev/null @@ -1,166 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - Copyright (c) 2005 by Thomas Schatzl - - TSigContext and associated structures - - 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. - - **********************************************************************} - -{$packrecords C} - -type - gpr_reg = cULong; - fpr_reg = double; - vvr_reg = array[0..1] of cULong; - -type - { from include/asm-ppc64/ptrace.h } - ppt_regs = ^pt_regs; - pt_regs = record - gpr : array[0..31] of gpr_reg; - nip : gpr_reg; - msr : gpr_reg; - orig_gpr3 : gpr_reg; { Used for restarting system calls } - ctr : gpr_reg; - link : gpr_reg; - xer : gpr_reg; - ccr : gpr_reg; - softe : gpr_reg; { Soft enabled/disabled } - trap : gpr_reg; { Reason for being here } - dar : gpr_reg; { Fault registers } - dsisr : gpr_reg; - result : gpr_reg; { Result of a system call } - end; - -{ index constants for the different register set arrays in TSigContext. - Comments were directly pasted from the sources. -} -const - PT_R0 = 0; - PT_R1 = 1; - PT_R2 = 2; - PT_R3 = 3; - PT_R4 = 4; - PT_R5 = 5; - PT_R6 = 6; - PT_R7 = 7; - PT_R8 = 8; - PT_R9 = 9; - PT_R10 = 10; - PT_R11 = 11; - PT_R12 = 12; - PT_R13 = 13; - PT_R14 = 14; - PT_R15 = 15; - PT_R16 = 16; - PT_R17 = 17; - PT_R18 = 18; - PT_R19 = 19; - PT_R20 = 20; - PT_R21 = 21; - PT_R22 = 22; - PT_R23 = 23; - PT_R24 = 24; - PT_R25 = 25; - PT_R26 = 26; - PT_R27 = 27; - PT_R28 = 28; - PT_R29 = 29; - PT_R30 = 30; - PT_R31 = 31; - PT_NIP = 32; - PT_MSR = 33; - PT_CTR = 35; - PT_LNK = 36; - PT_XER = 37; - PT_CCR = 38; - PT_SOFTE = 39; - PT_RESULT = 43; - PT_FPR0 = 48; - PT_FPR31 = PT_FPR0+31; - { Kernel and userspace will both use this PT_FPSCR value. 32-bit apps will have - visibility to the asm-ppc/ptrace.h header instead of this one. } - { each FP reg occupies 1 slot in 64-bit space } - PT_FPSCR = PT_FPR0+32; - { each Vector reg occupies 2 slots in 64-bit } - PT_VR0 = 82; - PT_VSCR = (PT_VR0+(32*2))+1; - PT_VRSAVE = PT_VR0+(33*2); - - { from include/asm-ppc64/signal.h } -type - stack_t = record - ss_sp : pointer; - ss_flags : cInt; - ss_size : size_t; - end; - - { from include/asm-ppc64/sigcontext.h and - include/asm-ppc64/elf.h - } -const - ELF_NGREG = 48; { includes nip, msr, lr, etc. } - ELF_NFPREG = 33; { includes fpscr } - ELF_NVRREG = 34; { includes vscr & vrsave in split vectors } - -type - elf_gregset_t = array[0..ELF_NGREG-1] of gpr_reg; - elf_fpregset_t = array[0..ELF_NFPREG-1] of fpr_reg; - - elf_vrreg_t = array[0..ELF_NVRREG-1] of vvr_reg; - - TSigContext = record - _unused : array[0..3] of cULong; - signal : cInt; - _pad0 : cInt; - handler : cULong; - oldmask : cULong; - regs : ppt_regs; - gp_regs : elf_gregset_t; - fp_regs : elf_fpregset_t; - - { To maintain compatibility with current implementations the sigcontext is - extended by appending a pointer (v_regs) to a quadword type (elf_vrreg_t) - followed by an unstructured (vmx_reserve) field of 69 doublewords. This - allows the array of vector registers to be quadword aligned independent of - the alignment of the containing sigcontext or ucontext. It is the - responsibility of the code setting the sigcontext to set this pointer to - either NULL (if this processor does not support the VMX feature) or the - address of the first quadword within the allocated (vmx_reserve) area. - - The pointer (v_regs) of vector type (elf_vrreg_t) is type compatible with - an array of 34 quadword entries (elf_vrregset_t). The entries with - indexes 0-31 contain the corresponding vector registers. The entry with - index 32 contains the vscr as the last word (offset 12) within the - quadword. This allows the vscr to be stored as either a quadword (since - it must be copied via a vector register to/from storage) or as a word. - The entry with index 33 contains the vrsave as the first word (offset 0) - within the quadword. } - v_regs : ^elf_vrreg_t; - vmx_reserve : array[0..ELF_NVRREG+ELF_NVRREG] of cLong; - end; - - { the kernel uses a different sigset_t type for the ucontext structure and the - sigset_t used for masking signals. To avoid name clash, and still use a dedicated - type for the fields, use _sigset_t } - _sigset_t = cULong; - - { from include/asm-ppc64/ucontext.h } - pucontext = ^tucontext; - tucontext = record - uc_flags : cuLong; - uc_link : pucontext; - uc_stack : stack_t; - uc_sigmask : _sigset_t; - __unused : array[0..14] of _sigset_t; { Allow for uc_sigmask growth } - uc_mcontext : TSigContext; { last for extensibility } - end; - - PSigContext = ^TSigContext; diff --git a/rtl/linux/powerpc64/stat.inc b/rtl/linux/powerpc64/stat.inc deleted file mode 100644 index 1119f13eae..0000000000 --- a/rtl/linux/powerpc64/stat.inc +++ /dev/null @@ -1,59 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by Jonas Maebe, - member of the Free Pascal development team. - - 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. - - **********************************************************************} - - Stat = packed record // No unix typing because of differences - case integer of - 0 : ( - st_dev : qword; - st_ino : qword; - st_nlink : qword; - - st_mode : dword; - st_uid : dword; - st_gid : dword; - __pad0 : dword; - st_rdev : qword; - st_size : int64; - st_blksize : int64; - st_blocks : int64; { Number 512-byte blocks allocated. } - - st_atime : qword; - __reserved0 : qword; { reserved for atime.nanoseconds } - st_mtime : qword; - __reserved1 : qword; { reserved for atime.nanoseconds } - st_ctime : qword; - __reserved2 : qword; { reserved for atime.nanoseconds } - __unused : array[0..2] of int64 - ); - 1 : ( - dev : qword; - ino, - mode : qword; - nlink_dummy : dword; - uid_dummy, - gid_dummy, - rdev : dword; - size : qword; - blksize, - blocks, - atime, - __unused1_dummy, - mtime, - __unused2_dummy, - ctime, - __unused3_dummy, - __unused4_dummy, - __unused5_dummy : qword; - ); - end; diff --git a/rtl/linux/powerpc64/syscall.inc b/rtl/linux/powerpc64/syscall.inc deleted file mode 100644 index dc0e38e8c8..0000000000 --- a/rtl/linux/powerpc64/syscall.inc +++ /dev/null @@ -1,378 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by Michael Van Canneyt, - member of the Free Pascal development team. - - 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. - - **********************************************************************} - -{No debugging for syslinux include !} -{$IFDEF SYS_LINUX} - {$UNDEF SYSCALL_DEBUG} -{$ENDIF SYS_LINUX} - - -{***************************************************************************** - --- Main:The System Call Self --- -*****************************************************************************} - -function FpSysCall(sysnr:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL0']; -{ - This function puts the registers in place, does the call, and then - copies back the registers as they are after the SysCall. -} -var - temp : qword; - retaddress: ptruint; -asm - mr r0,r3 - sc - bns .LDone - lis r10,(fpc_threadvar_relocate_proc)@highesta - ori r10, r10, (fpc_threadvar_relocate_proc)@highera - sldi r10, r10, 32 - oris r10, r10, (fpc_threadvar_relocate_proc)@ha - ld r10,(fpc_threadvar_relocate_proc)@l(r10) - - cmpdi r10,0 - bne .LThreaded - lis r4, (Errno+8)@highesta - ori r4, r4, (Errno+8)@highera - sldi r4, r4, 32 - oris r4, r4, (Errno+8)@ha - stw r3,(Errno+8)@l(r4) - b .LFailed -.LThreaded: - std r3,temp - mflr r3 - std r3,retaddress - ld r10, 0(r10) - mtctr r10 - lis r4, (errno)@highesta - ori r4, r4, (errno)@highera - sldi r4, r4, 32 - oris r4, r4, (errno)@ha - ld r3,(errno)@l(r4) - bctrl - ld r4,temp - ld r5,retaddress - std r4,0(r3) - mtlr r5 -.LFailed: - li r3, -1 -.LDone: -end; - -function FpSysCall(sysnr,param1:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL1']; -{ - This function puts the registers in place, does the call, and then - copies back the registers as they are after the SysCall. -} -var - temp : qword; - retaddress: ptruint; -asm - mr r0,r3 - mr r3,r4 - sc - bns .LDone - lis r10,(fpc_threadvar_relocate_proc)@highesta - ori r10, r10, (fpc_threadvar_relocate_proc)@highera - sldi r10, r10, 32 - oris r10, r10, (fpc_threadvar_relocate_proc)@ha - ld r10,(fpc_threadvar_relocate_proc)@l(r10) - - cmpdi r10,0 - bne .LThreaded - lis r4, (Errno+8)@highesta - ori r4, r4, (Errno+8)@highera - sldi r4, r4, 32 - oris r4, r4, (Errno+8)@ha - stw r3,(Errno+8)@l(r4) - b .LFailed -.LThreaded: - std r3,temp - mflr r3 - mtctr r10 - ld r10, 0(r10) - - lis r4, (errno)@highesta - ori r4, r4, (errno)@highera - sldi r4, r4, 32 - oris r4, r4, (errno)@ha - std r3,retaddress - ld r3,(errno)@l(r4) - bctrl - ld r4,temp - ld r5,retaddress - std r4,0(r3) - mtlr r5 -.LFailed: - li r3, -1 -.LDone: -end; - -function FpSysCall(sysnr,param1,param2:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL2']; -{ - This function puts the registers in place, does the call, and then - copies back the registers as they are after the SysCall. -} -var - temp : qword; - retaddress: ptruint; -asm - mr r0,r3 - mr r3,r4 - mr r4,r5 - sc - bns .LDone - lis r10,(fpc_threadvar_relocate_proc)@highesta - ori r10, r10, (fpc_threadvar_relocate_proc)@highera - sldi r10, r10, 32 - oris r10, r10, (fpc_threadvar_relocate_proc)@ha - ld r10,(fpc_threadvar_relocate_proc)@l(r10) - - cmpdi r10,0 - bne .LThreaded - lis r4, (Errno+8)@highesta - ori r4, r4, (Errno+8)@highera - sldi r4, r4, 32 - oris r4, r4, (Errno+8)@ha - stw r3,(Errno+8)@l(r4) - b .LFailed -.LThreaded: - std r3,temp - mflr r3 - ld r10, 0(r10) - mtctr r10 - lis r4, (errno)@highesta - ori r4, r4, (errno)@highera - sldi r4, r4, 32 - oris r4, r4, (errno)@ha - std r3,retaddress - ld r3,(errno)@l(r4) - bctrl - ld r4,temp - ld r5,retaddress - std r4,0(r3) - mtlr r5 -.LFailed: - li r3, -1 -.LDone: -end; - - -function FpSysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL3']; -{ - This function puts the registers in place, does the call, and then - copies back the registers as they are after the SysCall. -} -var - temp : qword; - retaddress: ptruint; -asm - mr r0,r3 - mr r3,r4 - mr r4,r5 - mr r5,r6 - sc - bns .LDone - lis r10,(fpc_threadvar_relocate_proc)@highesta - ori r10, r10, (fpc_threadvar_relocate_proc)@highera - sldi r10, r10, 32 - oris r10, r10, (fpc_threadvar_relocate_proc)@ha - ld r10,(fpc_threadvar_relocate_proc)@l(r10) - - cmpdi r10,0 - bne .LThreaded - lis r4, (Errno+8)@highesta - ori r4, r4, (Errno+8)@highera - sldi r4, r4, 32 - oris r4, r4, (Errno+8)@ha - stw r3,(Errno+8)@l(r4) - b .LFailed -.LThreaded: - std r3,temp - mflr r3 - ld r10, 0(r10) - mtctr r10 - lis r4, (errno)@highesta - ori r4, r4, (errno)@highera - sldi r4, r4, 32 - oris r4, r4, (errno)@ha - std r3,retaddress - ld r3,(errno)@l(r4) - bctrl - ld r4,temp - ld r5,retaddress - std r4,0(r3) - mtlr r5 -.LFailed: - li r3, -1 -.LDone: -end; - - -function FpSysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL4']; -{ - This function puts the registers in place, does the call, and then - copies back the registers as they are after the SysCall. -} -var - temp : qword; - retaddress: ptruint; -asm - mr r0,r3 - mr r3,r4 - mr r4,r5 - mr r5,r6 - mr r6,r7 - sc - bns .LDone - lis r10,(fpc_threadvar_relocate_proc)@highesta - ori r10, r10, (fpc_threadvar_relocate_proc)@highera - sldi r10, r10, 32 - oris r10, r10, (fpc_threadvar_relocate_proc)@ha - ld r10,(fpc_threadvar_relocate_proc)@l(r10) - - cmpdi r10,0 - bne .LThreaded - lis r4, (Errno+8)@highesta - ori r4, r4, (Errno+8)@highera - sldi r4, r4, 32 - oris r4, r4, (Errno+8)@ha - stw r3,(Errno+8)@l(r4) - b .LFailed -.LThreaded: - std r3,temp - mflr r3 - ld r10, 0(r10) - mtctr r10 - lis r4, (errno)@highesta - ori r4, r4, (errno)@highera - sldi r4, r4, 32 - oris r4, r4, (errno)@ha - std r3,retaddress - ld r3,(errno)@l(r4) - bctrl - ld r4,temp - ld r5,retaddress - std r4,0(r3) - mtlr r5 -.LFailed: - li r3, -1 -.LDone: -end; - - -function FpSysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL5']; -{ - This function puts the registers in place, does the call, and then - copies back the registers as they are after the SysCall. -} -var - temp : qword; - retaddress: ptruint; -asm - mr r0,r3 - mr r3,r4 - mr r4,r5 - mr r5,r6 - mr r6,r7 - mr r7,r8 - sc - bns .LDone - lis r10,(fpc_threadvar_relocate_proc)@highesta - ori r10, r10, (fpc_threadvar_relocate_proc)@highera - sldi r10, r10, 32 - oris r10, r10, (fpc_threadvar_relocate_proc)@ha - ld r10,(fpc_threadvar_relocate_proc)@l(r10) - - cmpdi r10,0 - bne .LThreaded - lis r4, (Errno+8)@highesta - ori r4, r4, (Errno+8)@highera - sldi r4, r4, 32 - oris r4, r4, (Errno+8)@ha - stw r3,(Errno+8)@l(r4) - b .LFailed -.LThreaded: - std r3,temp - mflr r3 - ld r10, 0(r10) - mtctr r10 - lis r4, (errno)@highesta - ori r4, r4, (errno)@highera - sldi r4, r4, 32 - oris r4, r4, (errno)@ha - std r3,retaddress - ld r3,(errno)@l(r4) - bctrl - ld r4,temp - ld r5,retaddress - std r4,0(r3) - mtlr r5 -.LFailed: - li r3, -1 -.LDone: -end; - - -function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult; assembler;[public,alias:'FPC_SYSCALL6']; -{ - This function puts the registers in place, does the call, and then - copies back the registers as they are after the SysCall. -} -var - temp : qword; - retaddress: ptruint; -asm - mr r0,r3 - mr r3,r4 - mr r4,r5 - mr r5,r6 - mr r6,r7 - mr r7,r8 - mr r8,r9 - sc - bns .LDone - lis r10,(fpc_threadvar_relocate_proc)@highesta - ori r10, r10, (fpc_threadvar_relocate_proc)@highera - sldi r10, r10, 32 - oris r10, r10, (fpc_threadvar_relocate_proc)@ha - ld r10,(fpc_threadvar_relocate_proc)@l(r10) - - cmpdi r10,0 - bne .LThreaded - lis r4, (Errno+8)@highesta - ori r4, r4, (Errno+8)@highera - sldi r4, r4, 32 - oris r4, r4, (Errno+8)@ha - stw r3,(Errno+8)@l(r4) - b .LFailed -.LThreaded: - std r3,temp - mflr r3 - ld r10, 0(r10) - mtctr r10 - lis r4, (errno)@highesta - ori r4, r4, (errno)@highera - sldi r4, r4, 32 - oris r4, r4, (errno)@ha - std r3,retaddress - ld r3,(errno)@l(r4) - bctrl - ld r4,temp - ld r5,retaddress - std r4,0(r3) - mtlr r5 -.LFailed: - li r3, -1 -.LDone: -end; diff --git a/rtl/linux/powerpc64/syscallh.inc b/rtl/linux/powerpc64/syscallh.inc deleted file mode 100644 index 7431f9965c..0000000000 --- a/rtl/linux/powerpc64/syscallh.inc +++ /dev/null @@ -1,42 +0,0 @@ -{ - Copyright (c) 2002 by Marco van de Voort - - Header for syscall in system unit for powerpc *nix. - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - - **************************************************************************** - -} - -Type - - TSysResult = Int64; // all platforms, cint=32-bit. - // On platforms with off_t =64-bit, people should - // use int64, and typecast all calls that don't - // return off_t to cint. - -// I don't think this is going to work on several platforms -// 64-bit machines don't have only 64-bit params. - - TSysParam = Int64; - -function Do_SysCall(sysnr:TSysParam):TSysResult; external name 'FPC_SYSCALL0'; -function Do_SysCall(sysnr,param1:TSysParam):TSysResult; external name 'FPC_SYSCALL1'; -function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult; external name 'FPC_SYSCALL2'; -function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; external name 'FPC_SYSCALL3'; -function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; external name 'FPC_SYSCALL4'; -function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; external name 'FPC_SYSCALL5'; -function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult; external name 'FPC_SYSCALL6'; diff --git a/rtl/linux/powerpc64/sysnr.inc b/rtl/linux/powerpc64/sysnr.inc deleted file mode 100644 index 285c15836c..0000000000 --- a/rtl/linux/powerpc64/sysnr.inc +++ /dev/null @@ -1,276 +0,0 @@ -{ - Automatically converted by H2Pas 1.0.0 from - /usr/include/asm-ppc64/unistd.h - The following command line parameters were used: - unistd.h -} - - -{* This file contains the system call numbers. } - -const - syscall_nr_exit = 1; - syscall_nr_fork = 2; - syscall_nr_read = 3; - syscall_nr_write = 4; - syscall_nr_open = 5; - syscall_nr_close = 6; - syscall_nr_waitpid = 7; - syscall_nr_creat = 8; - syscall_nr_link = 9; - syscall_nr_unlink = 10; - syscall_nr_execve = 11; - syscall_nr_chdir = 12; - syscall_nr_time = 13; - syscall_nr_mknod = 14; - syscall_nr_chmod = 15; - syscall_nr_lchown = 16; - syscall_nr_break = 17; - syscall_nr_oldstat = 18; - syscall_nr_lseek = 19; - syscall_nr_getpid = 20; - syscall_nr_mount = 21; - syscall_nr_umount = 22; - syscall_nr_setuid = 23; - syscall_nr_getuid = 24; - syscall_nr_stime = 25; - syscall_nr_ptrace = 26; - syscall_nr_alarm = 27; - syscall_nr_oldfstat = 28; - syscall_nr_pause = 29; - syscall_nr_utime = 30; - syscall_nr_stty = 31; - syscall_nr_gtty = 32; - syscall_nr_access = 33; - syscall_nr_nice = 34; - syscall_nr_ftime = 35; - syscall_nr_sync = 36; - syscall_nr_kill = 37; - syscall_nr_rename = 38; - syscall_nr_mkdir = 39; - syscall_nr_rmdir = 40; - syscall_nr_dup = 41; - syscall_nr_pipe = 42; - syscall_nr_times = 43; - syscall_nr_prof = 44; - syscall_nr_brk = 45; - syscall_nr_setgid = 46; - syscall_nr_getgid = 47; - syscall_nr_signal = 48; - syscall_nr_geteuid = 49; - syscall_nr_getegid = 50; - syscall_nr_acct = 51; - syscall_nr_umount2 = 52; - syscall_nr_lock = 53; - syscall_nr_ioctl = 54; - syscall_nr_fcntl = 55; - syscall_nr_mpx = 56; - syscall_nr_setpgid = 57; - syscall_nr_ulimit = 58; - syscall_nr_oldolduname = 59; - syscall_nr_umask = 60; - syscall_nr_chroot = 61; - syscall_nr_ustat = 62; - syscall_nr_dup2 = 63; - syscall_nr_getppid = 64; - syscall_nr_getpgrp = 65; - syscall_nr_setsid = 66; - syscall_nr_sigaction = 67; - syscall_nr_sgetmask = 68; - syscall_nr_ssetmask = 69; - syscall_nr_setreuid = 70; - syscall_nr_setregid = 71; - syscall_nr_sigsuspend = 72; - syscall_nr_sigpending = 73; - syscall_nr_sethostname = 74; - syscall_nr_setrlimit = 75; - syscall_nr_getrlimit = 76; - syscall_nr_getrusage = 77; - syscall_nr_gettimeofday = 78; - syscall_nr_settimeofday = 79; - syscall_nr_getgroups = 80; - syscall_nr_setgroups = 81; - syscall_nr_select = 82; - syscall_nr_symlink = 83; - syscall_nr_oldlstat = 84; - syscall_nr_readlink = 85; - syscall_nr_uselib = 86; - syscall_nr_swapon = 87; - syscall_nr_reboot = 88; - syscall_nr_readdir = 89; - syscall_nr_mmap = 90; - syscall_nr_munmap = 91; - syscall_nr_truncate = 92; - syscall_nr_ftruncate = 93; - syscall_nr_fchmod = 94; - syscall_nr_fchown = 95; - syscall_nr_getpriority = 96; - syscall_nr_setpriority = 97; - syscall_nr_profil = 98; - syscall_nr_statfs = 99; - syscall_nr_fstatfs = 100; - syscall_nr_ioperm = 101; - syscall_nr_socketcall = 102; - syscall_nr_syslog = 103; - syscall_nr_setitimer = 104; - syscall_nr_getitimer = 105; - syscall_nr_stat = 106; - syscall_nr_lstat = 107; - syscall_nr_fstat = 108; - syscall_nr_olduname = 109; - syscall_nr_iopl = 110; - syscall_nr_vhangup = 111; - syscall_nr_idle = 112; - syscall_nr_vm86 = 113; - syscall_nr_wait4 = 114; - syscall_nr_swapoff = 115; - syscall_nr_sysinfo = 116; - syscall_nr_ipc = 117; - syscall_nr_fsync = 118; - syscall_nr_sigreturn = 119; - syscall_nr_clone = 120; - syscall_nr_setdomainname = 121; - syscall_nr_uname = 122; - syscall_nr_modify_ldt = 123; - syscall_nr_adjtimex = 124; - syscall_nr_mprotect = 125; - syscall_nr_sigprocmask = 126; - syscall_nr_create_module = 127; - syscall_nr_init_module = 128; - syscall_nr_delete_module = 129; - syscall_nr_get_kernel_syms = 130; - syscall_nr_quotactl = 131; - syscall_nr_getpgid = 132; - syscall_nr_fchdir = 133; - syscall_nr_bdflush = 134; - syscall_nr_sysfs = 135; - syscall_nr_personality = 136; - { Syscall for Andrew File System } - syscall_nr_afs_syscall = 137; - syscall_nr_setfsuid = 138; - syscall_nr_setfsgid = 139; - syscall_nr__llseek = 140; - syscall_nr_getdents = 141; - syscall_nr__newselect = 142; - syscall_nr_flock = 143; - syscall_nr_msync = 144; - syscall_nr_readv = 145; - syscall_nr_writev = 146; - syscall_nr_getsid = 147; - syscall_nr_fdatasync = 148; - syscall_nr__sysctl = 149; - syscall_nr_mlock = 150; - syscall_nr_munlock = 151; - syscall_nr_mlockall = 152; - syscall_nr_munlockall = 153; - syscall_nr_sched_setparam = 154; - syscall_nr_sched_getparam = 155; - syscall_nr_sched_setscheduler = 156; - syscall_nr_sched_getscheduler = 157; - syscall_nr_sched_yield = 158; - syscall_nr_sched_get_priority_max = 159; - syscall_nr_sched_get_priority_min = 160; - syscall_nr_sched_rr_get_interval = 161; - syscall_nr_nanosleep = 162; - syscall_nr_mremap = 163; - syscall_nr_setresuid = 164; - syscall_nr_getresuid = 165; - syscall_nr_query_module = 166; - syscall_nr_poll = 167; - syscall_nr_nfsservctl = 168; - syscall_nr_setresgid = 169; - syscall_nr_getresgid = 170; - syscall_nr_prctl = 171; - syscall_nr_rt_sigreturn = 172; - syscall_nr_rt_sigaction = 173; - syscall_nr_rt_sigprocmask = 174; - syscall_nr_rt_sigpending = 175; - syscall_nr_rt_sigtimedwait = 176; - syscall_nr_rt_sigqueueinfo = 177; - syscall_nr_rt_sigsuspend = 178; - syscall_nr_pread = 179; - syscall_nr_pwrite = 180; - syscall_nr_chown = 181; - syscall_nr_getcwd = 182; - syscall_nr_capget = 183; - syscall_nr_capset = 184; - syscall_nr_sigaltstack = 185; - syscall_nr_sendfile = 186; - { some people actually want streams } - syscall_nr_getpmsg = 187; - { some people actually want streams } - syscall_nr_putpmsg = 188; - syscall_nr_vfork = 189; - { SuS compliant getrlimit } - syscall_nr_ugetrlimit = 190; - syscall_nr_mmap2 = 192; - syscall_nr_truncate64 = 193; - syscall_nr_ftruncate64 = 194; - syscall_nr_stat64 = 195; - syscall_nr_lstat64 = 196; - syscall_nr_fstat64 = 197; - syscall_nr_pciconfig_read = 198; - syscall_nr_pciconfig_write = 199; - syscall_nr_pciconfig_iobase = 200; - syscall_nr_multiplexer = 201; - syscall_nr_getdents64 = 202; - syscall_nr_pivot_root = 203; - syscall_nr_fcntl64 = 204; - syscall_nr_madvise = 205; - syscall_nr_mincore = 206; - syscall_nr_gettid = 207; - syscall_nr_tkill = 208; - syscall_nr_setxattr = 209; - syscall_nr_lsetxattr = 210; - syscall_nr_fsetxattr = 211; - syscall_nr_getxattr = 212; - syscall_nr_lgetxattr = 213; - syscall_nr_fgetxattr = 214; - syscall_nr_listxattr = 215; - syscall_nr_llistxattr = 216; - syscall_nr_flistxattr = 217; - syscall_nr_removexattr = 218; - syscall_nr_lremovexattr = 219; - syscall_nr_fremovexattr = 220; - syscall_nr_futex = 221; - syscall_nr_sched_setaffinity = 222; - syscall_nr_sched_getaffinity = 223; - { 224 currently unused } - syscall_nr_tuxcall = 225; - syscall_nr_sendfile64 = 226; - syscall_nr_io_setup = 227; - syscall_nr_io_destroy = 228; - syscall_nr_io_getevents = 229; - syscall_nr_io_submit = 230; - syscall_nr_io_cancel = 231; - syscall_nr_set_tid_address = 232; - syscall_nr_fadvise64 = 233; - syscall_nr_exit_group = 234; - syscall_nr_lookup_dcookie = 235; - syscall_nr_epoll_create = 236; - syscall_nr_epoll_ctl = 237; - syscall_nr_epoll_wait = 238; - syscall_nr_remap_file_pages = 239; - syscall_nr_timer_create = 240; - syscall_nr_timer_settime = 241; - syscall_nr_timer_gettime = 242; - syscall_nr_timer_getoverrun = 243; - syscall_nr_timer_delete = 244; - syscall_nr_clock_settime = 245; - syscall_nr_clock_gettime = 246; - syscall_nr_clock_getres = 247; - syscall_nr_clock_nanosleep = 248; - syscall_nr_tgkill = 250; - syscall_nr_utimes = 251; - syscall_nr_rtas = 255; - syscall_nr_mq_open = 262; - syscall_nr_mq_unlink = 263; - syscall_nr_mq_timedsend = 264; - syscall_nr_mq_timedreceive = 265; - syscall_nr_mq_notify = 266; - syscall_nr_mq_getsetattr = 267; - syscall_nr_kexec_load = 268; - syscall_nr_add_key = 269; - syscall_nr_request_key = 270; - syscall_nr_keyctl = 271; - syscall_nr_waitid = 272; diff --git a/rtl/linux/signal.inc b/rtl/linux/signal.inc index d3d21aebf8..929e4c456c 100644 --- a/rtl/linux/signal.inc +++ b/rtl/linux/signal.inc @@ -124,7 +124,7 @@ const type - SigSet = array[0..wordsinsigset-1] of cuLong; + SigSet = array[0..wordsinsigset-1] of cint; sigset_t= SigSet; PSigSet = ^SigSet; psigset_t=psigset; @@ -186,19 +186,15 @@ type {$define NEWSIGNAL} {$endif CPUx86_64} -{$ifdef CPUPOWERPC64} -{$define NEWSIGNAL} -{$endif CPUPOWERPC64} - SigActionRec = packed record // this is temporary for the migration sa_handler : SigActionHandler; {$ifdef NEWSIGNAL} - Sa_Flags : culong; + Sa_Flags : cuint; Sa_restorer : SignalRestorer; { Obsolete - Don't use } Sa_Mask : SigSet; {$else NEWSIGNAL} Sa_Mask : SigSet; - Sa_Flags : cuLong; + Sa_Flags : Longint; Sa_restorer : SignalRestorer; { Obsolete - Don't use } {$endif NEWSIGNAL} end; diff --git a/rtl/linux/sysosh.inc b/rtl/linux/sysosh.inc index ea2f626272..8fd3dd0e78 100644 --- a/rtl/linux/sysosh.inc +++ b/rtl/linux/sysosh.inc @@ -19,11 +19,7 @@ type { fd are int in C also for 64bit targets (x86_64) } THandle = Longint; - {$ifdef CPUPOWERPC64} - TThreadID = QWord; - {$else} TThreadID = THandle; - {$endif} { pthread_mutex_t } PRTLCriticalSection = ^TRTLCriticalSection; diff --git a/rtl/linux/system.pp b/rtl/linux/system.pp index 2bb4152232..00222ab2dc 100644 --- a/rtl/linux/system.pp +++ b/rtl/linux/system.pp @@ -111,8 +111,8 @@ begin fillchar(e,sizeof(e),#0); { set is 1 based PM } dec(sig); - i:=sig mod (sizeof(cuLong) * 8); - j:=sig div (sizeof(cuLong) * 8); + i:=sig mod 32; + j:=sig div 32; e[j]:=1 shl i; fpsigprocmask(SIG_UNBLOCK,@e,nil); reenable_signal:=geterrno=0; diff --git a/rtl/morphos/prt0.as b/rtl/morphos/prt0.as index e6a6a0d8c8..72a4a77930 100644 --- a/rtl/morphos/prt0.as +++ b/rtl/morphos/prt0.as @@ -1,20 +1,17 @@ -/* - $Id: prt0.as,v 1.12 2005/02/03 19:09:11 karoly Exp $ -*/ -/* - This file is part of the Free Pascal run time library. - Copyright (c) 2004 by Karoly Balogh for Genesi Sarl - - Thanks for Martin 'MarK' Kuchinka <kuchinka@volny.cz> - for his help. - - 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. -*/ +# +# This file is part of the Free Pascal run time library. +# Copyright (c) 2004 by Karoly Balogh for Genesi Sarl +# +# Thanks for Martin 'MarK' Kuchinka <kuchinka@volny.cz> +# for his help. +# +# 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. +# .section ".text" .globl _start .align 4 @@ -23,12 +20,12 @@ _start: stw 0,4(1) stwu 1,-16(1) - /* Get ExecBase */ + # Get ExecBase lwz 3,4(0) lis 4,_ExecBase@ha stw 3,_ExecBase@l(4) - /* Allocating new stack */ + # Allocating new stack lis 4,__stklen@ha lwz 3,__stklen@l(4) stw 3,0(2) @@ -36,7 +33,7 @@ _start: stw 3,56(2) lwz 3,100(2) mtlr 3 - li 3,-858 /* AllocTaskPooled */ + li 3,-858 # AllocTaskPooled blrl cmplwi cr0,3,0 @@ -45,7 +42,7 @@ _start: lis 4,stackArea@ha stw 3,stackArea@l(4) - /* Setting up stackSwap struct */ + # Setting up stackSwap struct lis 4,stackSwap@ha addi 4,4,stackSwap@l stw 3,0(4) @@ -55,7 +52,7 @@ _start: stw 3,4(4) stw 3,8(4) - /* Calling main function with the new stack */ + # Calling main function with the new stack stw 4,32(2) lis 4,_initproc@ha addi 4,4,_initproc@l @@ -64,10 +61,10 @@ _start: stw 3,40(2) lwz 4,100(2) mtlr 4 - li 3,-804 /* NewPPCStackSwap */ + li 3,-804 # NewPPCStackSwap blrl - /* Setting return value */ + # Setting return value lis 4,returnValue@ha lwz 3,returnValue@l(4) @@ -101,7 +98,7 @@ _initproc: stw 30,120(1) stw 31,124(1) - /* Save Stackpointer */ + # Save Stackpointer lis 4,OriginalStkPtr@ha stw 1,OriginalStkPtr@l(4) @@ -109,11 +106,11 @@ _initproc: .globl _haltproc _haltproc: - /* Restore Stackpointer */ + # Restore Stackpointer lis 4,OriginalStkPtr@ha lwz 1,OriginalStkPtr@l(4) - /* Store return value */ + # Store return value lis 4,returnValue@ha stw 3,returnValue@l(4) @@ -175,53 +172,12 @@ stackSwap: .long 0 .long 0 - /* This is needed to be a proper MOS ABox executable */ - /* This symbol _MUST NOT_ be stripped out from the executable */ - /* or else... */ + # This is needed to be a proper MOS ABox executable + # This symbol _MUST NOT_ be stripped out from the executable + # or else... .globl __abox__ .type __abox__,@object .size __abox__,4 __abox__: .long 1 -/* - - Revision 1.12 2005/02/03 19:09:11 karoly - * reworked startup code: - - now uses AllocTaskPooled - - check for unsuccessful stack allocation - - Revision 1.11 2004/06/06 22:02:22 karoly - * hopefully fixed stack problems causing hits - - Revision 1.10 2004/06/06 12:51:06 karoly - * changelog fixed - - Revision 1.9 2004/06/06 12:47:57 karoly - * some cleanup, comments added - - Revision 1.8 2004/06/05 19:25:12 karoly - + reworked to support resizing of stack - - Revision 1.7 2004/05/13 01:15:42 karoly - - removed comment about argc/argv, made it work another way - - Revision 1.6 2004/05/01 15:08:57 karoly - + haltproc added, saving/restoring stackpointer added - - Revision 1.5 2004/04/21 03:24:55 karoly - * rewritten to be similar to GCC startup code - - Revision 1.4 2004/04/09 04:02:43 karoly - * abox id symbol fixed - - Revision 1.3 2004/04/09 02:58:15 karoly - * typo fixed. - - Revision 1.2 2004/04/09 02:54:25 karoly - * execbase loading oops fixed. - - Revision 1.1 2004/03/16 10:29:22 karoly - * first implementation of some startup code for MOS - -*/ diff --git a/rtl/morphos/sysfile.inc b/rtl/morphos/sysfile.inc index fc42490eea..12f2a3de3f 100644 --- a/rtl/morphos/sysfile.inc +++ b/rtl/morphos/sysfile.inc @@ -1,8 +1,8 @@ { This file is part of the Free Pascal run time library. - Copyright (c) 2001 by Free Pascal development team + Copyright (c) 2005 by Free Pascal development team - Low leve file functions + Low level file functions See the file COPYING.FPC, included in this distribution, for details about the copyright. @@ -13,6 +13,9 @@ **********************************************************************} +{ Enable this for file handling debug } +{DEFINE MOSFPC_FILEDEBUG} + {***************************************************************************** MorphOS File-handling Support Functions *****************************************************************************} @@ -22,8 +25,9 @@ type { manually on exit. } PFileList = ^TFileList; TFileList = record { no packed, must be correctly aligned } - handle : LongInt; { Handle to file } - next : PFileList; { Next file in list } + handle : LongInt; { Handle to file } + next : PFileList; { Next file in list } + buffered : boolean; { used buffered I/O? } end; var @@ -80,29 +84,74 @@ begin if not inList then begin New(p); p^.handle:=h; + p^.buffered:=False; p^.next:=l^.next; l^.next:=p; - end; + end +{$IFDEF MOSFPC_FILEDEBUG} + else + RawDoFmt('FPC_FILE_DEBUG: Error! Trying add filehandle a filehandle twice: $%lx !'+#10,@h,pointer(1),nil); +{$ENDIF} + ; end; { Function to be called to remove a file from the list } -procedure RemoveFromList(var l: PFileList; h: LongInt); alias: 'REMOVEFROMLIST'; [public]; +function RemoveFromList(var l: PFileList; h: LongInt): boolean; alias: 'REMOVEFROMLIST'; [public]; var - p : PFileList; - inList: Boolean; + p : PFileList; + inList : Boolean; + tmpList: PFileList; begin - if l=nil then exit; - inList:=False; + if l=nil then begin + RemoveFromList:=inList; + exit; + end; + p:=l; while (p^.next<>nil) and (not inList) do if p^.next^.handle=h then inList:=True else p:=p^.next; - - if p^.next<>nil then begin + + if inList then begin + tmpList:=p^.next^.next; dispose(p^.next); - p^.next:=p^.next^.next; + p^.next:=tmpList; + end +{$IFDEF MOSFPC_FILEDEBUG} + else + RawDoFmt('FPC_FILE_DEBUG: Error! Trying to remove not existing filehandle: $%lx !'+#10,@h,pointer(1),nil); +{$ENDIF} + ; + + RemoveFromList:=inList; +end; + +{ Function to check if file is in the list } +function CheckInList(var l: PFileList; h: LongInt): pointer; alias: 'CHECKINLIST'; [public]; +var + p : PFileList; + inList : Pointer; + tmpList: PFileList; + +begin + inList:=nil; + if l=nil then begin + CheckInList:=inList; + exit; end; + + p:=l; + while (p^.next<>nil) and (inList=nil) do + if p^.next^.handle=h then inList:=p^.next + else p:=p^.next; + +{$IFDEF MOSFPC_FILEDEBUG} + if inList=nil then + RawDoFmt('FPC_FILE_DEBUG: Warning! Check for not existing filehandle: $%lx !'+#10,@h,pointer(1),nil); +{$ENDIF} + + CheckInList:=inList; end; @@ -114,13 +163,12 @@ end; { close a file from the handle value } procedure do_close(handle : longint); begin - if (handle<=0) then exit; - - RemoveFromList(MOS_fileList,handle); - { Do _NOT_ check CTRL_C on Close, because it will conflict - with System_Exit! } - if not dosClose(handle) then - dosError2InOut(IoErr); + if RemoveFromList(MOS_fileList,handle) then begin + { Do _NOT_ check CTRL_C on Close, because it will conflict + with System_Exit! } + if not dosClose(handle) then + dosError2InOut(IoErr); + end; end; procedure do_erase(p : pchar); @@ -137,13 +185,18 @@ begin dosError2InOut(IoErr); end; -function do_write(h:longint; addr: pointer; len: longint) : longint; +function do_write(h: longint; addr: pointer; len: longint) : longint; var dosResult: LongInt; begin checkCTRLC; do_write:=0; if (len<=0) or (h<=0) then exit; +{$IFDEF MOSFPC_FILEDEBUG} + if not ((h=StdOutputHandle) or (h=StdInputHandle) or + (h=StdErrorHandle)) then CheckInList(MOS_fileList,h); +{$ENDIF} + dosResult:=dosWrite(h,addr,len); if dosResult<0 then begin dosError2InOut(IoErr); @@ -152,13 +205,18 @@ begin end; end; -function do_read(h:longint; addr: pointer; len: longint) : longint; +function do_read(h: longint; addr: pointer; len: longint) : longint; var dosResult: LongInt; begin checkCTRLC; do_read:=0; if (len<=0) or (h<=0) then exit; +{$IFDEF MOSFPC_FILEDEBUG} + if not ((h=StdOutputHandle) or (h=StdInputHandle) or + (h=StdErrorHandle)) then CheckInList(MOS_fileList,h); +{$ENDIF} + dosResult:=dosRead(h,addr,len); if dosResult<0 then begin dosError2InOut(IoErr); @@ -167,46 +225,52 @@ begin end end; -function do_filepos(handle : longint) : longint; +function do_filepos(handle: longint) : longint; var dosResult: LongInt; begin checkCTRLC; do_filepos:=-1; - if (handle<=0) then exit; + if CheckInList(MOS_fileList,handle)<>nil then begin + + { Seeking zero from OFFSET_CURRENT to find out where we are } + dosResult:=dosSeek(handle,0,OFFSET_CURRENT); + if dosResult<0 then begin + dosError2InOut(IoErr); + end else begin + do_filepos:=dosResult; + end; - { Seeking zero from OFFSET_CURRENT to find out where we are } - dosResult:=dosSeek(handle,0,OFFSET_CURRENT); - if dosResult<0 then begin - dosError2InOut(IoErr); - end else begin - do_filepos:=dosResult; end; end; -procedure do_seek(handle,pos : longint); +procedure do_seek(handle, pos: longint); begin checkCTRLC; - if (handle<=0) then exit; + if CheckInList(MOS_fileList,handle)<>nil then begin - { Seeking from OFFSET_BEGINNING } - if dosSeek(handle,pos,OFFSET_BEGINNING)<0 then - dosError2InOut(IoErr); + { Seeking from OFFSET_BEGINNING } + if dosSeek(handle,pos,OFFSET_BEGINNING)<0 then + dosError2InOut(IoErr); + + end; end; -function do_seekend(handle:longint):longint; +function do_seekend(handle: longint):longint; var dosResult: LongInt; begin checkCTRLC; do_seekend:=-1; - if (handle<=0) then exit; + if CheckInList(MOS_fileList,handle)<>nil then begin + + { Seeking to OFFSET_END } + dosResult:=dosSeek(handle,0,OFFSET_END); + if dosResult<0 then begin + dosError2InOut(IoErr); + end else begin + do_seekend:=dosResult; + end; - { Seeking to OFFSET_END } - dosResult:=dosSeek(handle,0,OFFSET_END); - if dosResult<0 then begin - dosError2InOut(IoErr); - end else begin - do_seekend:=dosResult; - end + end; end; function do_filesize(handle : longint) : longint; @@ -214,24 +278,28 @@ var currfilepos: longint; begin checkCTRLC; do_filesize:=-1; - if (handle<=0) then exit; + if CheckInList(MOS_fileList,handle)<>nil then begin + + currfilepos:=do_filepos(handle); + { We have to do this twice, because seek returns the OLD position } + do_filesize:=do_seekend(handle); + do_filesize:=do_seekend(handle); + do_seek(handle,currfilepos); - currfilepos:=do_filepos(handle); - { We have to do this twice, because seek returns the OLD position } - do_filesize:=do_seekend(handle); - do_filesize:=do_seekend(handle); - do_seek(handle,currfilepos) + end; end; { truncate at a given position } -procedure do_truncate (handle,pos:longint); +procedure do_truncate(handle, pos: longint); begin checkCTRLC; - if (handle<=0) then exit; + if CheckInList(MOS_fileList,handle)<>nil then begin - { Seeking from OFFSET_BEGINNING } - if SetFileSize(handle,pos,OFFSET_BEGINNING)<0 then - dosError2InOut(IoErr); + { Seeking from OFFSET_BEGINNING } + if SetFileSize(handle,pos,OFFSET_BEGINNING)<0 then + dosError2InOut(IoErr); + + end; end; procedure do_open(var f;p:pchar;flags:longint); @@ -307,7 +375,7 @@ begin end; end; -function do_isdevice(handle:longint):boolean; +function do_isdevice(handle: longint): boolean; begin if (handle=StdOutputHandle) or (handle=StdInputHandle) or (handle=StdErrorHandle) then @@ -316,5 +384,3 @@ begin do_isdevice:=False; end; - - diff --git a/rtl/morphos/sysheap.inc b/rtl/morphos/sysheap.inc index a43c95ce31..27a64d2cb9 100644 --- a/rtl/morphos/sysheap.inc +++ b/rtl/morphos/sysheap.inc @@ -1,10 +1,8 @@ { This file is part of the Free Pascal run time library. - Copyright (c) 2001 by Free Pascal development team + Copyright (c) 2005 by Free Pascal development team - This file implements all the base types and limits required - for a minimal POSIX compliant subset required to port the compiler - to a new OS. + Low level memory functions See the file COPYING.FPC, included in this distribution, for details about the copyright. @@ -15,21 +13,39 @@ **********************************************************************} +{ Enable this for memory allocation debugging } +{DEFINE MOSFPC_MEMDEBUG} + {***************************************************************************** OS Memory allocation / deallocation ****************************************************************************} function SysOSAlloc(size: ptrint): pointer; +{$IFDEF MOSFPC_MEMDEBUG} +var values: array[0..2] of dword; +{$ENDIF} begin result:=AllocPooled(MOS_heapPool,size); +{$IFDEF MOSFPC_MEMDEBUG} + values[0]:=dword(result); + values[1]:=dword(size); + values[2]:=DWord(Sptr-StackBottom); + RawDoFmt('FPC_MEM_DEBUG: $%lx:=SysOSAlloc(%ld), free stack: %ld bytes'+#10,@values,pointer(1),nil); +{$ENDIF} end; {$define HAS_SYSOSFREE} procedure SysOSFree(p: pointer; size: ptrint); +{$IFDEF MOSFPC_MEMDEBUG} +var values: array[0..2] of dword; +{$ENDIF} begin FreePooled(MOS_heapPool,p,size); +{$IFDEF MOSFPC_MEMDEBUG} + values[0]:=dword(p); + values[1]:=dword(size); + values[2]:=DWord(Sptr-StackBottom); + RawDoFmt('FPC_MEM_DEBUG: SysOSFree($%lx,%ld), free stack: %ld bytes'+#10,@values,pointer(1),nil); +{$ENDIF} end; - - - diff --git a/rtl/morphos/system.pp b/rtl/morphos/system.pp index e65a76bb3b..e50f9bacfe 100644 --- a/rtl/morphos/system.pp +++ b/rtl/morphos/system.pp @@ -71,6 +71,14 @@ implementation {$I system.inc} +{$IFDEF MOSFPC_FILEDEBUG} +{$WARNING Compiling with file debug enabled!} +{$ENDIF} + +{$IFDEF MOSFPC_MEMDEBUG} +{$WARNING Compiling with memory debug enabled!} +{$ENDIF} + {***************************************************************************** Misc. System Dependent Functions diff --git a/rtl/morphos/sysutils.pp b/rtl/morphos/sysutils.pp index 03adffe80b..b89b3f9923 100644 --- a/rtl/morphos/sysutils.pp +++ b/rtl/morphos/sysutils.pp @@ -52,7 +52,8 @@ uses dos,sysconst; { * Followings are implemented in the system unit! * } function PathConv(path: shortstring): shortstring; external name 'PATHCONV'; procedure AddToList(var l: Pointer; h: LongInt); external name 'ADDTOLIST'; -procedure RemoveFromList(var l: Pointer; h: LongInt); external name 'REMOVEFROMLIST'; +function RemoveFromList(var l: Pointer; h: LongInt): boolean; external name 'REMOVEFROMLIST'; +function CheckInList(var l: Pointer; h: LongInt): pointer; external name 'CHECKINLIST'; var MOS_fileList: Pointer; external name 'MOS_FILELIST'; diff --git a/rtl/objpas/sysutils/filutilh.inc b/rtl/objpas/sysutils/filutilh.inc index e486101917..153d6c67c4 100644 --- a/rtl/objpas/sysutils/filutilh.inc +++ b/rtl/objpas/sysutils/filutilh.inc @@ -27,7 +27,7 @@ Type {$else unix} FindHandle : THandle; {$endif unix} -{$if defined(Win32) or defined(WinCE)} +{$ifdef Win32} FindData : TWin32FindData; {$endif} {$ifdef netware_clib} diff --git a/rtl/os2/pmwp.pas b/rtl/os2/pmwp.pas index 3ed8a544f5..cea3ba4d43 100644 --- a/rtl/os2/pmwp.pas +++ b/rtl/os2/pmwp.pas @@ -231,4 +231,3 @@ Function WinLoadFileIconN(pszFileName: PChar; ulIconIndex: Cardinal): Cardinal; cdecl; external 'PMWP' index ???; } - diff --git a/rtl/powerpc/powerpc.inc b/rtl/powerpc/powerpc.inc index 3fab9cba4a..ce9487b4f5 100644 --- a/rtl/powerpc/powerpc.inc +++ b/rtl/powerpc/powerpc.inc @@ -1,1163 +1,1163 @@ -{
-
- This file is part of the Free Pascal run time library.
- Copyright (c) 2000-2001 by the Free Pascal development team.
-
- Portions Copyright (c) 2000 by Casey Duncan (casey.duncan@state.co.us)
-
- Processor dependent implementation for the system unit for
- PowerPC
-
- 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.
-
- **********************************************************************}
-
-
-{****************************************************************************
- PowerPC specific stuff
-****************************************************************************}
-{
-
-const
- ppc_fpu_overflow = (1 shl (32-3));
- ppc_fpu_underflow = (1 shl (32-4));
- ppc_fpu_divbyzero = (1 shl (32-5));
- ppc_fpu_inexact = (1 shl (32-6));
- ppc_fpu_invalid_snan = (1 shl (32-7));
-}
-
-procedure fpc_enable_ppc_fpu_exceptions;
-assembler; nostackframe;
-asm
- { clear all "exception happened" flags we care about}
- mtfsfi 0,0
- mtfsfi 1,0
- mtfsfi 2,0
- mtfsfi 3,0
- mtfsb0 21
- mtfsb0 22
- mtfsb0 23
-
- { enable invalid operations and division by zero exceptions. }
- { No overflow/underflow, since those give some spurious }
- { exceptions }
- mtfsfi 6,9
-end;
-
-
-procedure fpc_cpuinit;
-begin
- fpc_enable_ppc_fpu_exceptions;
-end;
-
-
-function fpc_get_ppc_fpscr: cardinal;
-assembler;
-var
- temp: record a,b:longint; end;
-asm
- mffs f0
- stfd f0,temp
- lwz r3,temp.b
- { clear all exception flags }
-{
- rlwinm r4,r3,0,16,31
- stw r4,temp.b
- lfd f0,temp
- a_mtfsf f0
-}
-end;
-
-{ This function is never called directly, it's a dummy to hold the register save/
- load subroutines
-}
-{$ifndef MACOS}
-label
- _restfpr_14_x,
- _restfpr_15_x,
- _restfpr_16_x,
- _restfpr_17_x,
- _restfpr_18_x,
- _restfpr_19_x,
- _restfpr_20_x,
- _restfpr_21_x,
- _restfpr_22_x,
- _restfpr_23_x,
- _restfpr_24_x,
- _restfpr_25_x,
- _restfpr_26_x,
- _restfpr_27_x,
- _restfpr_28_x,
- _restfpr_29_x,
- _restfpr_30_x,
- _restfpr_31_x,
- _restfpr_14_l,
- _restfpr_15_l,
- _restfpr_16_l,
- _restfpr_17_l,
- _restfpr_18_l,
- _restfpr_19_l,
- _restfpr_20_l,
- _restfpr_21_l,
- _restfpr_22_l,
- _restfpr_23_l,
- _restfpr_24_l,
- _restfpr_25_l,
- _restfpr_26_l,
- _restfpr_27_l,
- _restfpr_28_l,
- _restfpr_29_l,
- _restfpr_30_l,
- _restfpr_31_l;
-
-procedure saverestorereg;assembler; nostackframe;
-asm
-{ exit }
-.globl _restfpr_14_x
-_restfpr_14_x: lfd f14, -144(r11)
-.globl _restfpr_15_x
-_restfpr_15_x: lfd f15, -136(r11)
-.globl _restfpr_16_x
-_restfpr_16_x: lfd f16, -128(r11)
-.globl _restfpr_17_x
-_restfpr_17_x: lfd f17, -120(r11)
-.globl _restfpr_18_x
-_restfpr_18_x: lfd f18, -112(r11)
-.globl _restfpr_19_x
-_restfpr_19_x: lfd f19, -104(r11)
-.globl _restfpr_20_x
-_restfpr_20_x: lfd f20, -96(r11)
-.globl _restfpr_21_x
-_restfpr_21_x: lfd f21, -88(r11)
-.globl _restfpr_22_x
-_restfpr_22_x: lfd f22, -80(r11)
-.globl _restfpr_23_x
-_restfpr_23_x: lfd f23, -72(r11)
-.globl _restfpr_24_x
-_restfpr_24_x: lfd f24, -64(r11)
-.globl _restfpr_25_x
-_restfpr_25_x: lfd f25, -56(r11)
-.globl _restfpr_26_x
-_restfpr_26_x: lfd f26, -48(r11)
-.globl _restfpr_27_x
-_restfpr_27_x: lfd f27, -40(r11)
-.globl _restfpr_28_x
-_restfpr_28_x: lfd f28, -32(r11)
-.globl _restfpr_29_x
-_restfpr_29_x: lfd f29, -24(r11)
-.globl _restfpr_30_x
-_restfpr_30_x: lfd f30, -16(r11)
-.globl _restfpr_31_x
-_restfpr_31_x: lwz r0, 4(r11)
- lfd f31, -8(r11)
- mtlr r0
- ori r1, r11, 0
- blr
-
-{ exit with restoring lr }
-.globl _restfpr_14_l
-_restfpr_14_l: lfd f14, -144(r11)
-.globl _restfpr_15_l
-_restfpr_15_l: lfd f15, -136(r11)
-.globl _restfpr_16_l
-_restfpr_16_l: lfd f16, -128(r11)
-.globl _restfpr_17_l
-_restfpr_17_l: lfd f17, -120(r11)
-.globl _restfpr_18_l
-_restfpr_18_l: lfd f18, -112(r11)
-.globl _restfpr_19_l
-_restfpr_19_l: lfd f19, -104(r11)
-.globl _restfpr_20_l
-_restfpr_20_l: lfd f20, -96(r11)
-.globl _restfpr_21_l
-_restfpr_21_l: lfd f21, -88(r11)
-.globl _restfpr_22_l
-_restfpr_22_l: lfd f22, -80(r11)
-.globl _restfpr_23_l
-_restfpr_23_l: lfd f23, -72(r11)
-.globl _restfpr_24_l
-_restfpr_24_l: lfd f24, -64(r11)
-.globl _restfpr_25_l
-_restfpr_25_l: lfd f25, -56(r11)
-.globl _restfpr_26_l
-_restfpr_26_l: lfd f26, -48(r11)
-.globl _restfpr_27_l
-_restfpr_27_l: lfd f27, -40(r11)
-.globl _restfpr_28_l
-_restfpr_28_l: lfd f28, -32(r11)
-.globl _restfpr_29_l
-_restfpr_29_l: lfd f29, -24(r11)
-.globl _restfpr_30_l
-_restfpr_30_l: lfd f30, -16(r11)
-.globl _restfpr_31_l
-_restfpr_31_l: lwz r0, 4(r11)
- lfd f31, -8(r11)
- mtlr r0
- ori r1, r11, 0
- blr
-end;
-{$endif MACOS}
-
-{****************************************************************************
- Move / Fill
-****************************************************************************}
-
-{$ifndef FPC_SYSTEM_HAS_MOVE}
-{$define FPC_SYSTEM_HAS_MOVE}
-procedure Move(const source;var dest;count:longint);[public, alias: 'FPC_MOVE'];assembler; nostackframe;
-asm
- { count <= 0 ? }
- cmpwi cr0,r5,0
- { check if we have to do the move backwards because of overlap }
- sub r10,r4,r3
- { carry := boolean(dest-source < count) = boolean(overlap) }
- subc r10,r10,r5
-
- { count < 15 ? (to decide whether we will move dwords or bytes }
- cmpwi cr1,r5,15
-
- { if overlap, then r10 := -1 else r10 := 0 }
- subfe r10,r10,r10
-
- { count < 63 ? (32 + max. alignment (31) }
- cmpwi cr7,r5,63
-
- { if count <= 0, stop }
- ble cr0,.LMoveDone
-
- { load the begin of the source in the data cache }
- dcbt 0,r3
- { and the dest as well }
- dcbtst 0,r4
-
- { if overlap, then r0 := count else r0 := 0 }
- and r0,r5,r10
- { if overlap, then point source and dest to the end }
- add r3,r3,r0
- add r4,r4,r0
- { if overlap, then r6 := 0, else r6 := -1 }
- not r6,r10
- { if overlap, then r10 := -2, else r10 := 0 }
- slwi r10,r10,1
- { if overlap, then r10 := -1, else r10 := 1 }
- addi r10,r10,1
-
- { if count < 15, copy everything byte by byte }
- blt cr1,.LMoveBytes
-
- { if no overlap, then source/dest += -1, otherwise they stay }
- { After the next instruction, r3/r4 + r10 = next position to }
- { load/store from/to }
- add r3,r3,r6
- add r4,r4,r6
-
- { otherwise, guarantee 4 byte alignment for dest for starters }
-.LMove4ByteAlignLoop:
- lbzux r0,r3,r10
- stbux r0,r4,r10
- { is dest now 4 aligned? }
- andi. r0,r4,3
- subi r5,r5,1
- { while not aligned, continue }
- bne cr0,.LMove4ByteAlignLoop
-
-{$ifndef ppc603}
- { check for 32 byte alignment }
- andi. r7,r4,31
-{$endif non ppc603}
- { we are going to copy one byte again (the one at the newly }
- { aligned address), so increase count byte 1 }
- addi r5,r5,1
- { count div 4 for number of dwords to copy }
- srwi r0,r5,2
- { if 11 <= count < 63, copy using dwords }
- blt cr7,.LMoveDWords
-
-{$ifndef ppc603}
- { # of dwords to copy to reach 32 byte alignment (*4) }
- { (depends on forward/backward copy) }
-
- { if forward copy, r6 = -1 -> r8 := 32 }
- { if backward copy, r6 = 0 -> r8 := 0 }
- rlwinm r8,r6,0,31-6+1,31-6+1
- { if forward copy, we have to copy 32 - unaligned count bytes }
- { if backward copy unaligned count bytes }
- sub r7,r8,r7
- { if backward copy, the calculated value is now negate -> }
- { make it positive again }
- not r8, r6
- add r7, r7, r8
- xor r7, r7, r8
-{$endif not ppc603}
-
- { multiply the update count with 4 }
- slwi r10,r10,2
- slwi r6,r6,2
- { and adapt the source and dest }
- add r3,r3,r6
- add r4,r4,r6
-
-{$ifndef ppc603}
- beq cr0,.LMove32BytesAligned
-.L32BytesAlignMoveLoop:
- { count >= 39 -> align to 8 byte boundary and then use the FPU }
- { since we're already at 4 byte alignment, use dword store }
- subic. r7,r7,4
- lwzux r0,r3,r10
- subi r5,r5,4
- stwux r0,r4,r10
- bne .L32BytesAlignMoveLoop
-
-.LMove32BytesAligned:
- { count div 32 ( >= 1, since count was >=63 }
- srwi r0,r5,5
- { remainder }
- andi. r5,r5,31
- { to decide if we will do some dword stores (instead of only }
- { byte stores) afterwards or not }
-{$else not ppc603}
- srwi r0,r5,4
- andi. r5,r5,15
-{$endif not ppc603}
- cmpwi cr1,r5,11
- mtctr r0
-
- { r0 := count div 4, will be moved to ctr when copying dwords }
- srwi r0,r5,2
-
-{$ifndef ppc603}
- { adjust the update count: it will now be 8 or -8 depending on overlap }
- slwi r10,r10,1
-
- { adjust source and dest pointers: because of the above loop, dest is now }
- { aligned to 8 bytes. So if we add r6 we will still have an 8 bytes }
- { aligned address) }
- add r3,r3,r6
- add r4,r4,r6
-
- slwi r6,r6,1
-
- { the dcbz offset must give a 32 byte aligned address when added }
- { to the current dest address and its address must point to the }
- { bytes that will be overwritten in the current iteration. In case }
- { of a forward loop, the dest address has currently an offset of }
- { -8 compared to the bytes that will be overwritten (and r6 = -8). }
- { In case of a backward of a loop, the dest address currently has }
- { an offset of +32 compared to the bytes that will be overwritten }
- { (and r6 = 0). So the forward dcbz offset must become +8 and the }
- { backward -32 -> (-r6 * 5) - 32 gives the correct offset }
- slwi r7,r6,2
- add r7,r7,r6
- neg r7,r7
- subi r7,r7,32
-
-.LMove32ByteDcbz:
- lfdux f0,r3,r10
- lfdux f1,r3,r10
- lfdux f2,r3,r10
- lfdux f3,r3,r10
- { must be done only now, in case source and dest are less than }
- { 32 bytes apart! }
- dcbz r4,r7
- stfdux f0,r4,r10
- stfdux f1,r4,r10
- stfdux f2,r4,r10
- stfdux f3,r4,r10
- bdnz .LMove32ByteDcbz
-.LMove32ByteLoopDone:
-{$else not ppc603}
-.LMove16ByteLoop:
- lwzux r11,r3,r10
- lwzux r7,r3,r10
- lwzux r8,r3,r10
- lwzux r9,r3,r10
- stwux r11,r4,r10
- stwux r7,r4,r10
- stwux r8,r4,r10
- stwux r9,r4,r10
- bdnz .LMove16ByteLoop
-{$endif not ppc603}
-
- { cr0*4+eq is true if "count and 31" = 0 }
- beq cr0,.LMoveDone
-
- { make r10 again -1 or 1, but first adjust source/dest pointers }
- sub r3,r3,r6
- sub r4,r4,r6
-{$ifndef ppc603}
- srawi r10,r10,3
- srawi r6,r6,3
-{$else not ppc603}
- srawi r10,r10,2
- srawi r6,r6,2
-{$endif not ppc603}
-
- { cr1 contains whether count <= 11 }
- ble cr1,.LMoveBytes
-
-.LMoveDWords:
- mtctr r0
- andi. r5,r5,3
- { r10 * 4 }
- slwi r10,r10,2
- slwi r6,r6,2
- add r3,r3,r6
- add r4,r4,r6
-
-.LMoveDWordsLoop:
- lwzux r0,r3,r10
- stwux r0,r4,r10
- bdnz .LMoveDWordsLoop
-
- beq cr0,.LMoveDone
- { make r10 again -1 or 1 }
- sub r3,r3,r6
- sub r4,r4,r6
- srawi r10,r10,2
- srawi r6,r6,2
-.LMoveBytes:
- add r3,r3,r6
- add r4,r4,r6
- mtctr r5
-.LMoveBytesLoop:
- lbzux r0,r3,r10
- stbux r0,r4,r10
- bdnz .LMoveBytesLoop
-.LMoveDone:
-end;
-{$endif FPC_SYSTEM_HAS_MOVE}
-
-
-{$ifndef FPC_SYSTEM_HAS_FILLCHAR}
-{$define FPC_SYSTEM_HAS_FILLCHAR}
-
-Procedure FillChar(var x;count:longint;value:byte);assembler;
-{ input: x in r3, count in r4, value in r5 }
-
-{$ifndef FPC_ABI_AIX}
-{ in the AIX ABI, we can use te red zone for temp storage, otherwise we have }
-{ to explicitely allocate room }
-var
- temp : packed record
- case byte of
- 0: (l1,l2: longint);
- 1: (d: double);
- end;
-{$endif FPC_ABI_AIX}
-asm
- { no bytes? }
- cmpwi cr6,r4,0
- { less than 15 bytes? }
- cmpwi cr7,r4,15
- { less than 64 bytes? }
- cmpwi cr1,r4,64
- { fill r5 with ValueValueValueValue }
- rlwimi r5,r5,8,16,23
- { setup for aligning x to multiple of 4}
- rlwinm r10,r3,0,31-2+1,31
- rlwimi r5,r5,16,0,15
- ble cr6,.LFillCharDone
- { get the start of the data in the cache (and mark it as "will be }
- { modified") }
- dcbtst 0,r3
- subfic r10,r10,4
- blt cr7,.LFillCharVerySmall
- { just store 4 bytes instead of using a loop to align (there are }
- { plenty of other instructions now to keep the processor busy }
- { while it handles the (possibly unaligned) store) }
- stw r5,0(r3)
- { r3 := align(r3,4) }
- add r3,r3,r10
- { decrease count with number of bytes already stored }
- sub r4,r4,r10
- blt cr1,.LFillCharSmall
- { if we have to fill with 0 (which happens a lot), we can simply use }
- { dcbz for the most part, which is very fast, so make a special case }
- { for that }
- cmplwi cr1,r5,0
- { align to a multiple of 32 (and immediately check whether we aren't }
- { already 32 byte aligned) }
- rlwinm. r10,r3,0,31-5+1,31
- { setup r3 for using update forms of store instructions }
- subi r3,r3,4
- { get number of bytes to store }
- subfic r10,r10,32
- { if already 32byte aligned, skip align loop }
- beq .L32ByteAlignLoopDone
- { substract from the total count }
- sub r4,r4,r10
-.L32ByteAlignLoop:
- { we were already aligned to 4 byres, so this will count down to }
- { exactly 0 }
- subic. r10,r10,4
- stwu r5,4(r3)
- bne .L32ByteAlignLoop
-.L32ByteAlignLoopDone:
- { get the amount of 32 byte blocks }
- srwi r10,r4,5
- { and keep the rest in r4 (recording whether there is any rest) }
- rlwinm. r4,r4,0,31-5+1,31
- { move to ctr }
- mtctr r10
- { check how many rest there is (to decide whether we'll use }
- { FillCharSmall or FillCharVerySmall) }
- cmplwi cr7,r4,11
- { if filling with zero, only use dcbz }
- bne cr1, .LFillCharNoZero
- { make r3 point again to the actual store position }
- addi r3,r3,4
-.LFillCharDCBZLoop:
- dcbz 0,r3
- addi r3,r3,32
- bdnz .LFillCharDCBZLoop
- { if there was no rest, we're finished }
- beq .LFillCharDone
- b .LFillCharVerySmall
-.LFillCharNoZero:
-{$ifdef FPC_ABI_AIX}
- stw r5,-4(r1)
- stw r5,-8(r1)
- lfd f0,-8(r1)
-{$else FPC_ABI_AIX}
- stw r5,temp
- stw r5,temp+4
- lfd f0,temp
-{$endif FPC_ABI_AIX}
- { make r3 point to address-8, so we're able to use fp double stores }
- { with update (it's already -4 now) }
- subi r3,r3,4
- { load r10 with 8, so that dcbz uses the correct address }
- li r10, 8
-.LFillChar32ByteLoop:
- dcbz r3,r10
- stfdu f0,8(r3)
- stfdu f0,8(r3)
- stfdu f0,8(r3)
- stfdu f0,8(r3)
- bdnz .LFillChar32ByteLoop
- { if there was no rest, we're finished }
- beq .LFillCharDone
- { make r3 point again to the actual next byte that must be written }
- addi r3,r3,8
- b .LFillCharVerySmall
-.LFillCharSmall:
- { when we arrive here, we're already 4 byte aligned }
- { get count div 4 to store dwords }
- srwi r10,r4,2
- { get ready for use of update stores }
- subi r3,r3,4
- mtctr r10
- rlwinm. r4,r4,0,31-2+1,31
-.LFillCharSmallLoop:
- stwu r5,4(r3)
- bdnz .LFillCharSmallLoop
- { if nothing left, stop }
- beq .LFillCharDone
- { get ready to store bytes }
- addi r3,r3,4
-.LFillCharVerySmall:
- mtctr r4
- subi r3,r3,1
-.LFillCharVerySmallLoop:
- stbu r5,1(r3)
- bdnz .LFillCharVerySmallLoop
-.LFillCharDone:
-end;
-{$endif FPC_SYSTEM_HAS_FILLCHAR}
-
-
-{$ifndef FPC_SYSTEM_HAS_FILLDWORD}
-{$define FPC_SYSTEM_HAS_FILLDWORD}
-procedure filldword(var x;count : longint;value : dword);
-assembler; nostackframe;
-asm
-{ registers:
- r3 x
- r4 count
- r5 value
-}
- cmpwi cr0,r4,0
- mtctr r4
- subi r3,r3,4
- ble .LFillDWordEnd //if count<=0 Then Exit
-.LFillDWordLoop:
- stwu r5,4(r3)
- bdnz .LFillDWordLoop
-.LFillDWordEnd:
-end;
-{$endif FPC_SYSTEM_HAS_FILLDWORD}
-
-
-{$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
-{$define FPC_SYSTEM_HAS_INDEXBYTE}
-function IndexByte(const buf;len:longint;b:byte):longint; assembler; nostackframe;
-{ input: r3 = buf, r4 = len, r5 = b }
-{ output: r3 = position of b in buf (-1 if not found) }
-asm
- { load the begin of the buffer in the data cache }
- dcbt 0,r3
- cmplwi r4,0
- mtctr r4
- subi r10,r3,1
- mr r0,r3
- { assume not found }
- li r3,-1
- ble .LIndexByteDone
-.LIndexByteLoop:
- lbzu r9,1(r10)
- cmplw r9,r5
- bdnzf cr0*4+eq,.LIndexByteLoop
- { r3 still contains -1 here }
- bne .LIndexByteDone
- sub r3,r10,r0
-.LIndexByteDone:
-end;
-{$endif FPC_SYSTEM_HAS_INDEXBYTE}
-
-
-{$ifndef FPC_SYSTEM_HAS_INDEXWORD}
-{$define FPC_SYSTEM_HAS_INDEXWORD}
-function IndexWord(const buf;len:longint;b:word):longint; assembler; nostackframe;
-{ input: r3 = buf, r4 = len, r5 = b }
-{ output: r3 = position of b in buf (-1 if not found) }
-asm
- { load the begin of the buffer in the data cache }
- dcbt 0,r3
- cmplwi r4,0
- mtctr r4
- subi r10,r3,2
- mr r0,r3
- { assume not found }
- li r3,-1
- ble .LIndexWordDone
-.LIndexWordLoop:
- lhzu r9,2(r10)
- cmplw r9,r5
- bdnzf cr0*4+eq,.LIndexWordLoop
- { r3 still contains -1 here }
- bne .LIndexWordDone
- sub r3,r10,r0
- srawi r3,r3,1
-.LIndexWordDone:
-end;
-{$endif FPC_SYSTEM_HAS_INDEXWORD}
-
-
-{$ifndef FPC_SYSTEM_HAS_INDEXDWORD}
-{$define FPC_SYSTEM_HAS_INDEXDWORD}
-function IndexDWord(const buf;len:longint;b:DWord):longint; assembler; nostackframe;
-{ input: r3 = buf, r4 = len, r5 = b }
-{ output: r3 = position of b in buf (-1 if not found) }
-asm
- { load the begin of the buffer in the data cache }
- dcbt 0,r3
- cmplwi r4,0
- mtctr r4
- subi r10,r3,4
- mr r0,r3
- { assume not found }
- li r3,-1
- ble .LIndexDWordDone
-.LIndexDWordLoop:
- lwzu r9,4(r10)
- cmplw r9,r5
- bdnzf cr0*4+eq, .LIndexDWordLoop
- { r3 still contains -1 here }
- bne .LIndexDWordDone
- sub r3,r10,r0
- srawi r3,r3,2
-.LIndexDWordDone:
-end;
-{$endif FPC_SYSTEM_HAS_INDEXDWORD}
-
-
-{$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
-{$define FPC_SYSTEM_HAS_COMPAREBYTE}
-function CompareByte(const buf1,buf2;len:longint):longint; assembler; nostackframe;
-{ input: r3 = buf1, r4 = buf2, r5 = len }
-{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
-{ note: almost direct copy of strlcomp() from strings.inc }
-asm
- { load the begin of the first buffer in the data cache }
- dcbt 0,r3
- { use r0 instead of r3 for buf1 since r3 contains result }
- cmplwi r5,0
- mtctr r5
- subi r11,r3,1
- subi r4,r4,1
- li r3,0
- ble .LCompByteDone
-.LCompByteLoop:
- { load next chars }
- lbzu r9,1(r11)
- lbzu r10,1(r4)
- { calculate difference }
- sub. r3,r9,r10
- { if chars not equal or at the end, we're ready }
- bdnzt cr0*4+eq, .LCompByteLoop
-.LCompByteDone:
-end;
-{$endif FPC_SYSTEM_HAS_COMPAREBYTE}
-
-
-{$ifndef FPC_SYSTEM_HAS_COMPAREWORD}
-{$define FPC_SYSTEM_HAS_COMPAREWORD}
-function CompareWord(const buf1,buf2;len:longint):longint; assembler; nostackframe;
-{ input: r3 = buf1, r4 = buf2, r5 = len }
-{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
-{ note: almost direct copy of strlcomp() from strings.inc }
-asm
- { load the begin of the first buffer in the data cache }
- dcbt 0,r3
- { use r0 instead of r3 for buf1 since r3 contains result }
- cmplwi r5,0
- mtctr r5
- subi r11,r3,2
- subi r4,r4,2
- li r3,0
- ble .LCompWordDone
-.LCompWordLoop:
- { load next chars }
- lhzu r9,2(r11)
- lhzu r10,2(r4)
- { calculate difference }
- sub. r3,r9,r10
- { if chars not equal or at the end, we're ready }
- bdnzt cr0*4+eq, .LCompWordLoop
-.LCompWordDone:
-end;
-{$endif FPC_SYSTEM_HAS_COMPAREWORD}
-
-
-{$ifndef FPC_SYSTEM_HAS_COMPAREDWORD}
-{$define FPC_SYSTEM_HAS_COMPAREDWORD}
-function CompareDWord(const buf1,buf2;len:longint):longint; assembler; nostackframe;
-{ input: r3 = buf1, r4 = buf2, r5 = len }
-{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
-{ note: almost direct copy of strlcomp() from strings.inc }
-asm
- { load the begin of the first buffer in the data cache }
- dcbt 0,r3
- { use r0 instead of r3 for buf1 since r3 contains result }
- cmplwi r5,0
- mtctr r5
- subi r11,r3,4
- subi r4,r4,4
- li r3,0
- ble .LCompDWordDone
-.LCompDWordLoop:
- { load next chars }
- lwzu r9,4(r11)
- lwzu r10,4(r4)
- { calculate difference }
- sub. r3,r9,r10
- { if chars not equal or at the end, we're ready }
- bdnzt cr0*4+eq, .LCompDWordLoop
-.LCompDWordDone:
-end;
-{$endif FPC_SYSTEM_HAS_COMPAREDWORD}
-
-
-{$ifndef FPC_SYSTEM_HAS_INDEXCHAR0}
-{$define FPC_SYSTEM_HAS_INDEXCHAR0}
-function IndexChar0(const buf;len:longint;b:Char):longint; assembler; nostackframe;
-{ input: r3 = buf, r4 = len, r5 = b }
-{ output: r3 = position of found position (-1 if not found) }
-asm
- { load the begin of the buffer in the data cache }
- dcbt 0,r3
- { length = 0? }
- cmplwi r4,0
- mtctr r4
- subi r9,r3,1
- subi r0,r3,1
- { assume not found }
- li r3,-1
- { if yes, do nothing }
- ble .LIndexChar0Done
-.LIndexChar0Loop:
- lbzu r10,1(r9)
- cmplwi cr1,r10,0
- cmplw r10,r5
- beq cr1,.LIndexChar0Done
- bdnzf cr0*4+eq, .LIndexChar0Loop
- bne .LIndexChar0Done
- sub r3,r9,r0
-.LIndexChar0Done:
-end;
-{$endif FPC_SYSTEM_HAS_INDEXCHAR0}
-
-
-{****************************************************************************
- String
-****************************************************************************}
-
-{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
-{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
-function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; [public,alias: 'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
-assembler; nostackframe;
-{ input: r3: pointer to result, r4: len, r5: sstr }
-asm
- { load length source }
- lbz r10,0(r5)
- { load the begin of the dest buffer in the data cache }
- dcbtst 0,r3
-
- { put min(length(sstr),len) in r4 }
- subfc r7,r10,r4 { r0 := r4 - r10 }
- subfe r4,r4,r4 { if r3 >= r4 then r3' := 0 else r3' := -1 }
- and r7,r7,r4 { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
- add r4,r10,r7 { if r3 >= r4 then r3' := r10 else r3' := r3 }
-
- cmplwi r4,0
- { put length in ctr }
- mtctr r4
- stb r4,0(r3)
- beq .LShortStrCopyDone
-.LShortStrCopyLoop:
- lbzu r0,1(r5)
- stbu r0,1(r3)
- bdnz .LShortStrCopyLoop
-.LShortStrCopyDone:
-end;
-
-
-procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN'];
-assembler; nostackframe;
-{ input: r3: len, r4: sstr, r5: dstr }
-asm
- { load length source }
- lbz r10,0(r4)
- { load the begin of the dest buffer in the data cache }
- dcbtst 0,r5
-
- { put min(length(sstr),len) in r3 }
- subc r0,r3,r10 { r0 := r3 - r10 }
- subfe r3,r3,r3 { if r3 >= r4 then r3' := 0 else r3' := -1 }
- and r3,r0,r3 { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
- add r3,r3,r10 { if r3 >= r4 then r3' := r10 else r3' := r3 }
-
- cmplwi r3,0
- { put length in ctr }
- mtctr r3
- stb r3,0(r5)
- beq .LShortStrCopyDone2
-.LShortStrCopyLoop2:
- lbzu r0,1(r4)
- stbu r0,1(r5)
- bdnz .LShortStrCopyLoop2
-.LShortStrCopyDone2:
-end;
-{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
-
-(*
-{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
-{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
-
-function fpc_shortstr_concat(const s1, s2: shortstring): shortstring; compilerproc; [public, alias: 'FPC_SHORTSTR_CONCAT'];
-{ expects that (r3) contains a pointer to the result r4 to s1, r5 to s2 }
-assembler;
-asm
- { load length s1 }
- lbz r6, 0(r4)
- { load length s2 }
- lbz r10, 0(r5)
- { length 0 for s1? }
- cmplwi cr7,r6,0
- { length 255 for s1? }
- subfic. r7,r6,255
- { length 0 for s2? }
- cmplwi cr1,r10,0
- { calculate min(length(s2),255-length(s1)) }
- subc r8,r7,r10 { r8 := r7 - r10 }
- cror 4*6+2,4*1+2,4*7+2
- subfe r7,r7,r7 { if r7 >= r10 then r7' := 0 else r7' := -1 }
- mtctr r6
- and r7,r8,r7 { if r7 >= r10 then r7' := 0 else r7' := r7-r10 }
- add r7,r7,r10 { if r7 >= r10 then r7' := r10 else r7' := r7 }
-
- mr r9,r3
-
- { calculate length of final string }
- add r8,r7,r6
- stb r8,0(r3)
- beq cr7, .Lcopys1loopDone
- .Lcopys1loop:
- lbzu r0,1(r4)
- stbu r0,1(r9)
- bdnz .Lcopys1loop
- .Lcopys1loopDone:
- mtctr r7
- beq cr6, .LconcatDone
- .Lcopys2loop:
- lbzu r0,1(r5)
- stbu r0,1(r9)
- bdnz .Lcopys2loop
-end;
-{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
-*)
-
-{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
-{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
-
-procedure fpc_shortstr_append_shortstr(var s1: shortstring; const s2: shortstring); compilerproc;
-{ expects that results (r3) contains a pointer to the current string s1, r4 }
-{ high(s1) and (r5) a pointer to the one that has to be concatenated }
-assembler; nostackframe;
-asm
- { load length s1 }
- lbz r6, 0(r3)
- { load length s2 }
- lbz r10, 0(r5)
- { length 0? }
- cmplw cr1,r6,r4
- cmplwi r10,0
-
- { calculate min(length(s2),high(result)-length(result)) }
- sub r9,r4,r6
- subc r8,r9,r10 { r8 := r9 - r10 }
- cror 4*7+2,4*0+2,4*1+2
- subfe r9,r9,r9 { if r9 >= r10 then r9' := 0 else r9' := -1 }
- and r9,r8,r9 { if r9 >= r10 then r9' := 0 else r9' := r9-r10 }
- add r9,r9,r10 { if r9 >= r10 then r9' := r10 else r9' := r9 }
-
- { calculate new length }
- add r10,r6,r9
- { load value to copy in ctr }
- mtctr r9
- { store new length }
- stb r10,0(r3)
- { go to last current character of result }
- add r3,r6,r3
-
- { if nothing to do, exit }
- beq cr7, .LShortStrAppendDone
- { and concatenate }
-.LShortStrAppendLoop:
- lbzu r10,1(r5)
- stbu r10,1(r3)
- bdnz .LShortStrAppendLoop
-.LShortStrAppendDone:
-end;
-{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
-
-(*
-{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
-function fpc_shortstr_compare(const dstr,sstr:shortstring): longint; [public,alias:'FPC_SHORTSTR_COMPARE']; compilerproc;
-assembler;
-asm
- { load length sstr }
- lbz r9,0(r4)
- { load length dstr }
- lbz r10,0(r3)
- { save their difference for later and }
- { calculate min(length(sstr),length(dstr)) }
- subfc r7,r10,r9 { r0 := r9 - r10 }
- subfe r9,r9,r9 { if r9 >= r10 then r9' := 0 else r9' := -1 }
- and r7,r7,r9 { if r9 >= r10 then r9' := 0 else r9' := r9-r8 }
- add r9,r10,r7 { if r9 >= r10 then r9' := r10 else r9' := r9 }
-
- { first compare dwords (length/4) }
- srwi. r5,r9,2
- { keep length mod 4 for the ends }
- rlwinm r9,r9,0,30,31
- { already check whether length mod 4 = 0 }
- cmplwi cr1,r9,0
- { so we can load r3 with 0, in case the strings both have length 0 }
- mr r8,r3
- li r3, 0
- { length div 4 in ctr for loop }
- mtctr r5
- { if length < 3, goto byte comparing }
- beq LShortStrCompare1
- { setup for use of update forms of load/store with dwords }
- subi r4,r4,3
- subi r8,r8,3
-LShortStrCompare4Loop:
- lwzu r3,4(r4)
- lwzu r10,4(r8)
- sub. r3,r3,r10
- bdnzt cr0+eq,LShortStrCompare4Loop
- { r3 contains result if we stopped because of "ne" flag }
- bne LShortStrCompareDone
- { setup for use of update forms of load/store with bytes }
- addi r4,r4,3
- addi r8,r8,3
-LShortStrCompare1:
- { if comparelen mod 4 = 0, skip this and return the difference in }
- { lengths }
- beq cr1,LShortStrCompareLen
- mtctr r9
-LShortStrCompare1Loop:
- lbzu r3,1(r4)
- lbzu r10,1(r8)
- sub. r3,r3,r10
- bdnzt cr0+eq,LShortStrCompare1Loop
- bne LShortStrCompareDone
-LShortStrCompareLen:
- { also return result in flags, maybe we can use this in the CG }
- mr. r3,r3
-LShortStrCompareDone:
-end;
-*)
-
-
-{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
-{$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
-function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
-assembler; nostackframe;
-{$include strpas.inc}
-{$endif FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
-
-
-{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
-{$define FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
-function fpc_pchar_length(p:pchar):longint;assembler;[public,alias:'FPC_PCHAR_LENGTH']; compilerproc; nostackframe;
-{$include strlen.inc}
-{$endif FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
-
-
-{$define FPC_SYSTEM_HAS_GET_FRAME}
-function get_frame:pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
-asm
- { all abi's I know use r1 as stack pointer }
- mr r3, r1
-end;
-
-{NOTE: On MACOS, 68000 code might call powerpc code, through the MixedMode manager,
-(even in the OS in system 9). The pointer to the switching stack frame is then
-indicated by the first bit set to 1. This is checked below.}
-
-{Both routines below assumes that framebp is a valid framepointer or nil.}
-
-{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
-function get_caller_addr(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
-asm
- cmplwi r3,0
- beq .Lcaller_addr_invalid
- lwz r3,0(r3)
- cmplwi r3,0
- beq .Lcaller_addr_invalid
-{$ifdef MACOS}
- rlwinm r4,r3,0,31,31
- cmpwi r4,0
- bne cr0,.Lcaller_addr_invalid
-{$endif MACOS}
-{$ifdef FPC_ABI_AIX}
- lwz r3,8(r3)
-{$else FPC_ABI_AIX}
- lwz r3,4(r3)
-{$endif FPC_ABI_AIX}
- blr
-.Lcaller_addr_invalid:
- li r3,0
-end;
-
-
-{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
-function get_caller_frame(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
-asm
- cmplwi r3,0
- beq .Lcaller_frame_invalid
- lwz r3,0(r3)
-{$ifdef MACOS}
- rlwinm r4,r3,0,31,31
- cmpwi r4,0
- bne cr0,.Lcaller_frame_invalid
-{$endif MACOS}
- blr
-.Lcaller_frame_invalid:
- li r3,0
-end;
-
-{$define FPC_SYSTEM_HAS_ABS_LONGINT}
-function abs(l:longint):longint; assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
-asm
- srawi r0,r3,31
- add r3,r0,r3
- xor r3,r3,r0
-end;
-
-
-{****************************************************************************
- Math
-****************************************************************************}
-
-{$define FPC_SYSTEM_HAS_ODD_LONGINT}
-function odd(l:longint):boolean;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
-asm
- rlwinm r3,r3,0,31,31
-end;
-
-
-{$define FPC_SYSTEM_HAS_SQR_LONGINT}
-function sqr(l:longint):longint;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
-asm
- mullw r3,r3,r3
-end;
-
-
-{$define FPC_SYSTEM_HAS_SPTR}
-Function Sptr : Pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
-asm
- mr r3,r1
-end;
-
-
-{****************************************************************************
- Str()
-****************************************************************************}
-
-{ int_str: generic implementation is used for now }
-
-
-{****************************************************************************
- Multithreading
-****************************************************************************}
-
-{ do a thread save inc/dec }
-
-{$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT}
-function declocked(var l : longint) : boolean;assembler;nostackframe;
-{ input: address of l in r3 }
-{ output: boolean indicating whether l is zero after decrementing }
-asm
-.LDecLockedLoop:
- lwarx r10,0,r3
- subi r10,r10,1
- stwcx. r10,0,r3
- bne- .LDecLockedLoop
- cntlzw r3,r10
- srwi r3,r3,5
-end;
-
-{$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT}
-procedure inclocked(var l : longint);assembler;nostackframe;
-asm
-.LIncLockedLoop:
- lwarx r10,0,r3
- addi r10,r10,1
- stwcx. r10,0,r3
- bne- .LIncLockedLoop
-end;
-
-
-{$IFDEF MORPHOS}
-{ this is only required for MorphOS }
-{$define FPC_SYSTEM_HAS_SYSRESETFPU}
-procedure SysResetFPU;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
-var tmp: array[0..1] of dword;
-asm
- { setting fpu to round to nearest mode }
- li r3,0
- stw r3,8(r1)
- stw r3,12(r1)
- lfd f1,8(r1)
- mtfsf 7,f1
-end;
-{$ENDIF}
+{ + + This file is part of the Free Pascal run time library. + Copyright (c) 2000-2001 by the Free Pascal development team. + + Portions Copyright (c) 2000 by Casey Duncan (casey.duncan@state.co.us) + + Processor dependent implementation for the system unit for + PowerPC + + 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. + + **********************************************************************} + + +{**************************************************************************** + PowerPC specific stuff +****************************************************************************} +{ + +const + ppc_fpu_overflow = (1 shl (32-3)); + ppc_fpu_underflow = (1 shl (32-4)); + ppc_fpu_divbyzero = (1 shl (32-5)); + ppc_fpu_inexact = (1 shl (32-6)); + ppc_fpu_invalid_snan = (1 shl (32-7)); +} + +procedure fpc_enable_ppc_fpu_exceptions; +assembler; nostackframe; +asm + { clear all "exception happened" flags we care about} + mtfsfi 0,0 + mtfsfi 1,0 + mtfsfi 2,0 + mtfsfi 3,0 + mtfsb0 21 + mtfsb0 22 + mtfsb0 23 + + { enable invalid operations and division by zero exceptions. } + { No overflow/underflow, since those give some spurious } + { exceptions } + mtfsfi 6,9 +end; + + +procedure fpc_cpuinit; +begin + fpc_enable_ppc_fpu_exceptions; +end; + + +function fpc_get_ppc_fpscr: cardinal; +assembler; +var + temp: record a,b:longint; end; +asm + mffs f0 + stfd f0,temp + lwz r3,temp.b + { clear all exception flags } +{ + rlwinm r4,r3,0,16,31 + stw r4,temp.b + lfd f0,temp + a_mtfsf f0 +} +end; + +{ This function is never called directly, it's a dummy to hold the register save/ + load subroutines +} +{$ifndef MACOS} +label + _restfpr_14_x, + _restfpr_15_x, + _restfpr_16_x, + _restfpr_17_x, + _restfpr_18_x, + _restfpr_19_x, + _restfpr_20_x, + _restfpr_21_x, + _restfpr_22_x, + _restfpr_23_x, + _restfpr_24_x, + _restfpr_25_x, + _restfpr_26_x, + _restfpr_27_x, + _restfpr_28_x, + _restfpr_29_x, + _restfpr_30_x, + _restfpr_31_x, + _restfpr_14_l, + _restfpr_15_l, + _restfpr_16_l, + _restfpr_17_l, + _restfpr_18_l, + _restfpr_19_l, + _restfpr_20_l, + _restfpr_21_l, + _restfpr_22_l, + _restfpr_23_l, + _restfpr_24_l, + _restfpr_25_l, + _restfpr_26_l, + _restfpr_27_l, + _restfpr_28_l, + _restfpr_29_l, + _restfpr_30_l, + _restfpr_31_l; + +procedure saverestorereg;assembler; nostackframe; +asm +{ exit } +.globl _restfpr_14_x +_restfpr_14_x: lfd f14, -144(r11) +.globl _restfpr_15_x +_restfpr_15_x: lfd f15, -136(r11) +.globl _restfpr_16_x +_restfpr_16_x: lfd f16, -128(r11) +.globl _restfpr_17_x +_restfpr_17_x: lfd f17, -120(r11) +.globl _restfpr_18_x +_restfpr_18_x: lfd f18, -112(r11) +.globl _restfpr_19_x +_restfpr_19_x: lfd f19, -104(r11) +.globl _restfpr_20_x +_restfpr_20_x: lfd f20, -96(r11) +.globl _restfpr_21_x +_restfpr_21_x: lfd f21, -88(r11) +.globl _restfpr_22_x +_restfpr_22_x: lfd f22, -80(r11) +.globl _restfpr_23_x +_restfpr_23_x: lfd f23, -72(r11) +.globl _restfpr_24_x +_restfpr_24_x: lfd f24, -64(r11) +.globl _restfpr_25_x +_restfpr_25_x: lfd f25, -56(r11) +.globl _restfpr_26_x +_restfpr_26_x: lfd f26, -48(r11) +.globl _restfpr_27_x +_restfpr_27_x: lfd f27, -40(r11) +.globl _restfpr_28_x +_restfpr_28_x: lfd f28, -32(r11) +.globl _restfpr_29_x +_restfpr_29_x: lfd f29, -24(r11) +.globl _restfpr_30_x +_restfpr_30_x: lfd f30, -16(r11) +.globl _restfpr_31_x +_restfpr_31_x: lwz r0, 4(r11) + lfd f31, -8(r11) + mtlr r0 + ori r1, r11, 0 + blr + +{ exit with restoring lr } +.globl _restfpr_14_l +_restfpr_14_l: lfd f14, -144(r11) +.globl _restfpr_15_l +_restfpr_15_l: lfd f15, -136(r11) +.globl _restfpr_16_l +_restfpr_16_l: lfd f16, -128(r11) +.globl _restfpr_17_l +_restfpr_17_l: lfd f17, -120(r11) +.globl _restfpr_18_l +_restfpr_18_l: lfd f18, -112(r11) +.globl _restfpr_19_l +_restfpr_19_l: lfd f19, -104(r11) +.globl _restfpr_20_l +_restfpr_20_l: lfd f20, -96(r11) +.globl _restfpr_21_l +_restfpr_21_l: lfd f21, -88(r11) +.globl _restfpr_22_l +_restfpr_22_l: lfd f22, -80(r11) +.globl _restfpr_23_l +_restfpr_23_l: lfd f23, -72(r11) +.globl _restfpr_24_l +_restfpr_24_l: lfd f24, -64(r11) +.globl _restfpr_25_l +_restfpr_25_l: lfd f25, -56(r11) +.globl _restfpr_26_l +_restfpr_26_l: lfd f26, -48(r11) +.globl _restfpr_27_l +_restfpr_27_l: lfd f27, -40(r11) +.globl _restfpr_28_l +_restfpr_28_l: lfd f28, -32(r11) +.globl _restfpr_29_l +_restfpr_29_l: lfd f29, -24(r11) +.globl _restfpr_30_l +_restfpr_30_l: lfd f30, -16(r11) +.globl _restfpr_31_l +_restfpr_31_l: lwz r0, 4(r11) + lfd f31, -8(r11) + mtlr r0 + ori r1, r11, 0 + blr +end; +{$endif MACOS} + +{**************************************************************************** + Move / Fill +****************************************************************************} + +{$ifndef FPC_SYSTEM_HAS_MOVE} +{$define FPC_SYSTEM_HAS_MOVE} +procedure Move(const source;var dest;count:longint);[public, alias: 'FPC_MOVE'];assembler; nostackframe; +asm + { count <= 0 ? } + cmpwi cr0,r5,0 + { check if we have to do the move backwards because of overlap } + sub r10,r4,r3 + { carry := boolean(dest-source < count) = boolean(overlap) } + subc r10,r10,r5 + + { count < 15 ? (to decide whether we will move dwords or bytes } + cmpwi cr1,r5,15 + + { if overlap, then r10 := -1 else r10 := 0 } + subfe r10,r10,r10 + + { count < 63 ? (32 + max. alignment (31) } + cmpwi cr7,r5,63 + + { if count <= 0, stop } + ble cr0,.LMoveDone + + { load the begin of the source in the data cache } + dcbt 0,r3 + { and the dest as well } + dcbtst 0,r4 + + { if overlap, then r0 := count else r0 := 0 } + and r0,r5,r10 + { if overlap, then point source and dest to the end } + add r3,r3,r0 + add r4,r4,r0 + { if overlap, then r6 := 0, else r6 := -1 } + not r6,r10 + { if overlap, then r10 := -2, else r10 := 0 } + slwi r10,r10,1 + { if overlap, then r10 := -1, else r10 := 1 } + addi r10,r10,1 + + { if count < 15, copy everything byte by byte } + blt cr1,.LMoveBytes + + { if no overlap, then source/dest += -1, otherwise they stay } + { After the next instruction, r3/r4 + r10 = next position to } + { load/store from/to } + add r3,r3,r6 + add r4,r4,r6 + + { otherwise, guarantee 4 byte alignment for dest for starters } +.LMove4ByteAlignLoop: + lbzux r0,r3,r10 + stbux r0,r4,r10 + { is dest now 4 aligned? } + andi. r0,r4,3 + subi r5,r5,1 + { while not aligned, continue } + bne cr0,.LMove4ByteAlignLoop + +{$ifndef ppc603} + { check for 32 byte alignment } + andi. r7,r4,31 +{$endif non ppc603} + { we are going to copy one byte again (the one at the newly } + { aligned address), so increase count byte 1 } + addi r5,r5,1 + { count div 4 for number of dwords to copy } + srwi r0,r5,2 + { if 11 <= count < 63, copy using dwords } + blt cr7,.LMoveDWords + +{$ifndef ppc603} + { # of dwords to copy to reach 32 byte alignment (*4) } + { (depends on forward/backward copy) } + + { if forward copy, r6 = -1 -> r8 := 32 } + { if backward copy, r6 = 0 -> r8 := 0 } + rlwinm r8,r6,0,31-6+1,31-6+1 + { if forward copy, we have to copy 32 - unaligned count bytes } + { if backward copy unaligned count bytes } + sub r7,r8,r7 + { if backward copy, the calculated value is now negate -> } + { make it positive again } + not r8, r6 + add r7, r7, r8 + xor r7, r7, r8 +{$endif not ppc603} + + { multiply the update count with 4 } + slwi r10,r10,2 + slwi r6,r6,2 + { and adapt the source and dest } + add r3,r3,r6 + add r4,r4,r6 + +{$ifndef ppc603} + beq cr0,.LMove32BytesAligned +.L32BytesAlignMoveLoop: + { count >= 39 -> align to 8 byte boundary and then use the FPU } + { since we're already at 4 byte alignment, use dword store } + subic. r7,r7,4 + lwzux r0,r3,r10 + subi r5,r5,4 + stwux r0,r4,r10 + bne .L32BytesAlignMoveLoop + +.LMove32BytesAligned: + { count div 32 ( >= 1, since count was >=63 } + srwi r0,r5,5 + { remainder } + andi. r5,r5,31 + { to decide if we will do some dword stores (instead of only } + { byte stores) afterwards or not } +{$else not ppc603} + srwi r0,r5,4 + andi. r5,r5,15 +{$endif not ppc603} + cmpwi cr1,r5,11 + mtctr r0 + + { r0 := count div 4, will be moved to ctr when copying dwords } + srwi r0,r5,2 + +{$ifndef ppc603} + { adjust the update count: it will now be 8 or -8 depending on overlap } + slwi r10,r10,1 + + { adjust source and dest pointers: because of the above loop, dest is now } + { aligned to 8 bytes. So if we add r6 we will still have an 8 bytes } + { aligned address) } + add r3,r3,r6 + add r4,r4,r6 + + slwi r6,r6,1 + + { the dcbz offset must give a 32 byte aligned address when added } + { to the current dest address and its address must point to the } + { bytes that will be overwritten in the current iteration. In case } + { of a forward loop, the dest address has currently an offset of } + { -8 compared to the bytes that will be overwritten (and r6 = -8). } + { In case of a backward of a loop, the dest address currently has } + { an offset of +32 compared to the bytes that will be overwritten } + { (and r6 = 0). So the forward dcbz offset must become +8 and the } + { backward -32 -> (-r6 * 5) - 32 gives the correct offset } + slwi r7,r6,2 + add r7,r7,r6 + neg r7,r7 + subi r7,r7,32 + +.LMove32ByteDcbz: + lfdux f0,r3,r10 + lfdux f1,r3,r10 + lfdux f2,r3,r10 + lfdux f3,r3,r10 + { must be done only now, in case source and dest are less than } + { 32 bytes apart! } + dcbz r4,r7 + stfdux f0,r4,r10 + stfdux f1,r4,r10 + stfdux f2,r4,r10 + stfdux f3,r4,r10 + bdnz .LMove32ByteDcbz +.LMove32ByteLoopDone: +{$else not ppc603} +.LMove16ByteLoop: + lwzux r11,r3,r10 + lwzux r7,r3,r10 + lwzux r8,r3,r10 + lwzux r9,r3,r10 + stwux r11,r4,r10 + stwux r7,r4,r10 + stwux r8,r4,r10 + stwux r9,r4,r10 + bdnz .LMove16ByteLoop +{$endif not ppc603} + + { cr0*4+eq is true if "count and 31" = 0 } + beq cr0,.LMoveDone + + { make r10 again -1 or 1, but first adjust source/dest pointers } + sub r3,r3,r6 + sub r4,r4,r6 +{$ifndef ppc603} + srawi r10,r10,3 + srawi r6,r6,3 +{$else not ppc603} + srawi r10,r10,2 + srawi r6,r6,2 +{$endif not ppc603} + + { cr1 contains whether count <= 11 } + ble cr1,.LMoveBytes + +.LMoveDWords: + mtctr r0 + andi. r5,r5,3 + { r10 * 4 } + slwi r10,r10,2 + slwi r6,r6,2 + add r3,r3,r6 + add r4,r4,r6 + +.LMoveDWordsLoop: + lwzux r0,r3,r10 + stwux r0,r4,r10 + bdnz .LMoveDWordsLoop + + beq cr0,.LMoveDone + { make r10 again -1 or 1 } + sub r3,r3,r6 + sub r4,r4,r6 + srawi r10,r10,2 + srawi r6,r6,2 +.LMoveBytes: + add r3,r3,r6 + add r4,r4,r6 + mtctr r5 +.LMoveBytesLoop: + lbzux r0,r3,r10 + stbux r0,r4,r10 + bdnz .LMoveBytesLoop +.LMoveDone: +end; +{$endif FPC_SYSTEM_HAS_MOVE} + + +{$ifndef FPC_SYSTEM_HAS_FILLCHAR} +{$define FPC_SYSTEM_HAS_FILLCHAR} + +Procedure FillChar(var x;count:longint;value:byte);assembler; +{ input: x in r3, count in r4, value in r5 } + +{$ifndef FPC_ABI_AIX} +{ in the AIX ABI, we can use te red zone for temp storage, otherwise we have } +{ to explicitely allocate room } +var + temp : packed record + case byte of + 0: (l1,l2: longint); + 1: (d: double); + end; +{$endif FPC_ABI_AIX} +asm + { no bytes? } + cmpwi cr6,r4,0 + { less than 15 bytes? } + cmpwi cr7,r4,15 + { less than 64 bytes? } + cmpwi cr1,r4,64 + { fill r5 with ValueValueValueValue } + rlwimi r5,r5,8,16,23 + { setup for aligning x to multiple of 4} + rlwinm r10,r3,0,31-2+1,31 + rlwimi r5,r5,16,0,15 + ble cr6,.LFillCharDone + { get the start of the data in the cache (and mark it as "will be } + { modified") } + dcbtst 0,r3 + subfic r10,r10,4 + blt cr7,.LFillCharVerySmall + { just store 4 bytes instead of using a loop to align (there are } + { plenty of other instructions now to keep the processor busy } + { while it handles the (possibly unaligned) store) } + stw r5,0(r3) + { r3 := align(r3,4) } + add r3,r3,r10 + { decrease count with number of bytes already stored } + sub r4,r4,r10 + blt cr1,.LFillCharSmall + { if we have to fill with 0 (which happens a lot), we can simply use } + { dcbz for the most part, which is very fast, so make a special case } + { for that } + cmplwi cr1,r5,0 + { align to a multiple of 32 (and immediately check whether we aren't } + { already 32 byte aligned) } + rlwinm. r10,r3,0,31-5+1,31 + { setup r3 for using update forms of store instructions } + subi r3,r3,4 + { get number of bytes to store } + subfic r10,r10,32 + { if already 32byte aligned, skip align loop } + beq .L32ByteAlignLoopDone + { substract from the total count } + sub r4,r4,r10 +.L32ByteAlignLoop: + { we were already aligned to 4 byres, so this will count down to } + { exactly 0 } + subic. r10,r10,4 + stwu r5,4(r3) + bne .L32ByteAlignLoop +.L32ByteAlignLoopDone: + { get the amount of 32 byte blocks } + srwi r10,r4,5 + { and keep the rest in r4 (recording whether there is any rest) } + rlwinm. r4,r4,0,31-5+1,31 + { move to ctr } + mtctr r10 + { check how many rest there is (to decide whether we'll use } + { FillCharSmall or FillCharVerySmall) } + cmplwi cr7,r4,11 + { if filling with zero, only use dcbz } + bne cr1, .LFillCharNoZero + { make r3 point again to the actual store position } + addi r3,r3,4 +.LFillCharDCBZLoop: + dcbz 0,r3 + addi r3,r3,32 + bdnz .LFillCharDCBZLoop + { if there was no rest, we're finished } + beq .LFillCharDone + b .LFillCharVerySmall +.LFillCharNoZero: +{$ifdef FPC_ABI_AIX} + stw r5,-4(r1) + stw r5,-8(r1) + lfd f0,-8(r1) +{$else FPC_ABI_AIX} + stw r5,temp + stw r5,temp+4 + lfd f0,temp +{$endif FPC_ABI_AIX} + { make r3 point to address-8, so we're able to use fp double stores } + { with update (it's already -4 now) } + subi r3,r3,4 + { load r10 with 8, so that dcbz uses the correct address } + li r10, 8 +.LFillChar32ByteLoop: + dcbz r3,r10 + stfdu f0,8(r3) + stfdu f0,8(r3) + stfdu f0,8(r3) + stfdu f0,8(r3) + bdnz .LFillChar32ByteLoop + { if there was no rest, we're finished } + beq .LFillCharDone + { make r3 point again to the actual next byte that must be written } + addi r3,r3,8 + b .LFillCharVerySmall +.LFillCharSmall: + { when we arrive here, we're already 4 byte aligned } + { get count div 4 to store dwords } + srwi r10,r4,2 + { get ready for use of update stores } + subi r3,r3,4 + mtctr r10 + rlwinm. r4,r4,0,31-2+1,31 +.LFillCharSmallLoop: + stwu r5,4(r3) + bdnz .LFillCharSmallLoop + { if nothing left, stop } + beq .LFillCharDone + { get ready to store bytes } + addi r3,r3,4 +.LFillCharVerySmall: + mtctr r4 + subi r3,r3,1 +.LFillCharVerySmallLoop: + stbu r5,1(r3) + bdnz .LFillCharVerySmallLoop +.LFillCharDone: +end; +{$endif FPC_SYSTEM_HAS_FILLCHAR} + + +{$ifndef FPC_SYSTEM_HAS_FILLDWORD} +{$define FPC_SYSTEM_HAS_FILLDWORD} +procedure filldword(var x;count : longint;value : dword); +assembler; nostackframe; +asm +{ registers: + r3 x + r4 count + r5 value +} + cmpwi cr0,r4,0 + mtctr r4 + subi r3,r3,4 + ble .LFillDWordEnd //if count<=0 Then Exit +.LFillDWordLoop: + stwu r5,4(r3) + bdnz .LFillDWordLoop +.LFillDWordEnd: +end; +{$endif FPC_SYSTEM_HAS_FILLDWORD} + + +{$ifndef FPC_SYSTEM_HAS_INDEXBYTE} +{$define FPC_SYSTEM_HAS_INDEXBYTE} +function IndexByte(const buf;len:longint;b:byte):longint; assembler; nostackframe; +{ input: r3 = buf, r4 = len, r5 = b } +{ output: r3 = position of b in buf (-1 if not found) } +asm + { load the begin of the buffer in the data cache } + dcbt 0,r3 + cmplwi r4,0 + mtctr r4 + subi r10,r3,1 + mr r0,r3 + { assume not found } + li r3,-1 + ble .LIndexByteDone +.LIndexByteLoop: + lbzu r9,1(r10) + cmplw r9,r5 + bdnzf cr0*4+eq,.LIndexByteLoop + { r3 still contains -1 here } + bne .LIndexByteDone + sub r3,r10,r0 +.LIndexByteDone: +end; +{$endif FPC_SYSTEM_HAS_INDEXBYTE} + + +{$ifndef FPC_SYSTEM_HAS_INDEXWORD} +{$define FPC_SYSTEM_HAS_INDEXWORD} +function IndexWord(const buf;len:longint;b:word):longint; assembler; nostackframe; +{ input: r3 = buf, r4 = len, r5 = b } +{ output: r3 = position of b in buf (-1 if not found) } +asm + { load the begin of the buffer in the data cache } + dcbt 0,r3 + cmplwi r4,0 + mtctr r4 + subi r10,r3,2 + mr r0,r3 + { assume not found } + li r3,-1 + ble .LIndexWordDone +.LIndexWordLoop: + lhzu r9,2(r10) + cmplw r9,r5 + bdnzf cr0*4+eq,.LIndexWordLoop + { r3 still contains -1 here } + bne .LIndexWordDone + sub r3,r10,r0 + srawi r3,r3,1 +.LIndexWordDone: +end; +{$endif FPC_SYSTEM_HAS_INDEXWORD} + + +{$ifndef FPC_SYSTEM_HAS_INDEXDWORD} +{$define FPC_SYSTEM_HAS_INDEXDWORD} +function IndexDWord(const buf;len:longint;b:DWord):longint; assembler; nostackframe; +{ input: r3 = buf, r4 = len, r5 = b } +{ output: r3 = position of b in buf (-1 if not found) } +asm + { load the begin of the buffer in the data cache } + dcbt 0,r3 + cmplwi r4,0 + mtctr r4 + subi r10,r3,4 + mr r0,r3 + { assume not found } + li r3,-1 + ble .LIndexDWordDone +.LIndexDWordLoop: + lwzu r9,4(r10) + cmplw r9,r5 + bdnzf cr0*4+eq, .LIndexDWordLoop + { r3 still contains -1 here } + bne .LIndexDWordDone + sub r3,r10,r0 + srawi r3,r3,2 +.LIndexDWordDone: +end; +{$endif FPC_SYSTEM_HAS_INDEXDWORD} + + +{$ifndef FPC_SYSTEM_HAS_COMPAREBYTE} +{$define FPC_SYSTEM_HAS_COMPAREBYTE} +function CompareByte(const buf1,buf2;len:longint):longint; assembler; nostackframe; +{ input: r3 = buf1, r4 = buf2, r5 = len } +{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 } +{ note: almost direct copy of strlcomp() from strings.inc } +asm + { load the begin of the first buffer in the data cache } + dcbt 0,r3 + { use r0 instead of r3 for buf1 since r3 contains result } + cmplwi r5,0 + mtctr r5 + subi r11,r3,1 + subi r4,r4,1 + li r3,0 + ble .LCompByteDone +.LCompByteLoop: + { load next chars } + lbzu r9,1(r11) + lbzu r10,1(r4) + { calculate difference } + sub. r3,r9,r10 + { if chars not equal or at the end, we're ready } + bdnzt cr0*4+eq, .LCompByteLoop +.LCompByteDone: +end; +{$endif FPC_SYSTEM_HAS_COMPAREBYTE} + + +{$ifndef FPC_SYSTEM_HAS_COMPAREWORD} +{$define FPC_SYSTEM_HAS_COMPAREWORD} +function CompareWord(const buf1,buf2;len:longint):longint; assembler; nostackframe; +{ input: r3 = buf1, r4 = buf2, r5 = len } +{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 } +{ note: almost direct copy of strlcomp() from strings.inc } +asm + { load the begin of the first buffer in the data cache } + dcbt 0,r3 + { use r0 instead of r3 for buf1 since r3 contains result } + cmplwi r5,0 + mtctr r5 + subi r11,r3,2 + subi r4,r4,2 + li r3,0 + ble .LCompWordDone +.LCompWordLoop: + { load next chars } + lhzu r9,2(r11) + lhzu r10,2(r4) + { calculate difference } + sub. r3,r9,r10 + { if chars not equal or at the end, we're ready } + bdnzt cr0*4+eq, .LCompWordLoop +.LCompWordDone: +end; +{$endif FPC_SYSTEM_HAS_COMPAREWORD} + + +{$ifndef FPC_SYSTEM_HAS_COMPAREDWORD} +{$define FPC_SYSTEM_HAS_COMPAREDWORD} +function CompareDWord(const buf1,buf2;len:longint):longint; assembler; nostackframe; +{ input: r3 = buf1, r4 = buf2, r5 = len } +{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 } +{ note: almost direct copy of strlcomp() from strings.inc } +asm + { load the begin of the first buffer in the data cache } + dcbt 0,r3 + { use r0 instead of r3 for buf1 since r3 contains result } + cmplwi r5,0 + mtctr r5 + subi r11,r3,4 + subi r4,r4,4 + li r3,0 + ble .LCompDWordDone +.LCompDWordLoop: + { load next chars } + lwzu r9,4(r11) + lwzu r10,4(r4) + { calculate difference } + sub. r3,r9,r10 + { if chars not equal or at the end, we're ready } + bdnzt cr0*4+eq, .LCompDWordLoop +.LCompDWordDone: +end; +{$endif FPC_SYSTEM_HAS_COMPAREDWORD} + + +{$ifndef FPC_SYSTEM_HAS_INDEXCHAR0} +{$define FPC_SYSTEM_HAS_INDEXCHAR0} +function IndexChar0(const buf;len:longint;b:Char):longint; assembler; nostackframe; +{ input: r3 = buf, r4 = len, r5 = b } +{ output: r3 = position of found position (-1 if not found) } +asm + { load the begin of the buffer in the data cache } + dcbt 0,r3 + { length = 0? } + cmplwi r4,0 + mtctr r4 + subi r9,r3,1 + subi r0,r3,1 + { assume not found } + li r3,-1 + { if yes, do nothing } + ble .LIndexChar0Done +.LIndexChar0Loop: + lbzu r10,1(r9) + cmplwi cr1,r10,0 + cmplw r10,r5 + beq cr1,.LIndexChar0Done + bdnzf cr0*4+eq, .LIndexChar0Loop + bne .LIndexChar0Done + sub r3,r9,r0 +.LIndexChar0Done: +end; +{$endif FPC_SYSTEM_HAS_INDEXCHAR0} + + +{**************************************************************************** + String +****************************************************************************} + +{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN} +{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN} +function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; [public,alias: 'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc; +assembler; nostackframe; +{ input: r3: pointer to result, r4: len, r5: sstr } +asm + { load length source } + lbz r10,0(r5) + { load the begin of the dest buffer in the data cache } + dcbtst 0,r3 + + { put min(length(sstr),len) in r4 } + subfc r7,r10,r4 { r0 := r4 - r10 } + subfe r4,r4,r4 { if r3 >= r4 then r3' := 0 else r3' := -1 } + and r7,r7,r4 { if r3 >= r4 then r3' := 0 else r3' := r3-r10 } + add r4,r10,r7 { if r3 >= r4 then r3' := r10 else r3' := r3 } + + cmplwi r4,0 + { put length in ctr } + mtctr r4 + stb r4,0(r3) + beq .LShortStrCopyDone +.LShortStrCopyLoop: + lbzu r0,1(r5) + stbu r0,1(r3) + bdnz .LShortStrCopyLoop +.LShortStrCopyDone: +end; + + +procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN']; +assembler; nostackframe; +{ input: r3: len, r4: sstr, r5: dstr } +asm + { load length source } + lbz r10,0(r4) + { load the begin of the dest buffer in the data cache } + dcbtst 0,r5 + + { put min(length(sstr),len) in r3 } + subc r0,r3,r10 { r0 := r3 - r10 } + subfe r3,r3,r3 { if r3 >= r4 then r3' := 0 else r3' := -1 } + and r3,r0,r3 { if r3 >= r4 then r3' := 0 else r3' := r3-r10 } + add r3,r3,r10 { if r3 >= r4 then r3' := r10 else r3' := r3 } + + cmplwi r3,0 + { put length in ctr } + mtctr r3 + stb r3,0(r5) + beq .LShortStrCopyDone2 +.LShortStrCopyLoop2: + lbzu r0,1(r4) + stbu r0,1(r5) + bdnz .LShortStrCopyLoop2 +.LShortStrCopyDone2: +end; +{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN} + +(* +{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT} +{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT} + +function fpc_shortstr_concat(const s1, s2: shortstring): shortstring; compilerproc; [public, alias: 'FPC_SHORTSTR_CONCAT']; +{ expects that (r3) contains a pointer to the result r4 to s1, r5 to s2 } +assembler; +asm + { load length s1 } + lbz r6, 0(r4) + { load length s2 } + lbz r10, 0(r5) + { length 0 for s1? } + cmplwi cr7,r6,0 + { length 255 for s1? } + subfic. r7,r6,255 + { length 0 for s2? } + cmplwi cr1,r10,0 + { calculate min(length(s2),255-length(s1)) } + subc r8,r7,r10 { r8 := r7 - r10 } + cror 4*6+2,4*1+2,4*7+2 + subfe r7,r7,r7 { if r7 >= r10 then r7' := 0 else r7' := -1 } + mtctr r6 + and r7,r8,r7 { if r7 >= r10 then r7' := 0 else r7' := r7-r10 } + add r7,r7,r10 { if r7 >= r10 then r7' := r10 else r7' := r7 } + + mr r9,r3 + + { calculate length of final string } + add r8,r7,r6 + stb r8,0(r3) + beq cr7, .Lcopys1loopDone + .Lcopys1loop: + lbzu r0,1(r4) + stbu r0,1(r9) + bdnz .Lcopys1loop + .Lcopys1loopDone: + mtctr r7 + beq cr6, .LconcatDone + .Lcopys2loop: + lbzu r0,1(r5) + stbu r0,1(r9) + bdnz .Lcopys2loop +end; +{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT} +*) + +{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR} +{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR} + +procedure fpc_shortstr_append_shortstr(var s1: shortstring; const s2: shortstring); compilerproc; +{ expects that results (r3) contains a pointer to the current string s1, r4 } +{ high(s1) and (r5) a pointer to the one that has to be concatenated } +assembler; nostackframe; +asm + { load length s1 } + lbz r6, 0(r3) + { load length s2 } + lbz r10, 0(r5) + { length 0? } + cmplw cr1,r6,r4 + cmplwi r10,0 + + { calculate min(length(s2),high(result)-length(result)) } + sub r9,r4,r6 + subc r8,r9,r10 { r8 := r9 - r10 } + cror 4*7+2,4*0+2,4*1+2 + subfe r9,r9,r9 { if r9 >= r10 then r9' := 0 else r9' := -1 } + and r9,r8,r9 { if r9 >= r10 then r9' := 0 else r9' := r9-r10 } + add r9,r9,r10 { if r9 >= r10 then r9' := r10 else r9' := r9 } + + { calculate new length } + add r10,r6,r9 + { load value to copy in ctr } + mtctr r9 + { store new length } + stb r10,0(r3) + { go to last current character of result } + add r3,r6,r3 + + { if nothing to do, exit } + beq cr7, .LShortStrAppendDone + { and concatenate } +.LShortStrAppendLoop: + lbzu r10,1(r5) + stbu r10,1(r3) + bdnz .LShortStrAppendLoop +.LShortStrAppendDone: +end; +{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR} + +(* +{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE} +function fpc_shortstr_compare(const dstr,sstr:shortstring): longint; [public,alias:'FPC_SHORTSTR_COMPARE']; compilerproc; +assembler; +asm + { load length sstr } + lbz r9,0(r4) + { load length dstr } + lbz r10,0(r3) + { save their difference for later and } + { calculate min(length(sstr),length(dstr)) } + subfc r7,r10,r9 { r0 := r9 - r10 } + subfe r9,r9,r9 { if r9 >= r10 then r9' := 0 else r9' := -1 } + and r7,r7,r9 { if r9 >= r10 then r9' := 0 else r9' := r9-r8 } + add r9,r10,r7 { if r9 >= r10 then r9' := r10 else r9' := r9 } + + { first compare dwords (length/4) } + srwi. r5,r9,2 + { keep length mod 4 for the ends } + rlwinm r9,r9,0,30,31 + { already check whether length mod 4 = 0 } + cmplwi cr1,r9,0 + { so we can load r3 with 0, in case the strings both have length 0 } + mr r8,r3 + li r3, 0 + { length div 4 in ctr for loop } + mtctr r5 + { if length < 3, goto byte comparing } + beq LShortStrCompare1 + { setup for use of update forms of load/store with dwords } + subi r4,r4,3 + subi r8,r8,3 +LShortStrCompare4Loop: + lwzu r3,4(r4) + lwzu r10,4(r8) + sub. r3,r3,r10 + bdnzt cr0+eq,LShortStrCompare4Loop + { r3 contains result if we stopped because of "ne" flag } + bne LShortStrCompareDone + { setup for use of update forms of load/store with bytes } + addi r4,r4,3 + addi r8,r8,3 +LShortStrCompare1: + { if comparelen mod 4 = 0, skip this and return the difference in } + { lengths } + beq cr1,LShortStrCompareLen + mtctr r9 +LShortStrCompare1Loop: + lbzu r3,1(r4) + lbzu r10,1(r8) + sub. r3,r3,r10 + bdnzt cr0+eq,LShortStrCompare1Loop + bne LShortStrCompareDone +LShortStrCompareLen: + { also return result in flags, maybe we can use this in the CG } + mr. r3,r3 +LShortStrCompareDone: +end; +*) + + +{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR} +{$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR} +function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc; +assembler; nostackframe; +{$include strpas.inc} +{$endif FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR} + + +{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH} +{$define FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH} +function fpc_pchar_length(p:pchar):longint;assembler;[public,alias:'FPC_PCHAR_LENGTH']; compilerproc; nostackframe; +{$include strlen.inc} +{$endif FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH} + + +{$define FPC_SYSTEM_HAS_GET_FRAME} +function get_frame:pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe; +asm + { all abi's I know use r1 as stack pointer } + mr r3, r1 +end; + +{NOTE: On MACOS, 68000 code might call powerpc code, through the MixedMode manager, +(even in the OS in system 9). The pointer to the switching stack frame is then +indicated by the first bit set to 1. This is checked below.} + +{Both routines below assumes that framebp is a valid framepointer or nil.} + +{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR} +function get_caller_addr(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe; +asm + cmplwi r3,0 + beq .Lcaller_addr_invalid + lwz r3,0(r3) + cmplwi r3,0 + beq .Lcaller_addr_invalid +{$ifdef MACOS} + rlwinm r4,r3,0,31,31 + cmpwi r4,0 + bne cr0,.Lcaller_addr_invalid +{$endif MACOS} +{$ifdef FPC_ABI_AIX} + lwz r3,8(r3) +{$else FPC_ABI_AIX} + lwz r3,4(r3) +{$endif FPC_ABI_AIX} + blr +.Lcaller_addr_invalid: + li r3,0 +end; + + +{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME} +function get_caller_frame(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe; +asm + cmplwi r3,0 + beq .Lcaller_frame_invalid + lwz r3,0(r3) +{$ifdef MACOS} + rlwinm r4,r3,0,31,31 + cmpwi r4,0 + bne cr0,.Lcaller_frame_invalid +{$endif MACOS} + blr +.Lcaller_frame_invalid: + li r3,0 +end; + +{$define FPC_SYSTEM_HAS_ABS_LONGINT} +function abs(l:longint):longint; assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe; +asm + srawi r0,r3,31 + add r3,r0,r3 + xor r3,r3,r0 +end; + + +{**************************************************************************** + Math +****************************************************************************} + +{$define FPC_SYSTEM_HAS_ODD_LONGINT} +function odd(l:longint):boolean;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe; +asm + rlwinm r3,r3,0,31,31 +end; + + +{$define FPC_SYSTEM_HAS_SQR_LONGINT} +function sqr(l:longint):longint;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe; +asm + mullw r3,r3,r3 +end; + + +{$define FPC_SYSTEM_HAS_SPTR} +Function Sptr : Pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe; +asm + mr r3,r1 +end; + + +{**************************************************************************** + Str() +****************************************************************************} + +{ int_str: generic implementation is used for now } + + +{**************************************************************************** + Multithreading +****************************************************************************} + +{ do a thread save inc/dec } + +{$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT} +function declocked(var l : longint) : boolean;assembler;nostackframe; +{ input: address of l in r3 } +{ output: boolean indicating whether l is zero after decrementing } +asm +.LDecLockedLoop: + lwarx r10,0,r3 + subi r10,r10,1 + stwcx. r10,0,r3 + bne- .LDecLockedLoop + cntlzw r3,r10 + srwi r3,r3,5 +end; + +{$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT} +procedure inclocked(var l : longint);assembler;nostackframe; +asm +.LIncLockedLoop: + lwarx r10,0,r3 + addi r10,r10,1 + stwcx. r10,0,r3 + bne- .LIncLockedLoop +end; + + +{$IFDEF MORPHOS} +{ this is only required for MorphOS } +{$define FPC_SYSTEM_HAS_SYSRESETFPU} +procedure SysResetFPU;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} +var tmp: array[0..1] of dword; +asm + { setting fpu to round to nearest mode } + li r3,0 + stw r3,8(r1) + stw r3,12(r1) + lfd f1,8(r1) + mtfsf 7,f1 +end; +{$ENDIF} diff --git a/rtl/powerpc64/int64p.inc b/rtl/powerpc64/int64p.inc deleted file mode 100644 index fbccb109f0..0000000000 --- a/rtl/powerpc64/int64p.inc +++ /dev/null @@ -1,18 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by the Free Pascal development team - - This file contains some helper routines for int64 and qword - - 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. - - **********************************************************************} - - - - diff --git a/rtl/powerpc64/makefile.cpu b/rtl/powerpc64/makefile.cpu deleted file mode 100644 index 97285083fb..0000000000 --- a/rtl/powerpc64/makefile.cpu +++ /dev/null @@ -1,6 +0,0 @@ -# -# Here we set processor dependent include file names. -# - -CPUNAMES=powerpc64 math set -CPUINCNAMES=$(addsuffix .inc,$(CPUNAMES)) diff --git a/rtl/powerpc64/math.inc b/rtl/powerpc64/math.inc deleted file mode 100644 index 59c4f95bd1..0000000000 --- a/rtl/powerpc64/math.inc +++ /dev/null @@ -1,114 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - Copyright (c) 2000 by Jonas Maebe and other members of the - Free Pascal development team - - Implementation of mathematical Routines (only for real) - - 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. - - **********************************************************************} - -{**************************************************************************** - EXTENDED data type routines - ****************************************************************************} - -{$define FPC_SYSTEM_HAS_PI} -function fpc_pi_real : valreal;compilerproc; -begin - { Function is handled internal in the compiler } - runerror(207); - result:=0; -end; - -{$define FPC_SYSTEM_HAS_ABS} -function fpc_abs_real(d : valreal) : valreal;compilerproc; -begin - { Function is handled internal in the compiler } - runerror(207); - result:=0; -end; - -{$define FPC_SYSTEM_HAS_SQR} -function fpc_sqr_real(d : valreal) : valreal;compilerproc; -begin - { Function is handled internal in the compiler } - runerror(207); - result:=0; -end; - -{$define FPC_SYSTEM_HAS_TRUNC} -function fpc_trunc_real(d : valreal) : int64;compilerproc; assembler; -{ input: d in fr1 } -{ output: result in r3 } -var - temp : int64; -asm - fctidz f1, f1 - stfd f1, temp - ld r3, temp -end; - -{$define FPC_SYSTEM_HAS_ROUND} -function fpc_round_real(d : valreal) : int64; compilerproc;assembler; -{ exactly the same as trunc, except that one fctiwz has become fctiw } -{ input: d in fr1 } -{ output: result in r3 } -var - temp: int64; -asm - fctid f1, f1 - stfd f1, temp - ld r3, temp -end; - -{**************************************************************************** - Int to real helpers - ****************************************************************************} - -{$define FPC_SYSTEM_HAS_INT64_TO_DOUBLE} -function fpc_int64_to_double(i: int64): double; compilerproc;assembler; -{ input: i in r3 } -{ output: double(i) in f0 } -{from "PowerPC Microprocessor Family: Programming Environments Manual for 64 and 32-Bit Microprocessors", v2.0, pg. 698 } -var temp : int64; -asm - std r3,temp // store dword - lfd f0,temp // load float - fcfid f0,f0 // convert to fpu int -end; - -{$define FPC_SYSTEM_HAS_QWORD_TO_DOUBLE} -function fpc_qword_to_double(q: qword): double; compilerproc;assembler; -const - longint_to_real_helper: qword = $80000000; -{from "PowerPC Microprocessor Family: Programming Environments Manual for - 64 and 32-Bit Microprocessors", v2.0, pg. 698, *exact version* } -{ input: q in r3 } -{ output: double(q) in f0 } -var - temp1, temp2: qword; -asm - // load 2^32 into f4 - lis r4, longint_to_real_helper@highesta - ori r4, r4, longint_to_real_helper@highera - sldi r4, r4, 32 - oris r4, r4, longint_to_real_helper@ha - lfd f4, longint_to_real_helper@l(r4) - - rldicl r4,r3,32,32 // isolate high half - rldicl r0,r3,0,32 // isolate low half - std r4,temp1 // store dword both - std r0,temp2 - lfd f2,temp1 // load float both - lfd f0,temp2 // load float both - fcfid f2,f2 // convert each half to - fcfid f0,f0 // fpu int (no rnd) - fmadd f0,f4,f2,f0 // (2**32)*high+low (only add can rnd) -end; - diff --git a/rtl/powerpc64/mathu.inc b/rtl/powerpc64/mathu.inc deleted file mode 100644 index 421303924d..0000000000 --- a/rtl/powerpc64/mathu.inc +++ /dev/null @@ -1,13 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by Florian Klaempfl - member of the Free Pascal development team - - 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. - - **********************************************************************} diff --git a/rtl/powerpc64/powerpc64.inc b/rtl/powerpc64/powerpc64.inc deleted file mode 100644 index 3fa159a9ad..0000000000 --- a/rtl/powerpc64/powerpc64.inc +++ /dev/null @@ -1,1067 +0,0 @@ -{
-
- This file is part of the Free Pascal run time library.
- Copyright (c) 2000-2001 by the Free Pascal development team.
-
- Portions Copyright (c) 2000 by Casey Duncan (casey.duncan@state.co.us)
-
- Processor dependent implementation for the system unit for
- PowerPC
-
- 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.
-
- **********************************************************************}
-
-
-{****************************************************************************
- PowerPC specific stuff
-****************************************************************************}
-
-const
- ppc_fpu_overflow = (1 shl (32-3));
- ppc_fpu_underflow = (1 shl (32-4));
- ppc_fpu_divbyzero = (1 shl (32-5));
- ppc_fpu_inexact = (1 shl (32-6));
- ppc_fpu_invalid_snan = (1 shl (32-7));
-
-
-procedure fpc_enable_ppc_fpu_exceptions;
-assembler; nostackframe;
-asm
- { clear all "exception happened" flags we care about}
- mtfsfi 0,0
- mtfsfi 1,0
- mtfsfi 2,0
- mtfsfi 3,0
-{$ifdef fpc_mtfsb0_corrected}
- mtfsb0 21
- mtfsb0 22
- mtfsb0 23
-
-{$endif fpc_mtfsb0_corrected}
-
- { enable invalid operations and division by zero exceptions. }
- { No overflow/underflow, since those give some spurious }
- { exceptions }
- mtfsfi 6,9
-end;
-
-
-procedure fpc_cpuinit;
-begin
- fpc_enable_ppc_fpu_exceptions;
-end;
-
-
-function fpc_get_ppc_fpscr: cardinal;
-assembler;
-var
- temp: record a,b:longint; end;
-asm
- mffs f0
- stfd f0,temp
- lwz r3,temp.b
- { clear all exception flags }
-{ TODO
- rlwinm r4,r3,0,16,31
- stw r4,temp.b
- lfd f0,temp
- mtfsf f0
-
}
-end;
-
-
-{ note: unused}
-{ The following code is never called directly, it's a dummy which holds the
-entry points and code to the register save/load subroutines; it is part of the
-PPC ABI and used in procedure entry and exit methods.
-See the comments in the code for "calling conventions". Directly taken from
-the ABI specification. The labels right below are required to shut up the
-compiler. }
-
-label
- // _savegpr0_x
- _savegpr0_14, _savegpr0_15, _savegpr0_16, _savegpr0_17, _savegpr0_18, _savegpr0_19,
- _savegpr0_20, _savegpr0_21, _savegpr0_22, _savegpr0_23, _savegpr0_24, _savegpr0_25,
- _savegpr0_26, _savegpr0_27, _savegpr0_28, _savegpr0_29, _savegpr0_30, _savegpr0_31,
- // _restgpr0_x
- _restgpr0_14, _restgpr0_15, _restgpr0_16, _restgpr0_17, _restgpr0_18, _restgpr0_19,
- _restgpr0_20, _restgpr0_21, _restgpr0_22, _restgpr0_23, _restgpr0_24, _restgpr0_25,
- _restgpr0_26, _restgpr0_27, _restgpr0_28, _restgpr0_29, _restgpr0_30, _restgpr0_31,
- // _savegpr1_x
- _savegpr1_14, _savegpr1_15, _savegpr1_16, _savegpr1_17, _savegpr1_18, _savegpr1_19,
- _savegpr1_20, _savegpr1_21, _savegpr1_22, _savegpr1_23, _savegpr1_24, _savegpr1_25,
- _savegpr1_26, _savegpr1_27, _savegpr1_28, _savegpr1_29, _savegpr1_30, _savegpr1_31,
- // _restgpr1_x
- _restgpr1_14, _restgpr1_15, _restgpr1_16, _restgpr1_17, _restgpr1_18, _restgpr1_19,
- _restgpr1_20, _restgpr1_21, _restgpr1_22, _restgpr1_23, _restgpr1_24, _restgpr1_25,
- _restgpr1_26, _restgpr1_27, _restgpr1_28, _restgpr1_29, _restgpr1_30, _restgpr1_31,
- // _savefpr_x
- _savefpr_14, _savefpr_15, _savefpr_16, _savefpr_17, _savefpr_18, _savefpr_19,
- _savefpr_20, _savefpr_21, _savefpr_22, _savefpr_23, _savefpr_24, _savefpr_25,
- _savefpr_26, _savefpr_27, _savefpr_28, _savefpr_29, _savefpr_30, _savefpr_31,
- // _restfpr_x
- _restfpr_14, _restfpr_15, _restfpr_16, _restfpr_17, _restfpr_18, _restfpr_19,
- _restfpr_20, _restfpr_21, _restfpr_22, _restfpr_23, _restfpr_24, _restfpr_25,
- _restfpr_26, _restfpr_27, _restfpr_28, _restfpr_29, _restfpr_30, _restfpr_31,
- // _savevr_x
- _savevr_20, _savevr_21, _savevr_22, _savevr_23, _savevr_24, _savevr_25,
- _savevr_26, _savevr_27, _savevr_28, _savevr_29, _savevr_30, _savevr_31,
- // _restvr_x
- _restvr_20, _restvr_21, _restvr_22, _restvr_23, _restvr_24, _restvr_25,
- _restvr_26, _restvr_27, _restvr_28, _restvr_29, _restvr_30, _restvr_31;
-
-
-procedure __save_restore_services; assembler; nostackframe;
-assembler;
-asm
-// Each _savegpr0_N routine saves the general registers from rN to r31, inclusive.
-// Each routine also saves the LR. When the routine is called, r1 must point to
-// the start of the general register save area, and r0 must contain the
-// value of LR on function entry.
-.globl _savegpr0_14
-_savegpr0_14: std r14,-144(r1)
-.globl _savegpr0_15
-_savegpr0_15: std r15,-136(r1)
-.globl _savegpr0_16
-_savegpr0_16: std r16,-128(r1)
-.globl _savegpr0_17
-_savegpr0_17: std r17,-120(r1)
-.globl _savegpr0_18
-_savegpr0_18: std r18,-112(r1)
-.globl _savegpr0_19
-_savegpr0_19: std r19,-104(r1)
-.globl _savegpr0_20
-_savegpr0_20: std r20,-96(r1)
-.globl _savegpr0_21
-_savegpr0_21: std r21,-88(r1)
-.globl _savegpr0_22
-_savegpr0_22: std r22,-80(r1)
-.globl _savegpr0_23
-_savegpr0_23: std r23,-72(r1)
-.globl _savegpr0_24
-_savegpr0_24: std r24,-64(r1)
-.globl _savegpr0_25
-_savegpr0_25: std r25,-56(r1)
-.globl _savegpr0_26
-_savegpr0_26: std r26,-48(r1)
-.globl _savegpr0_27
-_savegpr0_27: std r27,-40(r1)
-.globl _savegpr0_28
-_savegpr0_28: std r28,-32(r1)
-.globl _savegpr0_29
-_savegpr0_29: std r29,-24(r1)
-.globl _savegpr0_30
-_savegpr0_30: std r30,-16(r1)
-.globl _savegpr0_31
-_savegpr0_31: std r31,-8(r1)
- std r0, 16(r1)
- blr
-// The _restgpr0_N routines restore the general registers from rN to r31, and then
-// return to the caller. When the routine is called, r1 must point to the start of
-// the general register save area.
-.globl _restgpr0_14
-_restgpr0_14: ld r14,-144(r1)
-.globl _restgpr0_15
-_restgpr0_15: ld r15,-136(r1)
-.globl _restgpr0_16
-_restgpr0_16: ld r16,-128(r1)
-.globl _restgpr0_17
-_restgpr0_17: ld r17,-120(r1)
-.globl _restgpr0_18
-_restgpr0_18: ld r18,-112(r1)
-.globl _restgpr0_19
-_restgpr0_19: ld r19,-104(r1)
-.globl _restgpr0_20
-_restgpr0_20: ld r20,-96(r1)
-.globl _restgpr0_21
-_restgpr0_21: ld r21,-88(r1)
-.globl _restgpr0_22
-_restgpr0_22: ld r22,-80(r1)
-.globl _restgpr0_23
-_restgpr0_23: ld r23,-72(r1)
-.globl _restgpr0_24
-_restgpr0_24: ld r24,-64(r1)
-.globl _restgpr0_25
-_restgpr0_25: ld r25,-56(r1)
-.globl _restgpr0_26
-_restgpr0_26: ld r26,-48(r1)
-.globl _restgpr0_27
-_restgpr0_27: ld r27,-40(r1)
-.globl _restgpr0_28
-_restgpr0_28: ld r28,-32(r1)
-.globl _restgpr0_29
-_restgpr0_29: ld r0, 16(r1)
- ld r29,-24(r1)
- mtlr r0
- ld r30,-16(r1)
- ld r31,-8(r1)
- blr
-.globl _restgpr0_30
-_restgpr0_30: ld r30,-16(r1)
-.globl _restgpr0_31
-_restgpr0_31: ld r0, 16(r1)
- ld r31,-8(r1)
- mtlr r0
- blr
-// Each _savegpr1_N routine saves the general registers from rN to r31,
-// inclusive. When the routine is called, r12
-// must point to the start of the general register save area.
-.globl _savegpr1_14
-_savegpr1_14: std r14,-144(r12)
-.globl _savegpr1_15
-_savegpr1_15: std r15,-136(r12)
-.globl _savegpr1_16
-_savegpr1_16: std r16,-128(r12)
-.globl _savegpr1_17
-_savegpr1_17: std r17,-120(r12)
-.globl _savegpr1_18
-_savegpr1_18: std r18,-112(r12)
-.globl _savegpr1_19
-_savegpr1_19: std r19,-104(r12)
-.globl _savegpr1_20
-_savegpr1_20: std r20,-96(r12)
-.globl _savegpr1_21
-_savegpr1_21: std r21,-88(r12)
-.globl _savegpr1_22
-_savegpr1_22: std r22,-80(r12)
-.globl _savegpr1_23
-_savegpr1_23: std r23,-72(r12)
-.globl _savegpr1_24
-_savegpr1_24: std r24,-64(r12)
-.globl _savegpr1_25
-_savegpr1_25: std r25,-56(r12)
-.globl _savegpr1_26
-_savegpr1_26: std r26,-48(r12)
-.globl _savegpr1_27
-_savegpr1_27: std r27,-40(r12)
-.globl _savegpr1_28
-_savegpr1_28: std r28,-32(r12)
-.globl _savegpr1_29
-_savegpr1_29: std r29,-24(r12)
-.globl _savegpr1_30
-_savegpr1_30: std r30,-16(r12)
-.globl _savegpr1_31
-_savegpr1_31: std r31,-8(r12)
- blr
-// The _restgpr1_N routines restore the general registers from rN to r31.
-// When the routine is called, r12 must point to the start of the general
-// register save area.
-.globl _restgpr1_14
-_restgpr1_14: ld r14,-144(r12)
-.globl _restgpr1_15
-_restgpr1_15: ld r15,-136(r12)
-.globl _restgpr1_16
-_restgpr1_16: ld r16,-128(r12)
-.globl _restgpr1_17
-_restgpr1_17: ld r17,-120(r12)
-.globl _restgpr1_18
-_restgpr1_18: ld r18,-112(r12)
-.globl _restgpr1_19
-_restgpr1_19: ld r19,-104(r12)
-.globl _restgpr1_20
-_restgpr1_20: ld r20,-96(r12)
-.globl _restgpr1_21
-_restgpr1_21: ld r21,-88(r12)
-.globl _restgpr1_22
-_restgpr1_22: ld r22,-80(r12)
-.globl _restgpr1_23
-_restgpr1_23: ld r23,-72(r12)
-.globl _restgpr1_24
-_restgpr1_24: ld r24,-64(r12)
-.globl _restgpr1_25
-_restgpr1_25: ld r25,-56(r12)
-.globl _restgpr1_26
-_restgpr1_26: ld r26,-48(r12)
-.globl _restgpr1_27
-_restgpr1_27: ld r27,-40(r12)
-.globl _restgpr1_28
-_restgpr1_28: ld r28,-32(r12)
-.globl _restgpr1_29
-_restgpr1_29: ld r29,-24(r12)
-.globl _restgpr1_30
-_restgpr1_30: ld r30,-16(r12)
-.globl _restgpr1_31
-_restgpr1_31: ld r31,-8(r12)
- blr
-
-// Each _savefpr_M routine saves the floating point registers from fM to f31,
-// inclusive. When the routine is called, r1 must point to the start of the
-// floating point register save area, and r0 must contain the value of LR on
-// function entry.
-_savefpr_14: stfd f14,-144(r1)
-_savefpr_15: stfd f15,-136(r1)
-_savefpr_16: stfd f16,-128(r1)
-_savefpr_17: stfd f17,-120(r1)
-_savefpr_18: stfd f18,-112(r1)
-_savefpr_19: stfd f19,-104(r1)
-_savefpr_20: stfd f20,-96(r1)
-_savefpr_21: stfd f21,-88(r1)
-_savefpr_22: stfd f22,-80(r1)
-_savefpr_23: stfd f23,-72(r1)
-_savefpr_24: stfd f24,-64(r1)
-_savefpr_25: stfd f25,-56(r1)
-_savefpr_26: stfd f26,-48(r1)
-_savefpr_27: stfd f27,-40(r1)
-_savefpr_28: stfd f28,-32(r1)
-_savefpr_29: stfd f29,-24(r1)
-_savefpr_30: stfd f30,-16(r1)
-_savefpr_31: stfd f31,-8(r1)
- std r0, 16(r1)
- blr
-// The _restfpr_M routines restore the floating point registers from fM to f31.
-// When the routine is called, r1 must point to the start of the floating point
-// register save area.
-_restfpr_14: lfd f14,-144(r1)
-_restfpr_15: lfd f15,-136(r1)
-_restfpr_16: lfd f16,-128(r1)
-_restfpr_17: lfd f17,-120(r1)
-_restfpr_18: lfd f18,-112(r1)
-_restfpr_19: lfd f19,-104(r1)
-_restfpr_20: lfd f20,-96(r1)
-_restfpr_21: lfd f21,-88(r1)
-_restfpr_22: lfd f22,-80(r1)
-_restfpr_23: lfd f23,-72(r1)
-_restfpr_24: lfd f24,-64(r1)
-_restfpr_25: lfd f25,-56(r1)
-_restfpr_26: lfd f26,-48(r1)
-_restfpr_27: lfd f27,-40(r1)
-_restfpr_28: lfd f28,-32(r1)
-_restfpr_29: lfd f29,-24(r1)
-_restfpr_29: ld r0, 16(r1)
- lfd f29,-24(r1)
- mtlr r0
- lfd f30,-16(r1)
- lfd f31,-8(r1)
- blr
-_restfpr_30: lfd f30,-16(r1)
-_restfpr_31: ld r0, 16(r1)
- lfd f31,-8(r1)
- mtlr r0
- blr
-// Each _savevr_M routine saves the vector registers from vM to v31, inclusive.
-// When the routine is called, r0 must point to the word just beyound the end
-// of the vector register save area. On return the value of r0 is unchanged
-// while r12 may be modified.
-(* commented out: GAS does not understand VMX opcodes?
-_savevr_20: addi r12,r0,-192
- stvx v20,r12,r0
-_savevr_21: addi r12,r0,-176
- stvx v21,r12,r0
-_savevr_22: addi r12,r0,-160
- stvx v22,r12,r0
-_savevr_23: addi r12,r0,-144
- stvx v23,r12,r0
-_savevr_24: addi r12,r0,-128
- stvx v24,r12,r0
-_savevr_25: addi r12,r0,-112
- stvx v25,r12,r0
-_savevr_26: addi r12,r0,-96
- stvx v26,r12,r0
-_savevr_27: addi r12,r0,-80
- stvx v27,r12,r0
-_savevr_28: addi r12,r0,-64
- stvx v28,r12,r0
-_savevr_29: addi r12,r0,-48
- stvx v29,r12,r0
-_savevr_30: addi r12,r0,-32
- stvx v30,r12,r0
-_savevr_31: addi r12,r0,-16
- stvx v31,r12,r0
- blr
-*)
-// The _restvr_M routines restore the vector registers from vM to v31. When the
-// routine is called, r0 must point to the word just beyound the end of the
-// vector register save area. On return the value of r0 is unchanged while r12
-// may be modified.
-(* commented out: GAS does not understand VMX opcodes?
-_restvr_20: addi r12,r0,-192
- lvx v20,r12,r0
-_restvr_21: addi r12,r0,-176
- lvx v21,r12,r0
-_restvr_22: addi r12,r0,-160
- lvx v22,r12,r0
-_restvr_23: addi r12,r0,-144
- lvx v23,r12,r0
-_restvr_24: addi r12,r0,-128
- lvx v24,r12,r0
-_restvr_25: addi r12,r0,-112
- lvx v25,r12,r0
-_restvr_26: addi r12,r0,-96
- lvx v26,r12,r0
-_restvr_27: addi r12,r0,-80
- lvx v27,r12,r0
-_restvr_28: addi r12,r0,-64
- lvx v28,r12,r0
-_restvr_29: addi r12,r0,-48
- lvx v29,r12,r0
-_restvr_30: addi r12,r0,-32
- lvx v30,r12,r0
-_restvr_31: addi r12,r0,-16
- lvx v31,r12,r0
- blr
-*)
-end;
-
-
-{****************************************************************************
- Move / Fill
-****************************************************************************}
-
-{$ifndef FPC_SYSTEM_HAS_MOVE}
-{$define FPC_SYSTEM_HAS_MOVE}
-procedure Move(const source;var dest;count:SizeInt);[public, alias: 'FPC_MOVE'];
-type
- bytearray = array [0..high(sizeint)-1] of byte;
-var
- i:longint;
-begin
- if count <= 0 then exit;
- Dec(count);
- if @source<@dest then
- begin
- for i:=count downto 0 do
- bytearray(dest)[i]:=bytearray(source)[i];
- end
- else
- begin
- for i:=0 to count do
- bytearray(dest)[i]:=bytearray(source)[i];
- end;
-end;
-{$endif FPC_SYSTEM_HAS_MOVE}
-
-
-{$ifndef FPC_SYSTEM_HAS_FILLCHAR}
-{$define FPC_SYSTEM_HAS_FILLCHAR}
-
-Procedure FillChar(var x;count:SizeInt;value:byte);
-type
- longintarray = array [0..high(sizeint) div 4-1] of longint;
- bytearray = array [0..high(sizeint)-1] of byte;
-var
- i,v : longint;
-begin
- if count <= 0 then exit;
- v := 0;
- { aligned? }
- if (PtrUInt(@x) mod sizeof(PtrUInt))<>0 then
- begin
- for i:=0 to count-1 do
- bytearray(x)[i]:=value;
- end
- else
- begin
- v:=(value shl 8) or (value and $FF);
- v:=(v shl 16) or (v and $ffff);
- for i:=0 to (count div 4)-1 do
- longintarray(x)[i]:=v;
- for i:=(count div 4)*4 to count-1 do
- bytearray(x)[i]:=value;
- end;
-end;
-{$endif FPC_SYSTEM_HAS_FILLCHAR}
-
-
-{$ifndef FPC_SYSTEM_HAS_FILLDWORD}
-{$define FPC_SYSTEM_HAS_FILLDWORD}
-procedure filldword(var x;count : SizeInt;value : dword);
-assembler; nostackframe;
-asm
-{ registers:
- r3 x
- r4 count
- r5 value
-}
- cmpdi cr0,r4,0
- mtctr r4
- subi r3,r3,4
- ble .LFillDWordEnd //if count<=0 Then Exit
-.LFillDWordLoop:
- stwu r5,4(r3)
- bdnz .LFillDWordLoop
-.LFillDWordEnd:
-end;
-{$endif FPC_SYSTEM_HAS_FILLDWORD}
-
-(*
-{$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
-{$define FPC_SYSTEM_HAS_INDEXBYTE}
-function IndexByte(const buf;len:SizeInt;b:byte):int64; assembler; nostackframe;
-{ input: r3 = buf, r4 = len, r5 = b }
-{ output: r3 = position of b in buf (-1 if not found) }
-asm
- { load the begin of the buffer in the data cache }
- dcbt 0,r3
- cmplwi r4,0
- mtctr r4
- subi r10,r3,1
- mr r0,r3
- { assume not found }
- li r3,-1
- ble .LIndexByteDone
-.LIndexByteLoop:
- lbzu r9,1(r10)
- cmplw r9,r5
- bdnzf cr0*4+eq,.LIndexByteLoop
- { r3 still contains -1 here }
- bne .LIndexByteDone
- sub r3,r10,r0
-.LIndexByteDone:
-end;
-{$endif FPC_SYSTEM_HAS_INDEXBYTE}
-*)
-(*
-{$ifndef FPC_SYSTEM_HAS_INDEXWORD}
-{$define FPC_SYSTEM_HAS_INDEXWORD}
-function IndexWord(const buf;len:SizeInt;b:word):int64; assembler; nostackframe;
-{ input: r3 = buf, r4 = len, r5 = b }
-{ output: r3 = position of b in buf (-1 if not found) }
-asm
- { load the begin of the buffer in the data cache }
- dcbt 0,r3
- cmplwi r4,0
- mtctr r4
- subi r10,r3,2
- mr r0,r3
- { assume not found }
- li r3,-1
- ble .LIndexWordDone
-.LIndexWordLoop:
- lhzu r9,2(r10)
- cmplw r9,r5
- bdnzf cr0*4+eq,.LIndexWordLoop
- { r3 still contains -1 here }
- bne .LIndexWordDone
- sub r3,r10,r0
- srawi r3,r3,1
-.LIndexWordDone:
-end;
-{$endif FPC_SYSTEM_HAS_INDEXWORD}
-*)
-(*
-{$ifndef FPC_SYSTEM_HAS_INDEXDWORD}
-{$define FPC_SYSTEM_HAS_INDEXDWORD}
-function IndexDWord(const buf;len:SizeInt;b:DWord):int64; assembler; nostackframe;
-{ input: r3 = buf, r4 = len, r5 = b }
-{ output: r3 = position of b in buf (-1 if not found) }
-asm
- { load the begin of the buffer in the data cache }
- dcbt 0,r3
- cmplwi r4,0
- mtctr r4
- subi r10,r3,4
- mr r0,r3
- { assume not found }
- li r3,-1
- ble .LIndexDWordDone
-.LIndexDWordLoop:
- lwzu r9,4(r10)
- cmplw r9,r5
- bdnzf cr0*4+eq, .LIndexDWordLoop
- { r3 still contains -1 here }
- bne .LIndexDWordDone
- sub r3,r10,r0
- srawi r3,r3,2
-.LIndexDWordDone:
-end;
-{$endif FPC_SYSTEM_HAS_INDEXDWORD}
-*)
-(*
-{$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
-{$define FPC_SYSTEM_HAS_COMPAREBYTE}
-function CompareByte(const buf1,buf2;len:SizeInt):int64; assembler; nostackframe;
-{ input: r3 = buf1, r4 = buf2, r5 = len }
-{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
-{ note: almost direct copy of strlcomp() from strings.inc }
-asm
- { load the begin of the first buffer in the data cache }
- dcbt 0,r3
- { use r0 instead of r3 for buf1 since r3 contains result }
- cmplwi r5,0
- mtctr r5
- subi r11,r3,1
- subi r4,r4,1
- li r3,0
- ble .LCompByteDone
-.LCompByteLoop:
- { load next chars }
- lbzu r9,1(r11)
- lbzu r10,1(r4)
- { calculate difference }
- sub. r3,r9,r10
- { if chars not equal or at the end, we're ready }
- bdnzt cr0*4+eq, .LCompByteLoop
-.LCompByteDone:
-end;
-{$endif FPC_SYSTEM_HAS_COMPAREBYTE}
-*)
-(*
-{$ifndef FPC_SYSTEM_HAS_COMPAREWORD}
-{$define FPC_SYSTEM_HAS_COMPAREWORD}
-function CompareWord(const buf1,buf2;len:SizeInt):int64; assembler; nostackframe;
-{ input: r3 = buf1, r4 = buf2, r5 = len }
-{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
-{ note: almost direct copy of strlcomp() from strings.inc }
-asm
- { load the begin of the first buffer in the data cache }
- dcbt 0,r3
- { use r0 instead of r3 for buf1 since r3 contains result }
- cmplwi r5,0
- mtctr r5
- subi r11,r3,2
- subi r4,r4,2
- li r3,0
- ble .LCompWordDone
-.LCompWordLoop:
- { load next chars }
- lhzu r9,2(r11)
- lhzu r10,2(r4)
- { calculate difference }
- sub. r3,r9,r10
- { if chars not equal or at the end, we're ready }
- bdnzt cr0*4+eq, .LCompWordLoop
-.LCompWordDone:
-end;
-{$endif FPC_SYSTEM_HAS_COMPAREWORD}
-*)
-(*
-{$ifndef FPC_SYSTEM_HAS_COMPAREDWORD}
-{$define FPC_SYSTEM_HAS_COMPAREDWORD}
-function CompareDWord(const buf1,buf2;len:SizeInt):int64; assembler; nostackframe;
-{ input: r3 = buf1, r4 = buf2, r5 = len }
-{ output: r3 = 0 if equal, < 0 if buf1 < str2, > 0 if buf1 > str2 }
-{ note: almost direct copy of strlcomp() from strings.inc }
-asm
- { load the begin of the first buffer in the data cache }
- dcbt 0,r3
- { use r0 instead of r3 for buf1 since r3 contains result }
- cmplwi r5,0
- mtctr r5
- subi r11,r3,4
- subi r4,r4,4
- li r3,0
- ble .LCompDWordDone
-.LCompDWordLoop:
- { load next chars }
- lwzu r9,4(r11)
- lwzu r10,4(r4)
- { calculate difference }
- sub. r3,r9,r10
- { if chars not equal or at the end, we're ready }
- bdnzt cr0*4+eq, .LCompDWordLoop
-.LCompDWordDone:
-end;
-{$endif FPC_SYSTEM_HAS_COMPAREDWORD}
-*)
-(*
-{$ifndef FPC_SYSTEM_HAS_INDEXCHAR0}
-{$define FPC_SYSTEM_HAS_INDEXCHAR0}
-function IndexChar0(const buf;len:SizeInt;b:Char):int64; assembler; nostackframe;
-{ input: r3 = buf, r4 = len, r5 = b }
-{ output: r3 = position of found position (-1 if not found) }
-asm
- { load the begin of the buffer in the data cache }
- dcbt 0,r3
- { length = 0? }
- cmplwi r4,0
- mtctr r4
- subi r9,r3,1
- subi r0,r3,1
- { assume not found }
- li r3,-1
- { if yes, do nothing }
- ble .LIndexChar0Done
-.LIndexChar0Loop:
- lbzu r10,1(r9)
- cmplwi cr1,r10,0
- cmplw r10,r5
- beq cr1,.LIndexChar0Done
- bdnzf cr0*4+eq, .LIndexChar0Loop
- bne .LIndexChar0Done
- sub r3,r9,r0
-.LIndexChar0Done:
-end;
-{$endif FPC_SYSTEM_HAS_INDEXCHAR0}
-*)
-
-{****************************************************************************
- String
-****************************************************************************}
-(*
-{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
-{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
-function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; [public,alias: 'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
-assembler; nostackframe;
-{ input: r3: pointer to result, r4: len, r5: sstr }
-asm
- { load length source }
- lbz r10,0(r5)
- { load the begin of the dest buffer in the data cache }
- dcbtst 0,r3
-
- { put min(length(sstr),len) in r4 }
- subfc r7,r10,r4 { r0 := r4 - r10 }
- subfe r4,r4,r4 { if r3 >= r4 then r3' := 0 else r3' := -1 }
- and r7,r7,r4 { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
- add r4,r10,r7 { if r3 >= r4 then r3' := r10 else r3' := r3 }
-
- cmplwi r4,0
- { put length in ctr }
- mtctr r4
- stb r4,0(r3)
- beq .LShortStrCopyDone
-.LShortStrCopyLoop:
- lbzu r0,1(r5)
- stbu r0,1(r3)
- bdnz .LShortStrCopyLoop
-.LShortStrCopyDone:
-end;
-
-
-{$ifdef interncopy}
-procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN'];
-{$else}
-procedure fpc_shortstr_copy(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_COPY'];
-{$endif}
-assembler; nostackframe;
-{ input: r3: len, r4: sstr, r5: dstr }
-asm
- { load length source }
- lbz r10,0(r4)
- { load the begin of the dest buffer in the data cache }
- dcbtst 0,r5
-
- { put min(length(sstr),len) in r3 }
- subc r0,r3,r10 { r0 := r3 - r10 }
- subfe r3,r3,r3 { if r3 >= r4 then r3' := 0 else r3' := -1 }
- and r3,r0,r3 { if r3 >= r4 then r3' := 0 else r3' := r3-r10 }
- add r3,r3,r10 { if r3 >= r4 then r3' := r10 else r3' := r3 }
-
- cmplwi r3,0
- { put length in ctr }
- mtctr r3
- stb r3,0(r5)
- beq .LShortStrCopyDone2
-.LShortStrCopyLoop2:
- lbzu r0,1(r4)
- stbu r0,1(r5)
- bdnz .LShortStrCopyLoop2
-.LShortStrCopyDone2:
-end;
-{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
-*)
-(*
-{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
-{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
-
-function fpc_shortstr_concat(const s1, s2: shortstring): shortstring; compilerproc; [public, alias: 'FPC_SHORTSTR_CONCAT'];
-{ expects that (r3) contains a pointer to the result r4 to s1, r5 to s2 }
-assembler;
-asm
- { load length s1 }
- lbz r6, 0(r4)
- { load length s2 }
- lbz r10, 0(r5)
- { length 0 for s1? }
- cmplwi cr7,r6,0
- { length 255 for s1? }
- subfic. r7,r6,255
- { length 0 for s2? }
- cmplwi cr1,r10,0
- { calculate min(length(s2),255-length(s1)) }
- subc r8,r7,r10 { r8 := r7 - r10 }
- cror 4*6+2,4*1+2,4*7+2
- subfe r7,r7,r7 { if r7 >= r10 then r7' := 0 else r7' := -1 }
- mtctr r6
- and r7,r8,r7 { if r7 >= r10 then r7' := 0 else r7' := r7-r10 }
- add r7,r7,r10 { if r7 >= r10 then r7' := r10 else r7' := r7 }
-
- mr r9,r3
-
- { calculate length of final string }
- add r8,r7,r6
- stb r8,0(r3)
- beq cr7, .Lcopys1loopDone
- .Lcopys1loop:
- lbzu r0,1(r4)
- stbu r0,1(r9)
- bdnz .Lcopys1loop
- .Lcopys1loopDone:
- mtctr r7
- beq cr6, .LconcatDone
- .Lcopys2loop:
- lbzu r0,1(r5)
- stbu r0,1(r9)
- bdnz .Lcopys2loop
-end;
-{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
-*)
-(*
-{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
-{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
-
-procedure fpc_shortstr_append_shortstr(var s1: shortstring; const s2: shortstring); compilerproc;
-{ expects that results (r3) contains a pointer to the current string s1, r4 }
-{ high(s1) and (r5) a pointer to the one that has to be concatenated }
-assembler; nostackframe;
-asm
- { load length s1 }
- lbz r6, 0(r3)
- { load length s2 }
- lbz r10, 0(r5)
- { length 0? }
- cmplw cr1,r6,r4
- cmplwi r10,0
-
- { calculate min(length(s2),high(result)-length(result)) }
- sub r9,r4,r6
- subc r8,r9,r10 { r8 := r9 - r10 }
- cror 4*7+2,4*0+2,4*1+2
- subfe r9,r9,r9 { if r9 >= r10 then r9' := 0 else r9' := -1 }
- and r9,r8,r9 { if r9 >= r10 then r9' := 0 else r9' := r9-r10 }
- add r9,r9,r10 { if r9 >= r10 then r9' := r10 else r9' := r9 }
-
- { calculate new length }
- add r10,r6,r9
- { load value to copy in ctr }
- mtctr r9
- { store new length }
- stb r10,0(r3)
- { go to last current character of result }
- add r3,r6,r3
-
- { if nothing to do, exit }
- beq cr7, .LShortStrAppendDone
- { and concatenate }
-.LShortStrAppendLoop:
- lbzu r10,1(r5)
- stbu r10,1(r3)
- bdnz .LShortStrAppendLoop
-.LShortStrAppendDone:
-end;
-{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
-*)
-(*
-{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
-function fpc_shortstr_compare(const dstr,sstr:shortstring): longint; [public,alias:'FPC_SHORTSTR_COMPARE']; compilerproc;
-assembler;
-asm
- { load length sstr }
- lbz r9,0(r4)
- { load length dstr }
- lbz r10,0(r3)
- { save their difference for later and }
- { calculate min(length(sstr),length(dstr)) }
- subfc r7,r10,r9 { r0 := r9 - r10 }
- subfe r9,r9,r9 { if r9 >= r10 then r9' := 0 else r9' := -1 }
- and r7,r7,r9 { if r9 >= r10 then r9' := 0 else r9' := r9-r8 }
- add r9,r10,r7 { if r9 >= r10 then r9' := r10 else r9' := r9 }
-
- { first compare dwords (length/4) }
- srwi. r5,r9,2
- { keep length mod 4 for the ends }
- rlwinm r9,r9,0,30,31
- { already check whether length mod 4 = 0 }
- cmplwi cr1,r9,0
- { so we can load r3 with 0, in case the strings both have length 0 }
- mr r8,r3
- li r3, 0
- { length div 4 in ctr for loop }
- mtctr r5
- { if length < 3, goto byte comparing }
- beq LShortStrCompare1
- { setup for use of update forms of load/store with dwords }
- subi r4,r4,3
- subi r8,r8,3
-LShortStrCompare4Loop:
- lwzu r3,4(r4)
- lwzu r10,4(r8)
- sub. r3,r3,r10
- bdnzt cr0+eq,LShortStrCompare4Loop
- { r3 contains result if we stopped because of "ne" flag }
- bne LShortStrCompareDone
- { setup for use of update forms of load/store with bytes }
- addi r4,r4,3
- addi r8,r8,3
-LShortStrCompare1:
- { if comparelen mod 4 = 0, skip this and return the difference in }
- { lengths }
- beq cr1,LShortStrCompareLen
- mtctr r9
-LShortStrCompare1Loop:
- lbzu r3,1(r4)
- lbzu r10,1(r8)
- sub. r3,r3,r10
- bdnzt cr0+eq,LShortStrCompare1Loop
- bne LShortStrCompareDone
-LShortStrCompareLen:
- { also return result in flags, maybe we can use this in the CG }
- mr. r3,r3
-LShortStrCompareDone:
-end;
-*)
-
-
-{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
-{$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
-function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
-assembler; nostackframe;
-{$include strpas.inc}
-{$endif FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
-
-(*
-{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
-{$define FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
-function fpc_pchar_length(p:pchar):longint;assembler;[public,alias:'FPC_PCHAR_LENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif} nostackframe;
-{$include strlen.inc}
-{$endif FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
-*)
-
-{$define FPC_SYSTEM_HAS_GET_FRAME}
-function get_frame:pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
-asm
- { all abi's I know use r1 as stack pointer }
- mr r3, r1
-end;
-
-{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
-function get_caller_addr(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
-asm
- cmpldi r3,0
- beq .Lcaller_addr_frame_null
- ld r3, 0(r3)
-
- cmpldi r3,0
- beq .Lcaller_addr_frame_null
- ld r3, 16(r3)
-.Lcaller_addr_frame_null:
-end;
-
-
-{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
-function get_caller_frame(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
-asm
- cmpldi r3,0
- beq .Lcaller_frame_null
- ld r3, 0(r3)
-.Lcaller_frame_null:
-end;
-
-{$define FPC_SYSTEM_HAS_ABS_LONGINT}
-function abs(l:longint):longint; assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
-asm
- srawi r0,r3,31
- add r3,r0,r3
- xor r3,r3,r0
-end;
-
-
-{****************************************************************************
- Math
-****************************************************************************}
-
-{$define FPC_SYSTEM_HAS_ODD_LONGINT}
-function odd(l:longint):boolean;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
-asm
- rldicl r3, r3, 0, 63
-end;
-
-
-{$define FPC_SYSTEM_HAS_SQR_LONGINT}
-function sqr(l:longint):longint;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
-asm
- mullw r3,r3,r3
-end;
-
-{$define FPC_SYSTEM_HAS_ODD_INT64}
-function odd(l:int64):boolean;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
-asm
- rldicl r3, r3, 0, 63
-end;
-
-
-{$define FPC_SYSTEM_HAS_SQR_INT64}
-function sqr(l:int64):int64;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
-asm
- mulld r3,r3,r3
-end;
-
-
-{$define FPC_SYSTEM_HAS_SPTR}
-Function Sptr : Pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
-asm
- mr r3,r1
-end;
-
-
-{****************************************************************************
- Str()
-****************************************************************************}
-
-{ int_str: generic implementation is used for now }
-
-
-{****************************************************************************
- Multithreading
-****************************************************************************}
-
-{ do a thread save inc/dec }
-
-
-{$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT}
-function declocked(var l : longint) : boolean;assembler;nostackframe;
-{ input: address of l in r3 }
-{ output: boolean indicating whether l is zero after decrementing }
-asm
-.LDecLockedLoop:
- lwarx r10,0,r3
- subi r10,r10,1
- stwcx. r10,0,r3
- bne- .LDecLockedLoop
- cntlzd r3,r10
- srdi r3,r3,6
-end;
-
-{$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT}
-procedure inclocked(var l : longint);assembler;nostackframe;
-asm
-.LIncLockedLoop:
-
- lwarx r10,0,r3
- addi r10,r10,1
- stwcx. r10,0,r3
- bne- .LIncLockedLoop
-end;
-
-
-{$define FPC_SYSTEM_HAS_DECLOCKED_INT64}
-function declocked(var l : int64) : boolean;assembler;nostackframe;
-{ input: address of l in r3 }
-{ output: boolean indicating whether l is zero after decrementing }
-asm
-.LDecLockedLoop:
- ldarx r10,0,r3
- subi r10,r10,1
- stdcx. r10,0,r3
- bne- .LDecLockedLoop
- cntlzd r3,r10
- srdi r3,r3,6
-end;
-
-{$define FPC_SYSTEM_HAS_INCLOCKED_INT64}
-procedure inclocked(var l : int64);assembler;nostackframe;
-asm
-.LIncLockedLoop:
-
- ldarx r10,0,r3
- addi r10,r10,1
- stdcx. r10,0,r3
- bne- .LIncLockedLoop
-end;
-
diff --git a/rtl/powerpc64/set.inc b/rtl/powerpc64/set.inc deleted file mode 100644 index 4409d782ed..0000000000 --- a/rtl/powerpc64/set.inc +++ /dev/null @@ -1,357 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by Jonas Maebe, member of the - Free Pascal development team - - Include file with set operations called by the compiler - - 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. - - **********************************************************************} - -{$define FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL} -function fpc_set_load_small(l: fpc_small_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_LOAD_SMALL']; compilerproc; -{ - load a normal set p from a smallset l - - on entry: p in r3, l in r4 -} -asm - stw r4,0(r3) - li r0,0 - stw r0,4(r3) - std r0,8(r3) - std r0,16(r3) - std r0,24(r3) -end; - - -{$define FPC_SYSTEM_HAS_FPC_SET_CREATE_ELEMENT} -{ checked 2001/09/28 (JM) } -function fpc_set_create_element(b : byte): fpc_normal_set;assembler;[public,alias:'FPC_SET_CREATE_ELEMENT']; compilerproc; -{ - create a new set in p from an element b - - on entry: pointer to result in r3, b in r4 -} -asm - li r0,0 - stw r0,0(r3) - stw r0,4(r3) - stw r0,8(r3) - stw r0,12(r3) - stw r0,16(r3) - stw r0,20(r3) - stw r0,24(r3) - stw r0,28(r3) - - // r0 := 1 shl r4[27-31] -> bit index in dword (rotate instructions - // with count in register only consider lower 5 bits of this register) - li r0,1 - rlwnm r0,r0,r4,0,31 - - // get the index of the correct *dword* in the set - // (((b div 8) div 4)*4= (b div 8) and not(3)) - // r5 := (r4 rotl(32-3)) and (0x01ffffff8) - rlwinm r4,r4,31-3+1,3,31-2 - - // store the result - stwx r0,r3,r4 -end; - - -{$define FPC_SYSTEM_HAS_FPC_SET_SET_BYTE} -function fpc_set_set_byte(const source: fpc_normal_set; b : byte): fpc_normal_set;assembler; compilerproc; -{ - add the element b to the set pointed by p - - on entry: result in r3, source in r4, b in r5 -} -asm - // copy source to result - lfd f0,0(r4) - lfd f1,8(r4) - lfd f2,16(r4) - lfd f3,24(r4) - stfd f0,0(r3) - stfd f1,8(r3) - stfd f2,16(r3) - stfd f3,24(r3) - - // get the index of the correct *dword* in the set - // r0 := (r5 rotl(32-3)) and (0x0fffffff8) - rlwinm r0,r5,31-3+1,3,31-2 - // load dword in which the bit has to be set (and update r3 to this address) - lwzux r4,r3,r0 - li r0,1 - // generate bit which has to be inserted - // (can't use rlwimi, since that one only works for constants) - rlwnm r5,r0,r5,0,31 - // insert it - or r5,r4,r5 - // store result - stw r5,0(r3) -end; - - -{$define FPC_SYSTEM_HAS_FPC_SET_UNSET_BYTE} -function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_set;assembler; compilerproc; -{ - suppresses the element b to the set pointed by p - used for exclude(set,element) - - on entry: p in r3, b in r4 -} -asm - // copy source to result - lfd f0,0(r4) - lfd f1,8(r4) - lfd f2,16(r4) - lfd f3,24(r4) - stfd f0,0(r3) - stfd f1,8(r3) - stfd f2,16(r3) - stfd f3,24(r3) - // get the index of the correct *dword* in the set - // r0 := (r4 rotl(32-3)) and (0x0fffffff8) - rlwinm r0,r5,31-3+1,3,31-2 - // load dword in which the bit has to be set (and update r3 to this address) - lwzux r4,r3,r0 - li r0,1 - // generate bit which has to be removed - rlwnm r5,r0,r5,0,31 - // remove it - andc r5,r4,r5 - // store result - stw r4,0(r3) -end; - - -{$define FPC_SYSTEM_HAS_FPC_SET_SET_RANGE} -function fpc_set_set_range(const orgset: fpc_normal_set; l,h : byte): fpc_normal_set;assembler; compilerproc; -{ - on entry: result in r3, l in r4, h in r5 - - on entry: result in r3, ptr to orgset in r4, l in r5, h in r6 -} -asm - // copy source to result - lfd f0,0(r4) - lfd f1,8(r4) - lfd f2,16(r4) - lfd f3,24(r4) - stfd f0,0(r3) - stfd f1,8(r3) - stfd f2,16(r3) - stfd f3,24(r3) - - cmplw cr0,r5,r6 - bgt cr0,.Lset_range_exit - rlwinm r4,r5,31-3+1,3,31-2 // divide by 8 to get starting and ending byte- - { load the set the data cache } - dcbtst r3,r4 - rlwinm r9,r6,31-3+1,3,31-2 // address and clear two lowest bits to get - // start/end longint address - sub. r9,r9,r4 // are bit lo and hi in the same longint? - rlwinm r6,r6,0,31-5+1,31 // hi := hi mod 32 (= "hi and 31", but the andi - // instr. only exists in flags modifying form) - rlwinm r5,r5,0,31-5+1,31 // lo := lo mod 32 (= "lo and 31", but the andi - // instr. only exists in flags modifying form) - li r10,-1 // r10 = $0x0ffffffff = bitmask to be inserted - subfic r6,r6,31 // hi := 31 - (hi mod 32) = shift count for later - slw r10,r10,r5 // shift bitmask to clear bits below lo - lwzux r5,r3,r4 // go to starting pos in set and load value - // (lo is not necessary anymore) - beq .Lset_range_hi // if bit lo and hi in same longint, keep - // current mask and adjust for hi bit - subic. r9,r9,4 // bit hi in next longint? - or r5,r5,r10 // merge and - stw r5,0(r3) // store current mask - li r10,-1 // new mask - lwzu r5,4(r3) // load next longint of set - beq .Lset_range_hi // bit hi in this longint -> go to adjust for hi - subi r3,r3,4 -.Lset_range_loop: - subic. r9,r9,4 - stwu r10,4(r3) // fill longints in between with full mask - bne .Lset_range_loop - lwzu r5,4(r3) // load next value from set -.Lset_range_hi: // in all cases, r3 here contains the address of - // the longint which contains the hi bit and r4 - // contains this longint - srw r9,r10,r6 // r9 := bitmask shl (31 - (hi mod 32)) = - // bitmask with bits higher than hi cleared - // (r8 = $0xffffffff unless the first beq was - // taken) - and r10,r9,r10 // combine lo and hi bitmasks for this longint - or r5,r5,r10 // and combine with existing set - stw r5,0(r3) // store to set -.Lset_range_exit: -end; - - -{$define FPC_SYSTEM_HAS_FPC_SET_IN_BYTE} -function fpc_set_in_byte(const p: fpc_normal_set; b : byte): boolean;compilerproc;assembler;[public,alias:'FPC_SET_IN_BYTE']; -{ - tests if the element b is in the set p, the **zero** flag is cleared if it's present - - on entry: p in r3, b in r4 -} -asm - // get the index of the correct *dword* in the set - // r0 := (r4 rotl(32-3)) and (0x0fffffff8) - rlwinm r0,r4,31-3+1,3,31-2 - - // load dword in which the bit has to be tested - lwzx r3,r3,r0 - - // r4 := 32 - r4 (no problem if r4 > 32, the rlwnm next does a mod 32) - subfic r4,r4,32 - // r3 := (r3 shr (r4 mod 32)) and 1 - rlwnm r3,r3,r4,31,31 -end; - - - -{$define FPC_SYSTEM_HAS_FPC_SET_ADD_SETS} -function fpc_set_add_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_ADD_SETS']; compilerproc; -{ - adds set1 and set2 into set dest - on entry: result in r3, set1 in r4, set2 in r5 -} -asm - { load the begin of the result set in the data cache } - dcbtst 0,r3 - li r0,8 - mtctr r0 - subi r5,r5,4 - subi r4,r4,4 - subi r3,r3,4 - .LMADDSETS1: - lwzu r0,4(r4) - lwzu r10,4(r5) - or r0,r0,r10 - stwu r0,4(r3) - bdnz .LMADDSETS1 -end; - - -{$define FPC_SYSTEM_HAS_FPC_SET_MUL_SETS} -function fpc_set_mul_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_MUL_SETS']; compilerproc; -{ - multiplies (takes common elements of) set1 and set2 result put in dest - on entry: result in r3, set1 in r4, set2 in r5 -} -asm - { load the begin of the result set in the data cache } - dcbtst 0,r3 - li r0,8 - mtctr r0 - subi r5,r5,4 - subi r4,r4,4 - subi r3,r3,4 - .LMMULSETS1: - lwzu r0,4(r4) - lwzu r10,4(r5) - and r0,r0,r10 - stwu r0,4(r3) - bdnz .LMMULSETS1 -end; - - -{$define FPC_SYSTEM_HAS_FPC_SET_SUB_SETS} -function fpc_set_sub_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_SUB_SETS']; compilerproc; -{ - computes the diff from set1 to set2 result in dest - on entry: result in r3, set1 in r4, set2 in r5 -} -asm - { load the begin of the result set in the data cache } - dcbtst 0,r3 - li r0,8 - mtctr r0 - subi r5,r5,4 - subi r4,r4,4 - subi r3,r3,4 - .LMSUBSETS1: - lwzu r0,4(r4) - lwzu r10,4(r5) - andc r0,r0,r10 - stwu r0,4(r3) - bdnz .LMSUBSETS1 -end; - - -{$define FPC_SYSTEM_HAS_FPC_SET_SYMDIF_SETS} -function fpc_set_symdif_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_SYMDIF_SETS']; compilerproc; -{ - computes the symetric diff from set1 to set2 result in dest - on entry: result in r3, set1 in r4, set2 in r5 -} -asm - { load the begin of the result set in the data cache } - dcbtst 0,r3 - li r0,8 - mtctr r0 - subi r5,r5,4 - subi r4,r4,4 - subi r3,r3,4 - .LMSYMDIFSETS1: - lwzu r0,4(r4) - lwzu r10,4(r5) - xor r0,r0,r10 - stwu r0,4(r3) - bdnz .LMSYMDIFSETS1 -end; - - -{$define FPC_SYSTEM_HAS_FPC_SET_COMP_SETS} -function fpc_set_comp_sets(const set1,set2: fpc_normal_set): boolean;assembler;[public,alias:'FPC_SET_COMP_SETS']; compilerproc; -{ - compares set1 and set2 zeroflag is set if they are equal - on entry: set1 in r3, set2 in r4 -} -asm - li r0,8 - mtctr r0 - subi r3,r3,4 - subi r4,r4,4 - .LMCOMPSETS1: - lwzu r0,4(r3) - lwzu r10,4(r4) - sub. r0,r0,r10 - bdnzt cr0*4+eq,.LMCOMPSETS1 - cntlzw r3,r0 - srwi. r3,r3,5 -end; - - -{$define FPC_SYSTEM_HAS_FPC_SET_CONTAINS_SET} -function fpc_set_contains_sets(const set1,set2: fpc_normal_set): boolean;assembler;[public,alias:'FPC_SET_CONTAINS_SETS']; compilerproc; -{ - on exit, zero flag is set if set1 <= set2 (set2 contains set1) - on entry: set1 in r3, set2 in r4 -} -asm - li r0,8 - mtctr r0 - subi r3,r3,4 - subi r4,r4,4 - .LMCONTAINSSETS1: - lwzu r0,4(r3) - lwzu r10,4(r4) - { set1 and not(set2) = 0? } - andc. r0,r0,r10 - bdnzt cr0*4+eq,.LMCONTAINSSETS1 - cntlzw r3,r0 - srwi. r3,r3,5 -end; - - - - diff --git a/rtl/powerpc64/setjump.inc b/rtl/powerpc64/setjump.inc deleted file mode 100644 index e6099ec7eb..0000000000 --- a/rtl/powerpc64/setjump.inc +++ /dev/null @@ -1,125 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - Copyright (c) 2002 by Jonas Maebe and other members of the - Free Pascal development team - - SetJmp and LongJmp implementation for exception handling - - 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. - - **********************************************************************} -{ - jmp_buf = packed record - r1, r2, lr,r14,r15, - r16,r17,r18,r19,r20, - r21,r22,r23,r24,r25, - r26,r27,r28,r29,r30, - r31,cr : int64; - // 176 - f14,f15,f16, - // 200 - f17,f18,f19,f20,f21, - f22,f23,f24,f25,f26, - f27,f28,f29,f30,f31 : double; - end; - pjmp_buf = ^jmp_buf;} - -function setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP']; nostackframe; - asm - std r1,0(r3) // store r1 - mflr r0 - std r2,8(r3) // store r2 - std r14,24(r3) // store r14 - stfd f14,176(r3) // store f14 - std r0,16(r3) // store lr - std r15,32(r3) // store r15 - stfd f15,184(r3) // store f15 - mfcr r0 - std r16,40(r3) // store r16 - stfd f16,192(r3) // store f16 - stw r0,168(r3) // store cr - std r17,48(r3) // store r17 - stfd f17,200(r3) // store f17 - std r18,56(r3) // ... - stfd f18,208(r3) - std r19,64(r3) - stfd f19,216(r3) - std r20,72(r3) - stfd f20,224(r3) - std r21,80(r3) - stfd f21,232(r3) - std r22,88(r3) - stfd f22,240(r3) - std r23,96(r3) - stfd f23,248(r3) - std r24,104(r3) - stfd f24,256(r3) - std r25,112(r3) - stfd f25,264(r3) - std r26,120(r3) - stfd f26,272(r3) - std r27,128(r3) - stfd f27,280(r3) - std r28,136(r3) - stfd f28,288(r3) - std r29,144(r3) - stfd f29,296(r3) - std r30,152(r3) - stfd f30,304(r3) - std r31,160(r3) - stfd f31,312(r3) - li r3,0 - end; - -procedure longjmp(var S : jmp_buf;value : longint);assembler;[Public, alias : 'FPC_LONGJMP']; nostackframe; - asm - ld r1,0(r3) // load r1 - ld r2,8(r3) // load r2 - ld r0,16(r3) // load lr - ld r14,24(r3) // load r14 - lfd f14,176(r3) - ld r15,32(r3) // load r15 - lfd f15,184(r3) - ld r16,40(r3) - lfd f16,192(r3) - ld r17,48(r3) - lfd f17,200(r3) - ld r18,56(r3) - lfd f18,208(r3) - ld r19,64(r3) - lfd f19,216(r3) - ld r20,72(r3) - lfd f20,224(r3) - mtlr r0 - ld r21,80(r3) - lfd f21,232(r3) - ld r22,88(r3) - lfd f22,240(r3) - lwz r0,168(r3) - ld r23,96(r3) - lfd f23,248(r3) - ld r24,104(r3) - lfd f24,256(r3) - ld r25,112(r3) - lfd f25,264(r3) - mtcrf 0xff,r0 - ld r26,120(r3) - lfd f26,272(r3) - ld r27,128(r3) - lfd f27,280(r3) - ld r28,136(r3) - lfd f28,288(r3) - ld r29,144(r3) - lfd f29,296(r3) - ld r30,152(r3) - lfd f30,304(r3) - ld r31,160(r3) - lfd f31,312(r3) - mr r3,r4 - end; - diff --git a/rtl/powerpc64/setjumph.inc b/rtl/powerpc64/setjumph.inc deleted file mode 100644 index 83a4a68826..0000000000 --- a/rtl/powerpc64/setjumph.inc +++ /dev/null @@ -1,26 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - Copyright (c) 2000-2002 by Jonas Maebe and other members of the - Free Pascal development team - - SetJmp/Longjmp declarations - - 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. - - **********************************************************************} - -type - jmp_buf = packed record - r1,r2,lr,r14,r15,r16,r17,r18,r19,r20,r21,r22,r23,r24,r25,r26,r27,r28,r29,r30,r31,cr : int64; - f14,f15,f16,f17,f18,f19,f20,f21,f22,f23,f24,f25,f26,f27,f28,f29,f30,f31 : double; - end; - pjmp_buf = ^jmp_buf; - -function setjmp(var S : jmp_buf) : longint; -procedure longjmp(var S : jmp_buf;value : longint); - diff --git a/rtl/powerpc64/strings.inc b/rtl/powerpc64/strings.inc deleted file mode 100644 index 175b4f903a..0000000000 --- a/rtl/powerpc64/strings.inc +++ /dev/null @@ -1,503 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - Copyright (c) 2000 by Jonas Maebe, member of the - Free Pascal development team - - Processor dependent part of strings.pp, that can be shared with - sysutils unit. - - 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. - - **********************************************************************} - -{ Note: the implementation of these routines is for BIG ENDIAN only!! (JM) } - -{$ifndef FPC_UNIT_HAS_STRCOPY} -{$define FPC_UNIT_HAS_STRCOPY} -function strcopy(dest,source : pchar) : pchar;assembler; -{ in: dest in r3, source in r4 } -{ out: result (dest) in r3 } -asm -{ in: dest in r3, source in r4 } -{ out: result (dest) in r3 } - { load the begin of the source string in the data cache } - dcbt 0,r4 - { get # of misaligned bytes } - rlwinm. r10,r4,0,31-2+1,31 - subfic r10,r10,4 - mtctr r10 - { since we have to return dest intact, use another register for } - { dest in the copy loop } - subi r9,r3,1 - subi r4,r4,1 - beq .LStrCopyAligned -.LStrCopyAlignLoop: - { load next byte } - lbzu r0,1(r4) - { end of string? } - cmplwi cr0,r0,0 - { store byte } - stbu r0,1(r9) - { loop if misaligned bytes left and not end of string found } - bdnzf cr0*4+eq,.LStrCopyAlignLoop - beq .LStrCopyDone -.LStrCopyAligned: - subi r4,r4,3 - subi r9,r9,3 - { setup magic constants } - {$ifdef macos} - { load constant 0xfefefeff } - lis r8,0xfefe - addi r8,r8,0xfeff - { load constant 0x80808080} - lis r7,0x8080 - addi r7,r7,0x8080 - {$else} - lis r8,(0xfefefeff)@ha - addi r8,r8,(0xfefefeff)@l - lis r7,(0x80808080)@ha - addi r7,r7,(0x80808080)@l - {$endif} - { load first 4 bytes } - lwzu r0,4(r4) - -.LStrCopyAlignedLoop: - { test for zero byte } - add r10,r0,r8 - andc r10,r10,r0 - and. r10,r10,r7 - bne .LStrCopyEndFound - stwu r0,4(r9) - { load next 4 bytes (do it here so the load can begin while the } - { the branch is processed) } - lwzu r0,4(r4) - b .LStrCopyAlignedLoop -.LStrCopyEndFound: - { adjust for possible $01 bytes coming before the terminating 0 byte } - rlwinm r8,r0,7,0,31 - andc r10,r10,r8 - { result is either 0, 8, 16 or 24 depending on which byte is zero } - cntlzw r10,r10 - addi r9,r9,3 -.LStrCopyWrapUpLoop: - subic. r10,r10,8 - rlwinm r0,r0,8,0,31 - stbu r0,1(r9) - bge .LStrCopyWrapUpLoop -.LStrCopyDone: - { r3 still contains dest here } -end; -{$endif FPC_UNIT_HAS_STRCOPY} - - -{$ifndef FPC_UNIT_HAS_STRECOPY} -{$define FPC_UNIT_HAS_STRECOPY} -function strecopy(dest,source : pchar) : pchar;assembler; -{ in: dest in r3, source in r4 } -{ out: result (end of new dest) in r3 } -asm - { load the begin of the source string in the data cache } - dcbt 0,r4 - { get # of misaligned bytes } - rlwinm. r10,r4,0,31-2+1,31 - subfic r10,r10,4 - mtctr r10 - subi r3,r3,1 - subi r4,r4,1 - beq .LStrECopyAligned -.LStrECopyAlignLoop: - { load next byte } - lbzu r0,1(r4) - { end of string? } - cmplwi cr0,r0,0 - { store byte } - stbu r0,1(r3) - { loop if misaligned bytes left and not end of string found } - bdnzf cr0*4+eq,.LStrECopyAlignLoop - beq .LStrECopyDone -.LStrECopyAligned: - subi r4,r4,3 - subi r3,r3,3 - { setup magic constants } - {$ifdef macos} - { load constant 0xfefefeff } - lis r8,0xfefe - addi r8,r8,0xfeff - { load constant 0x80808080} - lis r7,0x8080 - addi r7,r7,0x8080 - {$else} - lis r8,(0xfefefeff)@ha - addi r8,r8,(0xfefefeff)@l - lis r7,(0x80808080)@ha - addi r7,r7,(0x80808080)@l - {$endif} -{ - li r8,-257 { 0x0feff } - andis. r8,r8,0x0fefe - li r9,-32640 { 0x08080 } - andis. r9,r9,0x08080 -} -.LStrECopyAlignedLoop: - - { load next 4 bytes } - lwzu r0,4(r4) - - { test for zero byte } - add r10,r0,r8 - andc r10,r10,r0 - and. r10,r10,r7 - bne .LStrECopyEndFound - stwu r0,4(r3) - b .LStrECopyAlignedLoop -.LStrECopyEndFound: - { adjust for possible $01 bytes coming before the terminating 0 byte } - rlwinm r8,r0,7,0,31 - andc r10,r10,r8 - { result is either 0, 8, 16 or 24 depending on which byte is zero } - cntlzw r10,r10 - addi r3,r3,3 -.LStrECopyWrapUpLoop: - subic. r10,r10,8 - rlwinm r0,r0,8,0,31 - stbu r0,1(r3) - bge .LStrECopyWrapUpLoop -.LStrECopyDone: - { r3 contains new dest here } -end; -{$endif FPC_UNIT_HAS_STRECOPY} - - -{$ifndef FPC_UNIT_HAS_STRLCOPY} -{$define FPC_UNIT_HAS_STRLCOPY} -function strlcopy(dest,source : pchar;maxlen : int64) : pchar;assembler; -{ in: dest in r3, source in r4, maxlen in r5 } -{ out: result (dest) in r3 } -asm - { load the begin of the source string in the data cache } - dcbt 0,r4 - mtctr r5 - subi r4,r4,1 - subi r10,r3,1 -.LStrlCopyLoop: - lbzu r0,1(r4) - cmplwi r0,0 - stbu r0,1(r10) - bdnzf cr0*4+eq, .LStrlCopyLoop - { if we stopped because we copied a #0, we're done } - beq .LStrlCopyDone - { otherwise add the #0 } - li r0,0 - stb r0,1(r10) -.LStrlCopyDone: -end; -{$endif FPC_UNIT_HAS_STRLCOPY} - - -{$ifndef FPC_UNIT_HAS_STREND} -{$define FPC_UNIT_HAS_STREND} -function strend(p : pchar) : pchar;assembler; -{ in: p in r3 } -{ out: result (end of p) in r3 } -asm - { load the begin of the string in the data cache } - dcbt 0,r3 - { empty/invalid string? } - cmplwi r3,0 - { if yes, do nothing } - beq .LStrEndDone - subi r3,r3,1 -.LStrEndLoop: - lbzu r0,1(r3) - cmplwi r0,0 - bne .LStrEndLoop -.LStrEndDone: -end; -{$endif FPC_UNIT_HAS_STREND} - - -{$ifndef FPC_UNIT_HAS_STRCOMP} -{$define FPC_UNIT_HAS_STRCOMP} -function strcomp(str1,str2 : pchar) : int64;assembler; -{ in: str1 in r3, str2 in r4 } -{ out: result (= 0 if strings equal, < 0 if str1 < str2, > 0 if str1 > str2 } -{ in r3 } -asm - { use r0 instead of r3 for str1 since r3 contains result } - subi r9,r3,1 - subi r4,r4,1 -.LStrCompLoop: - { load next chars } - lbzu r0,1(r9) - { check if one is zero } - cmplwi cr1,r0,0 - lbzu r10,1(r4) - { calculate difference } - sub. r3,r0,r10 - { if chars not equal, we're ready } - bne .LStrCompDone - { if they are equal and one is zero, then the other one is zero too } - { and we're done as well (r3 also contains 0 then) } - { otherwise loop } - bne cr1,.LStrCompLoop -.LStrCompDone: -end; -{$endif FPC_UNIT_HAS_STRCOMP} - - -{$ifndef FPC_UNIT_HAS_STRLCOMP} -{$define FPC_UNIT_HAS_STRLCOMP} -function strlcomp(str1,str2 : pchar;l : int64) : int64;assembler; -{ (same as strcomp, but maximally compare until l'th character) } -{ in: str1 in r3, str2 in r4, l in r5 } -{ out: result (= 0 if strings equal, < 0 if str1 < str2, > 0 if str1 > str2 } -{ in r3 } -asm - { load the begin of one of the strings in the data cache } - dcbt 0,r3 - { use r0 instead of r3 for str1 since r3 contains result } - cmplwi r5,0 - subi r9,r3,1 - li r3,0 - beq .LStrlCompDone - mtctr r5 - subi r4,r4,1 -.LStrlCompLoop: - { load next chars } - lbzu r0,1(r9) - { check if one is zero } - cmplwi cr1,r0,0 - lbzu r10,1(r4) - { calculate difference } - sub. r3,r0,r10 - { if chars not equal, we're ready } - bne .LStrlCompDone - { if they are equal and one is zero, then the other one is zero too } - { and we're done as well (r3 also contains 0 then) } - { otherwise loop (if ctr <> 0) } - bdnzf cr1*4+eq,.LStrlCompLoop -.LStrlCompDone: -end; -{$endif FPC_UNIT_HAS_STRLCOMP} - - -{$ifndef FPC_UNIT_HAS_STRICOMP} -{$define FPC_UNIT_HAS_STRICOMP} -function stricomp(str1,str2 : pchar) : int64;assembler; -{ in: str1 in r3, str2 in r4 } -{ out: result of case insensitive comparison (< 0, = 0, > 0) } -asm - { use r5 instead of r3 for str1 since r3 contains result } - subi r5,r3,1 - subi r4,r4,1 -.LStriCompLoop: - { load next chars } - lbzu r6,1(r5) - { check if one is zero } - cmplwi cr1,r6,0 - lbzu r7,1(r4) - { calculate difference } - sub. r3,r6,r7 - { if chars are equal, no further test is necessary } - beq+ .LStriCompEqual - - { make both lowercase, no branches } - - { r3 := pred('A') - r6 } - subfic r3,r6,64 - { if r6 < 'A' then r8 := 0 else r8 := $ffffffff } - subfe r8,r8,r8 - { same for r7 } - subfic r3,r7,64 - subfe r9,r9,r9 - - { r3 := r6 - succ('Z') } - subic r3,r6,91 - { if r6 < 'A' then r8 := 0 else r8 := $20 } - andi. r8,r8,0x020 - { if r6 > Z then r10 := 0 else r10 := $ffffffff } - subfe r10,r10,r10 - { same for r7 } - subic r3,r7,91 - andi. r9,r9,0x020 - subfe r11,r11,r11 - - { if (r6 in ['A'..'Z'] then r8 := $20 else r8 := 0 } - and r8,r8,r10 - { same for r7 } - and r9,r9,r11 - - { make lowercase } - add r6,r6,r8 - { same for r7 } - add r7,r7,r9 - - { compare again } - sub. r3,r6,r7 - bne- .LStriCompDone -.LStriCompEqual: - { if they are equal and one is zero, then the other one is zero too } - { and we're done as well (r3 also contains 0 then) } - { otherwise loop } - bne cr1,.LStriCompLoop -.LStriCompDone: -end; -{$endif FPC_UNIT_HAS_STRICOMP} - - -{$ifndef FPC_UNIT_HAS_STRLICOMP} -{$define FPC_UNIT_HAS_STRLICOMP} -function strlicomp(str1,str2 : pchar;l : int64) : int64;assembler; -{ (same as stricomp, but maximally compare until l'th character) } -{ in: str1 in r3, str2 in r4, l in r5 } -{ out: result of case insensitive comparison (< 0, = 0, > 0) } -asm - { load the begin of one of the string in the data cache } - dcbt 0,r3 - { use r0 instead of r3 for str1 since r3 contains result } - cmplwi r5,0 - subi r9,r3,1 - li r3,0 - beq- .LStrliCompDone - mtctr r5 - subi r4,r4,1 -.LStrliCompLoop: - { load next chars } - lbzu r0,1(r9) - { check if one is zero } - cmplwi cr1,r0,0 - lbzu r10,1(r4) - { calculate difference } - sub. r3,r0,r10 - { if chars are equal, no further test is necessary } - beq .LStrliCompEqual - - { see stricomp for explanation } - - subfic r3,r0,64 - subfe r8,r8,r8 - subfic r3,r10,64 - subfe r5,r5,r5 - - subic r3,r0,91 - andi. r8,r8,0x020 - subfe r7,r7,r7 - subic r3,r10,91 - andi. r5,r5,0x020 - subfe r11,r11,r11 - - and r8,r8,r7 - and r5,r5,r11 - add r0,r0,r8 - add r10,r10,r5 - - { compare again } - sub. r3,r0,r10 - bne .LStrliCompDone -.LStrliCompEqual: - { if they are equal and one is zero, then the other one is zero too } - { and we're done as well (r3 also contains 0 then) } - { otherwise loop (if ctr <> 0) } - bdnzf cr1*4+eq,.LStrliCompLoop -.LStrliCompDone: -end; -{$endif FPC_UNIT_HAS_STRLICOMP} - - -{$ifndef FPC_UNIT_HAS_STRSCAN} -{$define FPC_UNIT_HAS_STRSCAN} -function strscan(p : pchar;c : char) : pchar;assembler; -asm - { empty/invalid string? } - cmplwi r3,0 - { if yes, do nothing } - beq .LStrScanDone - subi r3,r3,1 -.LStrScanLoop: - lbzu r0,1(r3) - cmplw cr1,r0,r4 - cmplwi r0,0 - beq cr1,.LStrScanDone - bne .LStrScanLoop - li r3, 0 -.LStrScanDone: -end; -{$endif FPC_UNIT_HAS_STRSCAN} - - -{$ifndef FPC_UNIT_HAS_STRRSCAN} -{$define FPC_UNIT_HAS_STRRSCAN} -function strrscan(p : pchar;c : char) : pchar;assembler; -asm - { empty/invalid string? } - cmplwi r3,0 - { if yes, do nothing } - beq .LStrrScanDone - { make r5 will be walking through the string } - subi r5,r3,1 - { assume not found } - li r3,0 -.LStrrScanLoop: - lbzu r10,1(r5) - cmplw cr1,r10,r4 - cmplwi cr0,r10,0 - bne+ cr1,.LStrrScanNotFound - { store address of found position } - mr r3,r5 -.LStrrScanNotFound: - bne .LStrrScanLoop -.LStrrScanDone: -end; -{$endif FPC_UNIT_HAS_STRRSCAN} - - -{$ifndef FPC_UNIT_HAS_STRUPPER} -{$define FPC_UNIT_HAS_STRUPPER} -function strupper(p : pchar) : pchar;assembler; -asm - cmplwi r3,0 - beq .LStrUpperNil - subi r9,r3,1 -.LStrUpperLoop: - lbzu r10,1(r9) - { a <= x <= b <=> cardinal(x-a) <= cardinal(b-a) } - subi r0,r10,97 - cmplwi r0,122-97 - cmplwi cr1,r10,0 - subi r10,r10,0x20 - bgt .LStrUpper1 - stb r10,0(r9) -.LStrUpper1: - bne cr1,.LStrUpperLoop -.LStrUpperNil: -end; -{$endif FPC_UNIT_HAS_STRUPPER} - - -{$ifndef FPC_UNIT_HAS_STRLOWER} -{$define FPC_UNIT_HAS_STRLOWER} -function strlower(p : pchar) : pchar;assembler; -asm - cmplwi r3,0 - beq .LStrLowerNil - subi r9,r3,1 -.LStrLowerLoop: - lbzu r10,1(r9) - { a <= x <= b <=> cardinal(x-a) <= cardinal(b-a) } - subi r0,r10,65 - cmplwi r0,90-65 - cmplwi cr1,r10,0 - addi r10,r10,0x20 - bgt .LStrLower1 - stb r10,0(r9) -.LStrLower1: - bne cr1,.LStrLowerLoop -.LStrLowerNil: -end; -{$endif FPC_UNIT_HAS_STRLOWER} - diff --git a/rtl/powerpc64/stringss.inc b/rtl/powerpc64/stringss.inc deleted file mode 100644 index e7b73eacb1..0000000000 --- a/rtl/powerpc64/stringss.inc +++ /dev/null @@ -1,40 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by Jonas Maebe, member of the - Free Pascal development team - - Processor dependent part of strings.pp, not shared with - sysutils unit. - - 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. - - **********************************************************************} - -{$ifndef FPC_UNIT_HAS_STRPCOPY} -{$define FPC_UNIT_HAS_STRPCOPY} -function strpcopy(d : pchar;const s : string) : pchar;assembler; -asm - { get length } - lbz r0,0(r4) - { put in counter } - cmpldi r0,0 - mtctr r0 - subi r10,r3,1 - beq .LStrPCopyEmpty -.LStrPCopyLoop: - { copy everything } - lbzu r0,1(r4) - stbu r0,1(r10) - bdnz .LStrPCopyLoop - { add terminating #0 } - li r0,0 -.LStrPCopyEmpty: - stb r0,1(r10) -end; -{$endif FPC_UNIT_HAS_STRPCOPY} - diff --git a/rtl/powerpc64/strlen.inc b/rtl/powerpc64/strlen.inc deleted file mode 100644 index d9af82054e..0000000000 --- a/rtl/powerpc64/strlen.inc +++ /dev/null @@ -1,33 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by the Free Pascal development team - - Processor specific implementation of strlen - - 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. - - **********************************************************************} - -{ in: p in r3 } -{ out: result (length) in r3 } -asm - { load the begin of the string in the data cache } - dcbt 0,r3 - { empty/invalid string? } - cmpldi cr0,r3,0 - { if yes, do nothing } - beq .LStrLenDone - subi r9,r3,1 -.LStrLenLoop: - lbzu r10,1(r9) - cmpldi cr0,r10,0 - bne .LStrLenLoop - sub r3,r9,r3 -.LStrLenDone: -end; - diff --git a/rtl/powerpc64/strpas.inc b/rtl/powerpc64/strpas.inc deleted file mode 100644 index bcb6d38f0a..0000000000 --- a/rtl/powerpc64/strpas.inc +++ /dev/null @@ -1,54 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by the Free Pascal development team - - Processor specific implementation of strpas - - 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. - - **********************************************************************} -{ - r3: result address - r4: src -} -asm - { nil? } - cmpldi r4, 0 - { load the begin of the string in the data cache } - dcbt 0,r4 - { maxlength } - li r10,255 - mtctr r10 - { at LStrPasDone, we set the length of the result to 255 - r10 - r4 } - { = 255 - 255 - 0 if the soure = nil -> perfect :) } - beq .LStrPasDone - { save address for at the end and use r5 in loop } - mr r5,r3 - { no "subi r5,r5,1" because the first byte = length byte } - subi r4,r4,1 -.LStrPasLoop: - lbzu r10,1(r4) - cmpldi cr0,r10,0 - stbu r10,1(r5) - bdnzf cr0*4+eq, .LStrPasLoop - - { if we stopped because of a terminating #0, decrease the length by 1 } - cntlzd r4,r10 - { get remaining count for length } - mfctr r10 - { if r10 was zero (-> stopped because of zero byte), then r4 will be 64 } - { (64 leading zero bits) -> shr 6 = 1, otherwise this will be zero } - srdi r4,r4,6 -.LStrPasDone: - subfic r10,r10,255 - sub r10,r10,r4 - - { store length } - stb r10,0(r3) -end; - diff --git a/rtl/powerpc64/sysutilp.inc b/rtl/powerpc64/sysutilp.inc deleted file mode 100644 index 4cb192b2b6..0000000000 --- a/rtl/powerpc64/sysutilp.inc +++ /dev/null @@ -1,73 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - - Copyright (c) 2001 by Jonas Maebe, - member of the Free Pascal development team - - 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. - - **********************************************************************} - -{ --------------------------------------------------------------------- - This include contains cpu-specific routines - ---------------------------------------------------------------------} - -function InterLockedDecrement (var Target: longint) : longint; assembler; -{ input: address of target in r3 } -{ output: target-1 in r3 } -{ side-effect: target := target-1 } -asm -.LInterLockedDecLoop: - lwarx r10,0,r3 - subi r10,r10,1 - stwcx. r10,0,r3 - bne .LInterLockedDecLoop - mr r3,r10 -end; - - -function InterLockedIncrement (var Target: longint) : longint; assembler; -{ input: address of target in r3 } -{ output: target+1 in r3 } -{ side-effect: target := target+1 } -asm -.LInterLockedIncLoop: - lwarx r10,0,r3 - addi r10,r10,1 - stwcx. r10,0,r3 - bne .LInterLockedIncLoop - mr r3,r10 -end; - - -function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler; -{ input: address of target in r3, source in r4 } -{ output: target in r3 } -{ side-effect: target := source } -asm -.LInterLockedXchgLoop: - lwarx r10,0,r3 - stwcx. r4,0,r3 - bne .LInterLockedXchgLoop - mr r3,r10 -end; - - -function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler; -{ input: address of target in r3, source in r4 } -{ output: target in r3 } -{ side-effect: target := target+source } -asm -.LInterLockedXchgAddLoop: - lwarx r10,0,r3 - add r10,r10,r4 - stwcx. r10,0,r3 - bne .LInterLockedXchgAddLoop - sub r3,r10,r4 -end; - diff --git a/rtl/unix/cthreads.pp b/rtl/unix/cthreads.pp index e089847a57..6382e4e06b 100644 --- a/rtl/unix/cthreads.pp +++ b/rtl/unix/cthreads.pp @@ -93,10 +93,6 @@ Type PINTRTLEvent = ^TINTRTLEvent; threadvarblocksize:=align(threadvarblocksize,16); {$endif cpux86_64} - {$ifdef cpupowerpc64} - threadvarblocksize:=align(threadvarblocksize,16); - {$endif cpupowerpc64} - offset:=threadvarblocksize; inc(threadvarblocksize,size); diff --git a/rtl/unix/fpmake.inc b/rtl/unix/fpmake.inc deleted file mode 100644 index a6f0b13bca..0000000000 --- a/rtl/unix/fpmake.inc +++ /dev/null @@ -1,41 +0,0 @@ -Procedure ApplyUnixTargets(Installer : TInstaller); - -Var - T : TTarget; - -begin - With Installer,Targets do - begin - T:=AddUnit('unix/syscall.pp'); - T:=AddUnit('unix/unixtype.pp'); - T:=AddUnit('unix/baseunix.pp'); - T.Dependencies.Add('unixtype'); - T:=AddUnit('unix/errors.pp'); - T.Dependencies.Add('strings'); - T:=AddUnit('unix/unix.pp'); - T.Dependencies.Add('baseunix'); - T.Dependencies.Add('unixtype'); - T.Dependencies.Add('strings'); - T:=AddUnit('unix/terminfo.pp'); - T.Dependencies.Add('baseunix'); - T:=AddUnit('unix/linux.pp'); - T:=AddUnit('unix/oldlinux.pp'); - T:=AddUnit('unix/unixutil.pp'); - if Defaults.CPU=i386 then - T:=AddUnit('unix/x86'); - With Targets['sysutils'].dependencies do - begin - add('unix'); - add('errors'); - Add('unixtype'); - Add('baseunix'); - end; - With Targets['Dos'].dependencies do - begin - Add('strings'); - Add('unix'); - Add('baseunix'); - Add('syscall'); - end; - end; -end;
\ No newline at end of file diff --git a/rtl/win32/Makefile b/rtl/win32/Makefile index 6bc383a899..d5c1f0d6e3 100644 --- a/rtl/win32/Makefile +++ b/rtl/win32/Makefile @@ -239,8 +239,13 @@ COMMON=$(RTL)/common PROCINC=$(RTL)/$(CPU_TARGET) WININC=wininc UNITPREFIX=rtl +ifeq ($(findstring 1.0.,$(FPC_VERSION)),) SYSTEMUNIT=system PRT0=wprt0 +else +SYSTEMUNIT=syswin32 +PRT0=wprt0_10 +endif ifdef RELEASE override FPCOPT+=-Ur endif @@ -2020,8 +2025,8 @@ wprt0$(OEXT) : $(PRT0).as gprt0$(OEXT) : gprt0.as wdllprt0$(OEXT) : wdllprt0.as wcygprt0$(OEXT) : wcygprt0.as -$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS) - $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp -Fi../win +$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp win32.inc $(SYSDEPS) + $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT) $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\ diff --git a/rtl/win32/Makefile.fpc b/rtl/win32/Makefile.fpc index 5d861b4411..176cc700c7 100644 --- a/rtl/win32/Makefile.fpc +++ b/rtl/win32/Makefile.fpc @@ -44,8 +44,13 @@ WININC=wininc UNITPREFIX=rtl +ifeq ($(findstring 1.0.,$(FPC_VERSION)),) SYSTEMUNIT=system PRT0=wprt0 +else +SYSTEMUNIT=syswin32 +PRT0=wprt0_10 +endif # Use new feature from 1.0.5 version # that generates release PPU files @@ -100,8 +105,8 @@ wcygprt0$(OEXT) : wcygprt0.as # System Units (System, Objpas, Strings) # -$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS) - $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp -Fi../win +$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp win32.inc $(SYSDEPS) + $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT) $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp diff --git a/rtl/win32/crt.pp b/rtl/win32/crt.pp index 62cd42353c..cf1eb4ec1f 100644 --- a/rtl/win32/crt.pp +++ b/rtl/win32/crt.pp @@ -638,54 +638,21 @@ begin end; { while } end; - -procedure WriteStr(const s: string); -var - WritePos: Coord; { Upper-left cell to write from } - numWritten : DWord; - WinAttr : word; - i: integer; -begin - WritePos.X := currX - 1; - WritePos.Y := currY - 1; - - WriteConsoleOutputCharacter(GetStdhandle(STD_OUTPUT_HANDLE), @s[1], Length(s), writePos, numWritten); - - WinAttr:=TextAttr; - dec(WritePos.X); - for i:=0 to Length(s)-1 do - begin - inc(WritePos.X); - WriteConsoleOutputAttribute(GetStdhandle(STD_OUTPUT_HANDLE),@WinAttr, 1, writePos, numWritten); - end; - Inc(CurrX,Length(s)); -end; - - Function CrtWrite(var f : textrec) : integer; var i : longint; - s : string; begin GetScreenCursor(CurrX, CurrY); - s:=''; + for i:=0 to f.bufpos-1 do - if f.buffer[i]<#32 then - begin - if s<>'' then - WriteStr(s); - WriteChar(f.buffer[i]); - end - else - s:=s+f.buffer[i]; - if s<>'' then - WriteStr(s); + WriteChar(f.buffer[i]); SetScreenCursor(CurrX, CurrY); f.bufpos:=0; CrtWrite:=0; end; + Function CrtRead(Var F: TextRec): Integer; procedure BackSpace; diff --git a/rtl/win/sysdir.inc b/rtl/win32/sysdir.inc index 43430a75ab..4c27881b55 100644 --- a/rtl/win/sysdir.inc +++ b/rtl/win32/sysdir.inc @@ -58,27 +58,20 @@ end; procedure chdir(const s:string);[IOCHECK]; begin -{$ifndef WINCE} If (s='') or (InOutRes <> 0) then exit; dirfn(TDirFnType(@SetCurrentDirectory),s); if Inoutres=2 then Inoutres:=3; -{$else WINCE} - InOutRes:=1; -{$endif WINCE} end; procedure GetDir (DriveNr: byte; var Dir: ShortString); -{$ifndef WINCE} const Drive:array[0..3]of char=(#0,':',#0,#0); -{$endif WINCE} var defaultdrive:boolean; DirBuf,SaveBuf:array[0..259] of Char; begin -{$ifndef WINCE} defaultdrive:=drivenr=0; if not defaultdrive then begin @@ -99,18 +92,5 @@ begin dir:=strpas(DirBuf); if not FileNameCaseSensitive then dir:=upcase(dir); -{$else WINCE} - Dir:='\'; -{$endif WINCE} end; -{ - $Log: sysdir.inc,v $ - Revision 1.2 2005/02/14 17:13:32 peter - * truncate log - - Revision 1.1 2005/02/06 13:06:20 peter - * moved file and dir functions to sysfile/sysdir - * win32 thread in systemunit - -} diff --git a/rtl/win/sysfile.inc b/rtl/win32/sysfile.inc index d6cc632b61..8e8f513e02 100644 --- a/rtl/win/sysfile.inc +++ b/rtl/win32/sysfile.inc @@ -29,11 +29,7 @@ end; function do_isdevice(handle:thandle):boolean; begin -{$ifndef WINCE} do_isdevice:=(getfiletype(handle)=2); -{$else WINCE} - do_isdevice:=False; -{$endif WINCE} end; @@ -265,11 +261,4 @@ begin end; -{ - $Log: sysfile.inc,v $ - Revision 1.1 2005/02/06 13:06:20 peter - * moved file and dir functions to sysfile/sysdir - * win32 thread in systemunit - -} diff --git a/rtl/win/sysheap.inc b/rtl/win32/sysheap.inc index b9c4677af3..c3df32056b 100644 --- a/rtl/win/sysheap.inc +++ b/rtl/win32/sysheap.inc @@ -1,8 +1,10 @@ { - Basic heap handling for windows platforms - This file is part of the Free Pascal run time library. - Copyright (c) 2001-2005 by Free Pascal development team + Copyright (c) 2001 by Free Pascal development team + + This file implements all the base types and limits required + for a minimal POSIX compliant subset required to port the compiler + to a new OS. See the file COPYING.FPC, included in this distribution, for details about the copyright. @@ -19,27 +21,27 @@ ****************************************************************************} { memory functions } - function GetProcessHeap : THandle; - stdcall;external KernelDLL name 'GetProcessHeap'; - function HeapAlloc(hHeap : DWord; dwFlags : DWord; dwBytes : SIZE_T) : pointer; - stdcall;external KernelDLL name 'HeapAlloc'; - function HeapFree(hHeap : THandle; dwFlags : dword; lpMem: pointer) : boolean; - stdcall;external KernelDLL name 'HeapFree'; + function GetProcessHeap : DWord; + stdcall;external 'kernel32' name 'GetProcessHeap'; + function HeapAlloc(hHeap : DWord; dwFlags : DWord; dwBytes : DWord) : Longint; + stdcall;external 'kernel32' name 'HeapAlloc'; + function HeapFree(hHeap : dword; dwFlags : dword; lpMem: pointer) : boolean; + stdcall;external 'kernel32' name 'HeapFree'; {$IFDEF SYSTEMDEBUG} - function WinAPIHeapSize(hHeap : THandle; dwFlags : DWord; ptr : Pointer) : DWord; + function WinAPIHeapSize(hHeap : DWord; dwFlags : DWord; ptr : Pointer) : DWord; stdcall;external 'kernel32' name 'HeapSize'; {$ENDIF} function SysOSAlloc(size: ptrint): pointer; var - p : pointer; + l : longword; begin - p := HeapAlloc(GetProcessHeap, 0, size); + l := HeapAlloc(GetProcessHeap, 0, size); {$ifdef DUMPGROW} - Writeln('new heap part at $',hexstr(ptrint(p),sizeof(ptrint)*2), ' size = ',WinAPIHeapSize(GetProcessHeap())); + Writeln('new heap part at $',hexstr(l,8), ' size = ',WinAPIHeapSize(GetProcessHeap())); {$endif} - SysOSAlloc := p; + SysOSAlloc := pointer(l); end; {$define HAS_SYSOSFREE} @@ -49,3 +51,5 @@ begin HeapFree(GetProcessHeap, 0, p); end; + + diff --git a/rtl/win/sysos.inc b/rtl/win32/sysos.inc index 014c0cdb9e..49ef1933b9 100644 --- a/rtl/win/sysos.inc +++ b/rtl/win32/sysos.inc @@ -1,9 +1,11 @@ { - Basic stuff for windows rtls - This file is part of the Free Pascal run time library. Copyright (c) 2001 by Free Pascal development team + This file implements all the base types and limits required + for a minimal POSIX compliant subset required to port the compiler + to a new OS. + See the file COPYING.FPC, included in this distribution, for details about the copyright. @@ -165,86 +167,90 @@ type wMilliseconds: Word; end; +{$IFDEF SUPPORT_THREADVAR} threadvar - errno : longint; +{$ELSE SUPPORT_THREADVAR} +var +{$ENDIF SUPPORT_THREADVAR} + errno : longint; + +{$ASMMODE ATT} { misc. functions } function GetLastError : DWORD; - stdcall;external KernelDLL name 'GetLastError'; + stdcall;external 'kernel32' name 'GetLastError'; { time and date functions } function GetTickCount : longint; - stdcall;external KernelDLL name 'GetTickCount'; + stdcall;external 'kernel32' name 'GetTickCount'; -{$ifndef WINCE} { process functions } procedure ExitProcess(uExitCode : UINT); - stdcall;external KernelDLL name 'ExitProcess'; + stdcall;external 'kernel32' name 'ExitProcess'; { Startup } procedure GetStartupInfo(p : pointer); - stdcall;external KernelDLL name 'GetStartupInfoA'; + stdcall;external 'kernel32' name 'GetStartupInfoA'; function GetStdHandle(nStdHandle:DWORD):THANDLE; - stdcall;external KernelDLL name 'GetStdHandle'; + stdcall;external 'kernel32' name 'GetStdHandle'; { command line/enviroment functions } function GetCommandLine : pchar; - stdcall;external KernelDLL name 'GetCommandLineA'; + stdcall;external 'kernel32' name 'GetCommandLineA'; function GetCurrentProcessId:DWORD; - stdcall; external KernelDLL name 'GetCurrentProcessId'; + stdcall; external 'kernel32' name 'GetCurrentProcessId'; function Win32GetCurrentThreadId:DWORD; - stdcall; external KernelDLL name 'GetCurrentThreadId'; -{$endif WINCE} + stdcall; external 'kernel32' name 'GetCurrentThreadId'; { module functions } function GetModuleFileName(l1:longint;p:pointer;l2:longint):longint; - stdcall;external KernelDLL name 'GetModuleFileName' + ApiSuffix; + stdcall;external 'kernel32' name 'GetModuleFileNameA'; function GetModuleHandle(p : pointer) : longint; - stdcall;external KernelDLL name 'GetModuleHandle' + ApiSuffix; + stdcall;external 'kernel32' name 'GetModuleHandleA'; function GetCommandFile:pchar;forward; { file functions } function WriteFile(fh:thandle;buf:pointer;len:longint;var loaded:longint; overlap:pointer):longint; - stdcall;external KernelDLL name 'WriteFile'; + stdcall;external 'kernel32' name 'WriteFile'; function ReadFile(fh:thandle;buf:pointer;len:longint;var loaded:longint; overlap:pointer):longint; - stdcall;external KernelDLL name 'ReadFile'; + stdcall;external 'kernel32' name 'ReadFile'; function CloseHandle(h : thandle) : longint; - stdcall;external KernelDLL name 'CloseHandle'; - function SetFilePointer(l1,l2 : thandle;l3 : pointer;l4 : longint) : longint; - stdcall;external KernelDLL name 'SetFilePointer'; - function GetFileSize(h:thandle;p:pointer) : longint; - stdcall;external KernelDLL name 'GetFileSize'; - function SetEndOfFile(h : thandle) : longbool; - stdcall;external KernelDLL name 'SetEndOfFile'; -{$ifndef WINCE} - function GetFileType(Handle:thandle):DWord; - stdcall;external KernelDLL name 'GetFileType'; - function GetFileAttributes(p : pchar) : dword; - stdcall;external KernelDLL name 'GetFileAttributesA'; + stdcall;external 'kernel32' name 'CloseHandle'; function DeleteFile(p : pchar) : longint; - stdcall;external KernelDLL name 'DeleteFileA'; + stdcall;external 'kernel32' name 'DeleteFileA'; function MoveFile(old,_new : pchar) : longint; - stdcall;external KernelDLL name 'MoveFileA'; + stdcall;external 'kernel32' name 'MoveFileA'; + function SetFilePointer(l1,l2 : thandle;l3 : pointer;l4 : longint) : longint; + stdcall;external 'kernel32' name 'SetFilePointer'; + function GetFileSize(h:thandle;p:pointer) : longint; + stdcall;external 'kernel32' name 'GetFileSize'; function CreateFile(lpFileName:pchar; dwDesiredAccess:DWORD; dwShareMode:DWORD; lpSecurityAttributes:PSECURITYATTRIBUTES; dwCreationDisposition:DWORD; dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):longint; - stdcall;external KernelDLL name 'CreateFileA'; + stdcall;external 'kernel32' name 'CreateFileA'; + function SetEndOfFile(h : thandle) : longbool; + stdcall;external 'kernel32' name 'SetEndOfFile'; + function GetFileType(Handle:thandle):DWord; + stdcall;external 'kernel32' name 'GetFileType'; + function GetFileAttributes(p : pchar) : dword; + stdcall;external 'kernel32' name 'GetFileAttributesA'; { Directory } function CreateDirectory(name : pointer;sec : pointer) : longbool; - stdcall;external KernelDLL name 'CreateDirectoryA'; + stdcall;external 'kernel32' name 'CreateDirectoryA'; function RemoveDirectory(name:pointer):longbool; - stdcall;external KernelDLL name 'RemoveDirectoryA'; + stdcall;external 'kernel32' name 'RemoveDirectoryA'; function SetCurrentDirectory(name : pointer) : longbool; - stdcall;external KernelDLL name 'SetCurrentDirectoryA'; + stdcall;external 'kernel32' name 'SetCurrentDirectoryA'; function GetCurrentDirectory(bufsize : longint;name : pchar) : longbool; - stdcall;external KernelDLL name 'GetCurrentDirectoryA'; -{$endif WINCE} + stdcall;external 'kernel32' name 'GetCurrentDirectoryA'; + + Procedure Errno2InOutRes; Begin @@ -270,3 +276,6 @@ threadvar end; errno:=0; end; + + + diff --git a/rtl/win/sysosh.inc b/rtl/win32/sysosh.inc index e22d24db8c..bc441e1c81 100644 --- a/rtl/win/sysosh.inc +++ b/rtl/win32/sysosh.inc @@ -1,8 +1,10 @@ { - Basic Windows stuff - This file is part of the Free Pascal run time library. - Copyright (c) 2002-2005 by Free Pascal development team + Copyright (c) 2001 by Free Pascal development team + + This file implements all the base types and limits required + for a minimal POSIX compliant subset required to port the compiler + to a new OS. See the file COPYING.FPC, included in this distribution, for details about the copyright. @@ -13,18 +15,15 @@ **********************************************************************} -{ Platform specific information } +{Platform specific information} type {$ifdef CPU64} THandle = QWord; - ULONG_PTR = QWord; {$else CPU64} THandle = DWord; - ULONG_PTR = DWord; {$endif CPU64} TThreadID = THandle; - SIZE_T = ULONG_PTR; - + { the fields of this record are os dependent } { and they shouldn't be used in a program } { only the type TCriticalSection is important } @@ -33,16 +32,9 @@ type DebugInfo : pointer; LockCount : longint; RecursionCount : longint; - OwningThread : THandle; - LockSemaphore : THandle; - SpinCount : ULONG_PTR; + OwningThread : DWord; + LockSemaphore : DWord; + Reserved : DWord; end; -const -{$ifdef WINCE} - KernelDLL = 'coredll'; - ApiSuffix = 'W'; -{$else WINCE} - KernelDLL = 'kernel32'; - ApiSuffix = 'A'; -{$endif WINCE} + diff --git a/rtl/win/systhrd.inc b/rtl/win32/systhrd.inc index 4a00dc1420..4586e5fb89 100644 --- a/rtl/win/systhrd.inc +++ b/rtl/win32/systhrd.inc @@ -24,6 +24,11 @@ const LMEM_FIXED = 0; LMEM_ZEROINIT = 64; + KernelDLL = 'kernel32.dll'; + +type + SIZE_T = dword; + {$ifndef WINCE} function TlsAlloc : DWord; stdcall;external KernelDLL name 'TlsAlloc'; diff --git a/rtl/powerpc64/mathuh.inc b/rtl/win32/win32.inc index 9b0f206453..19be59d4ab 100644 --- a/rtl/powerpc64/mathuh.inc +++ b/rtl/win32/win32.inc @@ -1,7 +1,8 @@ { This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by Florian Klaempfl - member of the Free Pascal development team + Copyright (c) 1999-2000 by the Free Pascal development team. + + Win32 Types and Constants See the file COPYING.FPC, included in this distribution, for details about the copyright. @@ -12,3 +13,4 @@ **********************************************************************} + diff --git a/rtl/win64/Makefile b/rtl/win64/Makefile deleted file mode 100644 index 1f80da9573..0000000000 --- a/rtl/win64/Makefile +++ /dev/null @@ -1,1979 +0,0 @@ -# -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/10/20] -# -default: all -MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince powerpc64-linux -BSDs = freebsd netbsd openbsd darwin -UNIXs = linux $(BSDs) solaris qnx -LIMIT83fs = go32v2 os2 emx watcom -FORCE: -.PHONY: FORCE -override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH))) -ifneq ($(findstring darwin,$(OSTYPE)),) -inUnix=1 #darwin -SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH))) -else -ifeq ($(findstring ;,$(PATH)),) -inUnix=1 -SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH))) -else -SEARCHPATH:=$(subst ;, ,$(PATH)) -endif -endif -SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE)))) -PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH)))) -ifeq ($(PWD),) -PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH)))) -ifeq ($(PWD),) -$(error You need the GNU utils package to use this Makefile) -else -PWD:=$(firstword $(PWD)) -SRCEXEEXT= -endif -else -PWD:=$(firstword $(PWD)) -SRCEXEEXT=.exe -endif -ifndef inUnix -ifeq ($(OS),Windows_NT) -inWinNT=1 -else -ifdef OS2_SHELL -inOS2=1 -endif -endif -else -ifneq ($(findstring cygdrive,$(PATH)),) -inCygWin=1 -endif -endif -ifdef inUnix -SRCBATCHEXT=.sh -else -ifdef inOS2 -SRCBATCHEXT=.cmd -else -SRCBATCHEXT=.bat -endif -endif -ifdef inUnix -PATHSEP=/ -else -PATHSEP:=$(subst /,\,/) -ifdef inCygWin -PATHSEP=/ -endif -endif -ifdef PWD -BASEDIR:=$(subst \,/,$(shell $(PWD))) -ifdef inCygWin -ifneq ($(findstring /cygdrive/,$(BASEDIR)),) -BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR)) -BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR))) -BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR)) -endif -endif -else -BASEDIR=. -endif -ifdef inOS2 -ifndef ECHO -ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(ECHO),) -ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(ECHO),) -ECHO=echo -else -ECHO:=$(firstword $(ECHO)) -endif -else -ECHO:=$(firstword $(ECHO)) -endif -endif -export ECHO -endif -override OS_TARGET_DEFAULT=win64 -override DEFAULT_FPCDIR=../.. -ifndef FPC -ifdef PP -FPC=$(PP) -endif -endif -ifndef FPC -FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH)))) -ifneq ($(FPCPROG),) -FPCPROG:=$(firstword $(FPCPROG)) -FPC:=$(shell $(FPCPROG) -PB) -ifneq ($(findstring Error,$(FPC)),) -override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) -endif -else -override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) -endif -endif -override FPC:=$(subst $(SRCEXEEXT),,$(FPC)) -override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT) -FOUNDFPC:=$(strip $(wildcard $(FPC))) -ifeq ($(FOUNDFPC),) -FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH)))) -ifeq ($(FOUNDFPC),) -$(error Compiler $(FPC) not found) -endif -endif -ifndef FPC_COMPILERINFO -FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO) -endif -ifndef FPC_VERSION -FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO)) -endif -export FPC FPC_VERSION FPC_COMPILERINFO -unexport CHECKDEPEND ALLDEPENDENCIES -ifndef CPU_TARGET -ifdef CPU_TARGET_DEFAULT -CPU_TARGET=$(CPU_TARGET_DEFAULT) -endif -endif -ifndef OS_TARGET -ifdef OS_TARGET_DEFAULT -OS_TARGET=$(OS_TARGET_DEFAULT) -endif -endif -ifneq ($(words $(FPC_COMPILERINFO)),5) -FPC_COMPILERINFO+=$(shell $(FPC) -iSP) -FPC_COMPILERINFO+=$(shell $(FPC) -iTP) -FPC_COMPILERINFO+=$(shell $(FPC) -iSO) -FPC_COMPILERINFO+=$(shell $(FPC) -iTO) -endif -ifndef CPU_SOURCE -CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO)) -endif -ifndef CPU_TARGET -CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO)) -endif -ifndef OS_SOURCE -OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO)) -endif -ifndef OS_TARGET -OS_TARGET:=$(word 5,$(FPC_COMPILERINFO)) -endif -FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET) -FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE) -ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),) -TARGETSUFFIX=$(OS_TARGET) -SOURCESUFFIX=$(OS_SOURCE) -else -TARGETSUFFIX=$(FULL_TARGET) -SOURCESUFFIX=$(FULL_SOURCE) -endif -ifneq ($(FULL_TARGET),$(FULL_SOURCE)) -CROSSCOMPILE=1 -endif -ifeq ($(findstring makefile,$(MAKECMDGOALS)),) -ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),) -$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first) -endif -endif -ifneq ($(findstring $(OS_TARGET),$(BSDs)),) -BSDhier=1 -endif -ifeq ($(OS_TARGET),linux) -linuxHier=1 -endif -export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE -ifdef FPCDIR -override FPCDIR:=$(subst \,/,$(FPCDIR)) -ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) -override FPCDIR=wrong -endif -else -override FPCDIR=wrong -endif -ifdef DEFAULT_FPCDIR -ifeq ($(FPCDIR),wrong) -override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR)) -ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) -override FPCDIR=wrong -endif -endif -endif -ifeq ($(FPCDIR),wrong) -ifdef inUnix -override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION) -ifeq ($(wildcard $(FPCDIR)/units),) -override FPCDIR=/usr/lib/fpc/$(FPC_VERSION) -endif -else -override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH)))))) -override FPCDIR:=$(FPCDIR)/.. -ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) -override FPCDIR:=$(FPCDIR)/.. -ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) -override FPCDIR:=$(BASEDIR) -ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) -override FPCDIR=c:/pp -endif -endif -endif -endif -endif -ifndef CROSSBINDIR -CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX)) -endif -ifndef BINUTILSPREFIX -ifndef CROSSBINDIR -ifdef CROSSCOMPILE -BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)- -endif -endif -endif -UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX)) -ifeq ($(UNITSDIR),) -UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET)) -endif -PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra) -override PACKAGE_NAME=rtl -PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR)))))) -RTL=.. -INC=$(RTL)/inc -PROCINC=$(RTL)/$(CPU_TARGET) -WININC=wininc -UNITPREFIX=rtl -SYSTEMUNIT=system -PRT0=wprt0 -ifdef RELEASE -override FPCOPT+=-Ur -endif -OBJPASDIR=$(RTL)/objpas -GRAPHDIR=$(INC)/graph -WINDOWS_SOURCE_FILES=$(addprefix $(WININC)/,$(addsuffix .inc,$(WINDOWS_FILES))) -ifeq ($(FULL_TARGET),i386-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),i386-go32v2) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),i386-win32) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),i386-os2) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),i386-freebsd) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),i386-beos) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),i386-netbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),i386-solaris) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),i386-qnx) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),i386-netware) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),i386-openbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),i386-wdosx) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),i386-emx) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),i386-watcom) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),i386-netwlibc) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),i386-wince) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),m68k-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),m68k-freebsd) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),m68k-netbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),m68k-amiga) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),m68k-atari) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),m68k-openbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),m68k-palmos) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),powerpc-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),powerpc-netbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),powerpc-macos) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),powerpc-darwin) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),powerpc-morphos) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),sparc-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),sparc-netbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),sparc-solaris) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),x86_64-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),x86_64-freebsd) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),x86_64-win64) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),arm-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),arm-wince) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),powerpc64-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) # ctypes objpas macpas strings rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit -endif -ifeq ($(FULL_TARGET),i386-linux) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),i386-go32v2) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),i386-win32) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),i386-os2) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),i386-freebsd) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),i386-beos) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),i386-netbsd) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),i386-solaris) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),i386-qnx) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),i386-netware) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),i386-openbsd) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),i386-wdosx) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),i386-emx) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),i386-watcom) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),i386-netwlibc) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),i386-wince) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),m68k-linux) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),m68k-freebsd) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),m68k-netbsd) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),m68k-amiga) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),m68k-atari) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),m68k-openbsd) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),m68k-palmos) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),powerpc-linux) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),powerpc-netbsd) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),powerpc-macos) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),powerpc-darwin) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),powerpc-morphos) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),sparc-linux) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),sparc-netbsd) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),sparc-solaris) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),x86_64-linux) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),x86_64-freebsd) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),x86_64-win64) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),arm-linux) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),arm-wince) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -ifeq ($(FULL_TARGET),powerpc64-linux) -override TARGET_LOADERS+=#wprt0 wdllprt0 gprt0 wcygprt0 -endif -override INSTALL_FPCPACKAGE=y -ifeq ($(FULL_TARGET),i386-linux) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-go32v2) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-win32) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-os2) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-freebsd) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-beos) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-netbsd) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-solaris) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-qnx) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-netware) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-openbsd) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-wdosx) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-emx) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-watcom) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-netwlibc) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-wince) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),m68k-linux) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),m68k-freebsd) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),m68k-netbsd) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),m68k-amiga) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),m68k-atari) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),m68k-openbsd) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),m68k-palmos) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),powerpc-linux) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),powerpc-netbsd) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),powerpc-macos) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),powerpc-darwin) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),powerpc-morphos) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),sparc-linux) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),sparc-netbsd) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),sparc-solaris) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),x86_64-linux) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),x86_64-freebsd) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),x86_64-win64) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),arm-linux) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),arm-wince) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),powerpc64-linux) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-linux) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),i386-go32v2) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),i386-win32) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),i386-os2) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),i386-freebsd) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),i386-beos) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),i386-netbsd) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),i386-solaris) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),i386-qnx) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),i386-netware) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),i386-openbsd) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),i386-wdosx) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),i386-emx) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),i386-watcom) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),i386-netwlibc) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),i386-wince) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),m68k-linux) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),m68k-freebsd) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),m68k-netbsd) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),m68k-amiga) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),m68k-atari) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),m68k-openbsd) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),m68k-palmos) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),powerpc-linux) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),powerpc-netbsd) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),powerpc-macos) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),powerpc-darwin) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),powerpc-morphos) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),sparc-linux) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),sparc-netbsd) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),sparc-solaris) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),x86_64-linux) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),x86_64-freebsd) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),x86_64-win64) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),arm-linux) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),arm-wince) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifeq ($(FULL_TARGET),powerpc64-linux) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) -endif -ifdef REQUIRE_UNITSDIR -override UNITSDIR+=$(REQUIRE_UNITSDIR) -endif -ifdef REQUIRE_PACKAGESDIR -override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR) -endif -ifdef ZIPINSTALL -ifneq ($(findstring $(OS_TARGET),$(UNIXs)),) -UNIXHier=1 -endif -else -ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),) -UNIXHier=1 -endif -endif -ifndef INSTALL_PREFIX -ifdef PREFIX -INSTALL_PREFIX=$(PREFIX) -endif -endif -ifndef INSTALL_PREFIX -ifdef UNIXHier -INSTALL_PREFIX=/usr/local -else -ifdef INSTALL_FPCPACKAGE -INSTALL_BASEDIR:=/pp -else -INSTALL_BASEDIR:=/$(PACKAGE_NAME) -endif -endif -endif -export INSTALL_PREFIX -ifdef INSTALL_FPCSUBDIR -export INSTALL_FPCSUBDIR -endif -ifndef DIST_DESTDIR -DIST_DESTDIR:=$(BASEDIR) -endif -export DIST_DESTDIR -ifndef COMPILER_UNITTARGETDIR -ifdef PACKAGEDIR_MAIN -COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX) -else -COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX) -endif -endif -ifndef COMPILER_TARGETDIR -COMPILER_TARGETDIR=. -endif -ifndef INSTALL_BASEDIR -ifdef UNIXHier -ifdef INSTALL_FPCPACKAGE -INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION) -else -INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME) -endif -else -INSTALL_BASEDIR:=$(INSTALL_PREFIX) -endif -endif -ifndef INSTALL_BINDIR -ifdef UNIXHier -INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin -else -INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin -ifdef INSTALL_FPCPACKAGE -ifdef CROSSCOMPILE -ifdef CROSSINSTALL -INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX) -else -INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX) -endif -else -INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX) -endif -endif -endif -endif -ifndef INSTALL_UNITDIR -INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX) -ifdef INSTALL_FPCPACKAGE -ifdef PACKAGE_NAME -INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME) -endif -endif -endif -ifndef INSTALL_LIBDIR -ifdef UNIXHier -INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib -else -INSTALL_LIBDIR:=$(INSTALL_UNITDIR) -endif -endif -ifndef INSTALL_SOURCEDIR -ifdef UNIXHier -ifdef BSDhier -SRCPREFIXDIR=share/src -else -ifdef linuxHier -SRCPREFIXDIR=share/src -else -SRCPREFIXDIR=src -endif -endif -ifdef INSTALL_FPCPACKAGE -ifdef INSTALL_FPCSUBDIR -INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME) -else -INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) -endif -else -INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION) -endif -else -ifdef INSTALL_FPCPACKAGE -ifdef INSTALL_FPCSUBDIR -INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME) -else -INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME) -endif -else -INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source -endif -endif -endif -ifndef INSTALL_DOCDIR -ifdef UNIXHier -ifdef BSDhier -DOCPREFIXDIR=share/doc -else -ifdef linuxHier -DOCPREFIXDIR=share/doc -else -DOCPREFIXDIR=doc -endif -endif -ifdef INSTALL_FPCPACKAGE -INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) -else -INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION) -endif -else -ifdef INSTALL_FPCPACKAGE -INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME) -else -INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc -endif -endif -endif -ifndef INSTALL_EXAMPLEDIR -ifdef UNIXHier -ifdef INSTALL_FPCPACKAGE -ifdef BSDhier -INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) -else -ifdef linuxHier -INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples -else -INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME) -endif -endif -else -ifdef BSDhier -INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION) -else -ifdef linuxHier -INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION) -else -INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION) -endif -endif -endif -else -ifdef INSTALL_FPCPACKAGE -INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME) -else -INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples -endif -endif -endif -ifndef INSTALL_DATADIR -INSTALL_DATADIR=$(INSTALL_BASEDIR) -endif -ifdef CROSSCOMPILE -ifndef CROSSBINDIR -CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX)) -ifeq ($(CROSSBINDIR),) -CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE)) -endif -endif -else -CROSSBINDIR= -endif -BATCHEXT=.bat -LOADEREXT=.as -EXEEXT=.exe -PPLEXT=.ppl -PPUEXT=.ppu -OEXT=.o -ASMEXT=.s -SMARTEXT=.sl -STATICLIBEXT=.a -SHAREDLIBEXT=.so -STATICLIBPREFIX=libp -RSTEXT=.rst -ifeq ($(findstring 1.0.,$(FPC_VERSION)),) -ifeq ($(OS_TARGET),go32v1) -STATICLIBPREFIX= -SHORTSUFFIX=v1 -endif -ifeq ($(OS_TARGET),go32v2) -STATICLIBPREFIX= -SHORTSUFFIX=dos -endif -ifeq ($(OS_TARGET),watcom) -STATICLIBPREFIX= -OEXT=.obj -ASMEXT=.asm -SHAREDLIBEXT=.dll -SHORTSUFFIX=wat -endif -ifeq ($(OS_TARGET),linux) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=lnx -endif -ifeq ($(OS_TARGET),freebsd) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=fbs -endif -ifeq ($(OS_TARGET),netbsd) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=nbs -endif -ifeq ($(OS_TARGET),openbsd) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=obs -endif -ifeq ($(OS_TARGET),win32) -SHAREDLIBEXT=.dll -SHORTSUFFIX=w32 -endif -ifeq ($(OS_TARGET),os2) -BATCHEXT=.cmd -AOUTEXT=.out -STATICLIBPREFIX= -SHAREDLIBEXT=.dll -SHORTSUFFIX=os2 -ECHO=echo -endif -ifeq ($(OS_TARGET),emx) -BATCHEXT=.cmd -AOUTEXT=.out -STATICLIBPREFIX= -SHAREDLIBEXT=.dll -SHORTSUFFIX=emx -ECHO=echo -endif -ifeq ($(OS_TARGET),amiga) -EXEEXT= -SHAREDLIBEXT=.library -SHORTSUFFIX=amg -endif -ifeq ($(OS_TARGET),morphos) -EXEEXT= -SHAREDLIBEXT=.library -SHORTSUFFIX=mos -endif -ifeq ($(OS_TARGET),atari) -EXEEXT=.ttp -SHORTSUFFIX=ata -endif -ifeq ($(OS_TARGET),beos) -BATCHEXT=.sh -EXEEXT= -SHORTSUFFIX=be -endif -ifeq ($(OS_TARGET),solaris) -BATCHEXT=.sh -EXEEXT= -SHORTSUFFIX=sun -endif -ifeq ($(OS_TARGET),qnx) -BATCHEXT=.sh -EXEEXT= -SHORTSUFFIX=qnx -endif -ifeq ($(OS_TARGET),netware) -EXEEXT=.nlm -STATICLIBPREFIX= -SHORTSUFFIX=nw -endif -ifeq ($(OS_TARGET),netwlibc) -EXEEXT=.nlm -STATICLIBPREFIX= -SHORTSUFFIX=nwl -endif -ifeq ($(OS_TARGET),macos) -BATCHEXT= -EXEEXT= -DEBUGSYMEXT=.xcoff -SHORTSUFFIX=mac -endif -ifeq ($(OS_TARGET),darwin) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=dwn -endif -else -ifeq ($(OS_TARGET),go32v1) -PPUEXT=.pp1 -OEXT=.o1 -ASMEXT=.s1 -SMARTEXT=.sl1 -STATICLIBEXT=.a1 -SHAREDLIBEXT=.so1 -STATICLIBPREFIX= -SHORTSUFFIX=v1 -endif -ifeq ($(OS_TARGET),go32v2) -STATICLIBPREFIX= -SHORTSUFFIX=dos -endif -ifeq ($(OS_TARGET),watcom) -STATICLIBPREFIX= -SHORTSUFFIX=wat -endif -ifeq ($(OS_TARGET),linux) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=lnx -endif -ifeq ($(OS_TARGET),freebsd) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=fbs -endif -ifeq ($(OS_TARGET),netbsd) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=nbs -endif -ifeq ($(OS_TARGET),openbsd) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=obs -endif -ifeq ($(OS_TARGET),win32) -PPUEXT=.ppw -OEXT=.ow -ASMEXT=.sw -SMARTEXT=.slw -STATICLIBEXT=.aw -SHAREDLIBEXT=.dll -SHORTSUFFIX=w32 -endif -ifeq ($(OS_TARGET),os2) -BATCHEXT=.cmd -PPUEXT=.ppo -ASMEXT=.so2 -OEXT=.oo2 -AOUTEXT=.out -SMARTEXT=.sl2 -STATICLIBPREFIX= -STATICLIBEXT=.ao2 -SHAREDLIBEXT=.dll -SHORTSUFFIX=os2 -ECHO=echo -endif -ifeq ($(OS_TARGET),amiga) -EXEEXT= -PPUEXT=.ppu -ASMEXT=.asm -OEXT=.o -SMARTEXT=.sl -STATICLIBEXT=.a -SHAREDLIBEXT=.library -SHORTSUFFIX=amg -endif -ifeq ($(OS_TARGET),atari) -PPUEXT=.ppu -ASMEXT=.s -OEXT=.o -SMARTEXT=.sl -STATICLIBEXT=.a -EXEEXT=.ttp -SHORTSUFFIX=ata -endif -ifeq ($(OS_TARGET),beos) -BATCHEXT=.sh -PPUEXT=.ppu -ASMEXT=.s -OEXT=.o -SMARTEXT=.sl -STATICLIBEXT=.a -EXEEXT= -SHORTSUFFIX=be -endif -ifeq ($(OS_TARGET),solaris) -BATCHEXT=.sh -PPUEXT=.ppu -ASMEXT=.s -OEXT=.o -SMARTEXT=.sl -STATICLIBEXT=.a -EXEEXT= -SHORTSUFFIX=sun -endif -ifeq ($(OS_TARGET),qnx) -BATCHEXT=.sh -PPUEXT=.ppu -ASMEXT=.s -OEXT=.o -SMARTEXT=.sl -STATICLIBEXT=.a -EXEEXT= -SHORTSUFFIX=qnx -endif -ifeq ($(OS_TARGET),netware) -STATICLIBPREFIX= -PPUEXT=.ppu -OEXT=.o -ASMEXT=.s -SMARTEXT=.sl -STATICLIBEXT=.a -SHAREDLIBEXT=.nlm -EXEEXT=.nlm -SHORTSUFFIX=nw -endif -ifeq ($(OS_TARGET),netwlibc) -STATICLIBPREFIX= -PPUEXT=.ppu -OEXT=.o -ASMEXT=.s -SMARTEXT=.sl -STATICLIBEXT=.a -SHAREDLIBEXT=.nlm -EXEEXT=.nlm -SHORTSUFFIX=nwl -endif -ifeq ($(OS_TARGET),macos) -BATCHEXT= -PPUEXT=.ppu -ASMEXT=.s -OEXT=.o -SMARTEXT=.sl -STATICLIBEXT=.a -EXEEXT= -DEBUGSYMEXT=.xcoff -SHORTSUFFIX=mac -endif -endif -ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),) -FPCMADE=fpcmade.$(SHORTSUFFIX) -ZIPSUFFIX=$(SHORTSUFFIX) -ZIPCROSSPREFIX= -ZIPSOURCESUFFIX=src -ZIPEXAMPLESUFFIX=exm -else -FPCMADE=fpcmade.$(TARGETSUFFIX) -ZIPSOURCESUFFIX=.source -ZIPEXAMPLESUFFIX=.examples -ifdef CROSSCOMPILE -ZIPSUFFIX=.$(SOURCESUFFIX) -ZIPCROSSPREFIX=$(TARGETSUFFIX)- -else -ZIPSUFFIX=.$(TARGETSUFFIX) -ZIPCROSSPREFIX= -endif -endif -ifndef ECHO -ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(ECHO),) -ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(ECHO),) -ECHO= __missing_command_ECHO -else -ECHO:=$(firstword $(ECHO)) -endif -else -ECHO:=$(firstword $(ECHO)) -endif -endif -export ECHO -ifndef DATE -DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(DATE),) -DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(DATE),) -DATE= __missing_command_DATE -else -DATE:=$(firstword $(DATE)) -endif -else -DATE:=$(firstword $(DATE)) -endif -endif -export DATE -ifndef GINSTALL -GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(GINSTALL),) -GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(GINSTALL),) -GINSTALL= __missing_command_GINSTALL -else -GINSTALL:=$(firstword $(GINSTALL)) -endif -else -GINSTALL:=$(firstword $(GINSTALL)) -endif -endif -export GINSTALL -ifndef CPPROG -CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(CPPROG),) -CPPROG= __missing_command_CPPROG -else -CPPROG:=$(firstword $(CPPROG)) -endif -endif -export CPPROG -ifndef RMPROG -RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(RMPROG),) -RMPROG= __missing_command_RMPROG -else -RMPROG:=$(firstword $(RMPROG)) -endif -endif -export RMPROG -ifndef MVPROG -MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(MVPROG),) -MVPROG= __missing_command_MVPROG -else -MVPROG:=$(firstword $(MVPROG)) -endif -endif -export MVPROG -ifndef MKDIRPROG -MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(MKDIRPROG),) -MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(MKDIRPROG),) -MKDIRPROG= __missing_command_MKDIRPROG -else -MKDIRPROG:=$(firstword $(MKDIRPROG)) -endif -else -MKDIRPROG:=$(firstword $(MKDIRPROG)) -endif -endif -export MKDIRPROG -ifndef ECHOREDIR -ifndef inUnix -ECHOREDIR=echo -else -ECHOREDIR=$(ECHO) -endif -endif -ifndef COPY -COPY:=$(CPPROG) -fp -endif -ifndef COPYTREE -COPYTREE:=$(CPPROG) -Rfp -endif -ifndef MKDIRTREE -MKDIRTREE:=$(MKDIRPROG) -p -endif -ifndef MOVE -MOVE:=$(MVPROG) -f -endif -ifndef DEL -DEL:=$(RMPROG) -f -endif -ifndef DELTREE -DELTREE:=$(RMPROG) -rf -endif -ifndef INSTALL -ifdef inUnix -INSTALL:=$(GINSTALL) -c -m 644 -else -INSTALL:=$(COPY) -endif -endif -ifndef INSTALLEXE -ifdef inUnix -INSTALLEXE:=$(GINSTALL) -c -m 755 -else -INSTALLEXE:=$(COPY) -endif -endif -ifndef MKDIR -MKDIR:=$(GINSTALL) -m 755 -d -endif -export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR -ifndef PPUMOVE -PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(PPUMOVE),) -PPUMOVE= __missing_command_PPUMOVE -else -PPUMOVE:=$(firstword $(PPUMOVE)) -endif -endif -export PPUMOVE -ifndef FPCMAKE -FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(FPCMAKE),) -FPCMAKE= __missing_command_FPCMAKE -else -FPCMAKE:=$(firstword $(FPCMAKE)) -endif -endif -export FPCMAKE -ifndef ZIPPROG -ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(ZIPPROG),) -ZIPPROG= __missing_command_ZIPPROG -else -ZIPPROG:=$(firstword $(ZIPPROG)) -endif -endif -export ZIPPROG -ifndef TARPROG -TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(TARPROG),) -TARPROG= __missing_command_TARPROG -else -TARPROG:=$(firstword $(TARPROG)) -endif -endif -export TARPROG -ASNAME=$(BINUTILSPREFIX)as -LDNAME=$(BINUTILSPREFIX)ld -ARNAME=$(BINUTILSPREFIX)ar -RCNAME=$(BINUTILSPREFIX)rc -ifneq ($(findstring 1.0.,$(FPC_VERSION)),) -ifeq ($(OS_TARGET),win32) -ifeq ($(CROSSBINDIR),) -ASNAME=asw -LDNAME=ldw -ARNAME=arw -endif -endif -endif -ifndef ASPROG -ifdef CROSSBINDIR -ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT) -else -ASPROG=$(ASNAME) -endif -endif -ifndef LDPROG -ifdef CROSSBINDIR -LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT) -else -LDPROG=$(LDNAME) -endif -endif -ifndef RCPROG -ifdef CROSSBINDIR -RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT) -else -RCPROG=$(RCNAME) -endif -endif -ifndef ARPROG -ifdef CROSSBINDIR -ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT) -else -ARPROG=$(ARNAME) -endif -endif -AS=$(ASPROG) -LD=$(LDPROG) -RC=$(RCPROG) -AR=$(ARPROG) -PPAS=ppas$(SRCBATCHEXT) -ifdef inUnix -LDCONFIG=ldconfig -else -LDCONFIG= -endif -ifdef DATE -DATESTR:=$(shell $(DATE) +%Y%m%d) -else -DATESTR= -endif -ifndef UPXPROG -ifeq ($(OS_TARGET),go32v2) -UPXPROG:=1 -endif -ifeq ($(OS_TARGET),win32) -UPXPROG:=1 -endif -ifdef UPXPROG -UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(UPXPROG),) -UPXPROG= -else -UPXPROG:=$(firstword $(UPXPROG)) -endif -else -UPXPROG= -endif -endif -export UPXPROG -ZIPOPT=-9 -ZIPEXT=.zip -ifeq ($(USETAR),bz2) -TAROPT=vj -TAREXT=.tar.bz2 -else -TAROPT=vz -TAREXT=.tar.gz -endif -ifndef NOCPUDEF -override FPCOPTDEF=$(CPU_TARGET) -endif -ifneq ($(OS_TARGET),$(OS_SOURCE)) -override FPCOPT+=-T$(OS_TARGET) -endif -ifeq ($(OS_SOURCE),openbsd) -override FPCOPT+=-FD$(NEW_BINUTILS_PATH) -endif -ifndef CROSSBOOTSTRAP -ifneq ($(BINUTILSPREFIX),) -override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc -endif -ifneq ($(BINUTILSPREFIX),) -override FPCOPT+=-Xr$(RLINKPATH) -endif -endif -ifdef UNITDIR -override FPCOPT+=$(addprefix -Fu,$(UNITDIR)) -endif -ifdef LIBDIR -override FPCOPT+=$(addprefix -Fl,$(LIBDIR)) -endif -ifdef OBJDIR -override FPCOPT+=$(addprefix -Fo,$(OBJDIR)) -endif -ifdef INCDIR -override FPCOPT+=$(addprefix -Fi,$(INCDIR)) -endif -ifdef LINKSMART -override FPCOPT+=-XX -endif -ifdef CREATESMART -override FPCOPT+=-CX -endif -ifdef DEBUG -override FPCOPT+=-gl -override FPCOPTDEF+=DEBUG -endif -ifdef RELEASE -ifeq ($(CPU_TARGET),i386) -FPCCPUOPT:=-OG2p3 -else -ifeq ($(CPU_TARGET),powerpc) -FPCCPUOPT:=-O1r -else -FPCCPUOPT:= -endif -endif -override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n -override FPCOPTDEF+=RELEASE -endif -ifdef STRIP -override FPCOPT+=-Xs -endif -ifdef OPTIMIZE -ifeq ($(CPU_TARGET),i386) -override FPCOPT+=-OG2p3 -endif -endif -ifdef VERBOSE -override FPCOPT+=-vwni -endif -ifdef COMPILER_OPTIONS -override FPCOPT+=$(COMPILER_OPTIONS) -endif -ifdef COMPILER_UNITDIR -override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR)) -endif -ifdef COMPILER_LIBRARYDIR -override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR)) -endif -ifdef COMPILER_OBJECTDIR -override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR)) -endif -ifdef COMPILER_INCLUDEDIR -override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR)) -endif -ifdef CROSSBINDIR -override FPCOPT+=-FD$(CROSSBINDIR) -endif -ifdef COMPILER_TARGETDIR -override FPCOPT+=-FE$(COMPILER_TARGETDIR) -ifeq ($(COMPILER_TARGETDIR),.) -override TARGETDIRPREFIX= -else -override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/ -endif -endif -ifdef COMPILER_UNITTARGETDIR -override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR) -ifeq ($(COMPILER_UNITTARGETDIR),.) -override UNITTARGETDIRPREFIX= -else -override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/ -endif -else -ifdef COMPILER_TARGETDIR -override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR) -override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX) -endif -endif -ifeq ($(OS_TARGET),linux) -ifeq ($(FPC_VERSION),1.0.6) -override FPCOPTDEF+=HASUNIX -endif -endif -ifdef OPT -override FPCOPT+=$(OPT) -endif -ifdef FPCOPTDEF -override FPCOPT+=$(addprefix -d,$(FPCOPTDEF)) -endif -ifdef CFGFILE -override FPCOPT+=@$(CFGFILE) -endif -ifdef USEENV -override FPCEXTCMD:=$(FPCOPT) -override FPCOPT:=!FPCEXTCMD -export FPCEXTCMD -endif -override COMPILER:=$(FPC) $(FPCOPT) -ifeq (,$(findstring -s ,$(COMPILER))) -EXECPPAS= -else -ifeq ($(FULL_SOURCE),$(FULL_TARGET)) -EXECPPAS:=@$(PPAS) -endif -endif -.PHONY: fpc_loaders -ifneq ($(TARGET_LOADERS),) -override ALLTARGET+=fpc_loaders -override CLEANTARGET+=fpc_loaders_clean -override INSTALLTARGET+=fpc_loaders_install -override LOADEROFILES:=$(addsuffix $(OEXT),$(TARGET_LOADERS)) -endif -%$(OEXT): %$(LOADEREXT) -ifdef COMPILER_UNITTARGETDIR - $(AS) -o $(COMPILER_UNITTARGETDIR)/$*$(OEXT) $< -else - $(AS) -o $*$(OEXT) $< -endif -fpc_loaders: $(COMPILER_UNITTARGETDIR) $(LOADEROFILES) -fpc_loaders_clean: -ifdef COMPILER_UNITTARGETDIR - -$(DEL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES)) -else - -$(DEL) $(LOADEROFILES) -endif -fpc_loaders_install: - $(MKDIR) $(INSTALL_UNITDIR) -ifdef COMPILER_UNITTARGETDIR - $(INSTALL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES)) $(INSTALL_UNITDIR) -else - $(INSTALL) $(LOADEROFILES) $(INSTALL_UNITDIR) -endif -.PHONY: fpc_units -ifneq ($(TARGET_UNITS),) -override ALLTARGET+=fpc_units -override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS)) -override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS)) -override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES) -override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES) -endif -fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES) -ifdef TARGET_RSTS -override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS)) -override CLEANRSTFILES+=$(RSTFILES) -endif -.PHONY: fpc_all fpc_smart fpc_debug fpc_release -$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET) - @$(ECHOREDIR) Compiled > $(FPCMADE) -fpc_all: $(FPCMADE) -fpc_smart: - $(MAKE) all LINKSMART=1 CREATESMART=1 -fpc_debug: - $(MAKE) all DEBUG=1 -fpc_release: - $(MAKE) all RELEASE=1 -.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res -$(COMPILER_UNITTARGETDIR): - $(MKDIRTREE) $(COMPILER_UNITTARGETDIR) -$(COMPILER_TARGETDIR): - $(MKDIRTREE) $(COMPILER_TARGETDIR) -%$(PPUEXT): %.pp - $(COMPILER) $< - $(EXECPPAS) -%$(PPUEXT): %.pas - $(COMPILER) $< - $(EXECPPAS) -%$(EXEEXT): %.pp - $(COMPILER) $< - $(EXECPPAS) -%$(EXEEXT): %.pas - $(COMPILER) $< - $(EXECPPAS) -%$(EXEEXT): %.lpr - $(COMPILER) $< - $(EXECPPAS) -%$(EXEEXT): %.dpr - $(COMPILER) $< - $(EXECPPAS) -%.res: %.rc - windres -i $< -o $@ -vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) -vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) -vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) -vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) -vpath %$(OEXT) $(COMPILER_UNITTARGETDIR) -vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR) -.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall -ifdef INSTALL_UNITS -override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS)) -endif -ifdef INSTALL_BUILDUNIT -override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES)) -endif -ifdef INSTALLPPUFILES -override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) -ifneq ($(UNITTARGETDIRPREFIX),) -override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES))) -override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES)))) -endif -override INSTALL_CREATEPACKAGEFPC=1 -endif -ifdef INSTALLEXEFILES -ifneq ($(TARGETDIRPREFIX),) -override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES))) -endif -endif -fpc_install: all $(INSTALLTARGET) -ifdef INSTALLEXEFILES - $(MKDIR) $(INSTALL_BINDIR) -ifdef UPXPROG - -$(UPXPROG) $(INSTALLEXEFILES) -endif - $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR) -endif -ifdef INSTALL_CREATEPACKAGEFPC -ifdef FPCMAKE -ifdef PACKAGE_VERSION -ifneq ($(wildcard Makefile.fpc),) - $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc - $(MKDIR) $(INSTALL_UNITDIR) - $(INSTALL) Package.fpc $(INSTALL_UNITDIR) -endif -endif -endif -endif -ifdef INSTALLPPUFILES - $(MKDIR) $(INSTALL_UNITDIR) - $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR) -ifneq ($(INSTALLPPULINKFILES),) - $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR) -endif -ifneq ($(wildcard $(LIB_FULLNAME)),) - $(MKDIR) $(INSTALL_LIBDIR) - $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR) -ifdef inUnix - ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME) -endif -endif -endif -ifdef INSTALL_FILES - $(MKDIR) $(INSTALL_DATADIR) - $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR) -endif -fpc_sourceinstall: distclean - $(MKDIR) $(INSTALL_SOURCEDIR) - $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR) -fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS)) -ifdef HASEXAMPLES - $(MKDIR) $(INSTALL_EXAMPLEDIR) -endif -ifdef EXAMPLESOURCEFILES - $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR) -endif -ifdef TARGET_EXAMPLEDIRS - $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR) -endif -.PHONY: fpc_clean fpc_cleanall fpc_distclean -ifdef EXEFILES -override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES)) -endif -ifdef CLEAN_UNITS -override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS)) -endif -ifdef CLEANPPUFILES -override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) -ifdef DEBUGSYMEXT -override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES)) -endif -override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES)) -override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES))) -endif -fpc_clean: $(CLEANTARGET) -ifdef CLEANEXEFILES - -$(DEL) $(CLEANEXEFILES) -endif -ifdef CLEANPPUFILES - -$(DEL) $(CLEANPPUFILES) -endif -ifneq ($(CLEANPPULINKFILES),) - -$(DEL) $(CLEANPPULINKFILES) -endif -ifdef CLEANRSTFILES - -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES)) -endif -ifdef CLEAN_FILES - -$(DEL) $(CLEAN_FILES) -endif -ifdef LIB_NAME - -$(DEL) $(LIB_NAME) $(LIB_FULLNAME) -endif - -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE) - -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT) -fpc_cleanall: $(CLEANTARGET) -ifdef CLEANEXEFILES - -$(DEL) $(CLEANEXEFILES) -endif -ifdef COMPILER_UNITTARGETDIR -ifdef CLEANPPUFILES - -$(DEL) $(CLEANPPUFILES) -endif -ifneq ($(CLEANPPULINKFILES),) - -$(DEL) $(CLEANPPULINKFILES) -endif -ifdef CLEANRSTFILES - -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES)) -endif -endif - -$(DELTREE) units - -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT) -ifneq ($(PPUEXT),.ppu) - -$(DEL) *.o *.ppu *.a -endif - -$(DELTREE) *$(SMARTEXT) - -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE) - -$(DEL) *_ppas$(BATCHEXT) -ifdef AOUTEXT - -$(DEL) *$(AOUTEXT) -endif -ifdef DEBUGSYMEXT - -$(DEL) *$(DEBUGSYMEXT) -endif -fpc_distclean: cleanall -.PHONY: fpc_baseinfo -override INFORULES+=fpc_baseinfo -fpc_baseinfo: - @$(ECHO) - @$(ECHO) == Package info == - @$(ECHO) Package Name..... $(PACKAGE_NAME) - @$(ECHO) Package Version.. $(PACKAGE_VERSION) - @$(ECHO) - @$(ECHO) == Configuration info == - @$(ECHO) - @$(ECHO) FPC.......... $(FPC) - @$(ECHO) FPC Version.. $(FPC_VERSION) - @$(ECHO) Source CPU... $(CPU_SOURCE) - @$(ECHO) Target CPU... $(CPU_TARGET) - @$(ECHO) Source OS.... $(OS_SOURCE) - @$(ECHO) Target OS.... $(OS_TARGET) - @$(ECHO) Full Source.. $(FULL_SOURCE) - @$(ECHO) Full Target.. $(FULL_TARGET) - @$(ECHO) SourceSuffix. $(SOURCESUFFIX) - @$(ECHO) TargetSuffix. $(TARGETSUFFIX) - @$(ECHO) - @$(ECHO) == Directory info == - @$(ECHO) - @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES) - @$(ECHO) - @$(ECHO) Basedir......... $(BASEDIR) - @$(ECHO) FPCDir.......... $(FPCDIR) - @$(ECHO) CrossBinDir..... $(CROSSBINDIR) - @$(ECHO) UnitsDir........ $(UNITSDIR) - @$(ECHO) PackagesDir..... $(PACKAGESDIR) - @$(ECHO) - @$(ECHO) GCC library..... $(GCCLIBDIR) - @$(ECHO) Other library... $(OTHERLIBDIR) - @$(ECHO) - @$(ECHO) == Tools info == - @$(ECHO) - @$(ECHO) As........ $(AS) - @$(ECHO) Ld........ $(LD) - @$(ECHO) Ar........ $(AR) - @$(ECHO) Rc........ $(RC) - @$(ECHO) - @$(ECHO) Mv........ $(MVPROG) - @$(ECHO) Cp........ $(CPPROG) - @$(ECHO) Rm........ $(RMPROG) - @$(ECHO) GInstall.. $(GINSTALL) - @$(ECHO) Echo...... $(ECHO) - @$(ECHO) Shell..... $(SHELL) - @$(ECHO) Date...... $(DATE) - @$(ECHO) FPCMake... $(FPCMAKE) - @$(ECHO) PPUMove... $(PPUMOVE) - @$(ECHO) Upx....... $(UPXPROG) - @$(ECHO) Zip....... $(ZIPPROG) - @$(ECHO) - @$(ECHO) == Object info == - @$(ECHO) - @$(ECHO) Target Loaders........ $(TARGET_LOADERS) - @$(ECHO) Target Units.......... $(TARGET_UNITS) - @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS) - @$(ECHO) Target Programs....... $(TARGET_PROGRAMS) - @$(ECHO) Target Dirs........... $(TARGET_DIRS) - @$(ECHO) Target Examples....... $(TARGET_EXAMPLES) - @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS) - @$(ECHO) - @$(ECHO) Clean Units......... $(CLEAN_UNITS) - @$(ECHO) Clean Files......... $(CLEAN_FILES) - @$(ECHO) - @$(ECHO) Install Units....... $(INSTALL_UNITS) - @$(ECHO) Install Files....... $(INSTALL_FILES) - @$(ECHO) - @$(ECHO) == Install info == - @$(ECHO) - @$(ECHO) DateStr.............. $(DATESTR) - @$(ECHO) ZipName.............. $(ZIPNAME) - @$(ECHO) ZipPrefix............ $(ZIPPREFIX) - @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX) - @$(ECHO) ZipSuffix............ $(ZIPSUFFIX) - @$(ECHO) FullZipName.......... $(FULLZIPNAME) - @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE) - @$(ECHO) - @$(ECHO) Install base dir..... $(INSTALL_BASEDIR) - @$(ECHO) Install binary dir... $(INSTALL_BINDIR) - @$(ECHO) Install library dir.. $(INSTALL_LIBDIR) - @$(ECHO) Install units dir.... $(INSTALL_UNITDIR) - @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR) - @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR) - @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR) - @$(ECHO) Install data dir..... $(INSTALL_DATADIR) - @$(ECHO) - @$(ECHO) Dist destination dir. $(DIST_DESTDIR) - @$(ECHO) Dist zip name........ $(DIST_ZIPNAME) - @$(ECHO) -.PHONY: fpc_info -fpc_info: $(INFORULES) -.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \ - fpc_makefile_dirs -fpc_makefile: - $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc -fpc_makefile_sub1: -ifdef TARGET_DIRS - $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS)) -endif -ifdef TARGET_EXAMPLEDIRS - $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS)) -endif -fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS)) -fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2 -fpc_makefiles: fpc_makefile fpc_makefile_dirs -all: fpc_all -debug: fpc_debug -smart: fpc_smart -release: fpc_release -units: fpc_units -examples: -shared: -install: fpc_install -sourceinstall: fpc_sourceinstall -exampleinstall: fpc_exampleinstall -distinstall: -zipinstall: -zipsourceinstall: -zipexampleinstall: -zipdistinstall: -clean: fpc_clean -distclean: fpc_distclean -cleanall: fpc_cleanall -info: fpc_info -makefiles: fpc_makefiles -.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles -ifneq ($(wildcard fpcmake.loc),) -include fpcmake.loc -endif -SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT)) -include $(INC)/makefile.inc -SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES)) -include $(PROCINC)/makefile.cpu -SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES)) -SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS) -wprt0$(OEXT) : $(PRT0).as - $(AS) -o $(UNITTARGETDIRPREFIX)wprt0$(OEXT) $(PRT0).as -gprt0$(OEXT) : gprt0.as -wdllprt0$(OEXT) : wdllprt0.as -wcygprt0$(OEXT) : wcygprt0.as -$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS) - $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp -Fi..\win -objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp -strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\ - $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\ - $(SYSTEMUNIT)$(PPUEXT) -windows$(PPUEXT) : windows.pp $(WINDOWS_SOURCE_FILES) $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) -I$(WININC) windows.pp -messages$(PPUEXT): messages.pp $(WININC)/messages.inc $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) -I$(WININC) messages.pp -opengl32$(PPUEXT) : opengl32.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) -winsock$(PPUEXT) : winsock.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) -sockets$(PPUEXT) : sockets.pp windows$(PPUEXT) winsock$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \ - $(INC)/sockets.inc $(INC)/socketsh.inc -initc$(PPUEXT) : initc.pp $(SYSTEMUNIT)$(PPUEXT) -wincrt$(PPUEXT) : wincrt.pp $(SYSTEMUNIT)$(PPUEXT) windows$(PPUEXT) graph$(PPUEXT) -winmouse$(PPUEXT) : winmouse.pp $(SYSTEMUNIT)$(PPUEXT) windows$(PPUEXT) graph$(PPUEXT) -dynlibs$(PPUEXT) : $(INC)/dynlibs.pp windows$(PPUEXT) -dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) -crt$(PPUEXT) : crt.pp $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) -objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT) -include $(GRAPHDIR)/makefile.inc -GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES)) -graph$(PPUEXT) : graph.pp strings$(PPUEXT) windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \ - $(GRAPHINCDEPS) - $(COMPILER) -I$(GRAPHDIR) graph.pp -sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \ - objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) sysconst$(PPUEXT) - $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp -classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \ - sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) sysconst$(PPUEXT) - $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp -winsysut$(PPUEXT) : winsysut.pp sysutils$(PPUEXT) - $(COMPILER) winsysut.pp -typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) - $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp -math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT) - $(COMPILER) $(OBJPASDIR)/math.pp -varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \ - $(OBJPASDIR)/varutilh.inc varutils.pp sysutils$(PPUEXT) - $(COMPILER) -Fi$(OBJPASDIR) varutils.pp -variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) sysutils$(PPUEXT) sysconst$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) - $(COMPILER) -Fi$(INC) $(INC)/variants.pp -types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) $(OBJPASDIR)/types.pp -rtlconsts$(PPUEXT) : objpas$(PPUEXT) $(OBJPASDIR)/rtlconsts.pp - $(COMPILER) $(OBJPASDIR)/rtlconsts.pp -sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) $(OBJPASDIR)/sysconst.pp -dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp -convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/convutils.pp -strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/strutils.pp -macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) $(INC)/macpas.pp $(REDIR) -cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT) -mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) -getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT) -heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) -Sg $(INC)/heaptrc.pp -lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) -charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT) -cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT) -ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) -callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT) -ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT) -variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) typinfo$(PPUEXT) diff --git a/rtl/win64/Makefile.fpc b/rtl/win64/Makefile.fpc deleted file mode 100644 index 9eef363619..0000000000 --- a/rtl/win64/Makefile.fpc +++ /dev/null @@ -1,241 +0,0 @@ -# -# Makefile.fpc for Free Pascal Win64 RTL -# - -[package] -main=rtl - -[target] -loaders= #wprt0 wdllprt0 gprt0 wcygprt0 -units=$(SYSTEMUNIT) # ctypes objpas macpas strings \ -# lineinfo heaptrc matrix \ -# windows winsock initc cmem dynlibs signals \ -# dos crt objects graph messages \ -# rtlconsts sysconst sysutils math types \ -# strutils convutils dateutils varutils variants typinfo classes \ -# cpu mmx charset ucomplex getopts \ -# wincrt winmouse winevent sockets printer \ -# video mouse keyboard \ -# winsysut fpmkunit - -rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit - -[require] -nortl=y - -[install] -fpcpackage=y - -[default] -fpcdir=../.. -target=win64 - -[compiler] -includedir=$(INC) $(PROCINC) $(RTL)/win -sourcedir=$(INC) $(PROCINC) - - -[prerules] -RTL=.. -INC=$(RTL)/inc -PROCINC=$(RTL)/$(CPU_TARGET) -WININC=wininc - -UNITPREFIX=rtl - -SYSTEMUNIT=system -PRT0=wprt0 - -# Use new feature from 1.0.5 version -# that generates release PPU files -# which will not be recompiled -ifdef RELEASE -override FPCOPT+=-Ur -endif - -# Paths -OBJPASDIR=$(RTL)/objpas -GRAPHDIR=$(INC)/graph - -# Files used by windows.pp -# include $(WININC)/makefile.inc - -WINDOWS_SOURCE_FILES=$(addprefix $(WININC)/,$(addsuffix .inc,$(WINDOWS_FILES))) - - -[rules] -SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT)) - -# Get the system independent include file names. -# This will set the following variables : -# SYSINCNAMES -include $(INC)/makefile.inc -SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES)) - -# Get the processor dependent include file names. -# This will set the following variables : -# CPUINCNAMES -include $(PROCINC)/makefile.cpu -SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES)) - -# Put system unit dependencies together. -SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS) - - -# -# Loaders -# - -wprt0$(OEXT) : $(PRT0).as - $(AS) -o $(UNITTARGETDIRPREFIX)wprt0$(OEXT) $(PRT0).as - -gprt0$(OEXT) : gprt0.as - -wdllprt0$(OEXT) : wdllprt0.as - -wcygprt0$(OEXT) : wcygprt0.as - -# -# System Units (System, Objpas, Strings) -# - -$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS) - $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp -Fi..\win - -objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp - -strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\ - $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\ - $(SYSTEMUNIT)$(PPUEXT) - -# -# System Dependent Units -# - -windows$(PPUEXT) : windows.pp $(WINDOWS_SOURCE_FILES) $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) -I$(WININC) windows.pp - -messages$(PPUEXT): messages.pp $(WININC)/messages.inc $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) -I$(WININC) messages.pp - -opengl32$(PPUEXT) : opengl32.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - -winsock$(PPUEXT) : winsock.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - -sockets$(PPUEXT) : sockets.pp windows$(PPUEXT) winsock$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \ - $(INC)/sockets.inc $(INC)/socketsh.inc - -initc$(PPUEXT) : initc.pp $(SYSTEMUNIT)$(PPUEXT) - -wincrt$(PPUEXT) : wincrt.pp $(SYSTEMUNIT)$(PPUEXT) windows$(PPUEXT) graph$(PPUEXT) - -winmouse$(PPUEXT) : winmouse.pp $(SYSTEMUNIT)$(PPUEXT) windows$(PPUEXT) graph$(PPUEXT) - -dynlibs$(PPUEXT) : $(INC)/dynlibs.pp windows$(PPUEXT) - -# -# TP7 Compatible RTL Units -# - -dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - -crt$(PPUEXT) : crt.pp $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) - -objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT) - -# -# Graph -# - -include $(GRAPHDIR)/makefile.inc -GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES)) - -graph$(PPUEXT) : graph.pp strings$(PPUEXT) windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \ - $(GRAPHINCDEPS) - $(COMPILER) -I$(GRAPHDIR) graph.pp - - -# -# Delphi Compatible Units -# - -sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \ - objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) sysconst$(PPUEXT) - $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp - -classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \ - sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) sysconst$(PPUEXT) - $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp - -winsysut$(PPUEXT) : winsysut.pp sysutils$(PPUEXT) - $(COMPILER) winsysut.pp - -typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) - $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp - -math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT) - $(COMPILER) $(OBJPASDIR)/math.pp - -varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \ - $(OBJPASDIR)/varutilh.inc varutils.pp sysutils$(PPUEXT) - $(COMPILER) -Fi$(OBJPASDIR) varutils.pp - -variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) sysutils$(PPUEXT) sysconst$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) - $(COMPILER) -Fi$(INC) $(INC)/variants.pp - -types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) $(OBJPASDIR)/types.pp - -rtlconsts$(PPUEXT) : objpas$(PPUEXT) $(OBJPASDIR)/rtlconsts.pp - $(COMPILER) $(OBJPASDIR)/rtlconsts.pp - -sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) $(OBJPASDIR)/sysconst.pp - -dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp - -convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/convutils.pp - -strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/strutils.pp - -# -# Mac Pascal Model -# - -macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) $(INC)/macpas.pp $(REDIR) - -# -# Other system-independent RTL Units -# - -cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT) - -mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - -getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT) - -heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) -Sg $(INC)/heaptrc.pp - -lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) - -charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT) - -cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT) - -ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - -# -# Other system-dependent RTL Units -# - -callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT) - -ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT) - -variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) typinfo$(PPUEXT) diff --git a/rtl/win64/system.pp b/rtl/win64/system.pp deleted file mode 100644 index 84259b54e7..0000000000 --- a/rtl/win64/system.pp +++ /dev/null @@ -1,1106 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski - member of the Free Pascal development team. - - FPC Pascal system unit for the Win32 API. - - 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 System; -interface - -{$ifdef SYSTEMDEBUG} - {$define SYSTEMEXCEPTIONDEBUG} -{$endif SYSTEMDEBUG} - -{$ifdef cpui386} - {$define Set_i386_Exception_handler} -{$endif cpui386} - -{ include system-independent routine headers } -{$I systemh.inc} - -const - LineEnding = #13#10; - LFNSupport = true; - DirectorySeparator = '\'; - DriveSeparator = ':'; - PathSeparator = ';'; -{ FileNameCaseSensitive is defined separately below!!! } - maxExitCode = 65535; - MaxPathLen = 260; - -type - PEXCEPTION_FRAME = ^TEXCEPTION_FRAME; - TEXCEPTION_FRAME = record - next : PEXCEPTION_FRAME; - handler : pointer; - end; - -const -{ Default filehandles } - UnusedHandle : THandle = -1; - StdInputHandle : THandle = 0; - StdOutputHandle : THandle = 0; - StdErrorHandle : THandle = 0; - - FileNameCaseSensitive : boolean = true; - CtrlZMarksEOF: boolean = true; (* #26 not considered as end of file *) - - sLineBreak = LineEnding; - DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF; - - { Thread count for DLL } - Thread_count : longint = 0; - System_exception_frame : PEXCEPTION_FRAME =nil; - -type - TStartupInfo=packed record - cb : longint; - lpReserved : Pointer; - lpDesktop : Pointer; - lpTitle : Pointer; - dwX : longint; - dwY : longint; - dwXSize : longint; - dwYSize : longint; - dwXCountChars : longint; - dwYCountChars : longint; - dwFillAttribute : longint; - dwFlags : longint; - wShowWindow : Word; - cbReserved2 : Word; - lpReserved2 : Pointer; - hStdInput : longint; - hStdOutput : longint; - hStdError : longint; - end; - -var -{ C compatible arguments } - argc : longint; - argv : ppchar; -{ Win32 Info } - startupinfo : tstartupinfo; - hprevinst, - HInstance, - MainInstance, - cmdshow : longint; - DLLreason,DLLparam:longint; - Win32StackTop : Dword; - -type - TDLL_Process_Entry_Hook = function (dllparam : longint) : longbool; - TDLL_Entry_Hook = procedure (dllparam : longint); - -const - Dll_Process_Attach_Hook : TDLL_Process_Entry_Hook = nil; - Dll_Process_Detach_Hook : TDLL_Entry_Hook = nil; - Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil; - Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil; - -type - HMODULE = THandle; - -implementation - -{ include system independent routines } -{$I system.inc} - -{***************************************************************************** - Parameter Handling -*****************************************************************************} - -var - ModuleName : array[0..255] of char; - -function GetCommandFile:pchar; -begin - GetModuleFileName(0,@ModuleName,255); - GetCommandFile:=@ModuleName; -end; - - -procedure setup_arguments; -var - arglen, - count : longint; - argstart, - pc,arg : pchar; - quote : char; - argvlen : longint; - - procedure allocarg(idx,len:longint); - var - oldargvlen : longint; - begin - if idx>=argvlen then - begin - oldargvlen:=argvlen; - argvlen:=(idx+8) and (not 7); - sysreallocmem(argv,argvlen*sizeof(pointer)); - fillchar(argv[oldargvlen],(argvlen-oldargvlen)*sizeof(pointer),0); - end; - { use realloc to reuse already existing memory } - { always allocate, even if length is zero, since } - { the arg. is still present! } - sysreallocmem(argv[idx],len+1); - end; - -begin - { create commandline, it starts with the executed filename which is argv[0] } - { Win32 passes the command NOT via the args, but via getmodulefilename} - count:=0; - argv:=nil; - argvlen:=0; - pc:=getcommandfile; - Arglen:=0; - repeat - Inc(Arglen); - until (pc[Arglen]=#0); - allocarg(count,arglen); - move(pc^,argv[count]^,arglen); - { Setup cmdline variable } - cmdline:=GetCommandLine; - { process arguments } - pc:=cmdline; -{$IfDef SYSTEM_DEBUG_STARTUP} - Writeln(stderr,'Win32 GetCommandLine is #',pc,'#'); -{$EndIf } - while pc^<>#0 do - begin - { skip leading spaces } - while pc^ in [#1..#32] do - inc(pc); - if pc^=#0 then - break; - { calc argument length } - quote:=' '; - argstart:=pc; - arglen:=0; - while (pc^<>#0) do - begin - case pc^ of - #1..#32 : - begin - if quote<>' ' then - inc(arglen) - else - break; - end; - '"' : - begin - if quote<>'''' then - begin - if pchar(pc+1)^<>'"' then - begin - if quote='"' then - quote:=' ' - else - quote:='"'; - end - else - inc(pc); - end - else - inc(arglen); - end; - '''' : - begin - if quote<>'"' then - begin - if pchar(pc+1)^<>'''' then - begin - if quote='''' then - quote:=' ' - else - quote:=''''; - end - else - inc(pc); - end - else - inc(arglen); - end; - else - inc(arglen); - end; - inc(pc); - end; - { copy argument } - { Don't copy the first one, it is already there.} - If Count<>0 then - begin - allocarg(count,arglen); - quote:=' '; - pc:=argstart; - arg:=argv[count]; - while (pc^<>#0) do - begin - case pc^ of - #1..#32 : - begin - if quote<>' ' then - begin - arg^:=pc^; - inc(arg); - end - else - break; - end; - '"' : - begin - if quote<>'''' then - begin - if pchar(pc+1)^<>'"' then - begin - if quote='"' then - quote:=' ' - else - quote:='"'; - end - else - inc(pc); - end - else - begin - arg^:=pc^; - inc(arg); - end; - end; - '''' : - begin - if quote<>'"' then - begin - if pchar(pc+1)^<>'''' then - begin - if quote='''' then - quote:=' ' - else - quote:=''''; - end - else - inc(pc); - end - else - begin - arg^:=pc^; - inc(arg); - end; - end; - else - begin - arg^:=pc^; - inc(arg); - end; - end; - inc(pc); - end; - arg^:=#0; - end; - {$IfDef SYSTEM_DEBUG_STARTUP} - Writeln(stderr,'dos arg ',count,' #',arglen,'#',argv[count],'#'); - {$EndIf SYSTEM_DEBUG_STARTUP} - inc(count); - end; - { get argc and create an nil entry } - argc:=count; - allocarg(argc,0); - { free unused memory } - sysreallocmem(argv,(argc+1)*sizeof(pointer)); -end; - - -function paramcount : longint; -begin - paramcount := argc - 1; -end; - -function paramstr(l : longint) : string; -begin - if (l>=0) and (l<argc) then - paramstr:=strpas(argv[l]) - else - paramstr:=''; -end; - - -procedure randomize; -begin - randseed:=GetTickCount; -end; - - -{***************************************************************************** - System Dependent Exit code -*****************************************************************************} - -procedure install_exception_handlers;forward; -procedure remove_exception_handlers;forward; -procedure PascalMain;stdcall;external name 'PASCALMAIN'; -procedure fpc_do_exit;stdcall;external name 'FPC_DO_EXIT'; -Procedure ExitDLL(Exitcode : longint); forward; -procedure asm_exit(Exitcode : longint);external name 'asm_exit'; - -Procedure system_exit; -begin - { don't call ExitProcess inside - the DLL exit code !! - This crashes Win95 at least PM } - if IsLibrary then - ExitDLL(ExitCode); - if not IsConsole then - begin - Close(stderr); - Close(stdout); - { what about Input and Output ?? PM } - end; - remove_exception_handlers; - - { call exitprocess, with cleanup as required } - asm_exit(exitcode); -end; - -var - { value of the stack segment - to check if the call stack can be written on exceptions } - _SS : Cardinal; - -procedure Exe_entry;[public, alias : '_FPC_EXE_Entry']; - begin - IsLibrary:=false; - { install the handlers for exe only ? - or should we install them for DLL also ? (PM) } - install_exception_handlers; - { This strange construction is needed to solve the _SS problem - with a smartlinked syswin32 (PFV) } - asm -{!!!!!!! - { allocate space for an exception frame } - pushl $0 - pushl %fs:(0) - { movl %esp,%fs:(0) - but don't insert it as it doesn't - point to anything yet - this will be used in signals unit } - movl %esp,%eax - movl %eax,System_exception_frame - pushl %ebp - xorl %ebp,%ebp - movl %esp,%eax - movl %eax,Win32StackTop - movw %ss,%bp - movl %ebp,_SS - call SysResetFPU - xorl %ebp,%ebp - call PASCALMAIN - popl %ebp -} - end; - { if we pass here there was no error ! } - system_exit; - end; - -Const - { DllEntryPoint } - DLL_PROCESS_ATTACH = 1; - DLL_THREAD_ATTACH = 2; - DLL_PROCESS_DETACH = 0; - DLL_THREAD_DETACH = 3; -Var - DLLBuf : Jmp_buf; -Const - DLLExitOK : boolean = true; - -function Dll_entry : longbool;[public, alias : '_FPC_DLL_Entry']; -var - res : longbool; - - begin - IsLibrary:=true; - Dll_entry:=false; - case DLLreason of - DLL_PROCESS_ATTACH : - begin - If SetJmp(DLLBuf) = 0 then - begin - if assigned(Dll_Process_Attach_Hook) then - begin - res:=Dll_Process_Attach_Hook(DllParam); - if not res then - exit(false); - end; - PASCALMAIN; - Dll_entry:=true; - end - else - Dll_entry:=DLLExitOK; - end; - DLL_THREAD_ATTACH : - begin - inc(Thread_count); -{$warning Allocate Threadvars !} - if assigned(Dll_Thread_Attach_Hook) then - Dll_Thread_Attach_Hook(DllParam); - Dll_entry:=true; { return value is ignored } - end; - DLL_THREAD_DETACH : - begin - dec(Thread_count); - if assigned(Dll_Thread_Detach_Hook) then - Dll_Thread_Detach_Hook(DllParam); -{$warning Release Threadvars !} - Dll_entry:=true; { return value is ignored } - end; - DLL_PROCESS_DETACH : - begin - Dll_entry:=true; { return value is ignored } - If SetJmp(DLLBuf) = 0 then - begin - FPC_DO_EXIT; - end; - if assigned(Dll_Process_Detach_Hook) then - Dll_Process_Detach_Hook(DllParam); - end; - end; - end; - -Procedure ExitDLL(Exitcode : longint); -begin - DLLExitOK:=ExitCode=0; - LongJmp(DLLBuf,1); -end; - -function GetCurrentProcess : dword; - stdcall;external 'kernel32' name 'GetCurrentProcess'; - -function ReadProcessMemory(process : dword;address : pointer;dest : pointer;size : dword;bytesread : pdword) : longbool; - stdcall;external 'kernel32' name 'ReadProcessMemory'; - -function is_prefetch(p : pointer) : boolean; - var - a : array[0..15] of byte; - doagain : boolean; - instrlo,instrhi,opcode : byte; - i : longint; - begin - result:=false; - { read memory savely without causing another exeception } - if not(ReadProcessMemory(GetCurrentProcess,p,@a,sizeof(a),nil)) then - exit; - i:=0; - doagain:=true; - while doagain and (i<15) do - begin - opcode:=a[i]; - instrlo:=opcode and $f; - instrhi:=opcode and $f0; - case instrhi of - { prefix? } - $20,$30: - doagain:=(instrlo and 7)=6; - $60: - doagain:=(instrlo and $c)=4; - $f0: - doagain:=instrlo in [0,2,3]; - $0: - begin - result:=(instrlo=$f) and (a[i+1] in [$d,$18]); - exit; - end; - else - doagain:=false; - end; - inc(i); - end; - end; - - -// -// Hardware exception handling -// - -{$ifdef Set_i386_Exception_handler} - -{ - Error code definitions for the Win32 API functions - - - Values are 32 bit values layed out as follows: - 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 - 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 - +---+-+-+-----------------------+-------------------------------+ - |Sev|C|R| Facility | Code | - +---+-+-+-----------------------+-------------------------------+ - - where - Sev - is the severity code - 00 - Success - 01 - Informational - 10 - Warning - 11 - Error - - C - is the Customer code flag - R - is a reserved bit - Facility - is the facility code - Code - is the facility's status code -} - -const - SEVERITY_SUCCESS = $00000000; - SEVERITY_INFORMATIONAL = $40000000; - SEVERITY_WARNING = $80000000; - SEVERITY_ERROR = $C0000000; - -const - STATUS_SEGMENT_NOTIFICATION = $40000005; - DBG_TERMINATE_THREAD = $40010003; - DBG_TERMINATE_PROCESS = $40010004; - DBG_CONTROL_C = $40010005; - DBG_CONTROL_BREAK = $40010008; - - STATUS_GUARD_PAGE_VIOLATION = $80000001; - STATUS_DATATYPE_MISALIGNMENT = $80000002; - STATUS_BREAKPOINT = $80000003; - STATUS_SINGLE_STEP = $80000004; - DBG_EXCEPTION_NOT_HANDLED = $80010001; - - STATUS_ACCESS_VIOLATION = $C0000005; - STATUS_IN_PAGE_ERROR = $C0000006; - STATUS_INVALID_HANDLE = $C0000008; - STATUS_NO_MEMORY = $C0000017; - STATUS_ILLEGAL_INSTRUCTION = $C000001D; - STATUS_NONCONTINUABLE_EXCEPTION = $C0000025; - STATUS_INVALID_DISPOSITION = $C0000026; - STATUS_ARRAY_BOUNDS_EXCEEDED = $C000008C; - STATUS_FLOAT_DENORMAL_OPERAND = $C000008D; - STATUS_FLOAT_DIVIDE_BY_ZERO = $C000008E; - STATUS_FLOAT_INEXACT_RESULT = $C000008F; - STATUS_FLOAT_INVALID_OPERATION = $C0000090; - STATUS_FLOAT_OVERFLOW = $C0000091; - STATUS_FLOAT_STACK_CHECK = $C0000092; - STATUS_FLOAT_UNDERFLOW = $C0000093; - STATUS_INTEGER_DIVIDE_BY_ZERO = $C0000094; - STATUS_INTEGER_OVERFLOW = $C0000095; - STATUS_PRIVILEGED_INSTRUCTION = $C0000096; - STATUS_STACK_OVERFLOW = $C00000FD; - STATUS_CONTROL_C_EXIT = $C000013A; - STATUS_FLOAT_MULTIPLE_FAULTS = $C00002B4; - STATUS_FLOAT_MULTIPLE_TRAPS = $C00002B5; - STATUS_REG_NAT_CONSUMPTION = $C00002C9; - - EXCEPTION_EXECUTE_HANDLER = 1; - EXCEPTION_CONTINUE_EXECUTION = -1; - EXCEPTION_CONTINUE_SEARCH = 0; - - EXCEPTION_MAXIMUM_PARAMETERS = 15; - - CONTEXT_X86 = $00010000; - CONTEXT_CONTROL = CONTEXT_X86 or $00000001; - CONTEXT_INTEGER = CONTEXT_X86 or $00000002; - CONTEXT_SEGMENTS = CONTEXT_X86 or $00000004; - CONTEXT_FLOATING_POINT = CONTEXT_X86 or $00000008; - CONTEXT_DEBUG_REGISTERS = CONTEXT_X86 or $00000010; - CONTEXT_EXTENDED_REGISTERS = CONTEXT_X86 or $00000020; - - CONTEXT_FULL = CONTEXT_CONTROL or CONTEXT_INTEGER or CONTEXT_SEGMENTS; - - MAXIMUM_SUPPORTED_EXTENSION = 512; - -type - PFloatingSaveArea = ^TFloatingSaveArea; - TFloatingSaveArea = packed record - ControlWord : Cardinal; - StatusWord : Cardinal; - TagWord : Cardinal; - ErrorOffset : Cardinal; - ErrorSelector : Cardinal; - DataOffset : Cardinal; - DataSelector : Cardinal; - RegisterArea : array[0..79] of Byte; - Cr0NpxState : Cardinal; - end; - - PContext = ^TContext; - TContext = packed record - // - // The flags values within this flag control the contents of - // a CONTEXT record. - // - ContextFlags : Cardinal; - - // - // This section is specified/returned if CONTEXT_DEBUG_REGISTERS is - // set in ContextFlags. Note that CONTEXT_DEBUG_REGISTERS is NOT - // included in CONTEXT_FULL. - // - Dr0, Dr1, Dr2, - Dr3, Dr6, Dr7 : Cardinal; - - // - // This section is specified/returned if the - // ContextFlags word contains the flag CONTEXT_FLOATING_POINT. - // - FloatSave : TFloatingSaveArea; - - // - // This section is specified/returned if the - // ContextFlags word contains the flag CONTEXT_SEGMENTS. - // - SegGs, SegFs, - SegEs, SegDs : Cardinal; - - // - // This section is specified/returned if the - // ContextFlags word contains the flag CONTEXT_INTEGER. - // - Edi, Esi, Ebx, - Edx, Ecx, Eax : Cardinal; - - // - // This section is specified/returned if the - // ContextFlags word contains the flag CONTEXT_CONTROL. - // - Ebp : Cardinal; - Eip : Cardinal; - SegCs : Cardinal; - EFlags, Esp, SegSs : Cardinal; - - // - // This section is specified/returned if the ContextFlags word - // contains the flag CONTEXT_EXTENDED_REGISTERS. - // The format and contexts are processor specific - // - ExtendedRegisters : array[0..MAXIMUM_SUPPORTED_EXTENSION-1] of Byte; - end; - -type - PExceptionRecord = ^TExceptionRecord; - TExceptionRecord = packed record - ExceptionCode : Longint; - ExceptionFlags : Longint; - ExceptionRecord : PExceptionRecord; - ExceptionAddress : Pointer; - NumberParameters : Longint; - ExceptionInformation : array[0..EXCEPTION_MAXIMUM_PARAMETERS-1] of Pointer; - end; - - PExceptionPointers = ^TExceptionPointers; - TExceptionPointers = packed record - ExceptionRecord : PExceptionRecord; - ContextRecord : PContext; - end; - -{ type of functions that should be used for exception handling } - TTopLevelExceptionFilter = function (excep : PExceptionPointers) : Longint;stdcall; - -function SetUnhandledExceptionFilter(lpTopLevelExceptionFilter : TTopLevelExceptionFilter) : TTopLevelExceptionFilter; - stdcall;external 'kernel32' name 'SetUnhandledExceptionFilter'; - -const - MaxExceptionLevel = 16; - exceptLevel : Byte = 0; - -var - exceptEip : array[0..MaxExceptionLevel-1] of Longint; - exceptError : array[0..MaxExceptionLevel-1] of Byte; - resetFPU : array[0..MaxExceptionLevel-1] of Boolean; - -{$ifdef SYSTEMEXCEPTIONDEBUG} -procedure DebugHandleErrorAddrFrame(error, addr, frame : longint); -begin - if IsConsole then - begin - write(stderr,'HandleErrorAddrFrame(error=',error); - write(stderr,',addr=',hexstr(addr,8)); - writeln(stderr,',frame=',hexstr(frame,8),')'); - end; - HandleErrorAddrFrame(error,addr,frame); -end; -{$endif SYSTEMEXCEPTIONDEBUG} - -procedure JumpToHandleErrorFrame; -var - eip, ebp, error : Longint; -begin - // save ebp - asm - movl (%ebp),%eax - movl %eax,ebp - end; - if (exceptLevel > 0) then - dec(exceptLevel); - - eip:=exceptEip[exceptLevel]; - error:=exceptError[exceptLevel]; -{$ifdef SYSTEMEXCEPTIONDEBUG} - if IsConsole then - writeln(stderr,'In JumpToHandleErrorFrame error=',error); -{$endif SYSTEMEXCEPTIONDEBUG} - if resetFPU[exceptLevel] then asm - fninit - fldcw fpucw - end; - { build a fake stack } - asm -{$ifdef REGCALL} - movl ebp,%ecx - movl eip,%edx - movl error,%eax - pushl eip - movl ebp,%ebp // Change frame pointer -{$else} - movl ebp,%eax - pushl %eax - movl eip,%eax - pushl %eax - movl error,%eax - pushl %eax - movl eip,%eax - pushl %eax - movl ebp,%ebp // Change frame pointer -{$endif} - -{$ifdef SYSTEMEXCEPTIONDEBUG} - jmpl DebugHandleErrorAddrFrame -{$else not SYSTEMEXCEPTIONDEBUG} - jmpl HandleErrorAddrFrame -{$endif SYSTEMEXCEPTIONDEBUG} - end; -end; - -function syswin32_i386_exception_handler(excep : PExceptionPointers) : Longint;stdcall; -var - frame, - res : longint; - -function SysHandleErrorFrame(error, frame : Longint; must_reset_fpu : Boolean) : Longint; -begin - if (frame = 0) then - SysHandleErrorFrame:=EXCEPTION_CONTINUE_SEARCH - else begin - if (exceptLevel >= MaxExceptionLevel) then exit; - - exceptEip[exceptLevel] := excep^.ContextRecord^.Eip; - exceptError[exceptLevel] := error; - resetFPU[exceptLevel] := must_reset_fpu; - inc(exceptLevel); - - excep^.ContextRecord^.Eip := Longint(@JumpToHandleErrorFrame); - excep^.ExceptionRecord^.ExceptionCode := 0; - - SysHandleErrorFrame := EXCEPTION_CONTINUE_EXECUTION; -{$ifdef SYSTEMEXCEPTIONDEBUG} - if IsConsole then begin - writeln(stderr,'Exception Continue Exception set at ', - hexstr(exceptEip[exceptLevel],8)); - writeln(stderr,'Eip changed to ', - hexstr(longint(@JumpToHandleErrorFrame),8), ' error=', error); - end; -{$endif SYSTEMEXCEPTIONDEBUG} - end; -end; - -begin - if excep^.ContextRecord^.SegSs=_SS then - frame := excep^.ContextRecord^.Ebp - else - frame := 0; - res := EXCEPTION_CONTINUE_SEARCH; -{$ifdef SYSTEMEXCEPTIONDEBUG} - if IsConsole then Writeln(stderr,'Exception ', - hexstr(excep^.ExceptionRecord^.ExceptionCode, 8)); -{$endif SYSTEMEXCEPTIONDEBUG} - case cardinal(excep^.ExceptionRecord^.ExceptionCode) of - STATUS_INTEGER_DIVIDE_BY_ZERO, - STATUS_FLOAT_DIVIDE_BY_ZERO : - res := SysHandleErrorFrame(200, frame, true); - STATUS_ARRAY_BOUNDS_EXCEEDED : - res := SysHandleErrorFrame(201, frame, false); - STATUS_STACK_OVERFLOW : - res := SysHandleErrorFrame(202, frame, false); - STATUS_FLOAT_OVERFLOW : - res := SysHandleErrorFrame(205, frame, true); - STATUS_FLOAT_DENORMAL_OPERAND, - STATUS_FLOAT_UNDERFLOW : - res := SysHandleErrorFrame(206, frame, true); -{excep^.ContextRecord^.FloatSave.StatusWord := excep^.ContextRecord^.FloatSave.StatusWord and $ffffff00;} - STATUS_FLOAT_INEXACT_RESULT, - STATUS_FLOAT_INVALID_OPERATION, - STATUS_FLOAT_STACK_CHECK : - res := SysHandleErrorFrame(207, frame, true); - STATUS_INTEGER_OVERFLOW : - res := SysHandleErrorFrame(215, frame, false); - STATUS_ILLEGAL_INSTRUCTION: - res := SysHandleErrorFrame(216, frame, true); - STATUS_ACCESS_VIOLATION: - { Athlon prefetch bug? } - if is_prefetch(pointer(excep^.ContextRecord^.Eip)) then - begin - { if yes, then retry } - excep^.ExceptionRecord^.ExceptionCode := 0; - res:=EXCEPTION_CONTINUE_EXECUTION; - end - else - res := SysHandleErrorFrame(216, frame, true); - - STATUS_CONTROL_C_EXIT: - res := SysHandleErrorFrame(217, frame, true); - STATUS_PRIVILEGED_INSTRUCTION: - res := SysHandleErrorFrame(218, frame, false); - else - begin - if ((excep^.ExceptionRecord^.ExceptionCode and SEVERITY_ERROR) = SEVERITY_ERROR) then - res := SysHandleErrorFrame(217, frame, true) - else - res := SysHandleErrorFrame(255, frame, true); - end; - end; - syswin32_i386_exception_handler := res; -end; - - -procedure install_exception_handlers; -{$ifdef SYSTEMEXCEPTIONDEBUG} -var - oldexceptaddr, - newexceptaddr : Longint; -{$endif SYSTEMEXCEPTIONDEBUG} - -begin -{$ifdef SYSTEMEXCEPTIONDEBUG} - asm - movl $0,%eax - movl %fs:(%eax),%eax - movl %eax,oldexceptaddr - end; -{$endif SYSTEMEXCEPTIONDEBUG} - SetUnhandledExceptionFilter(@syswin32_i386_exception_handler); -{$ifdef SYSTEMEXCEPTIONDEBUG} - asm - movl $0,%eax - movl %fs:(%eax),%eax - movl %eax,newexceptaddr - end; - if IsConsole then - writeln(stderr,'Old exception ',hexstr(oldexceptaddr,8), - ' new exception ',hexstr(newexceptaddr,8)); -{$endif SYSTEMEXCEPTIONDEBUG} -end; - -procedure remove_exception_handlers; -begin - SetUnhandledExceptionFilter(nil); -end; - -{$else not cpui386 (Processor specific !!)} -procedure install_exception_handlers; -begin -end; - -procedure remove_exception_handlers; -begin -end; - -{$endif Set_i386_Exception_handler} - - -{$ifdef HASWIDESTRING} -{**************************************************************************** - OS dependend widestrings -****************************************************************************} - -function CharUpperBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; stdcall; external 'user32' name 'CharUpperBuffW'; -function CharLowerBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; stdcall; external 'user32' name 'CharLowerBuffW'; - - -function Win32WideUpper(const s : WideString) : WideString; - begin - result:=s; - UniqueString(result); - if length(result)>0 then - CharUpperBuff(LPWSTR(result),length(result)); - end; - - -function Win32WideLower(const s : WideString) : WideString; - begin - result:=s; - UniqueString(result); - if length(result)>0 then - CharLowerBuff(LPWSTR(result),length(result)); - end; - - -{ there is a similiar procedure in sysutils which inits the fields which - are only relevant for the sysutils units } -procedure InitWin32Widestrings; - begin - widestringmanager.UpperWideStringProc:=@Win32WideUpper; - widestringmanager.LowerWideStringProc:=@Win32WideLower; - end; - -{$endif HASWIDESTRING} - - -{**************************************************************************** - Error Message writing using messageboxes -****************************************************************************} - -function MessageBox(w1:longint;l1,l2:pointer;w2:longint):longint; - stdcall;external 'user32' name 'MessageBoxA'; - -const - ErrorBufferLength = 1024; -var - ErrorBuf : array[0..ErrorBufferLength] of char; - ErrorLen : longint; - -Function ErrorWrite(Var F: TextRec): Integer; -{ - An error message should always end with #13#10#13#10 -} -var - p : pchar; - i : longint; -Begin - if F.BufPos>0 then - begin - if F.BufPos+ErrorLen>ErrorBufferLength then - i:=ErrorBufferLength-ErrorLen - else - i:=F.BufPos; - Move(F.BufPtr^,ErrorBuf[ErrorLen],i); - inc(ErrorLen,i); - ErrorBuf[ErrorLen]:=#0; - end; - if ErrorLen>3 then - begin - p:=@ErrorBuf[ErrorLen]; - for i:=1 to 4 do - begin - dec(p); - if not(p^ in [#10,#13]) then - break; - end; - end; - if ErrorLen=ErrorBufferLength then - i:=4; - if (i=4) then - begin - MessageBox(0,@ErrorBuf,pchar('Error'),0); - ErrorLen:=0; - end; - F.BufPos:=0; - ErrorWrite:=0; -End; - - -Function ErrorClose(Var F: TextRec): Integer; -begin - if ErrorLen>0 then - begin - MessageBox(0,@ErrorBuf,pchar('Error'),0); - ErrorLen:=0; - end; - ErrorLen:=0; - ErrorClose:=0; -end; - - -Function ErrorOpen(Var F: TextRec): Integer; -Begin - TextRec(F).InOutFunc:=@ErrorWrite; - TextRec(F).FlushFunc:=@ErrorWrite; - TextRec(F).CloseFunc:=@ErrorClose; - ErrorOpen:=0; -End; - - -procedure AssignError(Var T: Text); -begin - Assign(T,''); - TextRec(T).OpenFunc:=@ErrorOpen; - Rewrite(T); -end; - - -procedure SysInitStdIO; -begin - { Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be - displayed in and messagebox } - StdInputHandle:=longint(GetStdHandle(cardinal(STD_INPUT_HANDLE))); - StdOutputHandle:=longint(GetStdHandle(cardinal(STD_OUTPUT_HANDLE))); - StdErrorHandle:=longint(GetStdHandle(cardinal(STD_ERROR_HANDLE))); - if not IsConsole then - begin - AssignError(stderr); - AssignError(stdout); - Assign(Output,''); - Assign(Input,''); - Assign(ErrOutput,''); - end - else - begin - OpenStdIO(Input,fmInput,StdInputHandle); - OpenStdIO(Output,fmOutput,StdOutputHandle); - OpenStdIO(ErrOutput,fmOutput,StdErrorHandle); - OpenStdIO(StdOut,fmOutput,StdOutputHandle); - OpenStdIO(StdErr,fmOutput,StdErrorHandle); - end; -end; - -(* ProcessID cached to avoid repeated calls to GetCurrentProcess. *) - -var - ProcessID: SizeUInt; - -function GetProcessID: SizeUInt; -begin - GetProcessID := ProcessID; -end; - - -const - Exe_entry_code : pointer = @Exe_entry; - Dll_entry_code : pointer = @Dll_entry; - -begin - StackLength := InitialStkLen; - StackBottom := Sptr - StackLength; - { get some helpful informations } - GetStartupInfo(@startupinfo); - { some misc Win32 stuff } - hprevinst:=0; - if not IsLibrary then - HInstance:=getmodulehandle(GetCommandFile); - MainInstance:=HInstance; - cmdshow:=startupinfo.wshowwindow; - { Setup heap } - InitHeap; - SysInitExceptions; - SysInitStdIO; - { Arguments } - setup_arguments; - { Reset IO Error } - InOutRes:=0; - ProcessID := GetCurrentProcessID; - { threading } - InitSystemThreads; - { Reset internal error variable } - errno:=0; -{$ifdef HASVARIANT} - initvariantmanager; -{$endif HASVARIANT} -{$ifdef HASWIDESTRING} - initwidestringmanager; - InitWin32Widestrings -{$endif HASWIDESTRING} -end. diff --git a/rtl/wince/Makefile b/rtl/wince/Makefile deleted file mode 100644 index 0a30dec862..0000000000 --- a/rtl/wince/Makefile +++ /dev/null @@ -1,1961 +0,0 @@ -# -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/10/20] -# -default: all -MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince powerpc64-linux -BSDs = freebsd netbsd openbsd darwin -UNIXs = linux $(BSDs) solaris qnx -LIMIT83fs = go32v2 os2 emx watcom -FORCE: -.PHONY: FORCE -override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH))) -ifneq ($(findstring darwin,$(OSTYPE)),) -inUnix=1 #darwin -SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH))) -else -ifeq ($(findstring ;,$(PATH)),) -inUnix=1 -SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH))) -else -SEARCHPATH:=$(subst ;, ,$(PATH)) -endif -endif -SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE)))) -PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH)))) -ifeq ($(PWD),) -PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH)))) -ifeq ($(PWD),) -$(error You need the GNU utils package to use this Makefile) -else -PWD:=$(firstword $(PWD)) -SRCEXEEXT= -endif -else -PWD:=$(firstword $(PWD)) -SRCEXEEXT=.exe -endif -ifndef inUnix -ifeq ($(OS),Windows_NT) -inWinNT=1 -else -ifdef OS2_SHELL -inOS2=1 -endif -endif -else -ifneq ($(findstring cygdrive,$(PATH)),) -inCygWin=1 -endif -endif -ifdef inUnix -SRCBATCHEXT=.sh -else -ifdef inOS2 -SRCBATCHEXT=.cmd -else -SRCBATCHEXT=.bat -endif -endif -ifdef inUnix -PATHSEP=/ -else -PATHSEP:=$(subst /,\,/) -ifdef inCygWin -PATHSEP=/ -endif -endif -ifdef PWD -BASEDIR:=$(subst \,/,$(shell $(PWD))) -ifdef inCygWin -ifneq ($(findstring /cygdrive/,$(BASEDIR)),) -BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR)) -BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR))) -BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR)) -endif -endif -else -BASEDIR=. -endif -ifdef inOS2 -ifndef ECHO -ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(ECHO),) -ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(ECHO),) -ECHO=echo -else -ECHO:=$(firstword $(ECHO)) -endif -else -ECHO:=$(firstword $(ECHO)) -endif -endif -export ECHO -endif -override OS_TARGET_DEFAULT=wince -override DEFAULT_FPCDIR=../.. -ifndef FPC -ifdef PP -FPC=$(PP) -endif -endif -ifndef FPC -FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH)))) -ifneq ($(FPCPROG),) -FPCPROG:=$(firstword $(FPCPROG)) -FPC:=$(shell $(FPCPROG) -PB) -ifneq ($(findstring Error,$(FPC)),) -override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) -endif -else -override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) -endif -endif -override FPC:=$(subst $(SRCEXEEXT),,$(FPC)) -override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT) -FOUNDFPC:=$(strip $(wildcard $(FPC))) -ifeq ($(FOUNDFPC),) -FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH)))) -ifeq ($(FOUNDFPC),) -$(error Compiler $(FPC) not found) -endif -endif -ifndef FPC_COMPILERINFO -FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO) -endif -ifndef FPC_VERSION -FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO)) -endif -export FPC FPC_VERSION FPC_COMPILERINFO -unexport CHECKDEPEND ALLDEPENDENCIES -ifndef CPU_TARGET -ifdef CPU_TARGET_DEFAULT -CPU_TARGET=$(CPU_TARGET_DEFAULT) -endif -endif -ifndef OS_TARGET -ifdef OS_TARGET_DEFAULT -OS_TARGET=$(OS_TARGET_DEFAULT) -endif -endif -ifneq ($(words $(FPC_COMPILERINFO)),5) -FPC_COMPILERINFO+=$(shell $(FPC) -iSP) -FPC_COMPILERINFO+=$(shell $(FPC) -iTP) -FPC_COMPILERINFO+=$(shell $(FPC) -iSO) -FPC_COMPILERINFO+=$(shell $(FPC) -iTO) -endif -ifndef CPU_SOURCE -CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO)) -endif -ifndef CPU_TARGET -CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO)) -endif -ifndef OS_SOURCE -OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO)) -endif -ifndef OS_TARGET -OS_TARGET:=$(word 5,$(FPC_COMPILERINFO)) -endif -FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET) -FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE) -ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),) -TARGETSUFFIX=$(OS_TARGET) -SOURCESUFFIX=$(OS_SOURCE) -else -TARGETSUFFIX=$(FULL_TARGET) -SOURCESUFFIX=$(FULL_SOURCE) -endif -ifneq ($(FULL_TARGET),$(FULL_SOURCE)) -CROSSCOMPILE=1 -endif -ifeq ($(findstring makefile,$(MAKECMDGOALS)),) -ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),) -$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first) -endif -endif -ifneq ($(findstring $(OS_TARGET),$(BSDs)),) -BSDhier=1 -endif -ifeq ($(OS_TARGET),linux) -linuxHier=1 -endif -export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE -ifdef FPCDIR -override FPCDIR:=$(subst \,/,$(FPCDIR)) -ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) -override FPCDIR=wrong -endif -else -override FPCDIR=wrong -endif -ifdef DEFAULT_FPCDIR -ifeq ($(FPCDIR),wrong) -override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR)) -ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) -override FPCDIR=wrong -endif -endif -endif -ifeq ($(FPCDIR),wrong) -ifdef inUnix -override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION) -ifeq ($(wildcard $(FPCDIR)/units),) -override FPCDIR=/usr/lib/fpc/$(FPC_VERSION) -endif -else -override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH)))))) -override FPCDIR:=$(FPCDIR)/.. -ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) -override FPCDIR:=$(FPCDIR)/.. -ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) -override FPCDIR:=$(BASEDIR) -ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) -override FPCDIR=c:/pp -endif -endif -endif -endif -endif -ifndef CROSSBINDIR -CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX)) -endif -ifndef BINUTILSPREFIX -ifndef CROSSBINDIR -ifdef CROSSCOMPILE -BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)- -endif -endif -endif -UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX)) -ifeq ($(UNITSDIR),) -UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET)) -endif -PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra) -override PACKAGE_NAME=rtl -PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR)))))) -RTL=.. -INC=$(RTL)/inc -COMMON=$(RTL)/common -PROCINC=$(RTL)/$(CPU_TARGET) -WININC=wininc -UNITPREFIX=rtl -SYSTEMUNIT=system -PRT0=wprt0 -ifdef RELEASE -override FPCOPT+=-Ur -endif -OBJPASDIR=$(RTL)/objpas -GRAPHDIR=$(INC)/graph -include $(WININC)/makefile.inc -WINDOWS_SOURCE_FILES=$(addprefix $(WININC)/,$(addsuffix .inc,$(WINDOWS_FILES))) -ifeq ($(FULL_TARGET),i386-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),i386-go32v2) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),i386-win32) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),i386-os2) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),i386-freebsd) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),i386-beos) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),i386-netbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),i386-solaris) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),i386-qnx) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),i386-netware) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),i386-openbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),i386-wdosx) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),i386-emx) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),i386-watcom) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),i386-netwlibc) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),i386-wince) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),m68k-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),m68k-freebsd) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),m68k-netbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),m68k-amiga) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),m68k-atari) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),m68k-openbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),m68k-palmos) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),powerpc-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),powerpc-netbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),powerpc-macos) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),powerpc-darwin) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),powerpc-morphos) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),sparc-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),sparc-netbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),sparc-solaris) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),x86_64-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),x86_64-freebsd) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),x86_64-win64) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),arm-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),arm-wince) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),powerpc64-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo heaptrc windows messages dynlibs dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils math dateutils varutils variants matrix ucomplex charset getopts -endif -ifeq ($(FULL_TARGET),i386-linux) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),i386-go32v2) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),i386-win32) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),i386-os2) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),i386-freebsd) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),i386-beos) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),i386-netbsd) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),i386-solaris) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),i386-qnx) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),i386-netware) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),i386-openbsd) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),i386-wdosx) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),i386-emx) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),i386-watcom) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),i386-netwlibc) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),i386-wince) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),m68k-linux) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),m68k-freebsd) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),m68k-netbsd) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),m68k-amiga) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),m68k-atari) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),m68k-openbsd) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),m68k-palmos) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),powerpc-linux) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),powerpc-netbsd) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),powerpc-macos) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),powerpc-darwin) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),powerpc-morphos) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),sparc-linux) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),sparc-netbsd) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),sparc-solaris) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),x86_64-linux) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),x86_64-freebsd) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),x86_64-win64) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),arm-linux) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),arm-wince) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -ifeq ($(FULL_TARGET),powerpc64-linux) -override TARGET_LOADERS+=wprt0 #wdllprt0 -endif -override INSTALL_FPCPACKAGE=y -ifeq ($(FULL_TARGET),i386-linux) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-go32v2) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-win32) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-os2) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-freebsd) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-beos) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-netbsd) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-solaris) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-qnx) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-netware) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-openbsd) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-wdosx) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-emx) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-watcom) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-netwlibc) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-wince) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),m68k-linux) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),m68k-freebsd) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),m68k-netbsd) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),m68k-amiga) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),m68k-atari) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),m68k-openbsd) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),m68k-palmos) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),powerpc-linux) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),powerpc-netbsd) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),powerpc-macos) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),powerpc-darwin) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),powerpc-morphos) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),sparc-linux) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),sparc-netbsd) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),sparc-solaris) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),x86_64-linux) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),x86_64-freebsd) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),x86_64-win64) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),arm-linux) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),arm-wince) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),powerpc64-linux) -override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(RTL)/win -endif -ifeq ($(FULL_TARGET),i386-linux) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),i386-go32v2) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),i386-win32) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),i386-os2) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),i386-freebsd) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),i386-beos) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),i386-netbsd) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),i386-solaris) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),i386-qnx) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),i386-netware) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),i386-openbsd) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),i386-wdosx) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),i386-emx) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),i386-watcom) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),i386-netwlibc) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),i386-wince) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),m68k-linux) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),m68k-freebsd) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),m68k-netbsd) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),m68k-amiga) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),m68k-atari) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),m68k-openbsd) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),m68k-palmos) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),powerpc-linux) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),powerpc-netbsd) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),powerpc-macos) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),powerpc-darwin) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),powerpc-morphos) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),sparc-linux) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),sparc-netbsd) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),sparc-solaris) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),x86_64-linux) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),x86_64-freebsd) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),x86_64-win64) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),arm-linux) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),arm-wince) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifeq ($(FULL_TARGET),powerpc64-linux) -override COMPILER_SOURCEDIR+=$(INC) $(PROCINC) $(COMMON) -endif -ifdef REQUIRE_UNITSDIR -override UNITSDIR+=$(REQUIRE_UNITSDIR) -endif -ifdef REQUIRE_PACKAGESDIR -override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR) -endif -ifdef ZIPINSTALL -ifneq ($(findstring $(OS_TARGET),$(UNIXs)),) -UNIXHier=1 -endif -else -ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),) -UNIXHier=1 -endif -endif -ifndef INSTALL_PREFIX -ifdef PREFIX -INSTALL_PREFIX=$(PREFIX) -endif -endif -ifndef INSTALL_PREFIX -ifdef UNIXHier -INSTALL_PREFIX=/usr/local -else -ifdef INSTALL_FPCPACKAGE -INSTALL_BASEDIR:=/pp -else -INSTALL_BASEDIR:=/$(PACKAGE_NAME) -endif -endif -endif -export INSTALL_PREFIX -ifdef INSTALL_FPCSUBDIR -export INSTALL_FPCSUBDIR -endif -ifndef DIST_DESTDIR -DIST_DESTDIR:=$(BASEDIR) -endif -export DIST_DESTDIR -ifndef COMPILER_UNITTARGETDIR -ifdef PACKAGEDIR_MAIN -COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX) -else -COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX) -endif -endif -ifndef COMPILER_TARGETDIR -COMPILER_TARGETDIR=. -endif -ifndef INSTALL_BASEDIR -ifdef UNIXHier -ifdef INSTALL_FPCPACKAGE -INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION) -else -INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME) -endif -else -INSTALL_BASEDIR:=$(INSTALL_PREFIX) -endif -endif -ifndef INSTALL_BINDIR -ifdef UNIXHier -INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin -else -INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin -ifdef INSTALL_FPCPACKAGE -ifdef CROSSCOMPILE -ifdef CROSSINSTALL -INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX) -else -INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX) -endif -else -INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX) -endif -endif -endif -endif -ifndef INSTALL_UNITDIR -INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX) -ifdef INSTALL_FPCPACKAGE -ifdef PACKAGE_NAME -INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME) -endif -endif -endif -ifndef INSTALL_LIBDIR -ifdef UNIXHier -INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib -else -INSTALL_LIBDIR:=$(INSTALL_UNITDIR) -endif -endif -ifndef INSTALL_SOURCEDIR -ifdef UNIXHier -ifdef BSDhier -SRCPREFIXDIR=share/src -else -ifdef linuxHier -SRCPREFIXDIR=share/src -else -SRCPREFIXDIR=src -endif -endif -ifdef INSTALL_FPCPACKAGE -ifdef INSTALL_FPCSUBDIR -INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME) -else -INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) -endif -else -INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION) -endif -else -ifdef INSTALL_FPCPACKAGE -ifdef INSTALL_FPCSUBDIR -INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME) -else -INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME) -endif -else -INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source -endif -endif -endif -ifndef INSTALL_DOCDIR -ifdef UNIXHier -ifdef BSDhier -DOCPREFIXDIR=share/doc -else -ifdef linuxHier -DOCPREFIXDIR=share/doc -else -DOCPREFIXDIR=doc -endif -endif -ifdef INSTALL_FPCPACKAGE -INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) -else -INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION) -endif -else -ifdef INSTALL_FPCPACKAGE -INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME) -else -INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc -endif -endif -endif -ifndef INSTALL_EXAMPLEDIR -ifdef UNIXHier -ifdef INSTALL_FPCPACKAGE -ifdef BSDhier -INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) -else -ifdef linuxHier -INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples -else -INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME) -endif -endif -else -ifdef BSDhier -INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION) -else -ifdef linuxHier -INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION) -else -INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION) -endif -endif -endif -else -ifdef INSTALL_FPCPACKAGE -INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME) -else -INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples -endif -endif -endif -ifndef INSTALL_DATADIR -INSTALL_DATADIR=$(INSTALL_BASEDIR) -endif -ifdef CROSSCOMPILE -ifndef CROSSBINDIR -CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX)) -ifeq ($(CROSSBINDIR),) -CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE)) -endif -endif -else -CROSSBINDIR= -endif -BATCHEXT=.bat -LOADEREXT=.as -EXEEXT=.exe -PPLEXT=.ppl -PPUEXT=.ppu -OEXT=.o -ASMEXT=.s -SMARTEXT=.sl -STATICLIBEXT=.a -SHAREDLIBEXT=.so -STATICLIBPREFIX=libp -RSTEXT=.rst -ifeq ($(findstring 1.0.,$(FPC_VERSION)),) -ifeq ($(OS_TARGET),go32v1) -STATICLIBPREFIX= -SHORTSUFFIX=v1 -endif -ifeq ($(OS_TARGET),go32v2) -STATICLIBPREFIX= -SHORTSUFFIX=dos -endif -ifeq ($(OS_TARGET),watcom) -STATICLIBPREFIX= -OEXT=.obj -ASMEXT=.asm -SHAREDLIBEXT=.dll -SHORTSUFFIX=wat -endif -ifeq ($(OS_TARGET),linux) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=lnx -endif -ifeq ($(OS_TARGET),freebsd) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=fbs -endif -ifeq ($(OS_TARGET),netbsd) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=nbs -endif -ifeq ($(OS_TARGET),openbsd) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=obs -endif -ifeq ($(OS_TARGET),win32) -SHAREDLIBEXT=.dll -SHORTSUFFIX=w32 -endif -ifeq ($(OS_TARGET),os2) -BATCHEXT=.cmd -AOUTEXT=.out -STATICLIBPREFIX= -SHAREDLIBEXT=.dll -SHORTSUFFIX=os2 -ECHO=echo -endif -ifeq ($(OS_TARGET),emx) -BATCHEXT=.cmd -AOUTEXT=.out -STATICLIBPREFIX= -SHAREDLIBEXT=.dll -SHORTSUFFIX=emx -ECHO=echo -endif -ifeq ($(OS_TARGET),amiga) -EXEEXT= -SHAREDLIBEXT=.library -SHORTSUFFIX=amg -endif -ifeq ($(OS_TARGET),morphos) -EXEEXT= -SHAREDLIBEXT=.library -SHORTSUFFIX=mos -endif -ifeq ($(OS_TARGET),atari) -EXEEXT=.ttp -SHORTSUFFIX=ata -endif -ifeq ($(OS_TARGET),beos) -BATCHEXT=.sh -EXEEXT= -SHORTSUFFIX=be -endif -ifeq ($(OS_TARGET),solaris) -BATCHEXT=.sh -EXEEXT= -SHORTSUFFIX=sun -endif -ifeq ($(OS_TARGET),qnx) -BATCHEXT=.sh -EXEEXT= -SHORTSUFFIX=qnx -endif -ifeq ($(OS_TARGET),netware) -EXEEXT=.nlm -STATICLIBPREFIX= -SHORTSUFFIX=nw -endif -ifeq ($(OS_TARGET),netwlibc) -EXEEXT=.nlm -STATICLIBPREFIX= -SHORTSUFFIX=nwl -endif -ifeq ($(OS_TARGET),macos) -BATCHEXT= -EXEEXT= -DEBUGSYMEXT=.xcoff -SHORTSUFFIX=mac -endif -ifeq ($(OS_TARGET),darwin) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=dwn -endif -else -ifeq ($(OS_TARGET),go32v1) -PPUEXT=.pp1 -OEXT=.o1 -ASMEXT=.s1 -SMARTEXT=.sl1 -STATICLIBEXT=.a1 -SHAREDLIBEXT=.so1 -STATICLIBPREFIX= -SHORTSUFFIX=v1 -endif -ifeq ($(OS_TARGET),go32v2) -STATICLIBPREFIX= -SHORTSUFFIX=dos -endif -ifeq ($(OS_TARGET),watcom) -STATICLIBPREFIX= -SHORTSUFFIX=wat -endif -ifeq ($(OS_TARGET),linux) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=lnx -endif -ifeq ($(OS_TARGET),freebsd) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=fbs -endif -ifeq ($(OS_TARGET),netbsd) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=nbs -endif -ifeq ($(OS_TARGET),openbsd) -BATCHEXT=.sh -EXEEXT= -HASSHAREDLIB=1 -SHORTSUFFIX=obs -endif -ifeq ($(OS_TARGET),win32) -PPUEXT=.ppw -OEXT=.ow -ASMEXT=.sw -SMARTEXT=.slw -STATICLIBEXT=.aw -SHAREDLIBEXT=.dll -SHORTSUFFIX=w32 -endif -ifeq ($(OS_TARGET),os2) -BATCHEXT=.cmd -PPUEXT=.ppo -ASMEXT=.so2 -OEXT=.oo2 -AOUTEXT=.out -SMARTEXT=.sl2 -STATICLIBPREFIX= -STATICLIBEXT=.ao2 -SHAREDLIBEXT=.dll -SHORTSUFFIX=os2 -ECHO=echo -endif -ifeq ($(OS_TARGET),amiga) -EXEEXT= -PPUEXT=.ppu -ASMEXT=.asm -OEXT=.o -SMARTEXT=.sl -STATICLIBEXT=.a -SHAREDLIBEXT=.library -SHORTSUFFIX=amg -endif -ifeq ($(OS_TARGET),atari) -PPUEXT=.ppu -ASMEXT=.s -OEXT=.o -SMARTEXT=.sl -STATICLIBEXT=.a -EXEEXT=.ttp -SHORTSUFFIX=ata -endif -ifeq ($(OS_TARGET),beos) -BATCHEXT=.sh -PPUEXT=.ppu -ASMEXT=.s -OEXT=.o -SMARTEXT=.sl -STATICLIBEXT=.a -EXEEXT= -SHORTSUFFIX=be -endif -ifeq ($(OS_TARGET),solaris) -BATCHEXT=.sh -PPUEXT=.ppu -ASMEXT=.s -OEXT=.o -SMARTEXT=.sl -STATICLIBEXT=.a -EXEEXT= -SHORTSUFFIX=sun -endif -ifeq ($(OS_TARGET),qnx) -BATCHEXT=.sh -PPUEXT=.ppu -ASMEXT=.s -OEXT=.o -SMARTEXT=.sl -STATICLIBEXT=.a -EXEEXT= -SHORTSUFFIX=qnx -endif -ifeq ($(OS_TARGET),netware) -STATICLIBPREFIX= -PPUEXT=.ppu -OEXT=.o -ASMEXT=.s -SMARTEXT=.sl -STATICLIBEXT=.a -SHAREDLIBEXT=.nlm -EXEEXT=.nlm -SHORTSUFFIX=nw -endif -ifeq ($(OS_TARGET),netwlibc) -STATICLIBPREFIX= -PPUEXT=.ppu -OEXT=.o -ASMEXT=.s -SMARTEXT=.sl -STATICLIBEXT=.a -SHAREDLIBEXT=.nlm -EXEEXT=.nlm -SHORTSUFFIX=nwl -endif -ifeq ($(OS_TARGET),macos) -BATCHEXT= -PPUEXT=.ppu -ASMEXT=.s -OEXT=.o -SMARTEXT=.sl -STATICLIBEXT=.a -EXEEXT= -DEBUGSYMEXT=.xcoff -SHORTSUFFIX=mac -endif -endif -ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),) -FPCMADE=fpcmade.$(SHORTSUFFIX) -ZIPSUFFIX=$(SHORTSUFFIX) -ZIPCROSSPREFIX= -ZIPSOURCESUFFIX=src -ZIPEXAMPLESUFFIX=exm -else -FPCMADE=fpcmade.$(TARGETSUFFIX) -ZIPSOURCESUFFIX=.source -ZIPEXAMPLESUFFIX=.examples -ifdef CROSSCOMPILE -ZIPSUFFIX=.$(SOURCESUFFIX) -ZIPCROSSPREFIX=$(TARGETSUFFIX)- -else -ZIPSUFFIX=.$(TARGETSUFFIX) -ZIPCROSSPREFIX= -endif -endif -ifndef ECHO -ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(ECHO),) -ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(ECHO),) -ECHO= __missing_command_ECHO -else -ECHO:=$(firstword $(ECHO)) -endif -else -ECHO:=$(firstword $(ECHO)) -endif -endif -export ECHO -ifndef DATE -DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(DATE),) -DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(DATE),) -DATE= __missing_command_DATE -else -DATE:=$(firstword $(DATE)) -endif -else -DATE:=$(firstword $(DATE)) -endif -endif -export DATE -ifndef GINSTALL -GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(GINSTALL),) -GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(GINSTALL),) -GINSTALL= __missing_command_GINSTALL -else -GINSTALL:=$(firstword $(GINSTALL)) -endif -else -GINSTALL:=$(firstword $(GINSTALL)) -endif -endif -export GINSTALL -ifndef CPPROG -CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(CPPROG),) -CPPROG= __missing_command_CPPROG -else -CPPROG:=$(firstword $(CPPROG)) -endif -endif -export CPPROG -ifndef RMPROG -RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(RMPROG),) -RMPROG= __missing_command_RMPROG -else -RMPROG:=$(firstword $(RMPROG)) -endif -endif -export RMPROG -ifndef MVPROG -MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(MVPROG),) -MVPROG= __missing_command_MVPROG -else -MVPROG:=$(firstword $(MVPROG)) -endif -endif -export MVPROG -ifndef MKDIRPROG -MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(MKDIRPROG),) -MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(MKDIRPROG),) -MKDIRPROG= __missing_command_MKDIRPROG -else -MKDIRPROG:=$(firstword $(MKDIRPROG)) -endif -else -MKDIRPROG:=$(firstword $(MKDIRPROG)) -endif -endif -export MKDIRPROG -ifndef ECHOREDIR -ifndef inUnix -ECHOREDIR=echo -else -ECHOREDIR=$(ECHO) -endif -endif -ifndef COPY -COPY:=$(CPPROG) -fp -endif -ifndef COPYTREE -COPYTREE:=$(CPPROG) -Rfp -endif -ifndef MKDIRTREE -MKDIRTREE:=$(MKDIRPROG) -p -endif -ifndef MOVE -MOVE:=$(MVPROG) -f -endif -ifndef DEL -DEL:=$(RMPROG) -f -endif -ifndef DELTREE -DELTREE:=$(RMPROG) -rf -endif -ifndef INSTALL -ifdef inUnix -INSTALL:=$(GINSTALL) -c -m 644 -else -INSTALL:=$(COPY) -endif -endif -ifndef INSTALLEXE -ifdef inUnix -INSTALLEXE:=$(GINSTALL) -c -m 755 -else -INSTALLEXE:=$(COPY) -endif -endif -ifndef MKDIR -MKDIR:=$(GINSTALL) -m 755 -d -endif -export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR -ifndef PPUMOVE -PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(PPUMOVE),) -PPUMOVE= __missing_command_PPUMOVE -else -PPUMOVE:=$(firstword $(PPUMOVE)) -endif -endif -export PPUMOVE -ifndef FPCMAKE -FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(FPCMAKE),) -FPCMAKE= __missing_command_FPCMAKE -else -FPCMAKE:=$(firstword $(FPCMAKE)) -endif -endif -export FPCMAKE -ifndef ZIPPROG -ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(ZIPPROG),) -ZIPPROG= __missing_command_ZIPPROG -else -ZIPPROG:=$(firstword $(ZIPPROG)) -endif -endif -export ZIPPROG -ifndef TARPROG -TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(TARPROG),) -TARPROG= __missing_command_TARPROG -else -TARPROG:=$(firstword $(TARPROG)) -endif -endif -export TARPROG -ASNAME=$(BINUTILSPREFIX)as -LDNAME=$(BINUTILSPREFIX)ld -ARNAME=$(BINUTILSPREFIX)ar -RCNAME=$(BINUTILSPREFIX)rc -ifneq ($(findstring 1.0.,$(FPC_VERSION)),) -ifeq ($(OS_TARGET),win32) -ifeq ($(CROSSBINDIR),) -ASNAME=asw -LDNAME=ldw -ARNAME=arw -endif -endif -endif -ifndef ASPROG -ifdef CROSSBINDIR -ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT) -else -ASPROG=$(ASNAME) -endif -endif -ifndef LDPROG -ifdef CROSSBINDIR -LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT) -else -LDPROG=$(LDNAME) -endif -endif -ifndef RCPROG -ifdef CROSSBINDIR -RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT) -else -RCPROG=$(RCNAME) -endif -endif -ifndef ARPROG -ifdef CROSSBINDIR -ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT) -else -ARPROG=$(ARNAME) -endif -endif -AS=$(ASPROG) -LD=$(LDPROG) -RC=$(RCPROG) -AR=$(ARPROG) -PPAS=ppas$(SRCBATCHEXT) -ifdef inUnix -LDCONFIG=ldconfig -else -LDCONFIG= -endif -ifdef DATE -DATESTR:=$(shell $(DATE) +%Y%m%d) -else -DATESTR= -endif -ifndef UPXPROG -ifeq ($(OS_TARGET),go32v2) -UPXPROG:=1 -endif -ifeq ($(OS_TARGET),win32) -UPXPROG:=1 -endif -ifdef UPXPROG -UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH)))) -ifeq ($(UPXPROG),) -UPXPROG= -else -UPXPROG:=$(firstword $(UPXPROG)) -endif -else -UPXPROG= -endif -endif -export UPXPROG -ZIPOPT=-9 -ZIPEXT=.zip -ifeq ($(USETAR),bz2) -TAROPT=vj -TAREXT=.tar.bz2 -else -TAROPT=vz -TAREXT=.tar.gz -endif -ifndef NOCPUDEF -override FPCOPTDEF=$(CPU_TARGET) -endif -ifneq ($(OS_TARGET),$(OS_SOURCE)) -override FPCOPT+=-T$(OS_TARGET) -endif -ifeq ($(OS_SOURCE),openbsd) -override FPCOPT+=-FD$(NEW_BINUTILS_PATH) -endif -ifndef CROSSBOOTSTRAP -ifneq ($(BINUTILSPREFIX),) -override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc -endif -ifneq ($(BINUTILSPREFIX),) -override FPCOPT+=-Xr$(RLINKPATH) -endif -endif -ifdef UNITDIR -override FPCOPT+=$(addprefix -Fu,$(UNITDIR)) -endif -ifdef LIBDIR -override FPCOPT+=$(addprefix -Fl,$(LIBDIR)) -endif -ifdef OBJDIR -override FPCOPT+=$(addprefix -Fo,$(OBJDIR)) -endif -ifdef INCDIR -override FPCOPT+=$(addprefix -Fi,$(INCDIR)) -endif -ifdef LINKSMART -override FPCOPT+=-XX -endif -ifdef CREATESMART -override FPCOPT+=-CX -endif -ifdef DEBUG -override FPCOPT+=-gl -override FPCOPTDEF+=DEBUG -endif -ifdef RELEASE -ifeq ($(CPU_TARGET),i386) -FPCCPUOPT:=-OG2p3 -else -ifeq ($(CPU_TARGET),powerpc) -FPCCPUOPT:=-O1r -else -FPCCPUOPT:= -endif -endif -override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n -override FPCOPTDEF+=RELEASE -endif -ifdef STRIP -override FPCOPT+=-Xs -endif -ifdef OPTIMIZE -ifeq ($(CPU_TARGET),i386) -override FPCOPT+=-OG2p3 -endif -endif -ifdef VERBOSE -override FPCOPT+=-vwni -endif -ifdef COMPILER_OPTIONS -override FPCOPT+=$(COMPILER_OPTIONS) -endif -ifdef COMPILER_UNITDIR -override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR)) -endif -ifdef COMPILER_LIBRARYDIR -override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR)) -endif -ifdef COMPILER_OBJECTDIR -override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR)) -endif -ifdef COMPILER_INCLUDEDIR -override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR)) -endif -ifdef CROSSBINDIR -override FPCOPT+=-FD$(CROSSBINDIR) -endif -ifdef COMPILER_TARGETDIR -override FPCOPT+=-FE$(COMPILER_TARGETDIR) -ifeq ($(COMPILER_TARGETDIR),.) -override TARGETDIRPREFIX= -else -override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/ -endif -endif -ifdef COMPILER_UNITTARGETDIR -override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR) -ifeq ($(COMPILER_UNITTARGETDIR),.) -override UNITTARGETDIRPREFIX= -else -override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/ -endif -else -ifdef COMPILER_TARGETDIR -override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR) -override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX) -endif -endif -ifeq ($(OS_TARGET),linux) -ifeq ($(FPC_VERSION),1.0.6) -override FPCOPTDEF+=HASUNIX -endif -endif -ifdef OPT -override FPCOPT+=$(OPT) -endif -ifdef FPCOPTDEF -override FPCOPT+=$(addprefix -d,$(FPCOPTDEF)) -endif -ifdef CFGFILE -override FPCOPT+=@$(CFGFILE) -endif -ifdef USEENV -override FPCEXTCMD:=$(FPCOPT) -override FPCOPT:=!FPCEXTCMD -export FPCEXTCMD -endif -override COMPILER:=$(FPC) $(FPCOPT) -ifeq (,$(findstring -s ,$(COMPILER))) -EXECPPAS= -else -ifeq ($(FULL_SOURCE),$(FULL_TARGET)) -EXECPPAS:=@$(PPAS) -endif -endif -.PHONY: fpc_loaders -ifneq ($(TARGET_LOADERS),) -override ALLTARGET+=fpc_loaders -override CLEANTARGET+=fpc_loaders_clean -override INSTALLTARGET+=fpc_loaders_install -override LOADEROFILES:=$(addsuffix $(OEXT),$(TARGET_LOADERS)) -endif -%$(OEXT): %$(LOADEREXT) -ifdef COMPILER_UNITTARGETDIR - $(AS) -o $(COMPILER_UNITTARGETDIR)/$*$(OEXT) $< -else - $(AS) -o $*$(OEXT) $< -endif -fpc_loaders: $(COMPILER_UNITTARGETDIR) $(LOADEROFILES) -fpc_loaders_clean: -ifdef COMPILER_UNITTARGETDIR - -$(DEL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES)) -else - -$(DEL) $(LOADEROFILES) -endif -fpc_loaders_install: - $(MKDIR) $(INSTALL_UNITDIR) -ifdef COMPILER_UNITTARGETDIR - $(INSTALL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES)) $(INSTALL_UNITDIR) -else - $(INSTALL) $(LOADEROFILES) $(INSTALL_UNITDIR) -endif -.PHONY: fpc_units -ifneq ($(TARGET_UNITS),) -override ALLTARGET+=fpc_units -override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS)) -override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS)) -override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES) -override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES) -endif -fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES) -ifdef TARGET_RSTS -override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS)) -override CLEANRSTFILES+=$(RSTFILES) -endif -.PHONY: fpc_all fpc_smart fpc_debug fpc_release -$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET) - @$(ECHOREDIR) Compiled > $(FPCMADE) -fpc_all: $(FPCMADE) -fpc_smart: - $(MAKE) all LINKSMART=1 CREATESMART=1 -fpc_debug: - $(MAKE) all DEBUG=1 -fpc_release: - $(MAKE) all RELEASE=1 -.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res -$(COMPILER_UNITTARGETDIR): - $(MKDIRTREE) $(COMPILER_UNITTARGETDIR) -$(COMPILER_TARGETDIR): - $(MKDIRTREE) $(COMPILER_TARGETDIR) -%$(PPUEXT): %.pp - $(COMPILER) $< - $(EXECPPAS) -%$(PPUEXT): %.pas - $(COMPILER) $< - $(EXECPPAS) -%$(EXEEXT): %.pp - $(COMPILER) $< - $(EXECPPAS) -%$(EXEEXT): %.pas - $(COMPILER) $< - $(EXECPPAS) -%$(EXEEXT): %.lpr - $(COMPILER) $< - $(EXECPPAS) -%$(EXEEXT): %.dpr - $(COMPILER) $< - $(EXECPPAS) -%.res: %.rc - windres -i $< -o $@ -vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) -vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) -vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) -vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) -vpath %$(OEXT) $(COMPILER_UNITTARGETDIR) -vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR) -.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall -ifdef INSTALL_UNITS -override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS)) -endif -ifdef INSTALL_BUILDUNIT -override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES)) -endif -ifdef INSTALLPPUFILES -override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) -ifneq ($(UNITTARGETDIRPREFIX),) -override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES))) -override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES)))) -endif -override INSTALL_CREATEPACKAGEFPC=1 -endif -ifdef INSTALLEXEFILES -ifneq ($(TARGETDIRPREFIX),) -override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES))) -endif -endif -fpc_install: all $(INSTALLTARGET) -ifdef INSTALLEXEFILES - $(MKDIR) $(INSTALL_BINDIR) -ifdef UPXPROG - -$(UPXPROG) $(INSTALLEXEFILES) -endif - $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR) -endif -ifdef INSTALL_CREATEPACKAGEFPC -ifdef FPCMAKE -ifdef PACKAGE_VERSION -ifneq ($(wildcard Makefile.fpc),) - $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc - $(MKDIR) $(INSTALL_UNITDIR) - $(INSTALL) Package.fpc $(INSTALL_UNITDIR) -endif -endif -endif -endif -ifdef INSTALLPPUFILES - $(MKDIR) $(INSTALL_UNITDIR) - $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR) -ifneq ($(INSTALLPPULINKFILES),) - $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR) -endif -ifneq ($(wildcard $(LIB_FULLNAME)),) - $(MKDIR) $(INSTALL_LIBDIR) - $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR) -ifdef inUnix - ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME) -endif -endif -endif -ifdef INSTALL_FILES - $(MKDIR) $(INSTALL_DATADIR) - $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR) -endif -fpc_sourceinstall: distclean - $(MKDIR) $(INSTALL_SOURCEDIR) - $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR) -fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS)) -ifdef HASEXAMPLES - $(MKDIR) $(INSTALL_EXAMPLEDIR) -endif -ifdef EXAMPLESOURCEFILES - $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR) -endif -ifdef TARGET_EXAMPLEDIRS - $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR) -endif -.PHONY: fpc_clean fpc_cleanall fpc_distclean -ifdef EXEFILES -override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES)) -endif -ifdef CLEAN_UNITS -override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS)) -endif -ifdef CLEANPPUFILES -override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) -ifdef DEBUGSYMEXT -override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES)) -endif -override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES)) -override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES))) -endif -fpc_clean: $(CLEANTARGET) -ifdef CLEANEXEFILES - -$(DEL) $(CLEANEXEFILES) -endif -ifdef CLEANPPUFILES - -$(DEL) $(CLEANPPUFILES) -endif -ifneq ($(CLEANPPULINKFILES),) - -$(DEL) $(CLEANPPULINKFILES) -endif -ifdef CLEANRSTFILES - -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES)) -endif -ifdef CLEAN_FILES - -$(DEL) $(CLEAN_FILES) -endif -ifdef LIB_NAME - -$(DEL) $(LIB_NAME) $(LIB_FULLNAME) -endif - -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE) - -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT) -fpc_cleanall: $(CLEANTARGET) -ifdef CLEANEXEFILES - -$(DEL) $(CLEANEXEFILES) -endif -ifdef COMPILER_UNITTARGETDIR -ifdef CLEANPPUFILES - -$(DEL) $(CLEANPPUFILES) -endif -ifneq ($(CLEANPPULINKFILES),) - -$(DEL) $(CLEANPPULINKFILES) -endif -ifdef CLEANRSTFILES - -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES)) -endif -endif - -$(DELTREE) units - -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT) -ifneq ($(PPUEXT),.ppu) - -$(DEL) *.o *.ppu *.a -endif - -$(DELTREE) *$(SMARTEXT) - -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE) - -$(DEL) *_ppas$(BATCHEXT) -ifdef AOUTEXT - -$(DEL) *$(AOUTEXT) -endif -ifdef DEBUGSYMEXT - -$(DEL) *$(DEBUGSYMEXT) -endif -fpc_distclean: cleanall -.PHONY: fpc_baseinfo -override INFORULES+=fpc_baseinfo -fpc_baseinfo: - @$(ECHO) - @$(ECHO) == Package info == - @$(ECHO) Package Name..... $(PACKAGE_NAME) - @$(ECHO) Package Version.. $(PACKAGE_VERSION) - @$(ECHO) - @$(ECHO) == Configuration info == - @$(ECHO) - @$(ECHO) FPC.......... $(FPC) - @$(ECHO) FPC Version.. $(FPC_VERSION) - @$(ECHO) Source CPU... $(CPU_SOURCE) - @$(ECHO) Target CPU... $(CPU_TARGET) - @$(ECHO) Source OS.... $(OS_SOURCE) - @$(ECHO) Target OS.... $(OS_TARGET) - @$(ECHO) Full Source.. $(FULL_SOURCE) - @$(ECHO) Full Target.. $(FULL_TARGET) - @$(ECHO) SourceSuffix. $(SOURCESUFFIX) - @$(ECHO) TargetSuffix. $(TARGETSUFFIX) - @$(ECHO) - @$(ECHO) == Directory info == - @$(ECHO) - @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES) - @$(ECHO) - @$(ECHO) Basedir......... $(BASEDIR) - @$(ECHO) FPCDir.......... $(FPCDIR) - @$(ECHO) CrossBinDir..... $(CROSSBINDIR) - @$(ECHO) UnitsDir........ $(UNITSDIR) - @$(ECHO) PackagesDir..... $(PACKAGESDIR) - @$(ECHO) - @$(ECHO) GCC library..... $(GCCLIBDIR) - @$(ECHO) Other library... $(OTHERLIBDIR) - @$(ECHO) - @$(ECHO) == Tools info == - @$(ECHO) - @$(ECHO) As........ $(AS) - @$(ECHO) Ld........ $(LD) - @$(ECHO) Ar........ $(AR) - @$(ECHO) Rc........ $(RC) - @$(ECHO) - @$(ECHO) Mv........ $(MVPROG) - @$(ECHO) Cp........ $(CPPROG) - @$(ECHO) Rm........ $(RMPROG) - @$(ECHO) GInstall.. $(GINSTALL) - @$(ECHO) Echo...... $(ECHO) - @$(ECHO) Shell..... $(SHELL) - @$(ECHO) Date...... $(DATE) - @$(ECHO) FPCMake... $(FPCMAKE) - @$(ECHO) PPUMove... $(PPUMOVE) - @$(ECHO) Upx....... $(UPXPROG) - @$(ECHO) Zip....... $(ZIPPROG) - @$(ECHO) - @$(ECHO) == Object info == - @$(ECHO) - @$(ECHO) Target Loaders........ $(TARGET_LOADERS) - @$(ECHO) Target Units.......... $(TARGET_UNITS) - @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS) - @$(ECHO) Target Programs....... $(TARGET_PROGRAMS) - @$(ECHO) Target Dirs........... $(TARGET_DIRS) - @$(ECHO) Target Examples....... $(TARGET_EXAMPLES) - @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS) - @$(ECHO) - @$(ECHO) Clean Units......... $(CLEAN_UNITS) - @$(ECHO) Clean Files......... $(CLEAN_FILES) - @$(ECHO) - @$(ECHO) Install Units....... $(INSTALL_UNITS) - @$(ECHO) Install Files....... $(INSTALL_FILES) - @$(ECHO) - @$(ECHO) == Install info == - @$(ECHO) - @$(ECHO) DateStr.............. $(DATESTR) - @$(ECHO) ZipName.............. $(ZIPNAME) - @$(ECHO) ZipPrefix............ $(ZIPPREFIX) - @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX) - @$(ECHO) ZipSuffix............ $(ZIPSUFFIX) - @$(ECHO) FullZipName.......... $(FULLZIPNAME) - @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE) - @$(ECHO) - @$(ECHO) Install base dir..... $(INSTALL_BASEDIR) - @$(ECHO) Install binary dir... $(INSTALL_BINDIR) - @$(ECHO) Install library dir.. $(INSTALL_LIBDIR) - @$(ECHO) Install units dir.... $(INSTALL_UNITDIR) - @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR) - @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR) - @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR) - @$(ECHO) Install data dir..... $(INSTALL_DATADIR) - @$(ECHO) - @$(ECHO) Dist destination dir. $(DIST_DESTDIR) - @$(ECHO) Dist zip name........ $(DIST_ZIPNAME) - @$(ECHO) -.PHONY: fpc_info -fpc_info: $(INFORULES) -.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \ - fpc_makefile_dirs -fpc_makefile: - $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc -fpc_makefile_sub1: -ifdef TARGET_DIRS - $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS)) -endif -ifdef TARGET_EXAMPLEDIRS - $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS)) -endif -fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS)) -fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2 -fpc_makefiles: fpc_makefile fpc_makefile_dirs -all: fpc_all -debug: fpc_debug -smart: fpc_smart -release: fpc_release -units: fpc_units -examples: -shared: -install: fpc_install -sourceinstall: fpc_sourceinstall -exampleinstall: fpc_exampleinstall -distinstall: -zipinstall: -zipsourceinstall: -zipexampleinstall: -zipdistinstall: -clean: fpc_clean -distclean: fpc_distclean -cleanall: fpc_cleanall -info: fpc_info -makefiles: fpc_makefiles -.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles -ifneq ($(wildcard fpcmake.loc),) -include fpcmake.loc -endif -SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT)) -include $(INC)/makefile.inc -SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES)) -include $(PROCINC)/makefile.cpu -SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES)) -SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS) winres.inc -wprt0$(OEXT) : $(CPU_TARGET)/$(PRT0).as - $(AS) $(ASTARGET) -o $(UNITTARGETDIRPREFIX)wprt0$(OEXT) $(CPU_TARGET)/$(PRT0).as -$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS) - $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp -objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp -strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\ - $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\ - $(SYSTEMUNIT)$(PPUEXT) -windows$(PPUEXT) : windows.pp $(WINDOWS_SOURCE_FILES) $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) -I$(WININC) windows.pp -messages$(PPUEXT): messages.pp $(WININC)/messages.inc $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) -I$(WININC) messages.pp -dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) windows$(PPUEXT) -objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT) -sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \ - objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) sysconst$(PPUEXT) - $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp -classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \ - sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) sysconst$(PPUEXT) - $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp -typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) - $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp -math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT) - $(COMPILER) $(OBJPASDIR)/math.pp -varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \ - $(OBJPASDIR)/varutilh.inc varutils.pp sysutils$(PPUEXT) - $(COMPILER) -Fi$(OBJPASDIR) varutils.pp -variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) sysutils$(PPUEXT) sysconst$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) - $(COMPILER) -Fi$(INC) $(INC)/variants.pp -types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) $(OBJPASDIR)/types.pp -rtlconsts$(PPUEXT) : objpas$(PPUEXT) $(OBJPASDIR)/rtlconsts.pp - $(COMPILER) $(OBJPASDIR)/rtlconsts.pp -sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) $(OBJPASDIR)/sysconst.pp -dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp -convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/convutils.pp -strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/strutils.pp -macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) $(INC)/macpas.pp $(REDIR) -cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT) -mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) -getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT) -heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) -Sg $(INC)/heaptrc.pp -lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) -charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT) -cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT) -ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) -fpmkunit$(PPUEXT) : $(COMMON)/fpmkunit.pp classes$(PPUEXT) -ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT) diff --git a/rtl/wince/Makefile.fpc b/rtl/wince/Makefile.fpc deleted file mode 100644 index 078164b488..0000000000 --- a/rtl/wince/Makefile.fpc +++ /dev/null @@ -1,244 +0,0 @@ -# -# Makefile.fpc for Free Pascal WinCE RTL -# - -[package] -main=rtl - -[target] -loaders= wprt0 #wdllprt0 -units=$(SYSTEMUNIT) ctypes objpas macpas strings \ - lineinfo heaptrc \ - windows messages dynlibs \ - dos objects \ - rtlconsts sysconst sysutils \ - typinfo types classes \ - strutils convutils math dateutils \ - varutils variants \ - matrix ucomplex \ - charset getopts - -# winsock initc cmem signals \ -# crt graph \ -# wincrt winmouse winevent sockets printer \ -# video mouse keyboard \ -# winsysut fpmkunit - -# rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit - -[require] -nortl=y - -[install] -fpcpackage=y - -[default] -fpcdir=../.. -target=wince - -[compiler] -includedir=$(INC) $(PROCINC) $(RTL)/win -sourcedir=$(INC) $(PROCINC) $(COMMON) - - -[prerules] -RTL=.. -INC=$(RTL)/inc -COMMON=$(RTL)/common -PROCINC=$(RTL)/$(CPU_TARGET) -WININC=wininc - -UNITPREFIX=rtl - -SYSTEMUNIT=system -PRT0=wprt0 - -# Use new feature from 1.0.5 version -# that generates release PPU files -# which will not be recompiled -ifdef RELEASE -override FPCOPT+=-Ur -endif - -# Paths -OBJPASDIR=$(RTL)/objpas -GRAPHDIR=$(INC)/graph - -# Files used by windows.pp -include $(WININC)/makefile.inc - -WINDOWS_SOURCE_FILES=$(addprefix $(WININC)/,$(addsuffix .inc,$(WINDOWS_FILES))) - - -[rules] -SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT)) - -# Get the system independent include file names. -# This will set the following variables : -# SYSINCNAMES -include $(INC)/makefile.inc -SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES)) - -# Get the processor dependent include file names. -# This will set the following variables : -# CPUINCNAMES -include $(PROCINC)/makefile.cpu -SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES)) - -# Put system unit dependencies together. -SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS) winres.inc - - -# -# Loaders -# - -wprt0$(OEXT) : $(CPU_TARGET)/$(PRT0).as - $(AS) $(ASTARGET) -o $(UNITTARGETDIRPREFIX)wprt0$(OEXT) $(CPU_TARGET)/$(PRT0).as - -#wdllprt0$(OEXT) : wdllprt0.as - -# -# System Units (System, Objpas, Strings) -# - -$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS) - $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp - -objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp - -strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\ - $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\ - $(SYSTEMUNIT)$(PPUEXT) - -# -# System Dependent Units -# - -windows$(PPUEXT) : windows.pp $(WINDOWS_SOURCE_FILES) $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) -I$(WININC) windows.pp - -messages$(PPUEXT): messages.pp $(WININC)/messages.inc $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) -I$(WININC) messages.pp - -#opengl32$(PPUEXT) : opengl32.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - -#winsock$(PPUEXT) : winsock.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - -#sockets$(PPUEXT) : sockets.pp windows$(PPUEXT) winsock$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \ -# $(INC)/sockets.inc $(INC)/socketsh.inc - -#initc$(PPUEXT) : initc.pp $(SYSTEMUNIT)$(PPUEXT) - -#wincrt$(PPUEXT) : wincrt.pp $(SYSTEMUNIT)$(PPUEXT) windows$(PPUEXT) graph$(PPUEXT) - -#winmouse$(PPUEXT) : winmouse.pp $(SYSTEMUNIT)$(PPUEXT) windows$(PPUEXT) graph$(PPUEXT) - -#dynlibs$(PPUEXT) : $(INC)/dynlibs.pp windows$(PPUEXT) - -# -# TP7 Compatible RTL Units -# - -dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) windows$(PPUEXT) - -#crt$(PPUEXT) : crt.pp $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) - -objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT) - -# -# Graph -# - -#include $(GRAPHDIR)/makefile.inc -#GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES)) - -#graph$(PPUEXT) : graph.pp strings$(PPUEXT) windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \ -# $(GRAPHINCDEPS) -# $(COMPILER) -I$(GRAPHDIR) graph.pp - - -# -# Delphi Compatible Units -# - -sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \ - objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) sysconst$(PPUEXT) - $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp - -classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \ - sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) sysconst$(PPUEXT) - $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp - -#winsysut$(PPUEXT) : winsysut.pp sysutils$(PPUEXT) -# $(COMPILER) winsysut.pp - -typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) - $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp - -math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT) - $(COMPILER) $(OBJPASDIR)/math.pp - -varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \ - $(OBJPASDIR)/varutilh.inc varutils.pp sysutils$(PPUEXT) - $(COMPILER) -Fi$(OBJPASDIR) varutils.pp - -variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) sysutils$(PPUEXT) sysconst$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) - $(COMPILER) -Fi$(INC) $(INC)/variants.pp - -types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) $(OBJPASDIR)/types.pp - -rtlconsts$(PPUEXT) : objpas$(PPUEXT) $(OBJPASDIR)/rtlconsts.pp - $(COMPILER) $(OBJPASDIR)/rtlconsts.pp - -sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) $(OBJPASDIR)/sysconst.pp - -dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp - -convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/convutils.pp - -strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp - $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/strutils.pp - -# -# Mac Pascal Model -# - -macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) $(INC)/macpas.pp $(REDIR) - -# -# Other system-independent RTL Units -# - -cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT) - -mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - -getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT) - -heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT) - $(COMPILER) -Sg $(INC)/heaptrc.pp - -lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) - -charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT) - -cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT) - -ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) - -fpmkunit$(PPUEXT) : $(COMMON)/fpmkunit.pp classes$(PPUEXT) - -# -# Other system-dependent RTL Units -# - -#callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT) - -ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT) diff --git a/rtl/wince/arm/wprt0.as b/rtl/wince/arm/wprt0.as deleted file mode 100644 index 8ac685574c..0000000000 --- a/rtl/wince/arm/wprt0.as +++ /dev/null @@ -1,79 +0,0 @@ -/* -Startup code for WinCE port of Free Pascal -Written by Yury Sidorov, 2005. -*/ - -.section .text -@ for kernel exception handler, must be directly before ___EH_CODE_START__ -__EH_HANDLER__: - .word _ARM_ExceptionHandler - .word 0 - -__EH_CODE_START__: - -.globl mainCRTStartup -mainCRTStartup: -.globl _mainCRTStartup -_mainCRTStartup: - mov r0,#1 - b do_start - -.globl WinMainCRTStartup -WinMainCRTStartup: -.globl _WinMainCRTStartup -_WinMainCRTStartup: - mov r0,#0 -do_start: - ldr r1, _PISCONSOLE - strb r0,[r1] - bl _FPC_EXE_Entry - mov r0,#0 - -.globl asm_exit -asm_exit: - bl exitthread - -_PISCONSOLE: - .long U_SYSTEM_ISCONSOLE - -.globl exitthread -exitthread: - ldr ip,.L100 - ldr pc,[ip] -.L100: - .long .L10 - -.section .idata$2 - .rva .L7 - .long 0,0 - .rva .L6 - .rva .L8 - -.section .idata$4 -.L7: - .rva .L9 - .long 0 - -.section .idata$5 -.L8: - -.section .idata$5 -.L10: - .rva .L9 - .long 0 - -.section .idata$6 -.L9: - .short 0 - .ascii "ExitThread\000" - .balign 2,0 - -.section .idata$7 -.L6: - .ascii "coredll.dll\000" - -@ for kernel exception handler - .section .pdata - .word __EH_CODE_START__ -@ max 22 bits for number of instructions - .word 0xc0000002 | (0xFFFFF << 8) diff --git a/rtl/wince/classes.pp b/rtl/wince/classes.pp deleted file mode 100644 index 289dd4f713..0000000000 --- a/rtl/wince/classes.pp +++ /dev/null @@ -1,49 +0,0 @@ -{
- This file is part of the Free Component Library (FCL)
- Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl
-
- Classes unit for wince
-
- 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.
-
- **********************************************************************}
-
-{$define UNICODE} //ce is unicode only, needed here for classes.inc
-
-{$mode objfpc}
-
-{ determine the type of the resource/form file }
-{$define Win16Res}
-
-unit Classes;
-
-interface
-
-uses
- rtlconsts,
- sysutils,
- types,
- typinfo,
- windows;
-
-{$i classesh.inc}
-
-implementation
-
-uses
- sysconst;
-
-{ OS - independent class implementations are in /inc directory. }
-{$i classes.inc}
-
-initialization
- CommonInit;
-
-finalization
- CommonCleanup;
-end.
diff --git a/rtl/wince/dos.pp b/rtl/wince/dos.pp deleted file mode 100644 index 9fbcf8a69b..0000000000 --- a/rtl/wince/dos.pp +++ /dev/null @@ -1,553 +0,0 @@ -{
- This file is part of the Free Pascal run time library.
- Copyright (c) 1999-2004 by the Free Pascal development team.
-
- Dos unit for BP7 compatible RTL
-
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-unit dos;
-interface
-
-uses windows;
-
-Const
- Max_Path = MaxPathLen;
-
-Type
- Searchrec = Packed Record
- FindHandle : THandle;
- W32FindData : TWin32FindData;
- ExcludeAttr : longint;
- time : longint;
- size : longint;
- attr : longint;
- name : string;
- end;
-
-{$i dosh.inc}
-
-Function WinToDosTime (Const Wtime : TFileTime; var DTime:longint):longbool;
-Function DosToWinTime (DTime:longint; var Wtime : TFileTime):longbool;
-
-implementation
-
-{$DEFINE HAS_GETMSCOUNT}
-
-{$DEFINE FPC_FEXPAND_NO_DEFAULT_PATHS}
-{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
-
-{$I dos.inc}
-
-{******************************************************************************
- --- Conversion ---
-******************************************************************************}
-
-function GetMsCount: int64;
-begin
- GetMsCount := cardinal (GetTickCount);
-end;
-
-function Last2DosError(d:dword):integer;
-begin
- case d of
- 87 : { Parameter invalid -> Data invalid }
- Last2DosError:=13;
- else
- Last2DosError:=integer(d);
- end;
-end;
-
-
-Function DosToWinAttr (Const Attr : Longint) : longint;
-begin
- DosToWinAttr:=Attr;
-end;
-
-
-Function WinToDosAttr (Const Attr : Longint) : longint;
-begin
- WinToDosAttr:=Attr;
-end;
-
-type
- Longrec=packed record
- lo,hi : word;
- end;
-
-Function DosToWinTime (DTime:longint; var Wtime : TFileTime):longbool;
-var
- FatDate, FatTime: WORD;
- lft: TFileTime;
- st: SYSTEMTIME;
-begin
- FatDate:=Longrec(Dtime).Hi;
- FatTime:=Longrec(Dtime).Lo;
- with st do
- begin
- wDay:=FatDate and $1F;
- wMonth:=(FatDate shr 5) and $F;
- wYear:=(FatDate shr 9) + 1980;
- wSecond:=(FatTime and $1F)*2;
- wMinute:=(FatTime shr 5) and $1F;
- wHour:=FatTime shr 11;
- wMilliseconds:=0;
- wDayOfWeek:=0;
- end;
- DosToWinTime:=SystemTimeToFileTime(@st, @lft) and LocalFileTimeToFileTime(@lft, @Wtime);
-end;
-
-
-Function WinToDosTime (Const Wtime : TFileTime; var DTime:longint):longbool;
-var
- FatDate, FatTime: WORD;
- lft: TFileTime;
- st: SYSTEMTIME;
- res: longbool;
-begin
- res:=FileTimeToLocalFileTime(@WTime, @lft) and FileTimeToSystemTime(@lft, @st);
- if res then
- begin
- FatDate:=st.wDay or (st.wMonth shl 5) or ((st.wYear - 1980) shl 9);
- FatTime:=(st.wSecond div 2) or (st.wMinute shl 5) or (st.wHour shl 11);
- Longrec(Dtime).Hi:=FatDate;
- Longrec(Dtime).Lo:=FatTime;
- end;
- WinToDosTime:=res;
-end;
-
-
-{******************************************************************************
- --- Info / Date / Time ---
-******************************************************************************}
-
-function dosversion : word;
-var
- versioninfo : OSVERSIONINFO;
-begin
- versioninfo.dwOSVersionInfoSize:=sizeof(versioninfo);
- GetVersionEx(versioninfo);
- dosversion:=versioninfo.dwMajorVersion and $FF or versioninfo.dwMinorVersion and $FF shl 8;
-end;
-
-
-procedure getdate(var year,month,mday,wday : word);
-var
- t : TSystemTime;
-begin
- GetLocalTime(t);
- year:=t.wYear;
- month:=t.wMonth;
- mday:=t.wDay;
- wday:=t.wDayOfWeek;
-end;
-
-
-procedure setdate(year,month,day : word);
-var
- t : TSystemTime;
-begin
- GetLocalTime(t);
- t.wYear:=year;
- t.wMonth:=month;
- t.wDay:=day;
- { only a quite good solution, we can loose some ms }
- SetLocalTime(t);
-end;
-
-
-procedure gettime(var hour,minute,second,sec100 : word);
-var
- t : TSystemTime;
-begin
- GetLocalTime(t);
- hour:=t.wHour;
- minute:=t.wMinute;
- second:=t.wSecond;
- sec100:=t.wMilliSeconds div 10;
-end;
-
-
-procedure settime(hour,minute,second,sec100 : word);
-var
- t : TSystemTime;
-begin
- GetLocalTime(t);
- t.wHour:=hour;
- t.wMinute:=minute;
- t.wSecond:=second;
- t.wMilliSeconds:=sec100*10;
- SetLocalTime(t);
-end;
-
-
-{******************************************************************************
- --- Exec ---
-******************************************************************************}
-
-procedure exec(const path : pathstr;const comline : comstr);
-var
- PI: TProcessInformation;
- Proc : THandle;
- l : LongInt;
- PathW : array[0..FileNameLen] of WideChar;
- CmdLineW : array[0..FileNameLen] of WideChar;
-begin
- DosError := 0;
- AnsiToWideBuf(@path[1], Length(path), PathW, SizeOf(PathW));
- AnsiToWideBuf(@comline[1], Length(comline), CmdLineW, SizeOf(CmdLineW));
- if not CreateProcess(PathW, CmdLineW,
- nil, nil, FALSE, 0, nil, nil, nil, PI) then
- begin
- DosError:=Last2DosError(GetLastError);
- exit;
- end;
- Proc:=PI.hProcess;
- CloseHandle(PI.hThread);
- if WaitForSingleObject(Proc, dword($ffffffff)) <> $ffffffff then
- GetExitCodeProcess(Proc, @l)
- else
- l:=-1;
- CloseHandle(Proc);
- LastDosExitCode:=l;
-end;
-
-
-{******************************************************************************
- --- Disk ---
-******************************************************************************}
-
-var
- DriveNames: array[1..24] of PWideChar;
-
-function GetDriveName(drive: byte): PWideChar;
-const
- dev_attr = FILE_ATTRIBUTE_TEMPORARY or FILE_ATTRIBUTE_DIRECTORY;
-
-var
- h: THandle;
- fd: TWin32FindData;
- i, len: LongInt;
-begin
- GetDriveName:=nil;
- // Current drive is C: drive always
- if drive = 0 then
- drive:=2;
- if (drive < 3) or (drive > 26) then
- exit;
- if DriveNames[1] = nil then
- begin
- // Drive C: is filesystem root always
- GetMem(DriveNames[1], 2*SizeOf(WideChar));
- DriveNames[1][0]:='\';
- DriveNames[1][1]:=#0;
-
- // Other drives are found dinamically
- h:=FindFirstFile('\*', @fd);
- if h <> 0 then
- begin
- i:=2;
- repeat
- if fd.dwFileAttributes and dev_attr = dev_attr then begin
- len:=0;
- while fd.cFileName[len] <> 0 do
- Inc(len);
- len:=(len + 2)*SizeOf(WideChar);
- GetMem(DriveNames[i], len);
- DriveNames[i]^:='\';
- Move(fd.cFileName, DriveNames[i][1], len - SizeOf(WideChar));
- Inc(i);
- end;
- until (i > 24) or not FindNextFile(h, fd);
- Windows.FindClose(h);
- end;
- end;
- GetDriveName:=DriveNames[drive - 2];
-end;
-
-function diskfree(drive : byte) : int64;
-var
- disk: PWideChar;
- qwtotal,qwfree,qwcaller : int64;
-begin
- disk:=GetDriveName(drive);
- if (disk <> nil) and GetDiskFreeSpaceEx(disk, @qwcaller, @qwtotal, @qwfree) then
- diskfree:=qwfree
- else
- diskfree:=-1;
-end;
-
-
-function disksize(drive : byte) : int64;
-var
- disk : PWideChar;
- qwtotal,qwfree,qwcaller : int64;
-begin
- disk:=GetDriveName(drive);
- if (disk <> nil) and GetDiskFreeSpaceEx(disk, @qwcaller, @qwtotal, @qwfree) then
- disksize:=qwtotal
- else
- disksize:=-1;
-end;
-
-
-{******************************************************************************
- --- Findfirst FindNext ---
-******************************************************************************}
-
-Procedure StringToPchar (Var S : String);
-Var L : Longint;
-begin
- L:=ord(S[0]);
- Move (S[1],S[0],L);
- S[L]:=#0;
-end;
-
-Procedure PCharToString (Var S : String);
-Var L : Longint;
-begin
- L:=strlen(pchar(@S[0]));
- Move (S[0],S[1],L);
- S[0]:=char(l);
-end;
-
-
-procedure FindMatch(var f:searchrec);
-var
- buf: array[0..MaxPathLen] of char;
-begin
- { Find file with correct attribute }
- While (F.W32FindData.dwFileAttributes and cardinal(F.ExcludeAttr))<>0 do
- begin
- if not FindNextFile (F.FindHandle, F.W32FindData) then
- begin
- DosError:=Last2DosError(GetLastError);
- if DosError=2 then
- DosError:=18;
- exit;
- end;
- end;
-
- { Convert some attributes back }
- f.size:=F.W32FindData.NFileSizeLow;
- f.attr:=WinToDosAttr(F.W32FindData.dwFileAttributes);
- WinToDosTime(F.W32FindData.ftLastWriteTime,f.Time);
- WideToAnsiBuf(@F.W32FindData.cFileName, -1, buf, SizeOf(buf));
- f.Name:=StrPas(@buf);
-end;
-
-
-procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
-var
- buf: array[0..MaxPathLen] of WideChar;
-begin
- fillchar(f,sizeof(f),0);
- { no error }
- doserror:=0;
- F.Name:=Path;
- F.Attr:=attr;
- F.ExcludeAttr:=(not Attr) and ($1e); {hidden,sys,dir,volume}
- StringToPchar(f.name);
-
- { FindFirstFile is a WinCE Call }
- F.W32FindData.dwFileAttributes:=DosToWinAttr(f.attr);
- AnsiToWideBuf(@f.Name, -1, buf, SizeOf(buf));
- F.FindHandle:=FindFirstFile (buf, F.W32FindData);
-
- If F.FindHandle = Invalid_Handle_value then
- begin
- DosError:=Last2DosError(GetLastError);
- if DosError=2 then
- DosError:=18;
- exit;
- end;
- { Find file with correct attribute }
- FindMatch(f);
-end;
-
-
-procedure findnext(var f : searchRec);
-begin
-{ no error }
- doserror:=0;
- if not FindNextFile (F.FindHandle, F.W32FindData) then
- begin
- DosError:=Last2DosError(GetLastError);
- if DosError=2 then
- DosError:=18;
- exit;
- end;
-{ Find file with correct attribute }
- FindMatch(f);
-end;
-
-
-Procedure FindClose(Var f: SearchRec);
-begin
- If F.FindHandle <> Invalid_Handle_value then
- Windows.FindClose(F.FindHandle);
-end;
-
-
-{******************************************************************************
- --- File ---
-******************************************************************************}
-
-Function FSearch(path: pathstr; dirlist: string): pathstr;
-var
- i,p1 : longint;
- s : searchrec;
- newdir : pathstr;
-begin
- { check if the file specified exists }
- findfirst(path,anyfile and not(directory),s);
- if doserror=0 then
- begin
- findclose(s);
- fsearch:=path;
- exit;
- end;
- { No wildcards allowed in these things }
- if (pos('?',path)<>0) or (pos('*',path)<>0) then
- fsearch:=''
- else
- begin
- { allow slash as backslash }
- for i:=1 to length(dirlist) do
- if dirlist[i]='/' then dirlist[i]:='\';
- repeat
- p1:=pos(';',dirlist);
- if p1<>0 then
- begin
- newdir:=copy(dirlist,1,p1-1);
- delete(dirlist,1,p1);
- end
- else
- begin
- newdir:=dirlist;
- dirlist:='';
- end;
- if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
- newdir:=newdir+'\';
- findfirst(newdir+path,anyfile and not(directory),s);
- if doserror=0 then
- newdir:=newdir+path
- else
- newdir:='';
- until (dirlist='') or (newdir<>'');
- fsearch:=newdir;
- end;
- findclose(s);
-end;
-
-{ </immobilizer> }
-
-procedure getftime(var f;var time : longint);
-var
- ft : TFileTime;
-begin
- doserror:=0;
- if GetFileTime(filerec(f).Handle,nil,nil,@ft) and
- WinToDosTime(ft,time) then
- exit
- else
- begin
- DosError:=Last2DosError(GetLastError);
- time:=0;
- end;
-end;
-
-
-procedure setftime(var f;time : longint);
-var
- ft : TFileTime;
-begin
- doserror:=0;
- if DosToWinTime(time,ft) and
- SetFileTime(filerec(f).Handle,nil,nil,@ft) then
- exit
- else
- DosError:=Last2DosError(GetLastError);
-end;
-
-
-procedure getfattr(var f;var attr : word);
-var
- l : longint;
- buf: array[0..MaxPathLen] of WideChar;
-begin
- doserror:=0;
- AnsiToWideBuf(@filerec(f).name, -1, buf, SizeOf(buf));
- l:=GetFileAttributes(buf);
- if l=longint($ffffffff) then
- begin
- doserror:=Last2DosError(GetLastError);
- attr:=0;
- end
- else
- attr:=l and $ffff;
-end;
-
-
-procedure setfattr(var f;attr : word);
-var
- buf: array[0..MaxPathLen] of WideChar;
-begin
- { Fail for setting VolumeId }
- if (attr and VolumeID)<>0 then
- doserror:=5
- else
- AnsiToWideBuf(@filerec(f).name, -1, buf, SizeOf(buf));
- if SetFileAttributes(buf,attr) then
- doserror:=0
- else
- doserror:=Last2DosError(GetLastError);
-end;
-
-{******************************************************************************
- --- Environment ---
-******************************************************************************}
-
-// WinCE does not have environment. It can be emulated via registry or file. (YS)
-
-function envcount : longint;
-begin
- envcount:=0;
-end;
-
-Function EnvStr (Index: longint): string;
-begin
- EnvStr:='';
-end;
-
-Function GetEnv(envvar: string): string;
-begin
- GetEnv:='';
-end;
-
-var
- oldexitproc : pointer;
-
-procedure dosexitproc;
-var
- i: LongInt;
-begin
- exitproc:=oldexitproc;
- if DriveNames[1] <> nil then
- for i:=1 to 24 do
- if DriveNames[i] <> nil then
- FreeMem(DriveNames[i])
- else
- break;
-end;
-
-begin
- oldexitproc:=exitproc;
- exitproc:=@dosexitproc;
-end.
diff --git a/rtl/wince/dynlibs.inc b/rtl/wince/dynlibs.inc deleted file mode 100644 index 1864e81683..0000000000 --- a/rtl/wince/dynlibs.inc +++ /dev/null @@ -1,60 +0,0 @@ -{
- This file is part of the Free Pascal run time library.
- Copyright (c) 1999-2000 by the Free Pascal development team
-
- Implements OS dependent part for loading of dynamic libraries.
-
- 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.
-
- **********************************************************************}
-
-
-{$ifdef readinterface}
-
-{ ---------------------------------------------------------------------
- Interface declarations
- ---------------------------------------------------------------------}
-
-Type
- TLibHandle = Longint;
-
-Const
- NilHandle = 0;
-
-{$else}
-
-{ ---------------------------------------------------------------------
- Implementation section
- ---------------------------------------------------------------------}
-
-Uses windows;
-
-Function LoadLibrary(Name : AnsiString) : TlibHandle;
-var
- ws: PWideChar;
-begin
- ws:=StringToPWideChar(Name);
- Result:=Windows.LoadLibrary(ws);
- FreeMem(ws);
-end;
-
-Function GetProcedureAddress(Lib : TLibHandle; ProcName : AnsiString) : Pointer;
-var
- ws: PWideChar;
-begin
- ws:=StringToPWideChar(ProcName);
- Result:=Windows.GetProcAddress(Lib, ws);
- FreeMem(ws);
-end;
-
-Function UnloadLibrary(Lib : TLibHandle) : Boolean;
-begin
- Result:=Windows.FreeLibrary(Lib);
-end;
-
-{$endif}
diff --git a/rtl/wince/i386/wprt0.as b/rtl/wince/i386/wprt0.as deleted file mode 100644 index 0ca9496f32..0000000000 --- a/rtl/wince/i386/wprt0.as +++ /dev/null @@ -1,56 +0,0 @@ -//Startup code for WIN32 port of Free Pascal -//Written by P.Ozerski 1998 -// modified by Pierre Muller - .text - .globl _mainCRTStartup -_mainCRTStartup: - movb $1,U_SYSTEM_ISCONSOLE - call _FPC_EXE_Entry - .globl __WinMainCRTStartup -__WinMainCRTStartup: - movb $0,U_SYSTEM_ISCONSOLE - call _FPC_EXE_Entry - - .globl asm_exit -asm_exit: - pushl %eax - call exitprocess - -.text -.globl exitprocess -exitprocess: - jmp *.L10 - .balign 4,144 - -.text - .balign 4,144 - -.section .idata$2 - .rva .L7 - .long 0,0 - .rva .L6 - .rva .L8 - -.section .idata$4 -.L7: - .rva .L9 - .long 0 - -.section .idata$5 -.L8: - - -.section .idata$5 -.L10: - .rva .L9 - .long 0 - -.section .idata$6 -.L9: - .short 0 - .ascii "ExitThread\000" - .balign 2,0 - -.section .idata$7 -.L6: - .ascii "coredll.dll\000" diff --git a/rtl/wince/messages.pp b/rtl/wince/messages.pp deleted file mode 100644 index bd1b7edeef..0000000000 --- a/rtl/wince/messages.pp +++ /dev/null @@ -1,15 +0,0 @@ -unit messages;
-
-
-interface
-
- uses
- windows;
-
-{$DEFINE read_interface}
-{$DEFINE MESSAGESUNIT}
-{$I messages.inc}
-
-implementation
-
-end.
diff --git a/rtl/wince/readme-winceapi-port b/rtl/wince/readme-winceapi-port deleted file mode 100644 index 1e403954e2..0000000000 --- a/rtl/wince/readme-winceapi-port +++ /dev/null @@ -1,143 +0,0 @@ -I.Introduction
-
-Main goal of these files is to make available wince api under FPC.
-
-Even if wince5.0 informations are available since end of 2004, wince 4.2
-second edition api have been used -main reason is that i can't find on the
-market any Pocket PC wince5 based -.
-
-Of course, any constructive comments will be appreciated
-Sincerely Yours
-orinaudo@gmail.com
-
-
-II.Remarks on how this have been done
-
-a)Row materials :
-
--existing FPC win32api files from latest FPC 2.X.1 snapshot :
-windows.pp
-base.inc
-defines.inc
-errors.inc
-func.inc
-messages.inc
-redef.inc
-struct.inc
-unidef.inc
-
-- sdk provided .h
-- sdk provided .lib wich are :
-authhlp.lib, aygshell.lib, btd.lib, bthguid.lib, bthlink.lib,
-bthutil.lib, cecap.lib, CellCore.lib, cemapi.lib,
-ceosutil.lib, ceshell.lib, commctrl.lib, commdlg.lib,
-conncfg.lib, coredll.lib, crypt32.lib, cxport.lib,
-dmoguids.lib, doclist.lib, grognard.lib,
-gx.lib, htmlview.lib, httpd.lib, imaging.lib, imgdecmp.lib,
-inkx.lib, iphlpapi.lib, mmtimer.lib, mqoa.lib, msdmo.lib,
-msmqrt.lib, msscript.lib, msxml.lib, msxmlguid.lib,
-ndis.lib, note_prj.lib, ntcompat.lib, ole32.lib,
-oleaut32.lib, phone.lib, pimstore.lib, pndtapi.lib,
-pushprxy.lib, richink.lib, secur32.lib, sms.lib,
-strmiids.lib, toolhelp.lib, urlmon.lib, uuid.lib,
-VBarCall.lib, VoiceCtl.lib, WAP.lib, webview.lib,
-wininet.lib, winsock.lib, wmlview.lib, ws2.lib,
-wsp.lib, wvuuid.lib.
-
-one problem was to be sure to use the right function name (with or without W)
-and the right corresponding wince dll name (wich is not same as win32) for each lib.
-
-Text extraction list of dll exported functions have been made.
-//with this kind of cmd script file:
-//FOR %%a in (*.lib) do arm-pe-objdump -p %aa >%aa-txt
-
-looking at lib imported, because some functions are implemented
-directly in the lib and not from the dll.
-
-
-b-Tools
-extensive use SciTE editor (based on Scintilla project, www.scintilla.org),
-particularly 'find in file' function.
-
-c-How porting ?
-.discussing in ng, Florian and Yuri think that for several reasons(including automatic win32
-file genaration), dedicatd winceapi files were better solution instead of {$ifdef} approach
-in order to have only one set of files for all windows plateforms.
-I remain persuated that with so big amount of stuff will be less time consuming to maintain
-if there is only one set of files for all windows plateforms at least for common base pritimives.
-
-..Also, it was important to be able to compile at any time, checking (struct type and syntax errors) of
-added functions and also to be able to stop at any time beeing sure that no function was forgotten
-or unckecked.
-
-So until now changes are win32-i386 compilable.
-
-
-2 differents rules have been retained for porting depending of file kind :
-
-1°) concerning const, records and all stuff located in :
-base.inc, defines.inc, errors.inc, messages.inc, struct.inc
-
-Win32 actual files have been reused 'as this', just added traceability informations
-at end of lines concerning changes or updates :
-
-
-//xxxxx : just checked no changes
-//+xxxxx : added
-//-xxxxx : removed
-//~xxxxx : updated
-xxxxx is the corresponding sdk .h filename
-
-defines were reused exactly as they are used in sdk .h files
-
-
-2°) concerning functions and procedures :
-func.inc,redef.inc,unidef.inc
-
-4 kinds of zone have been created using ifdef and/or comments
-
-x1.common win32 & wince
-x2.win32 only
-x3.win32 or wince not checked
-x4.wince only
-
-Starting, every existing win32 functions are moved in the x3 zone, then for each function
-using 'find in file', i search corresponding dll name and .h definition to update.
-Then - if required - the function header is updated and moved in the appropriate zone
-x1, x2 or x4.
-
-Actually unidef.inc has been done, there is no more x3 zone but func.inc and redef.inc
-have all zones.
-
-If an error is made, and an unexisting external function is declared in an existing dll then you'll
-get an error message saying 'not a valid PocketPC application'. That said, if you plan to add a new
-api, make a simple 'hello world' prg with just the new-api unit in uses clause, and check running prog
-every 10 or 20 functions, better than testing directly a new 200 functions block.
-
-III.Install
-
- windows.pp -> fpcroot\rtl\wince
- *.inc -> fpcroot\rtl\wince\wininc
-
-
-IV.Changes
-
-2005-08-17 :
- consts and structs related files :
- defines added _PPC_ was (__PPC__), _MIPS_,_MIPS64, _X86_,_MPPC_,_IA64_,SHx,SH3,SH4,SH3e,ARM
- several consts and struct added
-
- functions related files :
- {$ifdef} created
-
-2005-08-22 :
- consts and structs related files :
- several consts and struct added
-
- functions related files :
- unidef.inc : 100% done
- func.inc : 2% done
- redef.inc : 0% done
- .several header habe been updated because type was longint and was 'int' in api doc.
- on 32bits plateforms there's no difference but on 64 bits there is,
- so according to api doc i updated longint to Integer when it was the case for .h definition.
diff --git a/rtl/wince/readme.txt b/rtl/wince/readme.txt deleted file mode 100644 index 94866bc02f..0000000000 --- a/rtl/wince/readme.txt +++ /dev/null @@ -1,48 +0,0 @@ -WinCE port
-==========
-
-WinCE port is quite complete and usable. The port was started and maintained by Yury Sidorov. Oliver (Oro06) ported WinCE API headers.
-
-Status
-------
-* The 2.1.x compiler has compiler support WinCE.
-* ARM and i386 (old WinCE emulator) CPUs are supported.
-* The following platforms are supported:
- * Pocket PC 2002 – WinCE version: 3.0
- * Pocket PC 2003 – WinCE version: 4.20
- * Pocket PC 2003 Second Edition – WinCE version: 4.21
-* Base units are complete.
-* Windows unit is almost complete. Delphi compatible declarations is not ready.
-
-Building
---------
-* You need cross binutils for arm-wince, get them fromftp://ftp.freepascal.org/pub/fpc/contrib/cross/arm-wince-binutils.zip for Win32.
-* Extract them to some dir in the path on your machine.
-* Get the 2.1 source repository from SVN: http://www.freepascal.org/develop.html#svn
-* Go to fpc/compiler and execute:
- make cycle CPU_TARGET=arm OS_TARGET=wince
-
-You should end with the units compiled to fpc/rtl/units/arm-wince and a ppccrossarm.exe in fpc/compiler. Copy them to locations fitting your fpc installation.
-
-WinCE port notes
-----------------
-* chdir procedure always produces an error (WinCE does not support setting of current directory).
-* All file/dir paths must be absolute (started with \).
-* WinCE is unicode OS. All string parameters to API calls must be PWideChar.
-* WinCE does not have support for environment strings.
-* WinCE does not have support for console applications by default. But you can install console support by yourself. Please note that FPC creates GUI applications for WinCE target by default. To create console application you should use -WC compiler switch or put {$APPTYPE CONSOLE} directive to source code.<br>To enable console in WinCE install one of the following programs:
-
- - PocketCMD by SymbolicTools. It is recommended solution. Get it here: http://www.symbolictools.de/public/pocketconsole/applications/PocketCMD
-
- - PPC Command Shell from Microsoft Windows Mobile Developer Power Toys. Get it here: http://www.microsoft.com/downloads/details.aspx?FamilyID=74473fd6-1dcc-47aa-ab28-6a2b006edfe9&displaylang=en
-
-PPC Command Shell have less features than PocketCMD. Also it have some issues. One of them - a new console window is opened even if an application is started from a console command prompt.
-
-Links
------
-* WinCE Port page at Free Pascal Wiki: http://www.freepascal.org/wiki/index.php/WinCE_port
-* Useful WinCE info: http://www.rainer-keuchel.de/documents.html
-
-Contacts
---------
-Write any questions regarding WinCE port to Yury Sidorov yury_sidorov@mail.ru
diff --git a/rtl/wince/system.pp b/rtl/wince/system.pp deleted file mode 100644 index 0bc1b0b488..0000000000 --- a/rtl/wince/system.pp +++ /dev/null @@ -1,1668 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2005 by Florian Klaempfl and Pavel Ozerski - and Yury Sidorov member of the Free Pascal development team. - - FPC Pascal system unit for the WinCE. - - 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 System; - -interface - -{$ifdef SYSTEMDEBUG} - {$define SYSTEMEXCEPTIONDEBUG} -{$endif SYSTEMDEBUG} - -{$define WINCE_EXCEPTION_HANDLING} - -{ include system-independent routine headers } -{$I systemh.inc} - -const - LineEnding = #13#10; - LFNSupport = true; - DirectorySeparator = '\'; - DriveSeparator = ':'; - PathSeparator = ';'; -{ FileNameCaseSensitive is defined separately below!!! } - maxExitCode = 65535; - MaxPathLen = 260; - -const -{ Default filehandles } - UnusedHandle : THandle = -1; - StdInputHandle : THandle = 0; - StdOutputHandle : THandle = 0; - StdErrorHandle : THandle = 0; - - FileNameCaseSensitive : boolean = true; - CtrlZMarksEOF: boolean = true; (* #26 not considered as end of file *) - - sLineBreak = LineEnding; - DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF; - - { Thread count for DLL } - Thread_count : longint = 0; - -var -{ C compatible arguments } - argc : longint; - argv : ppchar; -{ WinCE Info } - hprevinst, - MainInstance, - DLLreason,DLLparam:longint; - Win32StackTop : Dword; // Used by heaptrc unit - -type - TDLL_Process_Entry_Hook = function (dllparam : longint) : longbool; - TDLL_Entry_Hook = procedure (dllparam : longint); - -const - Dll_Process_Attach_Hook : TDLL_Process_Entry_Hook = nil; - Dll_Process_Detach_Hook : TDLL_Entry_Hook = nil; - Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil; - Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil; - -{ ANSI <-> Wide } -function AnsiToWideBuf(AnsiBuf: PChar; AnsiBufLen: longint; WideBuf: PWideChar; WideBufLen: longint): longint; -function WideToAnsiBuf(WideBuf: PWideChar; WideBufLen: longint; AnsiBuf: PChar; AnsiBufLen: longint): longint; -function PCharToPWideChar(str: PChar; strlen: longint = -1; outlen: PLongInt = nil): PWideChar; -function StringToPWideChar(const s: AnsiString; outlen: PLongInt = nil): PWideChar; - -{ Wrappers for some WinAPI calls } -function CreateEvent(lpEventAttributes:pointer;bManualReset:longbool;bInitialState:longbool;lpName:pchar): THandle; stdcall; -function ResetEvent(h: THandle): LONGBOOL; stdcall; -function SetEvent(h: THandle): LONGBOOL; stdcall; -function GetCurrentProcessId:DWORD; stdcall; -function Win32GetCurrentThreadId:DWORD; stdcall; -function TlsAlloc : DWord; stdcall; -function TlsFree(dwTlsIndex : DWord) : LongBool; stdcall; - -function GetFileAttributes(p : pchar) : dword; stdcall; -function DeleteFile(p : pchar) : longint; stdcall; -function MoveFile(old,_new : pchar) : longint; stdcall; -function CreateFile(lpFileName:pchar; dwDesiredAccess:DWORD; dwShareMode:DWORD; - lpSecurityAttributes:pointer; dwCreationDisposition:DWORD; - dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):longint; stdcall; - -function CreateDirectory(name : pointer;sec : pointer) : longbool; stdcall; -function RemoveDirectory(name:pointer):longbool; stdcall; - - -{$ifdef CPUARM} -{ the external directive isn't really necessary here because it is overriden by external (FK) } - -function addd(d1,d2 : double) : double; compilerproc; - cdecl;external 'coredll' name '__addd'; - -function subd(d1,d2 : double) : double; compilerproc; - cdecl;external 'coredll' name '__subd'; - -function muld(d1,d2 : double) : double; compilerproc; - cdecl;external 'coredll' name '__muld'; - -function divd(d1,d2 : double) : double; compilerproc; - cdecl;external 'coredll' name '__divd'; - -function eqd(d1,d2 : double) : boolean; compilerproc; - cdecl;external 'coredll' name '__eqd'; - -function ned(d1,d2 : double) : boolean; compilerproc; - cdecl;external 'coredll' name '__ned'; - -function ltd(d1,d2 : double) : boolean; compilerproc; - cdecl;external 'coredll' name '__ltd'; - -function gtd(d1,d2 : double) : boolean; compilerproc; - cdecl;external 'coredll' name '__gtd'; - -function ged(d1,d2 : double) : boolean; compilerproc; - cdecl;external 'coredll' name '__ged'; - -function led(d1,d2 : double) : boolean; compilerproc; - cdecl;external 'coredll' name '__led'; - -{ ***************** single ******************** } - -function eqs(d1,d2 : single) : boolean; compilerproc; - cdecl;external 'coredll' name '__eqs'; - -function nes(d1,d2 : single) : boolean; compilerproc; - cdecl;external 'coredll' name '__nes'; - -function lts(d1,d2 : single) : boolean; compilerproc; - cdecl;external 'coredll' name '__lts'; - -function gts(d1,d2 : single) : boolean; compilerproc; - cdecl;external 'coredll' name '__gts'; - -function ges(d1,d2 : single) : boolean; compilerproc; - cdecl;external 'coredll' name '__ges'; - -function les(d1,d2 : single) : boolean; compilerproc; - cdecl;external 'coredll' name '__les'; - -function dtos(d : double) : single; compilerproc; - cdecl;external 'coredll' name '__dtos'; - -function stod(d : single) : double; compilerproc; - cdecl;external 'coredll' name '__stod'; - -function negs(d : single) : single; compilerproc; - cdecl;external 'coredll' name '__negs'; - -function negd(d : double) : double; compilerproc; - cdecl;external 'coredll' name '__negd'; - -function utod(i : dword) : double; compilerproc; - cdecl;external 'coredll' name '__utod'; - -function itod(i : longint) : double; compilerproc; - cdecl;external 'coredll' name '__itod'; - -function ui64tod(i : qword) : double; compilerproc; - cdecl;external 'coredll' name '__u64tod'; - -function i64tod(i : int64) : double; compilerproc; - cdecl;external 'coredll' name '__i64tod'; - -function adds(s1,s2 : single) : single; compilerproc; -function subs(s1,s2 : single) : single; compilerproc; -function muls(s1,s2 : single) : single; compilerproc; -function divs(s1,s2 : single) : single; compilerproc; -{$endif CPUARM} - -implementation - -var - SysInstance : Longint; - -{$define HAS_RESOURCES} -{$i winres.inc} - -function MessageBox(w1:longint;l1,l2:PWideChar;w2:longint):longint; - stdcall;external 'coredll' name 'MessageBoxW'; - -{*****************************************************************************} - -{$define FPC_SYSTEM_HAS_MOVE} -procedure memmove(dest, src: pointer; count: longint); - cdecl; external 'coredll' name 'memmove'; - -procedure Move(const source;var dest;count:SizeInt);[public, alias: 'FPC_MOVE']; -begin - memmove(@dest, @source, count); -end; - -{$define FPC_SYSTEM_HAS_COMPAREBYTE} -function memcmp(buf1, buf2: pointer; count: longint): longint; - cdecl; external 'coredll' name 'memcmp'; - -function CompareByte(Const buf1,buf2;len:SizeInt):SizeInt; -begin - CompareByte := memcmp(@buf1, @buf2, len); -end; - -{$ifdef CPUARM} - -{$define FPC_SYSTEM_HAS_INT} -function fpc_int_real(d: ValReal): ValReal;compilerproc; -begin - fpc_int_real := i64tod(trunc(d)); -end; - -{$define FPC_SYSTEM_HAS_TRUNC} -function fpc_trunc_real(d : ValReal) : int64;compilerproc; - external 'coredll' name '__dtoi64'; - -{$define FPC_SYSTEM_HAS_ABS} -function fpc_abs_real(d : ValReal) : ValReal;compilerproc; - external 'coredll' name 'fabs'; - -{$define FPC_SYSTEM_HAS_SQRT} -function fpc_sqrt_real(d : ValReal) : ValReal;compilerproc; - external 'coredll' name 'sqrt'; - -function adds(s1,s2 : single) : single; -begin - adds := addd(s1, s2); -end; - -function subs(s1,s2 : single) : single; -begin - subs := subd(s1, s2); -end; - -function muls(s1,s2 : single) : single; -begin - muls := muld(s1, s2); -end; - -function divs(s1,s2 : single) : single; -begin - divs := divd(s1, s2); -end; - -{$endif CPUARM} - -{*****************************************************************************} - -{ include system independent routines } -{$I system.inc} - -{***************************************************************************** - ANSI <-> Wide -*****************************************************************************} -const - { MultiByteToWideChar } - MB_PRECOMPOSED = 1; - MB_COMPOSITE = 2; - MB_ERR_INVALID_CHARS = 8; - MB_USEGLYPHCHARS = 4; - CP_ACP = 0; - CP_OEMCP = 1; - -function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:PChar; cchMultiByte:longint; lpWideCharStr:PWideChar;cchWideChar:longint):longint; - stdcall; external 'coredll' name 'MultiByteToWideChar'; -function WideCharToMultiByte(CodePage:UINT; dwFlags:DWORD; lpWideCharStr:PWideChar; cchWideChar:longint; lpMultiByteStr:PChar;cchMultiByte:longint; lpDefaultChar:PChar; lpUsedDefaultChar:pointer):longint; - stdcall; external 'coredll' name 'WideCharToMultiByte'; - -function AnsiToWideBuf(AnsiBuf: PChar; AnsiBufLen: longint; WideBuf: PWideChar; WideBufLen: longint): longint; -begin - Result := MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, AnsiBuf, AnsiBufLen, WideBuf, WideBufLen div SizeOf(WideChar)); - if ((AnsiBufLen <> -1) or (Result = 0)) and (WideBuf <> nil) then - begin - if (Result + 1)*SizeOf(WideChar) > WideBufLen then - begin - Result := 0; - if WideBufLen < SizeOf(WideChar) then - exit; - end; - WideBuf[Result] := #0; - if (Result <> 0) or (AnsiBufLen = 0) then - Inc(Result); - end; - Result:=Result*SizeOf(WideChar); -end; - -function WideToAnsiBuf(WideBuf: PWideChar; WideBufLen: longint; AnsiBuf: PChar; AnsiBufLen: longint): longint; -begin - Result := WideCharToMultiByte(CP_ACP, 0, WideBuf, WideBufLen, AnsiBuf, AnsiBufLen, nil, nil); - if ((WideBufLen <> -1) or (Result = 0)) and (AnsiBuf <> nil) then - begin - if Result + 1 > AnsiBufLen then - begin - Result := 0; - if AnsiBufLen < 1 then - exit; - end; - AnsiBuf[Result] := #0; - if (Result <> 0) or (WideBufLen = 0) then - Inc(Result); - end; -end; - -function PCharToPWideChar(str: PChar; strlen: longint = -1; outlen: PLongInt = nil): PWideChar; -var - len: longint; -begin - while True do begin - if strlen <> -1 then - len:=(strlen + 1) - else - len:=AnsiToWideBuf(str, -1, nil, 0); - if len > 0 then - begin - len:=len*SizeOf(WideChar); - GetMem(Result, len); - if (AnsiToWideBuf(str, -1, Result, len) = 0) and (strlen <> -1) then - begin - strlen:=-1; - continue; - end; - end - else begin - GetMem(Result, SizeOf(WideChar)); - Inc(len); - Result^:=#0; - end; - break; - end; - if outlen <> nil then - outlen^:=(len - 1)*SizeOf(WideChar); -end; - -function StringToPWideChar(const s: AnsiString; outlen: PLongInt = nil): PWideChar; -var - len, wlen: longint; -begin - len:=Length(s); - wlen:=(len + 1)*SizeOf(WideChar); - GetMem(Result, wlen); - wlen:=AnsiToWideBuf(PChar(s), len, Result, wlen); - if wlen = 0 then - begin - wlen:=AnsiToWideBuf(PChar(s), len, nil, 0); - if wlen > 0 then - begin - ReAllocMem(Result, wlen); - wlen:=AnsiToWideBuf(PChar(s), len, Result, wlen); - end - else - begin - Result^:=#0; - wlen:=SizeOf(WideChar); - end; - end; - if outlen <> nil then - outlen^:=(wlen - 1) div SizeOf(WideChar); -end; - -{***************************************************************************** - WinAPI wrappers implementation -*****************************************************************************} - -function GetFileAttributesW(p : pwidechar) : dword; - stdcall;external KernelDLL name 'GetFileAttributesW'; -function DeleteFileW(p : pwidechar) : longint; - stdcall;external KernelDLL name 'DeleteFileW'; -function MoveFileW(old,_new : pwidechar) : longint; - stdcall;external KernelDLL name 'MoveFileW'; -function CreateFileW(lpFileName:pwidechar; dwDesiredAccess:DWORD; dwShareMode:DWORD; - lpSecurityAttributes:pointer; dwCreationDisposition:DWORD; - dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):longint; - stdcall;external KernelDLL name 'CreateFileW'; -function CreateDirectoryW(name : pwidechar;sec : pointer) : longbool; - stdcall;external KernelDLL name 'CreateDirectoryW'; -function RemoveDirectoryW(name:pwidechar):longbool; - stdcall;external KernelDLL name 'RemoveDirectoryW'; - -function GetFileAttributes(p : pchar) : dword; stdcall; -var - buf: array[0..MaxPathLen] of WideChar; -begin - AnsiToWideBuf(p, -1, buf, SizeOf(buf)); - GetFileAttributes := GetFileAttributesW(buf); -end; - -function DeleteFile(p : pchar) : longint; stdcall; -var - buf: array[0..MaxPathLen] of WideChar; -begin - AnsiToWideBuf(p, -1, buf, SizeOf(buf)); - DeleteFile := DeleteFileW(buf); -end; - -function MoveFile(old,_new : pchar) : longint; stdcall; -var - buf_old, buf_new: array[0..MaxPathLen] of WideChar; -begin - AnsiToWideBuf(old, -1, buf_old, SizeOf(buf_old)); - AnsiToWideBuf(_new, -1, buf_new, SizeOf(buf_new)); - MoveFile := MoveFileW(buf_old, buf_new); -end; - -function CreateFile(lpFileName:pchar; dwDesiredAccess:DWORD; dwShareMode:DWORD; - lpSecurityAttributes:pointer; dwCreationDisposition:DWORD; - dwFlagsAndAttributes:DWORD; hTemplateFile:DWORD):longint; stdcall; -var - buf: array[0..MaxPathLen] of WideChar; -begin - AnsiToWideBuf(lpFileName, -1, buf, SizeOf(buf)); - CreateFile := CreateFileW(buf, dwDesiredAccess, dwShareMode, lpSecurityAttributes, - dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile); -end; - -function CreateDirectory(name : pointer;sec : pointer) : longbool; stdcall; -var - buf: array[0..MaxPathLen] of WideChar; -begin - AnsiToWideBuf(name, -1, buf, SizeOf(buf)); - CreateDirectory := CreateDirectoryW(buf, sec); -end; - -function RemoveDirectory(name:pointer):longbool; stdcall; -var - buf: array[0..MaxPathLen] of WideChar; -begin - AnsiToWideBuf(name, -1, buf, SizeOf(buf)); - RemoveDirectory := RemoveDirectoryW(buf); -end; - -const -{$ifdef CPUARM} - UserKData = $FFFFC800; -{$else CPUARM} - UserKData = $00005800; -{$endif CPUARM} - SYSHANDLE_OFFSET = $004; - SYS_HANDLE_BASE = 64; - SH_CURTHREAD = 1; - SH_CURPROC = 2; - -type - PHandle = ^THandle; - -const - EVENT_PULSE = 1; - EVENT_RESET = 2; - EVENT_SET = 3; - -function CreateEventW(lpEventAttributes:pointer;bManualReset:longbool;bInitialState:longbool;lpName:PWideChar): THandle; - stdcall; external KernelDLL name 'CreateEventW'; - -function CreateEvent(lpEventAttributes:pointer;bManualReset:longbool;bInitialState:longbool;lpName:pchar): THandle; stdcall; -var - buf: array[0..MaxPathLen] of WideChar; -begin - AnsiToWideBuf(lpName, -1, buf, SizeOf(buf)); - CreateEvent := CreateEventW(lpEventAttributes, bManualReset, bInitialState, buf); -end; - -function EventModify(h: THandle; func: DWORD): LONGBOOL; - stdcall; external KernelDLL name 'EventModify'; -function TlsCall(p1, p2: DWORD): DWORD; - stdcall; external KernelDLL name 'TlsCall'; - -function ResetEvent(h: THandle): LONGBOOL; stdcall; -begin - ResetEvent := EventModify(h,EVENT_RESET); -end; - -function SetEvent(h: THandle): LONGBOOL; stdcall; -begin - SetEvent := EventModify(h,EVENT_SET); -end; - -function GetCurrentProcessId:DWORD; stdcall; -var - p: PHandle; -begin - p:=PHandle(UserKData+SYSHANDLE_OFFSET + SH_CURPROC*SizeOf(THandle)); - GetCurrentProcessId := p^; -end; - -function Win32GetCurrentThreadId:DWORD; stdcall; -var - p: PHandle; -begin - p:=PHandle(UserKData+SYSHANDLE_OFFSET + SH_CURTHREAD*SizeOf(THandle)); - Win32GetCurrentThreadId := p^; -end; - -const - TLS_FUNCALLOC = 0; - TLS_FUNCFREE = 1; - -function TlsAlloc : DWord; stdcall; -begin - TlsAlloc := TlsCall(TLS_FUNCALLOC, 0); -end; - -function TlsFree(dwTlsIndex : DWord) : LongBool; stdcall; -begin - TlsFree := LongBool(TlsCall(TLS_FUNCFREE, dwTlsIndex)); -end; - -{***************************************************************************** - Parameter Handling -*****************************************************************************} - -function GetCommandLine : pwidechar; - stdcall;external KernelDLL name 'GetCommandLineW'; - -var - ModuleName : array[0..255] of char; - -function GetCommandFile:pchar; -var - buf: array[0..MaxPathLen] of WideChar; -begin - if ModuleName[0] = #0 then begin - GetModuleFileName(0, @buf, SizeOf(buf)); - WideToAnsiBuf(buf, -1, @ModuleName, SizeOf(ModuleName)); - end; - GetCommandFile:=@ModuleName; -end; - -procedure setup_arguments; -var - arglen, - count : longint; - argstart, - pc,arg : pchar; - quote : char; - argvlen : longint; - - procedure allocarg(idx,len:longint); - var - oldargvlen : longint; - begin - if idx>=argvlen then - begin - oldargvlen:=argvlen; - argvlen:=(idx+8) and (not 7); - sysreallocmem(argv,argvlen*sizeof(pointer)); - fillchar(argv[oldargvlen],(argvlen-oldargvlen)*sizeof(pointer),0); - end; - { use realloc to reuse already existing memory } - { always allocate, even if length is zero, since } - { the arg. is still present! } - sysreallocmem(argv[idx],len+1); - end; - -begin - { create commandline, it starts with the executed filename which is argv[0] } - { WinCE passes the command NOT via the args, but via getmodulefilename} - argv:=nil; - argvlen:=0; - pc:=getcommandfile; - Arglen:=0; - while pc[Arglen] <> #0 do - Inc(Arglen); - allocarg(0,arglen); - move(pc^,argv[0]^,arglen+1); - { Setup cmdline variable } - arg:=PChar(GetCommandLine); - count:=WideToAnsiBuf(PWideChar(arg), -1, nil, 0); - cmdline:=SysGetMem(arglen + count + 3); - cmdline^:='"'; - move(pc^, (cmdline + 1)^, arglen); - (cmdline + arglen + 1)^:='"'; - (cmdline + arglen + 2)^:=' '; - WideToAnsiBuf(PWideChar(arg), -1, cmdline + arglen + 3, count); - { process arguments } - count:=0; - pc:=cmdline; -{$IfDef SYSTEM_DEBUG_STARTUP} - Writeln(stderr,'WinCE GetCommandLine is #',pc,'#'); -{$EndIf } - while pc^<>#0 do - begin - { skip leading spaces } - while pc^ in [#1..#32] do - inc(pc); - if pc^=#0 then - break; - { calc argument length } - quote:=' '; - argstart:=pc; - arglen:=0; - while (pc^<>#0) do - begin - case pc^ of - #1..#32 : - begin - if quote<>' ' then - inc(arglen) - else - break; - end; - '"' : - begin - if quote<>'''' then - begin - if pchar(pc+1)^<>'"' then - begin - if quote='"' then - quote:=' ' - else - quote:='"'; - end - else - inc(pc); - end - else - inc(arglen); - end; - '''' : - begin - if quote<>'"' then - begin - if pchar(pc+1)^<>'''' then - begin - if quote='''' then - quote:=' ' - else - quote:=''''; - end - else - inc(pc); - end - else - inc(arglen); - end; - else - inc(arglen); - end; - inc(pc); - end; - { copy argument } - { Don't copy the first one, it is already there.} - If Count<>0 then - begin - allocarg(count,arglen); - quote:=' '; - pc:=argstart; - arg:=argv[count]; - while (pc^<>#0) do - begin - case pc^ of - #1..#32 : - begin - if quote<>' ' then - begin - arg^:=pc^; - inc(arg); - end - else - break; - end; - '"' : - begin - if quote<>'''' then - begin - if pchar(pc+1)^<>'"' then - begin - if quote='"' then - quote:=' ' - else - quote:='"'; - end - else - inc(pc); - end - else - begin - arg^:=pc^; - inc(arg); - end; - end; - '''' : - begin - if quote<>'"' then - begin - if pchar(pc+1)^<>'''' then - begin - if quote='''' then - quote:=' ' - else - quote:=''''; - end - else - inc(pc); - end - else - begin - arg^:=pc^; - inc(arg); - end; - end; - else - begin - arg^:=pc^; - inc(arg); - end; - end; - inc(pc); - end; - arg^:=#0; - end; - {$IfDef SYSTEM_DEBUG_STARTUP} - Writeln(stderr,'dos arg ',count,' #',arglen,'#',argv[count],'#'); - {$EndIf SYSTEM_DEBUG_STARTUP} - inc(count); - end; - { get argc and create an nil entry } - argc:=count; - allocarg(argc,0); - { free unused memory } - sysreallocmem(argv,(argc+1)*sizeof(pointer)); -end; - - -function paramcount : longint; -begin - paramcount := argc - 1; -end; - -function paramstr(l : longint) : string; -begin - if (l>=0) and (l<argc) then - paramstr:=strpas(argv[l]) - else - paramstr:=''; -end; - - -procedure randomize; -begin - randseed:=GetTickCount; -end; - - -{***************************************************************************** - System Dependent Exit code -*****************************************************************************} - -procedure PascalMain;stdcall;external name 'PASCALMAIN'; -procedure fpc_do_exit;stdcall;external name 'FPC_DO_EXIT'; -Procedure ExitDLL(Exitcode : longint); forward; -procedure asm_exit(Exitcode : longint);external name 'asm_exit'; - -Procedure system_exit; -begin - SysFreeMem(cmdline); - { don't call ExitProcess inside - the DLL exit code !! - This crashes Win95 at least PM } - if IsLibrary then - ExitDLL(ExitCode); - if not IsConsole then begin - Close(stderr); - Close(stdout); - { what about Input and Output ?? PM } - end; - { call exitprocess, with cleanup as required } - asm_exit(exitcode); -end; - -var - { value of the stack segment - to check if the call stack can be written on exceptions } - _SS : Cardinal; - -Const - { DllEntryPoint } - DLL_PROCESS_ATTACH = 1; - DLL_THREAD_ATTACH = 2; - DLL_PROCESS_DETACH = 0; - DLL_THREAD_DETACH = 3; -Var - DLLBuf : Jmp_buf; -Const - DLLExitOK : boolean = true; - -function Dll_entry : longbool;[public, alias : '_FPC_DLL_Entry']; -var - res : longbool; - - begin - IsLibrary:=true; - Dll_entry:=false; - case DLLreason of - DLL_PROCESS_ATTACH : - begin - If SetJmp(DLLBuf) = 0 then - begin - if assigned(Dll_Process_Attach_Hook) then - begin - res:=Dll_Process_Attach_Hook(DllParam); - if not res then - exit(false); - end; - PASCALMAIN; - Dll_entry:=true; - end - else - Dll_entry:=DLLExitOK; - end; - DLL_THREAD_ATTACH : - begin - inc(Thread_count); -{$warning Allocate Threadvars !} - if assigned(Dll_Thread_Attach_Hook) then - Dll_Thread_Attach_Hook(DllParam); - Dll_entry:=true; { return value is ignored } - end; - DLL_THREAD_DETACH : - begin - dec(Thread_count); - if assigned(Dll_Thread_Detach_Hook) then - Dll_Thread_Detach_Hook(DllParam); -{$warning Release Threadvars !} - Dll_entry:=true; { return value is ignored } - end; - DLL_PROCESS_DETACH : - begin - Dll_entry:=true; { return value is ignored } - If SetJmp(DLLBuf) = 0 then - begin - FPC_DO_EXIT; - end; - if assigned(Dll_Process_Detach_Hook) then - Dll_Process_Detach_Hook(DllParam); - end; - end; - end; - -Procedure ExitDLL(Exitcode : longint); -begin - DLLExitOK:=ExitCode=0; - LongJmp(DLLBuf,1); -end; - -{$ifdef WINCE_EXCEPTION_HANDLING} - -// -// Hardware exception handling -// - -{ - Error code definitions for the WinCE API functions - - - Values are 32 bit values layed out as follows: - 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 - 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 - +---+-+-+-----------------------+-------------------------------+ - |Sev|C|R| Facility | Code | - +---+-+-+-----------------------+-------------------------------+ - - where - Sev - is the severity code - 00 - Success - 01 - Informational - 10 - Warning - 11 - Error - - C - is the Customer code flag - R - is a reserved bit - Facility - is the facility code - Code - is the facility's status code -} - -const - SEVERITY_SUCCESS = $00000000; - SEVERITY_INFORMATIONAL = $40000000; - SEVERITY_WARNING = $80000000; - SEVERITY_ERROR = $C0000000; - -const - STATUS_SEGMENT_NOTIFICATION = $40000005; - DBG_TERMINATE_THREAD = $40010003; - DBG_TERMINATE_PROCESS = $40010004; - DBG_CONTROL_C = $40010005; - DBG_CONTROL_BREAK = $40010008; - - STATUS_GUARD_PAGE_VIOLATION = $80000001; - STATUS_DATATYPE_MISALIGNMENT = $80000002; - STATUS_BREAKPOINT = $80000003; - STATUS_SINGLE_STEP = $80000004; - DBG_EXCEPTION_NOT_HANDLED = $80010001; - - STATUS_ACCESS_VIOLATION = $C0000005; - STATUS_IN_PAGE_ERROR = $C0000006; - STATUS_INVALID_HANDLE = $C0000008; - STATUS_NO_MEMORY = $C0000017; - STATUS_ILLEGAL_INSTRUCTION = $C000001D; - STATUS_NONCONTINUABLE_EXCEPTION = $C0000025; - STATUS_INVALID_DISPOSITION = $C0000026; - STATUS_ARRAY_BOUNDS_EXCEEDED = $C000008C; - STATUS_FLOAT_DENORMAL_OPERAND = $C000008D; - STATUS_FLOAT_DIVIDE_BY_ZERO = $C000008E; - STATUS_FLOAT_INEXACT_RESULT = $C000008F; - STATUS_FLOAT_INVALID_OPERATION = $C0000090; - STATUS_FLOAT_OVERFLOW = $C0000091; - STATUS_FLOAT_STACK_CHECK = $C0000092; - STATUS_FLOAT_UNDERFLOW = $C0000093; - STATUS_INTEGER_DIVIDE_BY_ZERO = $C0000094; - STATUS_INTEGER_OVERFLOW = $C0000095; - STATUS_PRIVILEGED_INSTRUCTION = $C0000096; - STATUS_STACK_OVERFLOW = $C00000FD; - STATUS_CONTROL_C_EXIT = $C000013A; - STATUS_FLOAT_MULTIPLE_FAULTS = $C00002B4; - STATUS_FLOAT_MULTIPLE_TRAPS = $C00002B5; - STATUS_REG_NAT_CONSUMPTION = $C00002C9; - -const - ExceptionContinueExecution = 0; - ExceptionContinueSearch = 1; - ExceptionNestedException = 2; - ExceptionCollidedUnwind = 3; - ExceptionExecuteHandler = 4; - - MaxExceptionLevel = 16; - exceptLevel : Byte = 0; - -{$ifdef CPUARM} -const - CONTEXT_ARM = $0000040; - CONTEXT_CONTROL = CONTEXT_ARM or $00000001; - CONTEXT_INTEGER = CONTEXT_ARM or $00000002; - CONTEXT_SEGMENTS = CONTEXT_ARM or $00000004; - CONTEXT_FLOATING_POINT = CONTEXT_ARM or $00000008; - CONTEXT_DEBUG_REGISTERS = CONTEXT_ARM or $00000010; - CONTEXT_EXTENDED_REGISTERS = CONTEXT_ARM or $00000020; - - CONTEXT_FULL = CONTEXT_CONTROL or CONTEXT_INTEGER or CONTEXT_SEGMENTS; - - EXCEPTION_MAXIMUM_PARAMETERS = 15; - - NUM_VFP_REGS = 32; - NUM_EXTRA_CONTROL_REGS = 8; - -type - PContext = ^TContext; - TContext = record - ContextFlags : LongWord; -// This section is specified/returned if the ContextFlags word contains -// the flag CONTEXT_INTEGER. - R0 : LongWord; - R1 : LongWord; - R2 : LongWord; - R3 : LongWord; - R4 : LongWord; - R5 : LongWord; - R6 : LongWord; - R7 : LongWord; - R8 : LongWord; - R9 : LongWord; - R10 : LongWord; - R11 : LongWord; - R12 : LongWord; -// This section is specified/returned if the ContextFlags word contains -// the flag CONTEXT_CONTROL. - Sp : LongWord; - Lr : LongWord; - Pc : LongWord; - Psr : LongWord; - Fpscr : LongWord; - FpExc : LongWord; -// Floating point registers - S : array[0..(NUM_VFP_REGS + 1)-1] of LongWord; - FpExtra : array[0..(NUM_EXTRA_CONTROL_REGS)-1] of LongWord; - end; -{$endif CPUARM} - -{$ifdef CPUI386} -const - CONTEXT_X86 = $00010000; - CONTEXT_CONTROL = CONTEXT_X86 or $00000001; - CONTEXT_INTEGER = CONTEXT_X86 or $00000002; - CONTEXT_SEGMENTS = CONTEXT_X86 or $00000004; - CONTEXT_FLOATING_POINT = CONTEXT_X86 or $00000008; - CONTEXT_DEBUG_REGISTERS = CONTEXT_X86 or $00000010; - CONTEXT_EXTENDED_REGISTERS = CONTEXT_X86 or $00000020; - - MAXIMUM_SUPPORTED_EXTENSION = 512; - EXCEPTION_MAXIMUM_PARAMETERS = 15; - -type - PFloatingSaveArea = ^TFloatingSaveArea; - TFloatingSaveArea = packed record - ControlWord : Cardinal; - StatusWord : Cardinal; - TagWord : Cardinal; - ErrorOffset : Cardinal; - ErrorSelector : Cardinal; - DataOffset : Cardinal; - DataSelector : Cardinal; - RegisterArea : array[0..79] of Byte; - Cr0NpxState : Cardinal; - end; - - PContext = ^TContext; - TContext = packed record - // - // The flags values within this flag control the contents of - // a CONTEXT record. - // - ContextFlags : Cardinal; - - // - // This section is specified/returned if CONTEXT_DEBUG_REGISTERS is - // set in ContextFlags. Note that CONTEXT_DEBUG_REGISTERS is NOT - // included in CONTEXT_FULL. - // - Dr0, Dr1, Dr2, - Dr3, Dr6, Dr7 : Cardinal; - - // - // This section is specified/returned if the - // ContextFlags word contains the flag CONTEXT_FLOATING_POINT. - // - FloatSave : TFloatingSaveArea; - - // - // This section is specified/returned if the - // ContextFlags word contains the flag CONTEXT_SEGMENTS. - // - SegGs, SegFs, - SegEs, SegDs : Cardinal; - - // - // This section is specified/returned if the - // ContextFlags word contains the flag CONTEXT_INTEGER. - // - Edi, Esi, Ebx, - Edx, Ecx, Eax : Cardinal; - - // - // This section is specified/returned if the - // ContextFlags word contains the flag CONTEXT_CONTROL. - // - Ebp : Cardinal; - Eip : Cardinal; - SegCs : Cardinal; - EFlags, Esp, SegSs : Cardinal; - - // - // This section is specified/returned if the ContextFlags word - // contains the flag CONTEXT_EXTENDED_REGISTERS. - // The format and contexts are processor specific - // - ExtendedRegisters : array[0..MAXIMUM_SUPPORTED_EXTENSION-1] of Byte; - end; -{$endif CPUI386} - -type - PExceptionRecord = ^TExceptionRecord; - TExceptionRecord = packed record - ExceptionCode : Longint; - ExceptionFlags : Longint; - ExceptionRecord : PExceptionRecord; - ExceptionAddress : Pointer; - NumberParameters : Longint; - ExceptionInformation : array[0..EXCEPTION_MAXIMUM_PARAMETERS-1] of Pointer; - end; - - PExceptionPointers = ^TExceptionPointers; - TExceptionPointers = packed record - ExceptionRecord : PExceptionRecord; - ContextRecord : PContext; - end; - -{$ifdef CPUI386} -{**************************** i386 Exception handling *****************************************} - -function GetCurrentProcess:DWORD; stdcall; -begin - GetCurrentProcess := SH_CURPROC+SYS_HANDLE_BASE; -end; - -function ReadProcessMemory(process : dword;address : pointer;dest : pointer;size : dword;bytesread : pdword) : longbool; - stdcall;external 'coredll' name 'ReadProcessMemory'; - -function is_prefetch(p : pointer) : boolean; -var - a : array[0..15] of byte; - doagain : boolean; - instrlo,instrhi,opcode : byte; - i : longint; -begin - result:=false; - { read memory savely without causing another exeception } - if not(ReadProcessMemory(GetCurrentProcess,p,@a,sizeof(a),nil)) then - exit; - i:=0; - doagain:=true; - while doagain and (i<15) do - begin - opcode:=a[i]; - instrlo:=opcode and $f; - instrhi:=opcode and $f0; - case instrhi of - { prefix? } - $20,$30: - doagain:=(instrlo and 7)=6; - $60: - doagain:=(instrlo and $c)=4; - $f0: - doagain:=instrlo in [0,2,3]; - $0: - begin - result:=(instrlo=$f) and (a[i+1] in [$d,$18]); - exit; - end; - else - doagain:=false; - end; - inc(i); - end; -end; - -var - exceptEip : array[0..MaxExceptionLevel-1] of Longint; - exceptError : array[0..MaxExceptionLevel-1] of Byte; - resetFPU : array[0..MaxExceptionLevel-1] of Boolean; - -{$ifdef SYSTEMEXCEPTIONDEBUG} -procedure DebugHandleErrorAddrFrame(error, addr, frame : longint); -begin - if IsConsole then - begin - write(stderr,'HandleErrorAddrFrame(error=',error); - write(stderr,',addr=',hexstr(addr,8)); - writeln(stderr,',frame=',hexstr(frame,8),')'); - end; - HandleErrorAddrFrame(error,addr,frame); -end; -{$endif SYSTEMEXCEPTIONDEBUG} - -procedure JumpToHandleErrorFrame; -var - eip, ebp, error : Longint; -begin - // save ebp - asm - movl (%ebp),%eax - movl %eax,ebp - end; - if (exceptLevel > 0) then - dec(exceptLevel); - - eip:=exceptEip[exceptLevel]; - error:=exceptError[exceptLevel]; -{$ifdef SYSTEMEXCEPTIONDEBUG} - if IsConsole then - writeln(stderr,'In JumpToHandleErrorFrame error=',error); -{$endif SYSTEMEXCEPTIONDEBUG} - if resetFPU[exceptLevel] then asm - fninit - fldcw fpucw - end; - { build a fake stack } - asm -{$ifdef REGCALL} - movl ebp,%ecx - movl eip,%edx - movl error,%eax - pushl eip - movl ebp,%ebp // Change frame pointer -{$else} - movl ebp,%eax - pushl %eax - movl eip,%eax - pushl %eax - movl error,%eax - pushl %eax - movl eip,%eax - pushl %eax - movl ebp,%ebp // Change frame pointer -{$endif} - -{$ifdef SYSTEMEXCEPTIONDEBUG} - jmpl DebugHandleErrorAddrFrame -{$else not SYSTEMEXCEPTIONDEBUG} - jmpl HandleErrorAddrFrame -{$endif SYSTEMEXCEPTIONDEBUG} - end; -end; - -function i386_exception_handler(ExceptionRecord: PExceptionRecord; - EstablisherFrame: pointer; ContextRecord: PContext; - DispatcherContext: pointer): longint; cdecl; -var - res: longint; - must_reset_fpu: boolean; -begin - res := ExceptionContinueSearch; - if ContextRecord^.SegSs=_SS then begin - must_reset_fpu := true; - {$ifdef SYSTEMEXCEPTIONDEBUG} - if IsConsole then Writeln(stderr,'Exception ', - hexstr(excep^.ExceptionRecord^.ExceptionCode, 8)); - {$endif SYSTEMEXCEPTIONDEBUG} - case cardinal(ExceptionRecord^.ExceptionCode) of - STATUS_INTEGER_DIVIDE_BY_ZERO, - STATUS_FLOAT_DIVIDE_BY_ZERO : - res := 200; - STATUS_ARRAY_BOUNDS_EXCEEDED : - begin - res := 201; - must_reset_fpu := false; - end; - STATUS_STACK_OVERFLOW : - begin - res := 202; - must_reset_fpu := false; - end; - STATUS_FLOAT_OVERFLOW : - res := 205; - STATUS_FLOAT_DENORMAL_OPERAND, - STATUS_FLOAT_UNDERFLOW : - res := 206; - {excep^.ContextRecord^.FloatSave.StatusWord := excep^.ContextRecord^.FloatSave.StatusWord and $ffffff00;} - STATUS_FLOAT_INEXACT_RESULT, - STATUS_FLOAT_INVALID_OPERATION, - STATUS_FLOAT_STACK_CHECK : - res := 207; - STATUS_INTEGER_OVERFLOW : - begin - res := 215; - must_reset_fpu := false; - end; - STATUS_ILLEGAL_INSTRUCTION: - res := 216; - STATUS_ACCESS_VIOLATION: - { Athlon prefetch bug? } - if is_prefetch(pointer(ContextRecord^.Eip)) then - begin - { if yes, then retry } - ExceptionRecord^.ExceptionCode := 0; - res:=ExceptionContinueExecution; - end - else - res := 216; - - STATUS_CONTROL_C_EXIT: - res := 217; - STATUS_PRIVILEGED_INSTRUCTION: - begin - res := 218; - must_reset_fpu := false; - end; - else - begin - if ((ExceptionRecord^.ExceptionCode and SEVERITY_ERROR) = SEVERITY_ERROR) then - res := 217 - else - res := 255; - end; - end; - - if (res >= 200) and (exceptLevel < MaxExceptionLevel) then begin - exceptEip[exceptLevel] := ContextRecord^.Eip; - exceptError[exceptLevel] := res; - resetFPU[exceptLevel] := must_reset_fpu; - inc(exceptLevel); - - ContextRecord^.Eip := Longint(@JumpToHandleErrorFrame); - ExceptionRecord^.ExceptionCode := 0; - - res := ExceptionContinueExecution; - {$ifdef SYSTEMEXCEPTIONDEBUG} - if IsConsole then begin - writeln(stderr,'Exception Continue Exception set at ', - hexstr(exceptEip[exceptLevel],8)); - writeln(stderr,'Eip changed to ', - hexstr(longint(@JumpToHandleErrorFrame),8), ' error=', error); - end; - {$endif SYSTEMEXCEPTIONDEBUG} - end; - end; - i386_exception_handler := res; -end; - -{$endif CPUI386} - -{$ifdef CPUARM} -{**************************** ARM Exception handling *****************************************} - -var - exceptPC : array[0..MaxExceptionLevel-1] of Longint; - exceptError : array[0..MaxExceptionLevel-1] of Byte; - -procedure JumpToHandleErrorFrame; -var - _pc, _fp, _error : Longint; -begin - // get original fp - asm - ldr r0,[r11,#-12] - str r0,_fp - end; - if (exceptLevel > 0) then - dec(exceptLevel); - - _pc:=exceptPC[exceptLevel]; - _error:=exceptError[exceptLevel]; - asm - ldr r0,_error - ldr r1,_pc - ldr r2,_fp - mov r11,r2 // Change frame pointer - b HandleErrorAddrFrame - end; -end; - -function ARM_ExceptionHandler(ExceptionRecord: PExceptionRecord; - EstablisherFrame: pointer; ContextRecord: PContext; - DispatcherContext: pointer): longint; [public, alias : '_ARM_ExceptionHandler']; -var - res: longint; -begin - res := ExceptionContinueSearch; - - case cardinal(ExceptionRecord^.ExceptionCode) of - STATUS_INTEGER_DIVIDE_BY_ZERO, - STATUS_FLOAT_DIVIDE_BY_ZERO : - res := 200; - STATUS_ARRAY_BOUNDS_EXCEEDED : - res := 201; - STATUS_STACK_OVERFLOW : - res := 202; - STATUS_FLOAT_OVERFLOW : - res := 205; - STATUS_FLOAT_DENORMAL_OPERAND, - STATUS_FLOAT_UNDERFLOW : - res := 206; - STATUS_FLOAT_INEXACT_RESULT, - STATUS_FLOAT_INVALID_OPERATION, - STATUS_FLOAT_STACK_CHECK : - res := 207; - STATUS_INTEGER_OVERFLOW : - res := 215; - STATUS_ILLEGAL_INSTRUCTION: - res := 216; - STATUS_ACCESS_VIOLATION: - res := 216; - STATUS_DATATYPE_MISALIGNMENT: - res := 214; - STATUS_CONTROL_C_EXIT: - res := 217; - STATUS_PRIVILEGED_INSTRUCTION: - res := 218; - else - begin - if ((cardinal(ExceptionRecord^.ExceptionCode) and SEVERITY_ERROR) = SEVERITY_ERROR) then - res := 217 - else - res := 255; - end; - end; - - if (res <> ExceptionContinueSearch) and (exceptLevel < MaxExceptionLevel) then begin - exceptPC[exceptLevel] := ContextRecord^.PC; - exceptError[exceptLevel] := res; - inc(exceptLevel); - - ContextRecord^.PC := Longint(@JumpToHandleErrorFrame); - ExceptionRecord^.ExceptionCode := 0; - - res := ExceptionContinueExecution; - {$ifdef SYSTEMEXCEPTIONDEBUG} - if IsConsole then begin - writeln(stderr,'Exception Continue Exception set at ', - hexstr(exceptEip[exceptLevel],8)); - writeln(stderr,'Eip changed to ', - hexstr(longint(@JumpToHandleErrorFrame),8), ' error=', error); - end; - {$endif SYSTEMEXCEPTIONDEBUG} - end; - ARM_ExceptionHandler := res; -end; - -{$endif CPUARM} - -{$endif WINCE_EXCEPTION_HANDLING} - -procedure Exe_entry;[public, alias : '_FPC_EXE_Entry']; -begin - IsLibrary:=false; -{$ifdef CPUARM} - asm - mov fp,#0 - ldr r12,.LPWin32StackTop - str sp,[r12] - bl PASCALMAIN; - b .Lend -.LPWin32StackTop: - .long Win32StackTop -.Lend: - end; -{$endif CPUARM} - -{$ifdef CPUI386} - asm - {$ifdef WINCE_EXCEPTION_HANDLING} - pushl i386_exception_handler - pushl %fs:(0) - mov %esp,%fs:(0) - {$endif WINCE_EXCEPTION_HANDLING} - pushl %ebp - xorl %ebp,%ebp - movl %esp,%eax - movl %eax,Win32StackTop - movw %ss,%bp - movl %ebp,_SS - call SysResetFPU - xorl %ebp,%ebp - call PASCALMAIN - popl %ebp - {$ifdef WINCE_EXCEPTION_HANDLING} - popl %fs:(0) - addl $4, %esp - {$endif WINCE_EXCEPTION_HANDLING} - end; -{$endif CPUI386} - { if we pass here there was no error ! } - system_exit; -end; - -{**************************************************************************** - OS dependend widestrings -****************************************************************************} - -function CharUpperBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; stdcall; external KernelDLL name 'CharUpperBuffW'; -function CharLowerBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; stdcall; external KernelDLL name 'CharLowerBuffW'; - - -procedure WinCEWide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt); - var - i: integer; - begin - if len = 0 then - dest:='' - else - begin - for i:=1 to 2 do begin - setlength(dest, len); - len:=WideCharToMultiByte(CP_ACP, 0, source, len, @dest[1], len, nil, nil); - if len > 0 then - break; - len:=WideCharToMultiByte(CP_ACP, 0, source, len, nil, 0, nil, nil); - end; - setlength(dest, len); - end; - end; - -procedure WinCEAnsi2WideMove(source:pchar;var dest:widestring;len:SizeInt); - var - i: integer; - begin - if len = 0 then - dest:='' - else - begin - for i:=1 to 2 do begin - setlength(dest, len); - len:=MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len, @dest[1], len); - if len > 0 then - break; - len:=MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len, nil, 0); - end; - setlength(dest, len); - end; - end; - -function WinCEWideUpper(const s : WideString) : WideString; - begin - result:=s; - UniqueString(result); - if length(result)>0 then - CharUpperBuff(LPWSTR(result),length(result)); - end; - - -function WinCEWideLower(const s : WideString) : WideString; - begin - result:=s; - UniqueString(result); - if length(result)>0 then - CharLowerBuff(LPWSTR(result),length(result)); - end; - - -{ there is a similiar procedure in sysutils which inits the fields which - are only relevant for the sysutils units } -procedure InitWinCEWidestrings; - begin - widestringmanager.Wide2AnsiMoveProc:=@WinCEWide2AnsiMove; - widestringmanager.Ansi2WideMoveProc:=@WinCEAnsi2WideMove; - widestringmanager.UpperWideStringProc:=@WinCEWideUpper; - widestringmanager.LowerWideStringProc:=@WinCEWideLower; - end; - - - -{**************************************************************************** - Error Message writing using messageboxes -****************************************************************************} - -const - ErrorBufferLength = 1024; -var - ErrorBuf : array[0..ErrorBufferLength] of char; - ErrorBufW : array[0..ErrorBufferLength] of widechar; - ErrorLen : longint; - -Function ErrorWrite(Var F: TextRec): Integer; -{ - An error message should always end with #13#10#13#10 -} -var - p : pchar; - i : longint; -Begin - if F.BufPos>0 then - begin - if F.BufPos+ErrorLen>ErrorBufferLength then - i:=ErrorBufferLength-ErrorLen - else - i:=F.BufPos; - Move(F.BufPtr^,ErrorBuf[ErrorLen],i); - inc(ErrorLen,i); - ErrorBuf[ErrorLen]:=#0; - end; - if ErrorLen>3 then - begin - p:=@ErrorBuf[ErrorLen]; - for i:=1 to 4 do - begin - dec(p); - if not(p^ in [#10,#13]) then - break; - end; - end; - if ErrorLen=ErrorBufferLength then - i:=4; - if (i=4) then - begin - AnsiToWideBuf(@ErrorBuf, -1, @ErrorBufW, SizeOf(ErrorBufW)); - MessageBox(0,@ErrorBufW,'Error',0); - ErrorLen:=0; - end; - F.BufPos:=0; - ErrorWrite:=0; -End; - - -Function ErrorClose(Var F: TextRec): Integer; -begin - if ErrorLen>0 then - begin - AnsiToWideBuf(@ErrorBuf, -1, @ErrorBufW, SizeOf(ErrorBufW)); - MessageBox(0,@ErrorBufW,'Error',0); - ErrorLen:=0; - end; - ErrorLen:=0; - ErrorClose:=0; -end; - - -Function ErrorOpen(Var F: TextRec): Integer; -Begin - TextRec(F).InOutFunc:=@ErrorWrite; - TextRec(F).FlushFunc:=@ErrorWrite; - TextRec(F).CloseFunc:=@ErrorClose; - ErrorOpen:=0; -End; - - -procedure AssignError(Var T: Text); -begin - Assign(T,''); - TextRec(T).OpenFunc:=@ErrorOpen; - Rewrite(T); -end; - -function _getstdfilex(fd: integer): pointer; cdecl; external 'coredll'; -function _fileno(fd: pointer): THandle; cdecl; external 'coredll'; -function _controlfp(new: DWORD; mask: DWORD): DWORD; cdecl; external 'coredll'; - -procedure SysInitStdIO; -begin - { Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be - displayed in and messagebox } - if not IsConsole then begin - AssignError(stderr); - AssignError(stdout); - Assign(Output,''); - Assign(Input,''); - Assign(ErrOutput,''); - end - else begin - StdInputHandle:=_fileno(_getstdfilex(0)); - StdOutputHandle:=_fileno(_getstdfilex(1)); - StdErrorHandle:=_fileno(_getstdfilex(2)); - - OpenStdIO(Input,fmInput,StdInputHandle); - OpenStdIO(Output,fmOutput,StdOutputHandle); - OpenStdIO(ErrOutput,fmOutput,StdErrorHandle); - OpenStdIO(StdOut,fmOutput,StdOutputHandle); - OpenStdIO(StdErr,fmOutput,StdErrorHandle); - end; -end; - -(* ProcessID cached to avoid repeated calls to GetCurrentProcess. *) - -var - ProcessID: SizeUInt; - -function GetProcessID: SizeUInt; -begin - GetProcessID := ProcessID; -end; - -const - Exe_entry_code : pointer = @Exe_entry; - Dll_entry_code : pointer = @Dll_entry; - -begin - StackLength := InitialStkLen; - StackBottom := Sptr - StackLength; - { Enable FPU exceptions } - _controlfp(1, $0008001F); - { some misc stuff } - hprevinst:=0; - if not IsLibrary then - SysInstance:=GetModuleHandle(nil); - MainInstance:=SysInstance; - { Setup heap } - InitHeap; - SysInitExceptions; - SysInitStdIO; - { Arguments } - setup_arguments; - { Reset IO Error } - InOutRes:=0; - ProcessID := GetCurrentProcessID; - { threading } - InitSystemThreads; - { Reset internal error variable } - errno:=0; - initvariantmanager; - initwidestringmanager; - InitWinCEWidestrings -end. diff --git a/rtl/wince/sysutils.pp b/rtl/wince/sysutils.pp deleted file mode 100644 index d290cc7562..0000000000 --- a/rtl/wince/sysutils.pp +++ /dev/null @@ -1,973 +0,0 @@ -{
-
- This file is part of the Free Pascal run time library.
- Copyright (c) 1999-2005 by Florian Klaempfl and Yury Sidorov
- members of the Free Pascal development team
-
- Sysutils unit for wince
-
- 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 sysutils;
-interface
-
-{$MODE objfpc}
-{ force ansistrings }
-{$H+}
-
-uses
- dos,
- windows;
-
-{$DEFINE HAS_SLEEP}
-{$DEFINE HAS_OSERROR}
-{$DEFINE HAS_OSCONFIG}
-
-{ Include platform independent interface part }
-{$i sysutilh.inc}
-
-type
- EWinCEError = class(Exception)
- public
- ErrorCode : DWORD;
- end;
-
-
-Var
- WinCEPlatform : Longint;
- WinCEMajorVersion,
- WinCEMinorVersion,
- WinCEBuildNumber : dword;
- WinCECSDVersion : ShortString; // CSD record is 128 bytes only?
-
-
-implementation
-
- uses
- sysconst;
-
-{$DEFINE FPC_NOGENERICANSIROUTINES}
-{$define HASEXPANDUNCFILENAME}
-
-{ Include platform independent implementation part }
-{$i sysutils.inc}
-
-procedure PWideCharToString(const str: PWideChar; out Result: string; strlen: longint = -1);
-var
- len: longint;
-begin
- if str^ = #0 then
- Result:=''
- else
- begin
- while True do begin
- if strlen <> -1 then
- len:=(strlen + 1) div SizeOf(WideChar)
- else
- len:=WideToAnsiBuf(str, -1, nil, 0);
- if len > 0 then
- begin
- SetLength(Result, len - 1);
- if (WideToAnsiBuf(str, -1, @Result[1], len) = 0) and (strlen <> -1) then
- begin
- strlen:=-1;
- continue;
- end;
- end
- else
- Result:='';
- break;
- end;
- end;
-end;
-
-function ExpandUNCFileName (const filename:string) : string;
-{ returns empty string on errors }
-var
- s : widestring;
- size : dword;
- rc : dword;
- buf : pwidechar;
-begin
- s := ExpandFileName (filename);
-
- size := max_path*SizeOf(WideChar);
- getmem(buf,size);
-
- try
- rc := WNetGetUniversalName (pwidechar(s), UNIVERSAL_NAME_INFO_LEVEL, buf, @size);
-
- if rc=ERROR_MORE_DATA then
- begin
- buf:=reallocmem(buf,size);
- rc := WNetGetUniversalName (pwidechar(s), UNIVERSAL_NAME_INFO_LEVEL, buf, @size);
- end;
- if rc = NO_ERROR then
- Result := PRemoteNameInfo(buf)^.lpUniversalName
- else if rc = ERROR_NOT_CONNECTED then
- Result := filename
- else
- Result := '';
- finally
- freemem(buf);
- end;
-end;
-
-{****************************************************************************
- File Functions
-****************************************************************************}
-
-Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
-const
- AccessMode: array[0..2] of Cardinal = (
- GENERIC_READ,
- GENERIC_WRITE,
- GENERIC_READ or GENERIC_WRITE);
- ShareMode: array[0..4] of Integer = (
- 0,
- 0,
- FILE_SHARE_READ,
- FILE_SHARE_WRITE,
- FILE_SHARE_READ or FILE_SHARE_WRITE);
-var
- fn: PWideChar;
-begin
- fn:=StringToPWideChar(FileName);
- result := CreateFile(fn, dword(AccessMode[Mode and 3]),
- dword(ShareMode[(Mode and $F0) shr 4]), nil, OPEN_EXISTING,
- FILE_ATTRIBUTE_NORMAL, 0);
- FreeMem(fn);
-end;
-
-
-Function FileCreate (Const FileName : String) : Longint;
-var
- fn: PWideChar;
-begin
- fn:=StringToPWideChar(FileName);
- Result := CreateFile(fn, GENERIC_READ or GENERIC_WRITE,
- 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
- FreeMem(fn);
-end;
-
-
-Function FileCreate (Const FileName : String; Mode:longint) : SizeInt;
-begin
- FileCreate:=FileCreate(FileName);
-end;
-
-
-Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
-Var
- res : dword;
-begin
- if ReadFile(Handle, Buffer, Count, res, nil) then
- FileRead:=Res
- else
- FileRead:=-1;
-end;
-
-
-Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
-Var
- Res : dword;
-begin
- if WriteFile(Handle, Buffer, Count, Res, nil) then
- FileWrite:=Res
- else
- FileWrite:=-1;
-end;
-
-
-Function FileSeek (Handle,FOffset,Origin : Longint) : Longint;
-begin
- Result := longint(SetFilePointer(Handle, FOffset, nil, Origin));
-end;
-
-
-Function FileSeek (Handle : Longint; FOffset,Origin : Int64) : Int64;
-begin
- {$warning need to add 64bit call }
- Result := longint(SetFilePointer(Handle, longint(FOffset), nil, longint(Origin)));
-end;
-
-
-Procedure FileClose (Handle : Longint);
-begin
- if Handle<=4 then
- exit;
- CloseHandle(Handle);
-end;
-
-
-Function FileTruncate (Handle,Size: Longint) : boolean;
-begin
- Result:=longint(SetFilePointer(handle,Size,nil,FILE_BEGIN))<>-1;
- If Result then
- Result:=SetEndOfFile(handle);
-end;
-
-
-Function DosToWinTime (DTime:longint; out Wtime : TFileTime):longbool;
-begin
- DosToWinTime:=dos.DosToWinTime(DTime, Wtime);
-end;
-
-
-Function WinToDosTime (Const Wtime : TFileTime; out DTime:longint):longbool;
-begin
- WinToDosTime:=dos.WinToDosTime(Wtime, DTime);
-end;
-
-
-Function FileAge (Const FileName : String): Longint;
-var
- Handle: THandle;
- FindData: TWin32FindData;
- fn: PWideChar;
-begin
- fn:=StringToPWideChar(FileName);
- Handle := FindFirstFile(fn, FindData);
- FreeMem(fn);
- if Handle <> INVALID_HANDLE_VALUE then
- begin
- Windows.FindClose(Handle);
- if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
- If WinToDosTime(FindData.ftLastWriteTime,Result) then
- exit;
- end;
- Result := -1;
-end;
-
-
-Function FileExists (Const FileName : String) : Boolean;
-var
- Attr:Dword;
-begin
- Attr:=FileGetAttr(FileName);
- if Attr <> $ffffffff then
- Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) = 0
- else
- Result:=False;
-end;
-
-
-Function DirectoryExists (Const Directory : String) : Boolean;
-var
- Attr:Dword;
-begin
- Attr:=FileGetAttr(Directory);
- if Attr <> $ffffffff then
- Result:= (Attr and FILE_ATTRIBUTE_DIRECTORY) <> 0
- else
- Result:=False;
-end;
-
-
-Function FindMatch(var f: TSearchRec) : Longint;
-begin
- { Find file with correct attribute }
- While (F.FindData.dwFileAttributes and cardinal(F.ExcludeAttr))<>0 do
- begin
- if not FindNextFile (F.FindHandle,F.FindData) then
- begin
- Result:=GetLastError;
- exit;
- end;
- end;
- { Convert some attributes back }
- WinToDosTime(F.FindData.ftLastWriteTime,F.Time);
- f.size:=F.FindData.NFileSizeLow;
- f.attr:=F.FindData.dwFileAttributes;
- PWideCharToString(@F.FindData.cFileName, f.Name);
- Result:=0;
-end;
-
-
-Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
-var
- fn: PWideChar;
-begin
- fn:=StringToPWideChar(Path);
- Rslt.Name:=Path;
- Rslt.Attr:=attr;
- Rslt.ExcludeAttr:=(not Attr) and ($1e);
- { $1e = faHidden or faSysFile or faVolumeID or faDirectory }
- { FindFirstFile is a WinCE Call }
- Rslt.FindHandle:=FindFirstFile (fn, Rslt.FindData);
- FreeMem(fn);
- If Rslt.FindHandle=Invalid_Handle_value then
- begin
- Result:=GetLastError;
- exit;
- end;
- { Find file with correct attribute }
- Result:=FindMatch(Rslt);
-end;
-
-
-Function FindNext (Var Rslt : TSearchRec) : Longint;
-begin
- if FindNextFile(Rslt.FindHandle, Rslt.FindData) then
- Result := FindMatch(Rslt)
- else
- Result := GetLastError;
-end;
-
-
-Procedure FindClose (Var F : TSearchrec);
-begin
- if F.FindHandle <> INVALID_HANDLE_VALUE then
- Windows.FindClose(F.FindHandle);
-end;
-
-
-Function FileGetDate (Handle : Longint) : Longint;
-Var
- FT : TFileTime;
-begin
- If GetFileTime(Handle,nil,nil,@ft) and
- WinToDosTime(FT, Result) then
- exit;
- Result:=-1;
-end;
-
-
-Function FileSetDate (Handle,Age : Longint) : Longint;
-Var
- FT: TFileTime;
-begin
- Result := 0;
- if DosToWinTime(Age, FT) and SetFileTime(Handle, FT, FT, FT) then
- Exit;
- Result := GetLastError;
-end;
-
-
-Function FileGetAttr (Const FileName : String) : Longint;
-var
- fn: PWideChar;
-begin
- fn:=StringToPWideChar(FileName);
- Result:=GetFileAttributes(fn);
- FreeMem(fn);
-end;
-
-
-Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
-var
- fn: PWideChar;
-begin
- fn:=StringToPWideChar(FileName);
- if not SetFileAttributes(fn, Attr) then
- Result := GetLastError
- else
- Result:=0;
- FreeMem(fn);
-end;
-
-
-Function DeleteFile (Const FileName : String) : Boolean;
-var
- fn: PWideChar;
-begin
- fn:=StringToPWideChar(FileName);
- DeleteFile:=Windows.DeleteFile(fn);
- FreeMem(fn);
-end;
-
-
-Function RenameFile (Const OldName, NewName : String) : Boolean;
-var
- fold, fnew: PWideChar;
-begin
- fold:=StringToPWideChar(OldName);
- fnew:=StringToPWideChar(NewName);
- Result := MoveFile(fold, fnew);
- FreeMem(fnew);
- FreeMem(fold);
-end;
-
-
-{****************************************************************************
- Disk Functions
-****************************************************************************}
-
-function diskfree(drive : byte) : int64;
-begin
- Result := Dos.diskfree(drive);
-end;
-
-
-function disksize(drive : byte) : int64;
-begin
- Result := Dos.disksize(drive);
-end;
-
-
-Function GetCurrentDir : String;
-begin
- GetDir(0, result);
-end;
-
-
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-begin
- {$I-}
- ChDir(NewDir);
- {$I+}
- result := (IOResult = 0);
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
- {$I-}
- MkDir(NewDir);
- {$I+}
- result := (IOResult = 0);
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
- {$I-}
- RmDir(Dir);
- {$I+}
- result := (IOResult = 0);
-end;
-
-
-{****************************************************************************
- Time Functions
-****************************************************************************}
-
-
-Procedure GetLocalTime(var SystemTime: TSystemTime);
-Var
- Syst : Windows.TSystemtime;
-begin
- windows.Getlocaltime(@syst);
- SystemTime.year:=syst.wYear;
- SystemTime.month:=syst.wMonth;
- SystemTime.day:=syst.wDay;
- SystemTime.hour:=syst.wHour;
- SystemTime.minute:=syst.wMinute;
- SystemTime.second:=syst.wSecond;
- SystemTime.millisecond:=syst.wMilliSeconds;
-end;
-
-
-{****************************************************************************
- Misc Functions
-****************************************************************************}
-
-procedure Beep;
-begin
- MessageBeep(0);
-end;
-
-
-{****************************************************************************
- Locale Functions
-****************************************************************************}
-
-Procedure InitAnsi;
-Var
- i : longint;
-begin
- { Fill table entries 0 to 127 }
- for i := 0 to 96 do
- UpperCaseTable[i] := chr(i);
- for i := 97 to 122 do
- UpperCaseTable[i] := chr(i - 32);
- for i := 123 to 191 do
- UpperCaseTable[i] := chr(i);
- Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
-
- for i := 0 to 64 do
- LowerCaseTable[i] := chr(i);
- for i := 65 to 90 do
- LowerCaseTable[i] := chr(i + 32);
- for i := 91 to 191 do
- LowerCaseTable[i] := chr(i);
- Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
-end;
-
-
-function GetLocaleStr(LID, LT: Longint; const Def: string): ShortString;
-var
- L: Integer;
- Buf: array[0..255] of WideChar;
- s: widestring;
-begin
- L := GetLocaleInfo(LID, LT, Buf, SizeOf(Buf) div SizeOf(WideChar));
- if L > 0 then
- begin
- SetString(s, Buf, L - 1);
- Result:=s;
- end
- else
- Result := Def;
-end;
-
-
-function GetLocaleChar(LID, LT: Longint; Def: Char): Char;
-var
- Buf: array[0..1] of WideChar;
- Buf2: array[0..1] of Char;
-begin
- if GetLocaleInfo(LID, LT, Buf, 2) > 0 then
- begin
- WideToAnsiBuf(Buf, -1, Buf2, SizeOf(Buf2));
- Result := Buf2[0];
- end
- else
- Result := Def;
-end;
-
-
-Function GetLocaleInt(LID,TP,Def: LongInt): LongInt;
-Var
- S: String;
- C: Integer;
-Begin
- S:=GetLocaleStr(LID,TP,'0');
- Val(S,Result,C);
- If C<>0 Then
- Result:=Def;
-End;
-
-
-procedure GetFormatSettings;
-var
- HF : Shortstring;
- LID : LCID;
- I,Day,DateOrder : longint;
-begin
- LID := GetUserDefaultLCID;
- { Date stuff }
- for I := 1 to 12 do
- begin
- ShortMonthNames[I]:=GetLocaleStr(LID,LOCALE_SABBREVMONTHNAME1+I-1,ShortMonthNames[i]);
- LongMonthNames[I]:=GetLocaleStr(LID,LOCALE_SMONTHNAME1+I-1,LongMonthNames[i]);
- end;
- for I := 1 to 7 do
- begin
- Day := (I + 5) mod 7;
- ShortDayNames[I]:=GetLocaleStr(LID,LOCALE_SABBREVDAYNAME1+Day,ShortDayNames[i]);
- LongDayNames[I]:=GetLocaleStr(LID,LOCALE_SDAYNAME1+Day,LongDayNames[i]);
- end;
- DateSeparator := GetLocaleChar(LID, LOCALE_SDATE, '/');
- DateOrder := GetLocaleInt(LID, LOCALE_IDate, 0);
- Case DateOrder Of
- 1: Begin
- ShortDateFormat := 'dd/mm/yyyy';
- LongDateFormat := 'dddd, d. mmmm yyyy';
- End;
- 2: Begin
- ShortDateFormat := 'yyyy/mm/dd';
- LongDateFormat := 'dddd, yyyy mmmm d.';
- End;
- else
- // Default american settings...
- ShortDateFormat := 'mm/dd/yyyy';
- LongDateFormat := 'dddd, mmmm d. yyyy';
- End;
- { Time stuff }
- TimeSeparator := GetLocaleChar(LID, LOCALE_STIME, ':');
- TimeAMString := GetLocaleStr(LID, LOCALE_S1159, 'AM');
- TimePMString := GetLocaleStr(LID, LOCALE_S2359, 'PM');
- if StrToIntDef(GetLocaleStr(LID, LOCALE_ITLZERO, '0'), 0) = 0 then
- HF:='h'
- else
- HF:='hh';
- // No support for 12 hour stuff at the moment...
- ShortTimeFormat := HF+':nn';
- LongTimeFormat := HF + ':nn:ss';
- { Currency stuff }
- CurrencyString:=GetLocaleStr(LID, LOCALE_SCURRENCY, '');
- CurrencyFormat:=StrToIntDef(GetLocaleStr(LID, LOCALE_ICURRENCY, '0'), 0);
- NegCurrFormat:=StrToIntDef(GetLocaleStr(LID, LOCALE_INEGCURR, '0'), 0);
- { Number stuff }
- ThousandSeparator:=GetLocaleChar(LID, LOCALE_STHOUSAND, ',');
- DecimalSeparator:=GetLocaleChar(LID, LOCALE_SDECIMAL, '.');
- CurrencyDecimals:=StrToIntDef(GetLocaleStr(LID, LOCALE_ICURRDIGITS, '0'), 0);
-end;
-
-
-Procedure InitInternational;
-begin
- InitInternationalGeneric;
- SysLocale.MBCS:=GetSystemMetrics(SM_DBCSENABLED)<>0;
- SysLocale.RightToLeft:=GetSystemMetrics(SM_MIDEASTENABLED)<>0;
- InitAnsi;
- GetFormatSettings;
-end;
-
-
-{****************************************************************************
- Target Dependent
-****************************************************************************}
-
-function SysErrorMessage(ErrorCode: Integer): String;
-var
- MsgBuffer: PWideChar;
- len: longint;
-begin
- len:=FormatMessage(
- FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS,
- nil,
- ErrorCode,
- 0,
- @MsgBuffer, { This function allocs the memory }
- 0,
- nil);
- while (len > 0) and (MsgBuffer[len - 1] <= #32) do
- Dec(len);
- MsgBuffer[len]:=#0;
- PWideCharToString(PWideChar(MsgBuffer), Result);
- LocalFree(HLOCAL(MsgBuffer));
-end;
-
-{****************************************************************************
- Initialization code
-****************************************************************************}
-
-// WinCE does not have environment. It can be emulated via registry or file. (YS)
-
-Function GetEnvironmentVariable(Const EnvVar : String) : String;
-begin
- Result := '';
-end;
-
-Function GetEnvironmentVariableCount : Integer;
-begin
- Result := 0;
-end;
-
-Function GetEnvironmentString(Index : Integer) : String;
-begin
- Result := '';
-end;
-
-
-function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
-var
- PI: TProcessInformation;
- Proc : THandle;
- l : DWord;
- e : EOSError;
-
-begin
- DosError := 0;
- if not CreateProcess(PWideChar(widestring(Path)), PWideChar(widestring(ComLine)),
- nil, nil, FALSE, 0, nil, nil, nil, PI) then
- begin
- e:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,GetLastError]);
- e.ErrorCode:=GetLastError;
- raise e;
- end;
- Proc:=PI.hProcess;
- CloseHandle(PI.hThread);
- if WaitForSingleObject(Proc, dword($ffffffff)) <> $ffffffff then
- begin
- GetExitCodeProcess(Proc,l);
- CloseHandle(Proc);
- result:=l;
- end
- else
- begin
- e:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,GetLastError]);
- e.ErrorCode:=GetLastError;
- CloseHandle(Proc);
- raise e;
- end;
-end;
-
-function ExecuteProcess(Const Path: AnsiString; Const ComLine: Array of AnsiString):integer;
-
-Var
- CommandLine : AnsiString;
- i : Integer;
-
-Begin
- Commandline:='';
- For i:=0 to high(ComLine) Do
- Commandline:=CommandLine+' '+Comline[i];
- ExecuteProcess:=ExecuteProcess(Path,CommandLine);
-End;
-
-Procedure Sleep(Milliseconds : Cardinal);
-
-begin
- Windows.Sleep(MilliSeconds)
-end;
-
-Function GetLastOSError : Integer;
-
-begin
- Result:=GetLastError;
-end;
-
-{****************************************************************************
- Initialization code
-****************************************************************************}
-
-Procedure LoadVersionInfo;
-Var
- versioninfo : TOSVERSIONINFO;
- i : Integer;
-
-begin
- versioninfo.dwOSVersionInfoSize:=sizeof(versioninfo);
- GetVersionEx(versioninfo);
- WinCEPlatform:=versionInfo.dwPlatformId;
- WinCEMajorVersion:=versionInfo.dwMajorVersion;
- WinCEMinorVersion:=versionInfo.dwMinorVersion;
- WinCEBuildNumber:=versionInfo.dwBuildNumber;
- i:=WideToAnsiBuf(@versioninfo.szCSDVersion, -1, @WinCECSDVersion[1], SizeOf(WinCECSDVersion) - 1);
- if i <> 0 then
- WinCECSDVersion[0]:=chr(i - 1);
-end;
-
-Function GetSpecialDir(ID: Integer) : String;
-
-Var
- APath : array[0..MAX_PATH] of WideChar;
-begin
- if SHGetSpecialFolderPath(0, APath, ID, True) then
- begin
- PWideCharToString(APath, Result);
- Result:=IncludeTrailingPathDelimiter(Result);
- end
- else
- Result:='';
-end;
-
-Function GetAppConfigDir(Global : Boolean) : String;
-
-begin
- If Global then
- Result:=DGetAppConfigDir(Global) // or use windows dir ??
- else
- begin
- Result:=GetSpecialDir(CSIDL_APPDATA)+ApplicationName;
- If (Result='') then
- Result:=DGetAppConfigDir(Global);
- end;
-end;
-
-Function GetAppConfigFile(Global : Boolean; SubDir : Boolean) : String;
-
-begin
- if Global then
- begin
- Result:=IncludeTrailingPathDelimiter(DGetAppConfigDir(Global));
- if SubDir then
- Result:=IncludeTrailingPathDelimiter(Result+'Config');
- Result:=Result+ApplicationName+ConfigExtension;
- end
- else
- begin
- Result:=IncludeTrailingPathDelimiter(GetAppConfigDir(False));
- if SubDir then
- Result:=Result+'Config\';
- Result:=Result+ApplicationName+ConfigExtension;
- end;
-end;
-
-{****************************************************************************
- Target Dependent WideString stuff
-****************************************************************************}
-
-
-function WinCECompareWideString(const s1, s2 : WideString) : PtrInt;
-begin
- SetLastError(0);
- Result:=CompareString(LOCALE_USER_DEFAULT,0,pwidechar(s1),
- length(s1),pwidechar(s2),length(s2))-2;
- if GetLastError<>0 then
- RaiseLastOSError;
-end;
-
-
-function WinCECompareTextWideString(const s1, s2 : WideString) : PtrInt;
-begin
- SetLastError(0);
- Result:=CompareString(LOCALE_USER_DEFAULT,NORM_IGNORECASE,pwidechar(s1),
- length(s1),pwidechar(s2),length(s2))-2;
- if GetLastError<>0 then
- RaiseLastOSError;
-end;
-
-
-function WinCEAnsiUpperCase(const s: string): string;
-var
- buf: PWideChar;
- len: longint;
-begin
- if s <> '' then
- begin
- buf:=StringToPWideChar(s, @len);
- CharUpperBuff(buf, len);
- PWideCharToString(buf, Result, len);
- FreeMem(buf);
- end
- else
- Result:='';
-end;
-
-
-function WinCEAnsiLowerCase(const s: string): string;
-var
- buf: PWideChar;
- len: longint;
-begin
- if s <> '' then
- begin
- buf:=StringToPWideChar(s, @len);
- CharLowerBuff(buf, len);
- PWideCharToString(buf, Result, len);
- FreeMem(buf);
- end
- else
- Result:='';
-end;
-
-
-function WinCEAnsiCompareStr(const S1, S2: string): PtrInt;
-var
- ws1, ws2: PWideChar;
-begin
- ws1:=StringToPWideChar(S1);
- ws2:=StringToPWideChar(S2);
- Result:=CompareString(LOCALE_USER_DEFAULT, 0, ws1, -1, ws2, -1) - 2;
- FreeMem(ws2);
- FreeMem(ws1);
-end;
-
-
-function WinCEAnsiCompareText(const S1, S2: string): PtrInt;
-var
- ws1, ws2: PWideChar;
-begin
- ws1:=StringToPWideChar(S1);
- ws2:=StringToPWideChar(S2);
- Result:=CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, ws1, -1, ws2, -1) - 2;
- FreeMem(ws2);
- FreeMem(ws1);
-end;
-
-function WinCEAnsiStrComp(S1, S2: PChar): PtrInt;
-var
- ws1, ws2: PWideChar;
-begin
- ws1:=PCharToPWideChar(S1);
- ws2:=PCharToPWideChar(S2);
- Result:=CompareString(LOCALE_USER_DEFAULT, 0, ws1, -1, ws2, -1) - 2;
- FreeMem(ws2);
- FreeMem(ws1);
-end;
-
-
-function WinCEAnsiStrIComp(S1, S2: PChar): PtrInt;
-var
- ws1, ws2: PWideChar;
-begin
- ws1:=PCharToPWideChar(S1);
- ws2:=PCharToPWideChar(S2);
- Result:=CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, ws1, -1, ws2, -1) - 2;
- FreeMem(ws2);
- FreeMem(ws1);
-end;
-
-
-function WinCEAnsiStrLComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
-var
- ws1, ws2: PWideChar;
- len1, len2: longint;
-begin
- ws1:=PCharToPWideChar(S1, MaxLen, @len1);
- ws2:=PCharToPWideChar(S2, MaxLen, @len2);
- Result:=CompareString(LOCALE_USER_DEFAULT, 0, ws1, len1, ws2, len2) - 2;
- FreeMem(ws2);
- FreeMem(ws1);
-end;
-
-
-function WinCEAnsiStrLIComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
-var
- ws1, ws2: PWideChar;
- len1, len2: longint;
-begin
- ws1:=PCharToPWideChar(S1, MaxLen, @len1);
- ws2:=PCharToPWideChar(S2, MaxLen, @len2);
- Result:=CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, ws1, len1, ws2, len2) - 2;
- FreeMem(ws2);
- FreeMem(ws1);
-end;
-
-
-function WinCEAnsiStrLower(Str: PChar): PChar;
-var
- buf: PWideChar;
- len: longint;
-begin
- buf:=PCharToPWideChar(Str, -1, @len);
- CharLowerBuff(buf, len);
- WideToAnsiBuf(buf, -1, Result, len + 1);
- FreeMem(buf);
-end;
-
-
-function WinCEAnsiStrUpper(Str: PChar): PChar;
-var
- buf: PWideChar;
- len: longint;
-begin
- buf:=PCharToPWideChar(Str, -1, @len);
- CharUpperBuff(buf, len);
- WideToAnsiBuf(buf, -1, Result, len + 1);
- FreeMem(buf);
-end;
-
-
-{ there is a similiar procedure in the system unit which inits the fields which
- are relevant already for the system unit }
-procedure InitWinCEWidestrings;
- begin
- widestringmanager.CompareWideStringProc:=@WinCECompareWideString;
- widestringmanager.CompareTextWideStringProc:=@WinCECompareTextWideString;
-
- widestringmanager.UpperAnsiStringProc:=@WinCEAnsiUpperCase;
- widestringmanager.LowerAnsiStringProc:=@WinCEAnsiLowerCase;
- widestringmanager.CompareStrAnsiStringProc:=@WinCEAnsiCompareStr;
- widestringmanager.CompareTextAnsiStringProc:=@WinCEAnsiCompareText;
- widestringmanager.StrCompAnsiStringProc:=@WinCEAnsiStrComp;
- widestringmanager.StrICompAnsiStringProc:=@WinCEAnsiStrIComp;
- widestringmanager.StrLCompAnsiStringProc:=@WinCEAnsiStrLComp;
- widestringmanager.StrLICompAnsiStringProc:=@WinCEAnsiStrLIComp;
- widestringmanager.StrLowerAnsiStringProc:=@WinCEAnsiStrLower;
- widestringmanager.StrUpperAnsiStringProc:=@WinCEAnsiStrUpper;
- end;
-
-
-
-Initialization
- InitWinCEWidestrings;
- InitExceptions; { Initialize exceptions. OS independent }
- InitInternational; { Initialize internationalization settings }
- LoadVersionInfo;
- SysConfigDir:='\Windows';
-
-Finalization
- DoneExceptions;
-
-end.
diff --git a/rtl/wince/tthread.inc b/rtl/wince/tthread.inc deleted file mode 100644 index 528a8349a7..0000000000 --- a/rtl/wince/tthread.inc +++ /dev/null @@ -1,213 +0,0 @@ -{ Thread management routines }
-
-const
- CM_EXECPROC = $8FFF;
- CM_DESTROYWINDOW = $8FFE;
-
-type
- PRaiseFrame = ^TRaiseFrame;
- TRaiseFrame = record
- NextRaise: PRaiseFrame;
- ExceptAddr: Pointer;
- ExceptObject: TObject;
- ExceptionRecord: pointer; {PExceptionRecord}
- end;
-
-var
- ThreadWindow: HWND;
- ThreadCount: Integer;
- { event that happens when gui thread is done executing the method
-}
-
-function ThreadWndProc(Window: HWnd; AMessage:UInt; WParam : WParam; LParam: LParam): Longint; stdcall;
-
-begin
- case AMessage of
- CM_EXECPROC:
- with TThread(lParam) do
- begin
- Result := 0;
- try
- FSynchronizeException := nil;
- FMethod;
- except
-{ if RaiseList <> nil then
- begin
- FSynchronizeException := PRaiseFrame(RaiseList)^.ExceptObject;
- PRaiseFrame(RaiseList)^.ExceptObject := nil;
- end; }
- end;
- end;
- CM_DESTROYWINDOW:
- begin
- DestroyWindow(Window);
- Result := 0;
- end;
- else
- Result := DefWindowProc(Window, AMessage, wParam, lParam);
- end;
-end;
-
-const
- ThreadWindowClass: TWndClass = (
- style: 0;
- lpfnWndProc: nil;
- cbClsExtra: 0;
- cbWndExtra: 0;
- hInstance: 0;
- hIcon: 0;
- hCursor: 0;
- hbrBackground: 0;
- lpszMenuName: nil;
- lpszClassName: 'TThreadWindow');
-
-procedure AddThread;
-
- function AllocateWindow: HWND;
- var
- TempClass: TWndClass;
- ClassRegistered: Boolean;
- begin
- ThreadWindowClass.hInstance := HInstance;
- ThreadWindowClass.lpfnWndProc:=WndProc(@ThreadWndProc);
- ClassRegistered := GetClassInfo(HInstance, ThreadWindowClass.lpszClassName,
- @TempClass);
- if not ClassRegistered or (TempClass.lpfnWndProc <> WndProc(@ThreadWndProc)) then
- begin
- if ClassRegistered then
- Windows.UnregisterClass(ThreadWindowClass.lpszClassName, HInstance);
- Windows.RegisterClass(ThreadWindowClass);
- end;
- Result := CreateWindow(ThreadWindowClass.lpszClassName, '', 0,
- 0, 0, 0, 0, 0, 0, HInstance, nil);
- end;
-
-begin
- if ThreadCount = 0 then
- ThreadWindow := AllocateWindow;
- Inc(ThreadCount);
-end;
-
-procedure RemoveThread;
-begin
- Dec(ThreadCount);
- if ThreadCount = 0 then
- PostMessage(ThreadWindow, CM_DESTROYWINDOW, 0, 0);
-end;
-
-{ TThread }
-
-function ThreadProc(ThreadObjPtr: Pointer): Integer;
-var
- FreeThread: Boolean;
- Thread: TThread absolute ThreadObjPtr;
-begin
- try
- Thread.Execute;
- except
- Thread.FFatalException := TObject(AcquireExceptionObject);
- end;
- FreeThread := Thread.FFreeOnTerminate;
- Result := Thread.FReturnValue;
- Thread.FFinished := True;
- Thread.DoTerminate;
- if FreeThread then Thread.Free;
-end;
-
-constructor TThread.Create(CreateSuspended: Boolean; const StackSize: DWord = DefaultStackSize);
-var
- Flags: Integer;
-begin
- inherited Create;
- AddThread;
- FSuspended := CreateSuspended;
- Flags := 0;
- if CreateSuspended then Flags := CREATE_SUSPENDED;
- FHandle := BeginThread(nil, StackSize, @ThreadProc, pointer(self), Flags, FThreadID);
- FFatalException := nil;
-end;
-
-
-destructor TThread.Destroy;
-begin
- if not FFinished and not Suspended then
- begin
- Terminate;
- WaitFor;
- end;
- if FHandle <> 0 then CloseHandle(FHandle);
- FFatalException.Free;
- FFatalException := nil;
- inherited Destroy;
- RemoveThread;
-end;
-
-procedure TThread.CallOnTerminate;
-begin
- FOnTerminate(Self);
-end;
-
-procedure TThread.DoTerminate;
-begin
- if Assigned(FOnTerminate) then
- Synchronize(@CallOnTerminate);
-end;
-
-const
- Priorities: array [TThreadPriority] of Integer =
- (THREAD_PRIORITY_IDLE, THREAD_PRIORITY_LOWEST, THREAD_PRIORITY_BELOW_NORMAL,
- THREAD_PRIORITY_NORMAL, THREAD_PRIORITY_ABOVE_NORMAL,
- THREAD_PRIORITY_HIGHEST, THREAD_PRIORITY_TIME_CRITICAL);
-
-function TThread.GetPriority: TThreadPriority;
-var
- P: Integer;
- I: TThreadPriority;
-begin
- P := GetThreadPriority(FHandle);
- Result := tpNormal;
- for I := Low(TThreadPriority) to High(TThreadPriority) do
- if Priorities[I] = P then Result := I;
-end;
-
-procedure TThread.SetPriority(Value: TThreadPriority);
-begin
- SetThreadPriority(FHandle, Priorities[Value]);
-end;
-
-
-procedure TThread.SetSuspended(Value: Boolean);
-begin
- if Value <> FSuspended then
- if Value then
- Suspend else
- Resume;
-end;
-
-procedure TThread.Suspend;
-begin
- FSuspended := True;
- SuspendThread(FHandle);
-end;
-
-procedure TThread.Resume;
-begin
- if ResumeThread(FHandle) = 1 then FSuspended := False;
-end;
-
-procedure TThread.Terminate;
-begin
- FTerminated := True;
-end;
-
-function TThread.WaitFor: Integer;
-var
- Msg: TMsg;
-begin
- if GetCurrentThreadID = MainThreadID then
- while MsgWaitForMultipleObjects(1, FHandle, False, INFINITE, QS_SENDMESSAGE) = WAIT_OBJECT_0 + 1 do
- PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE)
- else
- WaitForSingleObject(ulong(FHandle), INFINITE);
- GetExitCodeThread(FHandle, DWord(Result));
-end;
diff --git a/rtl/wince/varutils.pp b/rtl/wince/varutils.pp deleted file mode 100644 index 365c12812e..0000000000 --- a/rtl/wince/varutils.pp +++ /dev/null @@ -1,38 +0,0 @@ -{
- This file is part of the Free Pascal run time library.
- Copyright (c) 1999-2000 by the Free Pascal development team
-
- Interface and OS-dependent part of variant support
-
- 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.
-
- **********************************************************************}
-
-{$MODE ObjFPC}
-
-Unit varutils;
-
-Interface
-
-Uses sysutils;
-
-// Read definitions.
-
-{$i varutilh.inc}
-
-Implementation
-
-// Code common to all platforms.
-
-{$i cvarutil.inc}
-
-// Code common to non-win32 platforms.
-
-{$i varutils.inc}
-
-end.
diff --git a/rtl/wince/windows.pp b/rtl/wince/windows.pp deleted file mode 100644 index 08fa31399d..0000000000 --- a/rtl/wince/windows.pp +++ /dev/null @@ -1,102 +0,0 @@ -{
- This file is part of the Free Pascal run time library.
- This unit contains the record definition for the Win32 API
- Copyright (c) 1999-2000 by Florian KLaempfl,
- member of the Free Pascal development team.
-
- 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.
-
- **********************************************************************
-
- Changes :
-
- 08-15-2005 : ORO06
- update for wince4.2 port
-}
-
-unit windows;
-
-{$ifndef NO_SMART_LINK}
-{$smartlink on}
-{$endif}
-
-{ stuff like array of const is used }
-{$mode objfpc}
-{$calling stdcall}
-
-interface
-
-
-{$define read_interface}
-{$undef read_implementation}
-
-
-{$ifdef UNDER_CE}
-{$define UNICODE} //ce is unicode only
-//{$define _X86_} //for testing compilation
-{$calling cedcl}
-{$endif UNDER_CE}
-
-{$i base.inc}
-{$i errors.inc}
-{$i defines.inc}
-{$i struct.inc}
-{$i messages.inc}
-
-{$ifndef UNDER_CE}
-{$i ascfun.inc}
-{$i unifun.inc}
-{$endif UNDER_CE}
-
-{$ifdef UNICODE}
-{$i unidef.inc}
-{$else not UNICODE}
-{$i ascdef.inc}
-{$endif UNICODE}
-
-{$i func.inc}
-{$i redef.inc}
-
-{$ifdef UNDER_CE}
-{$i aygshell.inc}
-//{$i commctrl.inc}
-{$endif UNDER_CE}
-
-implementation
-
-{$undef read_interface}
-{$define read_implementation}
-
-{$i base.inc}
-{$i errors.inc}
-{$i defines.inc}
-{$i struct.inc}
-{$i messages.inc}
-
-{$ifndef UNDER_CE}
-{$i ascfun.inc}
-{$i unifun.inc}
-{$endif UNDER_CE}
-
-{$ifdef UNICODE}
-{$i unidef.inc}
-{$else not UNICODE}
-{$i ascdef.inc}
-{$endif UNICODE}
-
-{$i func.inc}
-{$i redef.inc}
-
-{$ifdef UNDER_CE}
-{$i aygshell.inc}
-//{$i commctrl.inc}
-{$endif UNDER_CE}
-
-{$undef read_implementation}
-
-end.
diff --git a/rtl/wince/wininc/aygshell.inc b/rtl/wince/wininc/aygshell.inc deleted file mode 100644 index 132e528852..0000000000 --- a/rtl/wince/wininc/aygshell.inc +++ /dev/null @@ -1,374 +0,0 @@ -{
- This file is part of the Free Pascal run time library.
- Copyright (c) 2005 Free Pascal development team.
-
- 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.
-
- **********************************************************************}
-
-{
- aygshell.h
-
- Declarations for aygshell WinCE API
-
- Changes :
-
- 09-28-2005 : orinaudo@gmail.com
- First release
-
-}
-
-{exported functions list = to do,
- * please remove functions done *
-
- Exports
-
- ordinal name
-
- 146 ?ClearFontManager@@YAXXZ (void __cdecl ClearFontManager(void))
- 166 ?CreateBackgroundSpec@@YAJPAPAVIBackgroundSpec@@@Z (long __cdecl CreateBackgroundSpec(class IBackgroundSpec * *))
- 148 ?GetAppMetric@@YAHW4_enAppMetricID@@@Z (int __cdecl GetAppMetric(enum _enAppMetricID))
- 145 ?GetStandardFont@@YAJW4eFontID@@PAPAUHFONT__@@@Z (long __cdecl GetStandardFont(enum eFontID,struct HFONT__ * *))
- 348 ?IsScreenRotationSupported@@YAHXZ (int __cdecl IsScreenRotationSupported(void))
- 63 ?MinPowerOff@@YAHXZ (int __cdecl MinPowerOff(void))
- 147 ?OnSettingChange@@YAHIJ@Z (int __cdecl OnSettingChange(unsigned int,long))
- 189 ?SHDrawGradientBubbleTitle@@YAXPAUtagGRADIENTTITLEINFO@@@Z (void __cdecl SHDrawGradientBubbleTitle(struct tagGRADIENTTITLEINFO *))
- 2006 ?SHIdleTimerReset@@YAXXZ (void __cdecl SHIdleTimerReset(void))
- 228 ?SHLoadMenuExtensions@@YAHPAUIUnknown@@PBG1PAPAX@Z (int __cdecl SHLoadMenuExtensions(struct IUnknown *,unsigned short const *,unsigned short const *,void * *))
- 66 ?SHMenuBar_GetMenu@@YAPAUHMENU__@@PAUHWND__@@H@Z (struct HMENU__ * __cdecl SHMenuBar_GetMenu(struct HWND__ *,int))
- 140 ADChgTaskList
- 139 ADChgTrustedSrcList
- 142 ADRegisterCallback
- 141 ADTaskInfo
- 143 AssociateNoteWithCall
- 52 CancelSIPUp
- 46 ComboBoxEditSubProc
- 29 ComboEditAutoComplete
- 45 ComboSubProc
- 190 CreateImageCache
- 2021 DMProcessConfigXML
- 330 DPI_ExtractIconEx
- 311 DPI_LoadImageFile
- 310 DPI_LoadLibraryRes
- 237 DisplayNotRunnableAppDialog
- 226 DoEditContextMenu
- 191 DrawAlignedIcon
- 44 EditSubProc
- 2011 ExitWindowsEx
- 13 FreeRegisteredAppInfo
- 137 GetProtocol
- 11 GetRegisteredAppInfo
- 286 HIDPI_ImageList_LoadImage
- 287 HIDPI_ImageList_ReplaceIcon
- 92 IsFullScreenWindow
- 347 IsModulePreWinCE421
- 62 IsSANMessage
- 70 LFHeightForPoint
- 302 LoadHTML
- 241 LoadStringEtcOver
- 180 NotifyAppsOnEvent
- 24 PathAddBackslash
- 26 PathCombine
- 23 PathFindExtension
- 27 PathFindFileName
- 160 PathFindNextComponent
- 116 PathIsPrefix
- 28 PathIsRelative
- 25 PathRemoveBackslash
- 42 PathRemoveBlanks
- 107 PhoneGetCallProperties
- 106 PhoneGetCallPropertyBag
- 159 PhoneShowCallLog
- 158 SHAnimateListviewOpen
- 117 SHAnimateRects
- 22 SHAppNotifyDone
- 130 SHBoldFontAllowed
- 289 SHBorderPolyline
- 288 SHBorderRectangle
- 104 SHBox
- 103 SHBoxEx
- 114 SHChangeNotifyDeregister
- 115 SHChangeNotifyFree
- 113 SHChangeNotifyRegister
- 48 SHCheckForContextMenu
- 86 SHClearStartedBit
- 10 SHCloseApps
- 55 SHColorDisplay
- 37 SHCommandBar_EnableCommand
- 38 SHCommandBar_GetClientRect
- 36 SHCommandBar_GetCommandBarByID
- 223 SHCopyBitmap
- 306 SHCopyIcon
- 164 SHCreateCOleWindow
- 41 SHCreateContextMenu
- 43 SHCreateMainWindow
- 74 SHCreateMenuBarInternal
- 108 SHCreateNewItem
- 53 SHCreateSystemFont
- 35 SHCreateWorkerWindow
- 329 SHDeleteTodayWallpaper
- 109 SHDocManagerCreate
- 112 SHDocManagerDestroy
- 111 SHDocManagerQuery
- 110 SHDocManagerRegister
- 69 SHDoneButton
- 233 SHDrawBranding
- 234 SHDrawClippedText
- 331 SHDrawTextOverImage
- 58 SHDrawUnderline
- 136 SHDrawUnderlineColor
- 49 SHEnableEditMenu
- 192 SHEnableRadio
- 81 SHEndProfileObj
- 2013 SHEnumFiles
- 2020 SHEnumFolders
- 98 SHEnumPropSheetHandlers
- 203 SHEscapeAccelerators
- 201 SHEscapeBubbleHtml
- 168 SHFadeImage
- 54 SHFillRectClr
- 132 SHFindForegroundMenuBar
- 188 SHFindMenuBar
- 283 SHFindMenuBarInternal
- 209 SHFindPreviousInstance
- 212 SHFindPreviousInstanceEx
- 71 SHFontMgrCreate
- 73 SHFontMgrDestroy
- 72 SHFontMgrManageFonts
- 33 SHForceBaseState
- 99 SHForceBaseStateEx
- 102 SHFreeContextMenuExtensions
- 120 SHFreeScanners
- 65 SHFullScreen
- 213 SHGetActiveDialog
- 2 SHGetAppKeyAssoc
- 90 SHGetAutoRunPath
- 292 SHGetBitmapDimensions
- 285 SHGetBitmapLogPixels
- 225 SHGetCarrierBranding
- 224 SHGetCarrierBrandingFlag
- 96 SHGetDeviceFeatureLevel
- 299 SHGetDisplayRotation
- 128 SHGetEmergencyCallList
- 218 SHGetFontHeight
- 232 SHGetInputContext
- 133 SHGetKOBits
- 305 SHGetLandscapeRotationSettings
- 345 SHGetLegacySupportWindow
- 242 SHGetLocaleInfo
- 167 SHGetMessageBoxIcon
- 281 SHGetMetric
- 172 SHGetNavBarItemRect
- 163 SHGetPowerOnTime
- 153 SHGetPresetMessage
- 282 SHGetScreenOrientation
- 204 SHGetSimToolkitMenu
- 2014 SHGetSoundFileList
- 177 SHGetStyleBkColor
- 178 SHGetStyleColor
- 179 SHGetStyleFont
- 217 SHGetSystemDefaultLCID
- 144 SHGetTimeFormat
- 312 SHGetUIMetrics
- 219 SHGetUiInfo
- 221 SHGradientDeInit
- 222 SHGradientDraw
- 220 SHGradientInit
- 31 SHHandleActivate
- 30 SHHandleSipChange
- 76 SHHdrGrpSepLineDraw
- 8 SHImListPopup
- 56 SHInitDialog
- 9 SHInitExtraControls
- 149 SHInitPresetMessages
- 39 SHInputDialog
- 181 SHInsertPresetMessage
- 129 SHInvalidateScreen
- 101 SHInvokeContextMenuCommand
- 123 SHIsLocked
- 295 SHIsPreOzoneUpdate
- 94 SHIsPreRapierApp
- 100 SHLoadContextMenuExtensions
- 230 SHLoadFileContextMenuExtensions
- 313 SHLoadFontFromResource
- 75 SHLoadImageFile
- 64 SHLoadImageResource
- 91 SHLoadMenuPopup
- 216 SHLoadSKFromReg
- 121 SHLock
- 138 SHMakeCall
- 235 SHMakeValidFilename
- 32 SHMessageBox
- 183 SHNavigateBack
- 80 SHNewProfileObj
- 155 SHNotificationAdd
- 173 SHNotificationGetData
- 157 SHNotificationRemove
- 156 SHNotificationUpdate
- 208 SHNotifyAppsOnCallConnect
- 210 SHNotifyAppsOnCarkit
- 165 SHNotifyAppsOnDock
- 195 SHNotifyAppsOnHeadset
- 214 SHNotifyAppsOnIncomingCall
- 211 SHNotifyAppsOnSpeakerPhone
- 135 SHOnFullScreenAppActivate
- 238 SHOnMissedCallCountChange
- 2008 SHOnPluginDataChange
- 227 SHOnVoiceMailCountChange
- 162 SHPaintBubbleFrame
- 294 SHPolyline
- 152 SHPopulatePresetMessageMenu
- 175 SHPreProcessLogFont
- 229 SHQueryMenuExtensions
- 297 SHRCMLDialogProc
- 40 SHRecognizeGesture
- 293 SHRectangle
- 2022 SHRefreshStartMenu
- 215 SHRegGetHLMDWValue
- 176 SHRegSetValueEx
- 346 SHReleaseLegacySupportWindow
- 150 SHReleasePresetMessages
- 202 SHReplaceString
- 245 SHResizeDialogProc
- 50 SHRunCpl
- 82 SHRunFontManager
- 151 SHRunPresetMessagesEdit
- 239 SHRunSafeApplet
- 174 SHSameWindowProcesses
- 95 SHSavePWWarning
- 118 SHScanBuffer
- 119 SHScanFile
- 97 SHSendBackToFocusWindow
- 3 SHSetAppKeyWndAssoc
- 169 SHSetAsWatermark
- 184 SHSetBack
- 161 SHSetBubbleRegion
- 298 SHSetDisplayRotation
- 131 SHSetForegroundLastActivePopup
- 231 SHSetInputContext
- 134 SHSetKOBits
- 88 SHSetNavBarText
- 154 SHSetPresetMessage
- 170 SHSetSimToolkitMenu
- 1003 SHSetSoftKey
- 300 SHSetStretchMode
- 59 SHSetWindowBits
- 67 SHShowContextMenu
- 1004 SHShowSoftKeys
- 79 SHSignalDone
- 4 SHSipInfo
- 314 SHSipMightBlockUI
- 21 SHSipPreference
- 308 SHSkipDialogInitialFocus
- 207 SHSoundManGetDisplayName
- 205 SHSoundManGetDisplayNameList
- 206 SHSoundManGetFileName
- 93 SHStartAndBlock
- 85 SHStartIfNeeded
- 87 SHStartProfile
- 284 SHStretchBitmap
- 290 SHStretchBltBitmap
- 291 SHStretchBltBitmapEx
- 307 SHStretchIcon
- 105 SHTextBox
- 171 SHToolkitQueryShell
- 57 SHTrackPopupMenu
- 1000 SHTurnScreenOn
- 240 SHUnEscapeAccelerators
- 122 SHUnlock
- 2003 SHVoiceTagDelete
- 2002 SHVoiceTagPlayback
- 2001 SHVoiceTagRecognize
- 2000 SHVoiceTagTrain
- 124 SHWriteLockState
- 301 SetDialogAutoScrollBar
- 12 SetRegisteredAppInfo
- 296 SetWindowPosOnRotate
- 15 Shell_Alloc
- 17 Shell_AllocString
- 18 Shell_CatStrAlloc
- 16 Shell_Free
- 14 Shell_HeapCreate
- 19 Shell_LoadStringAlloc
- 20 Shell_RegAllocString
- 51 StrStrI
- 47 SubClassThisWindow
- 199 TZFindClose
- 197 TZFindNext
- 196 TZFindOpen
- 198 TZGetData
- 1005 UIHGetTextToStruct
- 1007 UIHLimitTextControls
- 1008 UIHSetHWNDToStruct
- 1006 UIHSetTextFromStruct
- 236 VerifyTrust
-}
-
-{$ifdef read_interface}
-
-{$PACKRECORDS C}
-
-//*****************************************************************************
-// consts
-//*****************************************************************************
-const
- NOMENU = $FFFF;
- SHA_INPUTDIALOG = $0001;
- SHACTI_FSIPUP = $0001;
- SHACTI_FSIPONDEACTIVATE = $0002;
- SHACTI_FSIPRESERVED = $FFFF xor SHACTI_FSIPUP xor SHACTI_FSIPUP;
-
- SHCMBF_EMPTYBAR = $0001;
- SHCMBF_HIDDEN = $0002; // create it hidden
- SHCMBF_HIDESIPBUTTON = $0004;
- SHCMBF_COLORBK = $0008;
- SHCMBF_HMENU = $0010; // specify an hmenu for resource rather than toolbar info
-
-
-//*****************************************************************************
-// types
-//*****************************************************************************
-
-type
-
- SHACTIVATEINFO = record
- cbSize : DWORD;
- hwndLastFocus : HWND ;
- bits : Longint ;
- end;
- PSHACTIVATEINFO=^SHACTIVATEINFO;
-
- tagSHMENUBARINFO = record
- cbSize : DWORD; // IN - Indicates which members of struct are valid
- hwndParent : HWND ; // IN
- dwFlags : DWORD ; // IN - Some features we want
- nToolBarId : UINT ; // IN - Which toolbar are we using
- hInstRes : HINST; // IN - Instance that owns the resources
- nBmpId : Integer;
- cBmpImages : Integer; // IN - Count of bitmap images
- hwndMB : HWND ; // OUT
- clrBk : COLORREF ; // IN - background color of the menu bar (excluding sip)
- end;
- SHMENUBARINFO=tagSHMENUBARINFO;
- PSHMENUBARINFO=^tagSHMENUBARINFO;
-
-//*****************************************************************************
-// functions
-//*****************************************************************************
-
-function SHCreateMenuBar(pmbi : PSHMENUBARINFO ): WINBOOL; external UserDLLAyg name 'SHCreateMenuBar';
-function SHHandleWMActivate(hwnd:HWND; wParam:WPARAM; lParam:LPARAM; psai: PSHACTIVATEINFO; dwFlags:DWORD ): WINBOOL; external UserDLLAyg name 'SHHandleWMActivate';
-function SHHandleWMSettingChange(hwnd:HWND; wParam:WPARAM; lParam:LPARAM; psai: PSHACTIVATEINFO): WINBOOL; external UserDLLAyg name 'SHHandleWMSettingChange';
-
-{$endif read_interface}
-
-{$ifdef read_implementation}
-
-{$endif read_implementation}
-
-
diff --git a/rtl/wince/wininc/base.inc b/rtl/wince/wininc/base.inc deleted file mode 100644 index 813c0a460e..0000000000 --- a/rtl/wince/wininc/base.inc +++ /dev/null @@ -1,994 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - This unit contains base definition for the Win32 API - Copyright (c) 1999-2000 by Florian Klaempfl, - member of the Free Pascal development team. - - 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. - - **********************************************************************} - -{ - Base.h - - Base definitions - - Copyright (C) 1996, 1997 Free Software Foundation, Inc. - - Author: Scott Christley <scottc@net-community.com> - - This file is part of the Windows32 API Library. - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Library General Public - License as published by the Free Software Foundation; either - version 2 of the License, or (at your option) any later version. - - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Library General Public License for more details. - - If you are interested in a warranty or support for this source code, - contact Scott Christley <scottc@net-community.com> for more information. - - - You should have received a copy of the GNU Library General Public - License along with this library; see the file COPYING.LIB. - If not, write to the Free Software Foundation, - 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - - Changes : - - 08/15/2005 update for wince4.2 port,ORO06 -} - -{$ifdef read_interface} - -{$PACKRECORDS C} - const - ANYSIZE_ARRAY = 1; //~winnt, moved from define to compile SID - type - ATOM = word; //windef - TAtom = ATOM; - - WINBOOL = longbool; - BOOL = WINBOOL; //windef - - CALTYPE = cardinal; - CALID = cardinal; - - CCHAR = char; //winnt - - COLORREF = Cardinal; //windef - TCOLORREF = cardinal; - - SHORT = smallint; //winnt - WINT = longint; - LONG = longint; //winnt - DWORD = Cardinal; //windef - - PINTEGER = ^longint; - PBOOL = ^BOOL; //windef - - LONGLONG = int64; //winnt - PLONGLONG = ^LONGLONG; //winnt - ULONGLONG = qword; //+winnt - PULONGLONG = ^ULONGLONG; //+winnt - - DWORDLONG = qword; { was unsigned long } - PDWORDLONG = ^DWORDLONG; - - HANDLE = System.THandle; - HRESULT = System.HResult; //winnt LONG - PHRESULT= ^HRESULT; - - HACCEL = HANDLE; //windef - HBITMAP = HANDLE; //windef - HBRUSH = HANDLE; //windef - HCOLORSPACE = HANDLE; //windef - HCONV = HANDLE; - HCONVLIST = HANDLE; - HCURSOR = HANDLE; //windef - HDBC = HANDLE; - HDC = HANDLE; //windef - HDDEDATA = HANDLE; - HDESK = HANDLE; //windef - HDROP = HANDLE; - HDWP = HANDLE; - HENHMETAFILE = HANDLE; //windef - HENV = HANDLE; - HEVENT = HANDLE; //+windef - HFILE = HANDLE; //windef - HFONT = HANDLE; //windef - HGDIOBJ = HANDLE; //windef - HGLOBAL = HANDLE; //windef - HGLRC = HANDLE; //windef - HHOOK = HANDLE; //windef - HICON = HCURSOR; //~windef - LPHICON = ^HICON; //+tapi - HIMAGELIST = HANDLE; - HINST = HANDLE; { Not HINSTANCE, else it has problems with the var HInstance } - HKEY = HANDLE; //windef - HKL = HANDLE; //windef - HLOCAL = HANDLE; //windef - HMENU = HANDLE; //windef - HMETAFILE = HANDLE; //windef - HMODULE = HANDLE; //windef - HMONITOR = HANDLE; //+windef - HPALETTE = HANDLE; //windef - HPEN = HANDLE; //windef - HRASCONN = HANDLE; - HRGN = HANDLE; //windef - HRSRC = HANDLE; //windef - HSTMT = HANDLE; - HSTR = HANDLE; //windef - HSZ = HANDLE; - HTASK = HANDLE; //windef - HWINSTA = HANDLE; //windef - HWND = HANDLE; //windef - HWINEVENTHOOK = HANDLE; //+windef - - LANGID = word; //winnt - LCID = DWORD; //winnt - PLCID = ^LCID; //+winnt - LCTYPE = DWORD; - LPARAM = longint; //windef LONG_PTR - - LP = ^word; - LPBOOL = ^WINBOOL; //windef - LPBYTE = ^BYTE; //windef - LPCCH = PCHAR; //winnt - LPCH = PCHAR; //winnt - - LPCOLORREF = ^COLORREF; //windef - - LPCSTR = Pchar; //winnt -{$ifdef UNICODE} - LPCTSTR = Pwidechar; //winnt -{$else} - LPCTSTR = Pchar; //winnt -{$endif} - - LPCWCH = Pwidechar; //winnt - LPCWSTR = Pwidechar; //winnt - - LPDWORD = ^DWORD; //windef - - LPHANDLE = ^HANDLE; //windef - LPINT = ^longint; //windef - LPLONG = ^longint; //windef - - LPSTR = Pchar; //winnt -{$ifdef UNICODE} - LPTCH = Pwidechar; - LPTSTR = Pwidechar; -{$else} - LPTCH = Pchar; - LPTSTR = Pchar; -{$endif} - - LRESULT = longint; //windef LONG_PTR - - LPVOID = pointer; //windef - - LPCVOID = pointer; //windef - - LPWCH = Pwidechar; - LPWORD = ^word; //windef - LPWSTR = Pwidechar; //winnt - - // - // Locally Unique Identifier
- //
- //winnt : declaration moved and changed : was in struct as LUID = TlargeInteger
- LUID = record
- LowPart : DWORD; - HighPart : LONG ;
- end;
- TLUID = LUID; - PLUID = ^LUID; -
- NWPSTR = Pwidechar; //winnt - - PWINBOOL = ^WINBOOL; - PBOOLEAN = ^BYTE; - - PBYTE = ^BYTE; //windef - - PCCH = PCHAR; //winnt - PCH = PCHAR; //winnt - - PCSTR = Pchar; - - PCWCH = Pwidechar; //winnt - PCWSTR = Pwidechar; //winnt - - PDWORD = ^DWORD; //windef - - PHANDLE = ^HANDLE; //windef - PHKEY = ^HKEY; //windef - - PINT = ^longint; - PLONG = ^longint; //windef - PSHORT = ^SHORT; //windef - LPSHORT = ^SHORT; //+windef - - PSTR = Pchar; - - PSZ = Pchar; //winnt -{$ifdef UNICODE} - PTBYTE = ^word; //winnt - PTCH = Pwidechar; - PTCHAR = Pwidechar; //winnt - PTSTR = Pwidechar; -{$else} - PTBYTE = ^byte; - PTCH = Pchar; - PTCHAR = Pchar; - PTSTR = Pchar; -{$endif} - - PUCHAR = ^byte; //windef - PWCH = Pwidechar; //winnt - PWCHAR = Pwidechar; //winnt - - PWORD = ^word; //windef - PUINT = ^Cardinal; //windef - PULONG = ^Cardinal; //windef - PUSHORT = ^word; //windef - - PVOID = pointer; - - RETCODE = SHORT; - - SC_HANDLE = HANDLE; - SC_LOCK = LPVOID; - LPSC_HANDLE = ^SC_HANDLE; - SPHANDLE = ^HANDLE; //+windef - - SERVICE_STATUS_HANDLE = DWORD; - SIZE_T = Cardinal; //+winnt -{$ifdef UNICODE} - TBYTE = word; - TCHAR = word; - BCHAR = word; -{$else} - TBYTE = byte; - TCHAR = char; - BCHAR = BYTE; -{$endif} - - UCHAR = byte; //windef - WCHAR = WideChar; //winnt - - UINT = Cardinal; //windef - ULONG = Cardinal; //windef - USHORT = word; //windef - - PLPSTR = ^LPSTR; - PLPWStr= ^LPWStr; - - FLOAT = single; //+windef - PFLOAT = ^FLOAT; //+windef - WCHAR_T = USHORT; //+stdlib - WINT_T = WCHAR_T; //+stdlib - WCTYPE_T = WCHAR_T; //+stdlib - TIME_T=ULONG; //+stdlib - WPARAM = Longint; //windef UINT_PTR -{ - Enumerations -} - - ACL_INFORMATION_CLASS = (AclRevisionInformation := 1,AclSizeInformation - ); - - _ACL_INFORMATION_CLASS = ACL_INFORMATION_CLASS; - - MEDIA_TYPE = (Unknown,F5_1Pt2_512,F3_1Pt44_512,F3_2Pt88_512, - F3_20Pt8_512,F3_720_512,F5_360_512,F5_320_512, - F5_320_1024,F5_180_512,F5_160_512,RemovableMedia, - FixedMedia); - - _MEDIA_TYPE = MEDIA_TYPE; - - const - RASCS_DONE = $2000; - RASCS_PAUSED = $1000; - - type - - RASCONNSTATE = (RASCS_OpenPort := 0,RASCS_PortOpened, - RASCS_ConnectDevice,RASCS_DeviceConnected, - RASCS_AllDevicesConnected,RASCS_Authenticate, - RASCS_AuthNotify,RASCS_AuthRetry,RASCS_AuthCallback, - RASCS_AuthChangePassword,RASCS_AuthProject, - RASCS_AuthLinkSpeed,RASCS_AuthAck,RASCS_ReAuthenticate, - RASCS_Authenticated,RASCS_PrepareForCallback, - RASCS_WaitForModemReset,RASCS_WaitForCallback, - RASCS_Projected,RASCS_StartAuthentication, - RASCS_CallbackComplete,RASCS_LogonNetwork, - RASCS_Interactive := RASCS_PAUSED,RASCS_RetryAuthentication, - RASCS_CallbackSetByCaller,RASCS_PasswordExpired, - RASCS_Connected := RASCS_DONE,RASCS_Disconnected - ); - - _RASCONNSTATE = RASCONNSTATE; - - RASPROJECTION = (RASP_Amb := $10000,RASP_PppNbf := $803F,RASP_PppIpx := $802B, - RASP_PppIp := $8021); - - _RASPROJECTION = RASPROJECTION; - - PSECURITY_DESCRIPTO = PVOID; //+winnt - SECURITY_IMPERSONATION_LEVEL = (SecurityAnonymous,SecurityIdentification, - SecurityImpersonation,SecurityDelegation - ); - - _SECURITY_IMPERSONATION_LEVEL = SECURITY_IMPERSONATION_LEVEL; - - SID_IDENTIFIER_AUTHORITY_REC = array[0..5] of BYTE; //~ added for pre-defined SID declaration - SID_IDENTIFIER_AUTHORITY = record //~winnt, moved to declare pre-defined SID - Value : SID_IDENTIFIER_AUTHORITY_REC; - end; - LPSID_IDENTIFIER_AUTHORITY = ^SID_IDENTIFIER_AUTHORITY; - PSID_IDENTIFIER_AUTHORITY = ^SID_IDENTIFIER_AUTHORITY; - _SID_IDENTIFIER_AUTHORITY = SID_IDENTIFIER_AUTHORITY; - TSIDIDENTIFIERAUTHORITY = SID_IDENTIFIER_AUTHORITY; - PSIDIDENTIFIERAUTHORITY = ^SID_IDENTIFIER_AUTHORITY; - - - SID = record //~wint - Revision : Byte; - SubAuthorityCount : Byte; - IdentifierAuthority : SID_IDENTIFIER_AUTHORITY; - SubAuthority : Array [0..ANYSIZE_ARRAY-1] of DWORD; - end; - _SID = SID; - PSID = ^SID; - - SID_NAME_USE = ( //~winnt, added SidTypeComputer - SidTypeUser:= 1, - SidTypeGroup, - SidTypeDomain,
- SidTypeAlias,
- SidTypeWellKnownGroup,
- SidTypeDeletedAccount,
- SidTypeInvalid,
- SidTypeUnknown,
- SidTypeComputer);
- - PSID_NAME_USE = ^SID_NAME_USE; //winnt - _SID_NAME_USE = SID_NAME_USE; - - TOKEN_INFORMATION_CLASS = (TokenUser := 1,TokenGroups,TokenPrivileges, - TokenOwner,TokenPrimaryGroup,TokenDefaultDacl, - TokenSource,TokenType,TokenImpersonationLevel, - TokenStatistics); - - _TOKEN_INFORMATION_CLASS = TOKEN_INFORMATION_CLASS; - TTokenInformationClass = TOKEN_INFORMATION_CLASS; - - TOKEN_TYPE = (TokenPrimary := 1,TokenImpersonation - ); - - tagTOKEN_TYPE = TOKEN_TYPE; - - { - Macros - } - - { was #define dname(params) def_expr } - { argument types are unknown } - function GetBValue(rgb : longint) : BYTE; - - { was #define dname(params) def_expr } - { argument types are unknown } - function GetGValue(rgb : longint) : BYTE; - - { was #define dname(params) def_expr } - { argument types are unknown } - function GetRValue(rgb : longint) : BYTE; - - { was #define dname(params) def_expr } - { argument types are unknown } - function RGB(r,g,b : longint) : DWORD; - - { Not convertable by H2PAS - #define HANDLE_WM_NOTIFY(hwnd, wParam, lParam, fn) \ - (fn)((hwnd), (int)(wParam), (NMHDR FAR )(lParam)) - } - - { was #define dname(params) def_expr } - { argument types are unknown } - function HIBYTE(w : longint) : BYTE; //windef - - { was #define dname(params) def_expr } - { argument types are unknown } - function HIWORD(l : longint) : WORD; //windef - - { was #define dname(params) def_expr } - { argument types are unknown } - function LOBYTE(w : longint) : BYTE; //windef - - { was #define dname(params) def_expr } - { argument types are unknown } - function LOWORD(l : longint) : WORD; //windef - - { was #define dname(params) def_expr } - { argument types are unknown } - function MAKELONG(a,b : longint) : LONG; //windef - - { was #define dname(params) def_expr } - { argument types are unknown } - function MAKEWORD(a,b : longint) : WORD; //windef - - { original Cygnus headers also had the following defined: } - { was #define dname(params) def_expr } - { argument types are unknown } - { return type might be wrong } - function SEXT_HIWORD(l : longint) : longint; - { return type might be wrong } - - { was #define dname(params) def_expr } - { argument types are unknown } - { return type might be wrong } - function ZEXT_HIWORD(l : longint) : longint; - { return type might be wrong } - - { was #define dname(params) def_expr } - { argument types are unknown } - function SEXT_LOWORD(l : longint) : longint; - - { was #define dname(params) def_expr } - { argument types are unknown } - { return type might be wrong } - function INDEXTOOVERLAYMASK(i : longint) : longint; - { return type might be wrong } - - { was #define dname(params) def_expr } - { argument types are unknown } - { return type might be wrong } - function INDEXTOSTATEIMAGEMASK(i : longint) : longint; - { return type might be wrong } - - { was #define dname(params) def_expr } - { argument types are unknown } - function MAKEINTATOM(i : longint) : LPTSTR; - - { was #define dname(params) def_expr } - { argument types are unknown } - function MAKEINTRESOURCE(i : longint) : LPTSTR; - - { was #define dname(params) def_expr } - { argument types are unknown } - { return type might be wrong } - function MAKELANGID(p,s : longint) : longint; //winnt - { return type might be wrong } - - { was #define dname(params) def_expr } - { argument types are unknown } - function PRIMARYLANGID(lgid : longint) : WORD; //winnt - - { was #define dname(params) def_expr } - { argument types are unknown } - { return type might be wrong } - function SUBLANGID(lgid : longint) : longint; //winnt - { return type might be wrong } - - { was #define dname(params) def_expr } - { argument types are unknown } - function LANGIDFROMLCID(lcid : longint) : WORD; - - { was #define dname(params) def_expr } - { argument types are unknown } - function SORTIDFROMLCID(lcid : longint) : WORD; - - { was #define dname(params) def_expr } - { argument types are unknown } - function MAKELCID(lgid,srtid : longint) : DWORD; - - { was #define dname(params) def_expr } - { argument types are unknown } - function MAKELPARAM(l,h : longint) : LPARAM; - - { was #define dname(params) def_expr } - { argument types are unknown } - function MAKELRESULT(l,h : longint) : LRESULT; - - { Not convertable by H2PAS - #define MAKEPOINTS(l) ( ((POINTS FAR ) & (l))) - } - { was #define dname(params) def_expr } - { argument types are unknown } - function MAKEROP4(fore,back : longint) : DWORD; - - { was #define dname(params) def_expr } - { argument types are unknown } - function MAKEWPARAM(l,h : longint) : WPARAM; - -{$ifndef max} - { was #define dname(params) def_expr } - { argument types are unknown } - { return type might be wrong } - function max(a,b : longint) : longint; //windef - { return type might be wrong } - -{$endif} -{$ifndef min} - { was #define dname(params) def_expr } - { argument types are unknown } - { return type might be wrong } - function min(a,b : longint) : longint; //windef - { return type might be wrong } - -{$endif} - { was #define dname(params) def_expr } - { argument types are unknown } - function PALETTEINDEX(i : longint) : COLORREF; - - { was #define dname(params) def_expr } - { argument types are unknown } - { return type might be wrong } - function PALETTERGB(r,g,b : longint) : longint; - { return type might be wrong } - - (* Not convertable by H2PAS - #define POINTSTOPOINT(pt, pts) {(pt).x = (SHORT) LOWORD(pts); \ - (pt).y = (SHORT) HIWORD(pts);} - #define POINTTOPOINTS(pt) \ - (MAKELONG((short) ((pt).x), (short) ((pt).y))) - *) - { already declared before - #define INDEXTOOVERLAYMASK(i) ((i) << 8) - #define INDEXTOSTATEIMAGEMASK(i) ((i) << 12) - } - { Not convertable by H2PAS - #ifdef UNICODE - #define TEXT(quote) L##quote - #else - #define TEXT(quote) quote - #endif - } - - { - Definitions for callback procedures - } - - type - - BFFCALLBACK = function (_para1:HWND; _para2:UINT; _para3:LPARAM; _para4:LPARAM):longint;stdcall; - - LPCCHOOKPROC = function (_para1:HWND; _para2:UINT; _para3:WPARAM; _para4:LPARAM):UINT;stdcall; - - LPCFHOOKPROC = function (_para1:HWND; _para2:UINT; _para3:WPARAM; _para4:LPARAM):UINT;stdcall; - - PTHREAD_START_ROUTINE = Pointer; - - LPTHREAD_START_ROUTINE = PTHREAD_START_ROUTINE; - - EDITSTREAMCALLBACK = function (_para1:DWORD; _para2:LPBYTE; _para3:LONG; _para4:LONG):DWORD;stdcall; - - LPFRHOOKPROC = function (_para1:HWND; _para2:UINT; _para3:WPARAM; _para4:LPARAM):UINT;stdcall; - - LPOFNHOOKPROC = function (_para1:HWND; _para2:UINT; _para3:WPARAM; _para4:LPARAM):UINT;stdcall; - - LPPRINTHOOKPROC = function (_para1:HWND; _para2:UINT; _para3:WPARAM; _para4:LPARAM):UINT;stdcall; - - LPSETUPHOOKPROC = function (_para1:HWND; _para2:UINT; _para3:WPARAM; _para4:LPARAM):UINT;stdcall; - - DLGPROC = function (_para1:HWND; _para2:UINT; _para3:WPARAM; _para4:LPARAM):LRESULT;stdcall; - - PFNPROPSHEETCALLBACK = function (_para1:HWND; _para2:UINT; _para3:LPARAM):longint;stdcall; - - LPSERVICE_MAIN_FUNCTION = procedure (_para1:DWORD; _para2:LPTSTR);stdcall; - - PFNTVCOMPARE = function (_para1:LPARAM; _para2:LPARAM; _para3:LPARAM):longint;stdcall; - - WNDPROC = function (_para1:HWND; _para2:UINT; _para3:WPARAM; _para4:LPARAM):LRESULT;stdcall; - - - FARPROC = pointer; //windef - NEARPROC= FARPROC; //+windef - PROC = FARPROC; //~windef - - ENUMRESTYPEPROC = function (_para1:HANDLE; _para2:LPTSTR; _para3:LONG):WINBOOL;stdcall; - - ENUMRESNAMEPROC = function (_para1:HANDLE; _para2:LPCTSTR; _para3:LPTSTR; _para4:LONG):WINBOOL;stdcall; - - ENUMRESLANGPROC = function (_para1:HANDLE; _para2:LPCTSTR; _para3:LPCTSTR; _para4:WORD; _para5:LONG):WINBOOL;stdcall; - - DESKTOPENUMPROC = FARPROC; - - ENUMWINDOWSPROC = function (_para1:HWND; _para2:LPARAM):WINBOOL;stdcall; - - ENUMWINDOWSTATIONPROC = function (_para1:LPTSTR; _para2:LPARAM):WINBOOL;stdcall; - - SENDASYNCPROC = procedure (_para1:HWND; _para2:UINT; _para3:DWORD; _para4:LRESULT);stdcall; - - TIMERPROC = procedure (_para1:HWND; _para2:UINT; _para3:UINT; _para4:DWORD);stdcall; - - GRAYSTRINGPROC = FARPROC; - - DRAWSTATEPROC = function (_para1:HDC; _para2:LPARAM; _para3:WPARAM; _para4:longint; _para5:longint):WINBOOL;stdcall; - - PROPENUMPROCEX = function (_para1:HWND; _para2:LPCTSTR; _para3:HANDLE; _para4:DWORD):WINBOOL;stdcall; - - PROPENUMPROC = function (_para1:HWND; _para2:LPCTSTR; _para3:HANDLE):WINBOOL;stdcall; - - HOOKPROC = function (_para1:longint; _para2:WPARAM; _para3:LPARAM):LRESULT;stdcall; - - ENUMOBJECTSPROC = procedure (_para1:LPVOID; _para2:LPARAM);stdcall; - - LINEDDAPROC = procedure (_para1:longint; _para2:longint; _para3:LPARAM);stdcall; - - TABORTPROC = function (_para1:HDC; _para2:longint):WINBOOL;stdcall; - - LPPAGEPAINTHOOK = function (_para1:HWND; _para2:UINT; _para3:WPARAM; _para4:LPARAM):UINT;stdcall; - - LPPAGESETUPHOOK = function (_para1:HWND; _para2:UINT; _para3:WPARAM; _para4:LPARAM):UINT;stdcall; - - ICMENUMPROC = function (_para1:LPTSTR; _para2:LPARAM):longint;stdcall; - - EDITWORDBREAKPROCEX = function (_para1:pchar; _para2:LONG; _para3:BYTE; _para4:WINT):LONG;stdcall; - - PFNLVCOMPARE = function (_para1:LPARAM; _para2:LPARAM; _para3:LPARAM):longint;stdcall; - - LOCALE_ENUMPROC = function (_para1:LPTSTR):WINBOOL;stdcall; - - CODEPAGE_ENUMPROC = function (_para1:LPTSTR):WINBOOL;stdcall; - CODEPAGE_ENUMPROCW = function (_para1:LPWSTR):WINBOOL; //+winnls - DATEFMT_ENUMPROC = function (_para1:LPTSTR):WINBOOL;stdcall; - - TIMEFMT_ENUMPROC = function (_para1:LPTSTR):WINBOOL;stdcall; - - CALINFO_ENUMPROC = function (_para1:LPTSTR):WINBOOL;stdcall; - - PHANDLER_ROUTINE = function (_para1:DWORD):WINBOOL;stdcall; - - LPHANDLER_FUNCTION = function (_para1:DWORD):WINBOOL;stdcall; - - PFNGETPROFILEPATH = function (_para1:LPCTSTR; _para2:LPSTR; _para3:UINT):UINT;stdcall; - - PFNRECONCILEPROFILE = function (_para1:LPCTSTR; _para2:LPCTSTR; _para3:DWORD):UINT;stdcall; - - PFNPROCESSPOLICIES = function (_para1:HWND; _para2:LPCTSTR; _para3:LPCTSTR; _para4:LPCTSTR; _para5:DWORD):WINBOOL;stdcall; - const - SE_CREATE_TOKEN_NAME = 'SeCreateTokenPrivilege'; - SE_ASSIGNPRIMARYTOKEN_NAME = 'SeAssignPrimaryTokenPrivilege'; - SE_LOCK_MEMORY_NAME = 'SeLockMemoryPrivilege'; - SE_INCREASE_QUOTA_NAME = 'SeIncreaseQuotaPrivilege'; - SE_UNSOLICITED_INPUT_NAME = 'SeUnsolicitedInputPrivilege'; - SE_MACHINE_ACCOUNT_NAME = 'SeMachineAccountPrivilege'; - SE_TCB_NAME = 'SeTcbPrivilege'; - SE_SECURITY_NAME = 'SeSecurityPrivilege'; - SE_TAKE_OWNERSHIP_NAME = 'SeTakeOwnershipPrivilege'; - SE_LOAD_DRIVER_NAME = 'SeLoadDriverPrivilege'; - SE_SYSTEM_PROFILE_NAME = 'SeSystemProfilePrivilege'; - SE_SYSTEMTIME_NAME = 'SeSystemtimePrivilege'; - SE_PROF_SINGLE_PROCESS_NAME = 'SeProfileSingleProcessPrivilege'; - SE_INC_BASE_PRIORITY_NAME = 'SeIncreaseBasePriorityPrivilege'; - SE_CREATE_PAGEFILE_NAME = 'SeCreatePagefilePrivilege'; - SE_CREATE_PERMANENT_NAME = 'SeCreatePermanentPrivilege'; - SE_BACKUP_NAME = 'SeBackupPrivilege'; - SE_RESTORE_NAME = 'SeRestorePrivilege'; - SE_SHUTDOWN_NAME = 'SeShutdownPrivilege'; - SE_DEBUG_NAME = 'SeDebugPrivilege'; - SE_AUDIT_NAME = 'SeAuditPrivilege'; - SE_SYSTEM_ENVIRONMENT_NAME = 'SeSystemEnvironmentPrivilege'; - SE_CHANGE_NOTIFY_NAME = 'SeChangeNotifyPrivilege'; - SE_REMOTE_SHUTDOWN_NAME = 'SeRemoteShutdownPrivilege'; - - //SERVICES_ACTIVE_DATABASEW L"ServicesActive" - //#define SERVICES_FAILED_DATABASEW L"ServicesFailed" - SERVICES_ACTIVE_DATABASEA = 'ServicesActive'; - SERVICES_FAILED_DATABASEA = 'ServicesFailed'; - { Not convertable by H2PAS - #define SC_GROUP_IDENTIFIERW L'+' - } - SC_GROUP_IDENTIFIERA = '+'; -{$ifdef UNICODE} - //temporary removed to compile in unicode, ORO06 08/2005 - //SERVICES_ACTIVE_DATABASE = SERVICES_ACTIVE_DATABASEW; - //SERVICES_FAILED_DATABASE = SERVICES_FAILED_DATABASEW; - //SC_GROUP_IDENTIFIER = SC_GROUP_IDENTIFIERW; - SERVICES_ACTIVE_DATABASE = SERVICES_ACTIVE_DATABASEA; - SERVICES_FAILED_DATABASE = SERVICES_FAILED_DATABASEA; - SC_GROUP_IDENTIFIER = SC_GROUP_IDENTIFIERA; -{$else} - SERVICES_ACTIVE_DATABASE = SERVICES_ACTIVE_DATABASEA; - SERVICES_FAILED_DATABASE = SERVICES_FAILED_DATABASEA; - SC_GROUP_IDENTIFIER = SC_GROUP_IDENTIFIERA; -{$endif} - -type - - { PFNCALLBACK = CALLB; } - PFNCALLBACK = function(_para1, _para2: UINT;_para3: HCONV;_para4, _para5: HSZ; _para6: HDDEDATA;_para7 ,_para8 :DWORD): HDDEData;stdcall; - { CALLB = procedure ;CDECL; } - CALLB = PFNCALLBACK; - - - SECURITY_CONTEXT_TRACKING_MODE = WINBOOL; - { End of stuff from ddeml.h in old Cygnus headers } - { ----------------------------------------------- } - - WNDENUMPROC = FARPROC; - - ENHMFENUMPROC = FARPROC; - - CCSTYLE = DWORD; - - PCCSTYLE = ^CCSTYLE; - - LPCCSTYLE = ^CCSTYLE; - - CCSTYLEFLAGA = DWORD; - - PCCSTYLEFLAGA = ^CCSTYLEFLAGA; - - LPCCSTYLEFLAGA = ^CCSTYLEFLAGA; - -{$endif read_interface} - - -{$ifdef read_implementation} - - { was #define dname(params) def_expr } - { argument types are unknown } - function GetBValue(rgb : longint) : BYTE; - begin - GetBValue:=BYTE(rgb shr 16); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - function GetGValue(rgb : longint) : BYTE; - begin - GetGValue:=BYTE((WORD(rgb)) shr 8); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - function GetRValue(rgb : longint) : BYTE; - begin - GetRValue:=BYTE(rgb); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - function RGB(r,g,b : longint) : DWORD; - begin - RGB:=DWORD(((DWORD(BYTE(r))) or ((DWORD(WORD(g))) shl 8)) or ((DWORD(BYTE(b))) shl 16)); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - function HIBYTE(w : longint) : BYTE; - begin - HIBYTE:=BYTE(((WORD(w)) shr 8) and $FF); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - function HIWORD(l : longint) : WORD; - begin - HIWORD:=WORD(((DWORD(l)) shr 16) and $FFFF); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - function LOBYTE(w : longint) : BYTE; - begin - LOBYTE:=BYTE(w); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - function LOWORD(l : longint) : WORD; - begin - LOWORD:=WORD(l); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - function MAKELONG(a,b : longint) : LONG; - begin - MAKELONG:=LONG((WORD(a)) or ((DWORD(WORD(b))) shl 16)); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - function MAKEWORD(a,b : longint) : WORD; - begin - MAKEWORD:=WORD((BYTE(a)) or ((WORD(BYTE(b))) shl 8)); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - { return type might be wrong } - function SEXT_HIWORD(l : longint) : longint; - { return type might be wrong } - begin - SEXT_HIWORD:=(longint(l)) shr 16; - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - { return type might be wrong } - function ZEXT_HIWORD(l : longint) : longint; - { return type might be wrong } - begin - ZEXT_HIWORD:=(Cardinal(l)) shr 16; - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - function SEXT_LOWORD(l : longint) : longint; - begin - SEXT_LOWORD:=longint(SHORT(l)); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - { return type might be wrong } - function INDEXTOOVERLAYMASK(i : longint) : longint; - { return type might be wrong } - begin - INDEXTOOVERLAYMASK:=i shl 8; - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - { return type might be wrong } - function INDEXTOSTATEIMAGEMASK(i : longint) : longint; - { return type might be wrong } - begin - INDEXTOSTATEIMAGEMASK:=i shl 12; - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - function MAKEINTATOM(i : longint) : LPTSTR; - begin - MAKEINTATOM:=LPTSTR(DWORD(WORD(i))); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - function MAKEINTRESOURCE(i : longint) : LPTSTR; - begin - MAKEINTRESOURCE:=LPTSTR(DWORD(WORD(i))); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - { return type might be wrong } - function MAKELANGID(p,s : longint) : longint; - { return type might be wrong } - begin - MAKELANGID:=((WORD(s)) shl 10) or (WORD(p)); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - function PRIMARYLANGID(lgid : longint) : WORD; - begin - { PRIMARYLANGID:=WORD(lgid(@($3ff))); - h2pas error here corrected by hand PM } - PRIMARYLANGID:=WORD(lgid) and ($3ff); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - { return type might be wrong } - function SUBLANGID(lgid : longint) : longint; - { return type might be wrong } - begin - SUBLANGID:=(WORD(lgid)) shr 10; - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - function LANGIDFROMLCID(lcid : longint) : WORD; - begin - LANGIDFROMLCID:=WORD(lcid); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - function SORTIDFROMLCID(lcid : longint) : WORD; - begin - SORTIDFROMLCID:=WORD(((DWORD(lcid)) and $000FFFFF) shr 16); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - function MAKELCID(lgid,srtid : longint) : DWORD; - begin - MAKELCID:=DWORD(((DWORD(WORD(srtid))) shl 16) or (DWORD(WORD(lgid)))); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - function MAKELPARAM(l,h : longint) : LPARAM; - begin - MAKELPARAM:=LPARAM(MAKELONG(l,h)); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - function MAKELRESULT(l,h : longint) : LRESULT; - begin - MAKELRESULT:=LRESULT(MAKELONG(l,h)); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - function MAKEROP4(fore,back : longint) : DWORD; - begin - MAKEROP4:=DWORD((DWORD(back shl 8) and $FF000000) or DWORD(fore)); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - function MAKEWPARAM(l,h : longint) : WPARAM; - begin - MAKEWPARAM:=WPARAM(MAKELONG(l,h)); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - { return type might be wrong } - function max(a,b : longint) : longint; - { return type might be wrong } - var - if_local1 : longint; - (* result types are not known *) - begin - if a > b then - if_local1:=a - else - if_local1:=b; - max:=if_local1; - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - { return type might be wrong } - function min(a,b : longint) : longint; - { return type might be wrong } - var - if_local1 : longint; - (* result types are not known *) - begin - if a < b then - if_local1:=a - else - if_local1:=b; - min:=if_local1; - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - function PALETTEINDEX(i : longint) : COLORREF; - begin - PALETTEINDEX:=COLORREF($01000000 or (DWORD(WORD(i)))); - end; - - { was #define dname(params) def_expr } - { argument types are unknown } - { return type might be wrong } - function PALETTERGB(r,g,b : longint) : longint; - { return type might be wrong } - begin - PALETTERGB:=$02000000 or (RGB(r,g,b)); - end; - -{$endif read_implementation} - diff --git a/rtl/wince/wininc/commctrl.inc b/rtl/wince/wininc/commctrl.inc deleted file mode 100644 index 6ae9b8a7fb..0000000000 --- a/rtl/wince/wininc/commctrl.inc +++ /dev/null @@ -1,170 +0,0 @@ -{
- This file is part of the Free Pascal run time library.
- Copyright (c) 2005 Free Pascal development team.
-
- 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.
-
- **********************************************************************}
-
-{
- commctrl.h
-
- Declarations for commctrl WinCE API
-
- Changes :
-
- 09-28-2005 : orinaudo@gmail.com
- First release
-
-}
-
-{exported functions list = to do,
- * please remove functions done *
-
- Exports
-
- ordinal name
-
- 73 AddMRUData
- 66 AddMRUStringA
- 67 AddMRUStringW
- 35 CenterWindow
- 39 CommandBands_AddAdornments
- 37 CommandBands_AddBands
- 36 CommandBands_Create
- 38 CommandBands_GetCommandBar
- 41 CommandBands_GetRestoreInformation
- 40 CommandBands_Show
- 10 CommandBar_AddAdornments
- 5 CommandBar_AddBitmap
- 3 CommandBar_Create
- 43 CommandBar_DrawMenuBar
- 11 CommandBar_GetItemWindow
- 9 CommandBar_GetMenu
- 12 CommandBar_Height
- 6 CommandBar_InsertComboBox
- 7 CommandBar_InsertControl
- 8 CommandBar_InsertMenubar
- 42 CommandBar_InsertMenubarEx
- 4 CommandBar_Show
- 63 CreateMRUListA
- 64 CreateMRUListW
- 19 CreatePropertySheetPageW
- 17 CreateStatusWindowW
- 15 CreateToolbar
- 16 CreateToolbarEx
- 14 CreateUpDownControl
- 50 DPA_Create
- 61 DPA_DeleteAllPtrs
- 60 DPA_DeletePtr
- 31 DPA_Destroy
- 56 DPA_DestroyCallback
- 32 DPA_GetPtr
- 62 DPA_GetPtrIndex
- 54 DPA_Grow
- 51 DPA_InsertPtr
- 59 DPA_Search
- 53 DPA_SetPtr
- 52 DPA_Sort
- 46 DSA_Clone
- 23 DSA_Create
- 30 DSA_DeleteAllItems
- 29 DSA_DeleteItem
- 24 DSA_Destroy
- 47 DSA_DestroyCallback
- 48 DSA_EnumCallback
- 25 DSA_GetItem
- 26 DSA_GetItemPtr
- 27 DSA_InsertItem
- 45 DSA_Search
- 28 DSA_SetItem
- 58 DSA_SetRange
- 57 DSA_Sort
- 68 DelMRUString
- 20 DestroyPropertySheetPage
- 49 DoReaderMode
- 21 DrawStatusTextW
- 71 EnumMRUListA
- 72 EnumMRUListW
- 74 FindMRUData
- 69 FindMRUStringA
- 70 FindMRUStringW
- 65 FreeMRUList
- 1 InitCommonControls
- 2 InitCommonControlsEx
- 22 InvertRect
- 55 IsCapEditAvailable
- 13 IsCommandBarMessage
- ListView_SetItemSpacing
- 75 PopulateComboWithMRU
- 76 PopulateMenuWithMRU
- 18 PropertySheetW
- 80 SHCreateDefaultGradient
- 79 SHDrawGradient
- 81 SHDrawText
- 77 SHGetSysColor
- 78 SHGetSystemMetrics
- 82 SHSetSysColors
- 83 SHSetSystemMetrics
- 34 StrToIntW
- 33 Str_SetPtrW
-}
-
-{$ifdef read_interface}
-
-//*****************************************************************************
-// consts
-//*****************************************************************************
-const
-
- TBSTATE_CHECKED = $01;
- TBSTATE_PRESSED = $02;
- TBSTATE_ENABLED = $04;
- TBSTATE_HIDDEN = $08;
- TBSTATE_INDETERMINATE = $10;
- TBSTATE_WRAP = $20;
- TBSTATE_ELLIPSES = $40;
- TBSTATE_HIGHLIGHTED = $80;
-
- TBSTYLE_BUTTON = $0000;
- TBSTYLE_SEP = $0001;
- TBSTYLE_CHECK = $0002;
- TBSTYLE_GROUP = $0004;
- TBSTYLE_CHECKGROUP =(TBSTYLE_GROUP or TBSTYLE_CHECK);
- TBSTYLE_DROPDOWN = $0008;
- TBSTYLE_AUTOSIZE = $0010; // automatically calculate the cx of the button
-
- TBSTYLE_TOOLTIPS = $0100;
- TBSTYLE_WRAPABLE = $0200;
- TBSTYLE_ALTDRAG = $0400;
- TBSTYLE_FLAT = $0800;
- TBSTYLE_LIST = $1000;
- TBSTYLE_CUSTOMERASE = $2000;
- TBSTYLE_TRANSPARENT = $8000;
-
- I_IMAGENONE = -2; // Desktop listview uses this same value for I_IMAGENONE when (_WIN32_IE >= 0x0501)
-
-//*****************************************************************************
-// types
-//*****************************************************************************
-
-type
-
-
-//*****************************************************************************
-// functions
-//*****************************************************************************
-
-
-{$endif read_interface}
-
-{$ifdef read_implementation}
-
-{$endif read_implementation}
-
-
diff --git a/rtl/wince/wininc/defines.inc b/rtl/wince/wininc/defines.inc deleted file mode 100644 index b61ff2db93..0000000000 --- a/rtl/wince/wininc/defines.inc +++ /dev/null @@ -1,6425 +0,0 @@ -{
- This file is part of the Free Pascal run time library.
- This unit contains the constant definitions for the Win32 API
- Copyright (c) 1999-2000 by Florian Klaempfl,
- member of the Free Pascal development team.
-
- 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.
-
- **********************************************************************}
-
-{
- Defines.h
-
- Windows32 API definitions
-
- Copyright (C) 1996, 1997 Free Software Foundation, Inc.
-
- Author: Scott Christley <scottc@net-community.com>
-
- This file is part of the Windows32 API Library.
-
- This library is free software; you can redistribute it and/or
- modify it under the terms of the GNU Library General Public
- License as published by the Free Software Foundation; either
- version 2 of the License, or (at your option) any later version.
-
- This library is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
-
- If you are interested in a warranty or support for this source code,
- contact Scott Christley <scottc@net-community.com> for more information.
-
- License along with this library; see the file COPYING.LIB.
- If not, write to the Free Software Foundation,
- 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-
- Changes :
-
- 08/15/2005 update for wince4.2 port,ORO06
-}
-
-{$ifdef read_interface}
-
-{$ifdef WINCE}
- const
- UserDLLCore = KernelDLL;
- UserDLLAyg = 'aygshell';
- SecurDLL = KernelDLL;
- GdiDLL = KernelDLL;
- ComctlDLL = 'commctrl';
- ComctlDLLCore = KernelDLL;
- ComdlgDLL = 'commdlg';
- ComdlgDLLCore = KernelDLL;
- VersionDLL = KernelDLL;
- AdvapiDLLCore = KernelDLL;
- MprDLLCore = KernelDLL;
- ShellDLLCore = KernelDLL;
- ShellDLL = 'CEShell';
-{$endif WINCE}
-
-{$ifdef WIN32}
- const
- UserDLLCore = 'user32';
- UserDLLAyg = UserDLL;
- SecurDLL = 'secur32';
- GdiDLL = 'gdi32';
- ComctlDLL = 'comctl32';
- ComctlDLLCore = ComctlDLL;
- ComdlgDLL = 'comdlg32';
- ComdlgDLLCore = ComdlgDLL;
- VersionDLL = 'version';
- AdvApiDLLCore = 'advapi32';
- MprDLLCore = 'mpr';
- ShellDLLCore = 'shell32';
- ShellDLL = ShellDLLCore;
-
-{$endif WIN32}
-
-{$PACKRECORDS C}
-
- { was #define dname def_expr }
- function UNICODE_NULL : WCHAR;
-
- const
- NULL=0; //+windef
- //FALSE=0; //+windef, removed can't compile
- //TRUE=1; //+windef, removed can't compile
- MAX_PATH = 260; //windef
- LF_FACESIZE = 32;
- LF_FULLFACESIZE = 64;
- ELF_VENDOR_SIZE = 4;
- SECURITY_STATIC_TRACKING = 0;
- SECURITY_DYNAMIC_TRACKING = 1;
- MAX_DEFAULTCHAR = 2;
- MAX_LEADBYTES = 12;
- EXCEPTION_MAXIMUM_PARAMETERS = 15; //winnt
- CCHDEVICENAME = 32;
- CCHFORMNAME = 32;
- MENU_TEXT_LEN = 40;
- MAX_LANA = 254;
- NCBNAMSZ = 16;
- NETBIOS_NAME_LEN = 16;
- OFS_MAXPATHNAME = 128;
- MAX_TAB_STOPS = 32;
- RAS_MaxCallbackNumber = 128;
- RAS_MaxDeviceName = 128;
- RAS_MaxDeviceType = 16;
- RAS_MaxEntryName = 256;
- RAS_MaxIpAddress = 15;
- RAS_MaxIpxAddress = 21;
- RAS_MaxPhoneNumber = 128;
- UNLEN = 256;
- PWLEN = 256;
- CNLEN = 15;
- DNLEN = 15;
- { Unsigned types max }
- MAXDWORD = $FFFFFFFF; //winnt
- MAXWORD = $FFFF; //winnt
- MAXBYTE = $FF; //winnt
- { Signed types max/min }
- MINCHAR = $80; //winnt
- MAXCHAR = $7F; //winnt
- MINSHORT = $8000; //winnt
- MAXSHORT = $7FFF; //winnt
- MINLONG = $80000000; //winnt
- MAXLONG = $7FFFFFFF; //winnt
- { _llseek }
- FILE_BEGIN = 0;
- FILE_CURRENT = 1;
- FILE_END = 2;
- { _lopen, LZOpenFile, OpenFile }
- OF_READ = 0;
- OF_READWRITE = 2;
- OF_WRITE = 1;
- OF_SHARE_COMPAT = 0;
- OF_SHARE_DENY_NONE = 64;
- OF_SHARE_DENY_READ = 48;
- OF_SHARE_DENY_WRITE = 32;
- OF_SHARE_EXCLUSIVE = 16;
- OF_CANCEL = 2048;
- OF_CREATE = 4096;
- OF_DELETE = 512;
- OF_EXIST = 16384;
- OF_PARSE = 256;
- OF_PROMPT = 8192;
- OF_REOPEN = 32768;
- OF_VERIFY = 1024;
- { ActivateKeyboardLayout, LoadKeyboardLayout }
- HKL_NEXT = 1;
- HKL_PREV = 0;
- KLF_REORDER = 8;
- KLF_UNLOADPREVIOUS = 4;
- KLF_ACTIVATE = 1;
- KLF_NOTELLSHELL = 128;
- KLF_REPLACELANG = 16;
- KLF_SUBSTITUTE_OK = 2;
- { AppendMenu }
- MF_BITMAP = $4;
- MF_DISABLED = $2;
- MF_ENABLED = 0;
- MF_GRAYED = $1;
- MF_HELP = $4000;
- MF_MENUBARBREAK = $20;
- MF_MENUBREAK = $40;
- MF_MOUSESELECT = $8000;
- MF_OWNERDRAW = $100;
- MF_POPUP = $10;
- MF_SEPARATOR = $800;
- MF_STRING = 0;
- MF_SYSMENU = $2000;
- MF_USECHECKBITMAPS = $200;
- { Ternary Raster Operations - BitBlt }
- BLACKNESS = $00000042;
- NOTSRCERASE = $001100A6;
- NOTSRCCOPY = $00330008;
- SRCERASE = $00440328;
- DSTINVERT = $00550009;
- PATINVERT = $005A0049;
- SRCINVERT = $00660046;
- SRCAND = $008800C6;
- MERGEPAINT = $00BB0226;
- MERGECOPY = $00C000CA;
- SRCCOPY = $00CC0020;
- SRCPAINT = $00EE0086;
- PATCOPY = $00F00021;
- PATPAINT = $00FB0A09;
- WHITENESS = $00FF0062;
- { Binary Raster Operations }
- R2_BLACK = 1;
- R2_COPYPEN = 13;
- R2_MASKNOTPEN = 3;
- R2_MASKPEN = 9;
- R2_MASKPENNOT = 5;
- R2_MERGENOTPEN = 12;
- R2_MERGEPEN = 15;
- R2_MERGEPENNOT = 14;
- R2_NOP = 11;
- R2_NOT = 6;
- R2_NOTCOPYPEN = 4;
- R2_NOTMASKPEN = 8;
- R2_NOTMERGEPEN = 2;
- R2_NOTXORPEN = 10;
- R2_WHITE = 16;
- R2_XORPEN = 7;
- { BroadcastSystemMessage }
- BSF_FLUSHDISK = 4;
- BSF_FORCEIFHUNG = 32;
- BSF_IGNORECURRENTTASK = 2;
- BSF_NOHANG = 8;
- BSF_POSTMESSAGE = 16;
- BSF_QUERY = 1;
- BSM_ALLCOMPONENTS = 0;
- BSM_APPLICATIONS = 8;
- BSM_INSTALLABLEDRIVERS = 4;
- BSM_NETDRIVER = 2;
- BSM_VXDS = 1;
- BROADCAST_QUERY_DENY = 1112363332;
- { BrowseCallbackProc }
- { CallNamedPipe }
- NMPWAIT_NOWAIT = 1;
- NMPWAIT_WAIT_FOREVER = -(1);
- NMPWAIT_USE_DEFAULT_WAIT = 0;
- { CascadeWindows, TileWindows }
- MDITILE_SKIPDISABLED = 2;
- MDITILE_HORIZONTAL = 1;
- MDITILE_VERTICAL = 0;
- { CBTProc }
- HCBT_ACTIVATE = 5;
- HCBT_CLICKSKIPPED = 6;
- HCBT_CREATEWND = 3;
- HCBT_DESTROYWND = 4;
- HCBT_KEYSKIPPED = 7;
- HCBT_MINMAX = 1;
- HCBT_MOVESIZE = 0;
- HCBT_QS = 2;
- HCBT_SETFOCUS = 9;
- HCBT_SYSCOMMAND = 8;
- { ChangeDisplaySettings }
- DM_BITSPERPEL = $40000;
- DM_PELSWIDTH = $80000;
- DM_PELSHEIGHT = $100000;
- DM_DISPLAYFLAGS = $200000;
- DM_DISPLAYFREQUENCY = $400000;
- CDS_UPDATEREGISTRY = 1;
- CDS_TEST = 2;
- CDS_FULLSCREEN = 4;
- CDS_GLOBAL = 8;
- CDS_SET_PRIMARY = $10;
- CDS_RESET = $40000000;
- CDS_SETRECT = $20000000;
- CDS_NORESET = $10000000;
- DISP_CHANGE_SUCCESSFUL = 0;
- DISP_CHANGE_RESTART = 1;
- DISP_CHANGE_BADFLAGS = -(4);
- DISP_CHANGE_FAILED = -(1);
- DISP_CHANGE_BADMODE = -(2);
- DISP_CHANGE_NOTUPDATED = -(3);
- { ChangeServiceConfig }
- SERVICE_NO_CHANGE = -(1);
- SERVICE_WIN32_OWN_PROCESS = 16;
- SERVICE_WIN32_SHARE_PROCESS = 32;
- SERVICE_KERNEL_DRIVER = 1;
- SERVICE_FILE_SYSTEM_DRIVER = 2;
- SERVICE_INTERACTIVE_PROCESS = 256;
- SERVICE_BOOT_START = 0;
- SERVICE_SYSTEM_START = 1;
- SERVICE_AUTO_START = 2;
- SERVICE_DEMAND_START = 3;
- SERVICE_DISABLED = 4;
- { SERVICE_STATUS structure }
- SERVICE_STOPPED = 1;
- SERVICE_START_PENDING = 2;
- SERVICE_STOP_PENDING = 3;
- SERVICE_RUNNING = 4;
- SERVICE_CONTINUE_PENDING = 5;
- SERVICE_PAUSE_PENDING = 6;
- SERVICE_PAUSED = 7;
- SERVICE_ACCEPT_STOP = 1;
- SERVICE_ACCEPT_PAUSE_CONTINUE = 2;
- SERVICE_ACCEPT_SHUTDOWN = 4;
- { CheckDlgButton }
- BST_CHECKED = 1;
- BST_INDETERMINATE = 2;
- BST_UNCHECKED = 0;
- BST_FOCUS = 8;
- BST_PUSHED = 4;
- { CheckMenuItem, HiliteMenuItem }
- MF_BYCOMMAND = 0;
- MF_BYPOSITION = $400;
- MF_CHECKED = $8;
- MF_UNCHECKED = 0;
- MF_HILITE = $80;
- MF_UNHILITE = 0;
- { ChildWindowFromPointEx }
- CWP_ALL = 0;
- CWP_SKIPINVISIBLE = 1;
- CWP_SKIPDISABLED = 2;
- CWP_SKIPTRANSPARENT = 4;
- { ClearCommError }
- CE_BREAK = 16;
- CE_DNS = 2048;
- CE_FRAME = 8;
- CE_IOE = 1024;
- CE_MODE = 32768;
- CE_OOP = 4096;
- CE_OVERRUN = 2;
- CE_PTO = 512;
- CE_RXOVER = 1;
- CE_RXPARITY = 4;
- CE_TXFULL = 256;
- { ChooseMatchToTarget }
- { CombineRgn }
- RGN_AND = 1;
- RGN_COPY = 5;
- RGN_DIFF = 4;
- RGN_OR = 2;
- RGN_XOR = 3;
- NULLREGION = 1;
- SIMPLEREGION = 2;
- COMPLEXREGION = 3;
- ERROR = 0;
- { CommonDlgExtendedError }
- CDERR_DIALOGFAILURE = $ffff;
- CDERR_FINDRESFAILURE = 6;
- CDERR_INITIALIZATION = 2;
- CDERR_LOADRESFAILURE = 7;
- CDERR_LOADSTRFAILURE = 5;
- CDERR_LOCKRESFAILURE = 8;
- CDERR_MEMALLOCFAILURE = 9;
- CDERR_MEMLOCKFAILURE = 10;
- CDERR_NOHINSTANCE = 4;
- CDERR_NOHOOK = 11;
- CDERR_NOTEMPLATE = 3;
- CDERR_REGISTERMSGFAIL = 12;
- CDERR_STRUCTSIZE = 1;
- PDERR_CREATEICFAILURE = $1000 + 10;
- PDERR_DEFAULTDIFFERENT = $1000 + 12;
- PDERR_DNDMMISMATCH = $1000 + 9;
- PDERR_GETDEVMODEFAIL = $1000 + 5;
- PDERR_INITFAILURE = $1000 + 6;
- PDERR_LOADDRVFAILURE = $1000 + 4;
- PDERR_NODEFAULTPRN = $1000 + 8;
- PDERR_NODEVICES = $1000 + 7;
- PDERR_PARSEFAILURE = $1000 + 2;
- PDERR_PRINTERNOTFOUND = $1000 + 11;
- PDERR_RETDEFFAILURE = $1000 + 3;
- PDERR_SETUPFAILURE = $1000 + 1;
- CFERR_MAXLESSTHANMIN = $2000 + 2;
- CFERR_NOFONTS = $2000 + 1;
- FNERR_BUFFERTOOSMALL = $3000 + 3;
- FNERR_INVALIDFILENAME = $3000 + 2;
- FNERR_SUBCLASSFAILURE = $3000 + 1;
- FRERR_BUFFERLENGTHZERO = $4000 + 1;
- { CompareString, LCMapString }
- //LOCALE_SYSTEM_DEFAULT = $800; //-winnt, replaced by function
- //LOCALE_USER_DEFAULT = $400; //-winnt, replaced by function
- NORM_IGNORECASE = 1;
- NORM_IGNOREKANATYPE = 65536;
- NORM_IGNORENONSPACE = 2;
- NORM_IGNORESYMBOLS = 4;
- NORM_IGNOREWIDTH = 131072;
- SORT_STRINGSORT = 4096;
- LCMAP_BYTEREV = 2048;
- LCMAP_FULLWIDTH = 8388608;
- LCMAP_HALFWIDTH = 4194304;
- LCMAP_HIRAGANA = 1048576;
- LCMAP_KATAKANA = 2097152;
- LCMAP_LOWERCASE = 256;
- LCMAP_SORTKEY = 1024;
- LCMAP_UPPERCASE = 512;
- { ContinueDebugEvent }
- DBG_CONTINUE = $10002;
- DBG_CONTROL_BREAK = $40010008;
- DBG_CONTROL_C = $40010005;
- DBG_EXCEPTION_NOT_HANDLED = $80010001;
- DBG_TERMINATE_THREAD = $40010003;
- DBG_TERMINATE_PROCESS = $40010004;
- { ControlService }
- SERVICE_CONTROL_STOP = 1;
- SERVICE_CONTROL_PAUSE = 2;
- SERVICE_CONTROL_CONTINUE = 3;
- SERVICE_CONTROL_INTERROGATE = 4;
- SERVICE_CONTROL_SHUTDOWN = 5;
- { CopyImage, LoadImage }
- IMAGE_BITMAP = 0;
- IMAGE_CURSOR = 2;
- IMAGE_ENHMETAFILE = 1;
- IMAGE_ICON = 1;
- LR_COPYDELETEORG = 8;
- LR_COPYRETURNORG = 4;
- LR_MONOCHROME = 1;
- LR_CREATEDIBSECTION = 8192;
- LR_DEFAULTSIZE = 64;
- { CreateDesktop }
- DF_ALLOWOTHERACCOUNTHOOK = $1;
- DESKTOP_CREATEMENU = $4;
- DESKTOP_CREATEWINDOW = $2;
- DESKTOP_ENUMERATE = $40;
- DESKTOP_HOOKCONTROL = $8;
- DESKTOP_JOURNALPLAYBACK = $20;
- DESKTOP_JOURNALRECORD = $10;
- DESKTOP_READOBJECTS = $1;
- DESKTOP_SWITCHDESKTOP = $100;
- DESKTOP_WRITEOBJECTS = $80;
- WSF_VISIBLE = $1;
- { CreateDIBitmap }
- CBM_INIT = $4;
- DIB_PAL_COLORS = 1;
- DIB_RGB_COLORS = 0;
- { file & pipe }
- FILE_READ_DATA = $0001;
- { directory }
- FILE_LIST_DIRECTORY = $0001;
- { file & pipe }
- FILE_WRITE_DATA = $0002;
- { directory }
- FILE_ADD_FILE = $0002;
- { file }
- FILE_APPEND_DATA = $0004;
- { directory }
- FILE_ADD_SUBDIRECTORY = $0004;
- { named pipe }
- FILE_CREATE_PIPE_INSTANCE = $0004;
- { file & directory }
- FILE_READ_EA = $0008;
- FILE_READ_PROPERTIES = FILE_READ_EA;
- { file & directory }
- FILE_WRITE_EA = $0010;
- FILE_WRITE_PROPERTIES = FILE_WRITE_EA;
- { file }
- FILE_EXECUTE = $0020;
- { directory }
- FILE_TRAVERSE = $0020;
- { directory }
- FILE_DELETE_CHILD = $0040;
- { all }
- FILE_READ_ATTRIBUTES = $0080;
- { all }
- FILE_WRITE_ATTRIBUTES = $0100;
- { displaced lower
- #define FILE_ALL_ACCESS (STANDARD_RIGHTS_REQUIRED | SYNCHRONIZE | 0x1FF)
-
- #define FILE_GENERIC_READ (STANDARD_RIGHTS_READ |\
- FILE_READ_DATA |\
- FILE_READ_ATTRIBUTES |\
- FILE_READ_EA |\
- SYNCHRONIZE)
-
-
- #define FILE_GENERIC_WRITE (STANDARD_RIGHTS_WRITE |\
- FILE_WRITE_DATA |\
- FILE_WRITE_ATTRIBUTES |\
- FILE_WRITE_EA |\
- FILE_APPEND_DATA |\
- SYNCHRONIZE)
-
-
- #define FILE_GENERIC_EXECUTE (STANDARD_RIGHTS_EXECUTE |\
- FILE_READ_ATTRIBUTES |\
- FILE_EXECUTE |\
- SYNCHRONIZE)
- }
- FILE_SHARE_DELETE = 4;
- FILE_SHARE_READ = 1;
- FILE_SHARE_WRITE = 2;
- CONSOLE_TEXTMODE_BUFFER = 1;
- CREATE_NEW = 1;
- CREATE_ALWAYS = 2;
- OPEN_EXISTING = 3;
- OPEN_ALWAYS = 4;
- TRUNCATE_EXISTING = 5;
- FILE_ATTRIBUTE_ARCHIVE = 32;
- FILE_ATTRIBUTE_COMPRESSED = 2048;
- FILE_ATTRIBUTE_NORMAL = 128;
- FILE_ATTRIBUTE_DIRECTORY = 16;
- FILE_ATTRIBUTE_HIDDEN = 2;
- FILE_ATTRIBUTE_READONLY = 1;
- FILE_ATTRIBUTE_SYSTEM = 4;
- FILE_ATTRIBUTE_TEMPORARY = 256;
- FILE_FLAG_WRITE_THROUGH = $80000000;
- FILE_FLAG_OVERLAPPED = 1073741824;
- FILE_FLAG_NO_BUFFERING = 536870912;
- FILE_FLAG_RANDOM_ACCESS = 268435456;
- FILE_FLAG_SEQUENTIAL_SCAN = 134217728;
- FILE_FLAG_DELETE_ON_CLOSE = 67108864;
- FILE_FLAG_BACKUP_SEMANTICS = 33554432;
- FILE_FLAG_POSIX_SEMANTICS = 16777216;
- SECURITY_ANONYMOUS = 0;
- SECURITY_IDENTIFICATION = 65536;
- SECURITY_IMPERSONATION = 131072;
- SECURITY_DELEGATION = 196608;
- SECURITY_CONTEXT_TRACKING = 262144;
- SECURITY_EFFECTIVE_ONLY = 524288;
- SECURITY_SQOS_PRESENT = 1048576;
- { CreateFileMapping, VirtualAlloc, VirtualFree, VirtualProtect }
- SEC_COMMIT = 134217728;
- SEC_IMAGE = 16777216;
- SEC_NOCACHE = 268435456;
- SEC_RESERVE = 67108864;
- PAGE_READONLY = 2;
- PAGE_READWRITE = 4;
- PAGE_WRITECOPY = 8;
- PAGE_EXECUTE = 16;
- PAGE_EXECUTE_READ = 32;
- PAGE_EXECUTE_READWRITE = 64;
- PAGE_EXECUTE_WRITECOPY = 128;
- PAGE_GUARD = 256;
- PAGE_NOACCESS = 1;
- PAGE_NOCACHE = 512;
- MEM_COMMIT = 4096;
- MEM_FREE = 65536;
- MEM_RESERVE = 8192;
- MEM_IMAGE = 16777216;
- MEM_MAPPED = 262144;
- MEM_PRIVATE = 131072;
- MEM_DECOMMIT = 16384;
- MEM_RELEASE = 32768;
- MEM_TOP_DOWN = 1048576;
- EXCEPTION_GUARD_PAGE = $80000001;
- SECTION_EXTEND_SIZE = $10;
- SECTION_MAP_READ = $4;
- SECTION_MAP_WRITE = $2;
- SECTION_QUERY = $1;
- SECTION_ALL_ACCESS = $f001f;
- { CreateFont }
- FW_DONTCARE = 0;
- FW_THIN = 100;
- FW_EXTRALIGHT = 200;
- FW_LIGHT = 300;
- FW_NORMAL = 400;
- FW_REGULAR = FW_NORMAL;
- FW_MEDIUM = 500;
- FW_SEMIBOLD = 600;
- FW_BOLD = 700;
- FW_EXTRABOLD = 800;
- FW_HEAVY = 900;
- ANSI_CHARSET = 0;
- DEFAULT_CHARSET = 1;
- SYMBOL_CHARSET = 2;
- SHIFTJIS_CHARSET = 128;
- HANGEUL_CHARSET = 129;
- GB2312_CHARSET = 134;
- CHINESEBIG5_CHARSET = 136;
- GREEK_CHARSET = 161;
- TURKISH_CHARSET = 162;
- HEBREW_CHARSET = 177;
- ARABIC_CHARSET = 178;
- BALTIC_CHARSET = 186;
- RUSSIAN_CHARSET = 204;
- THAI_CHARSET = 222;
- EASTEUROPE_CHARSET = 238;
-
- OEM_CHARSET = 255;
- OEM_CERTIFY_TRUST = 2; //+windef
- OEM_CERTIFY_RUN = 1; //+windef
- OEM_CERTIFY_FALSE = 0; //+windef
-
- OUT_DEFAULT_PRECIS = 0;
- OUT_STRING_PRECIS = 1;
- OUT_CHARACTER_PRECIS = 2;
- OUT_STROKE_PRECIS = 3;
- OUT_TT_PRECIS = 4;
- OUT_DEVICE_PRECIS = 5;
- OUT_RASTER_PRECIS = 6;
- OUT_TT_ONLY_PRECIS = 7;
- OUT_OUTLINE_PRECIS = 8;
- CLIP_DEFAULT_PRECIS = 0;
- CLIP_CHARACTER_PRECIS = 1;
- CLIP_STROKE_PRECIS = 2;
- CLIP_MASK = 15;
- CLIP_LH_ANGLES = 16;
- CLIP_TT_ALWAYS = 32;
- CLIP_EMBEDDED = 128;
- DEFAULT_QUALITY = 0;
- DRAFT_QUALITY = 1;
- PROOF_QUALITY = 2;
- NONANTIALIASED_QUALITY = 3;
- ANTIALIASED_QUALITY = 4;
- DEFAULT_PITCH = 0;
- FIXED_PITCH = 1;
- VARIABLE_PITCH = 2;
- MONO_FONT = 8;
- FF_DECORATIVE = 80;
- FF_DONTCARE = 0;
- FF_MODERN = 48;
- FF_ROMAN = 16;
- FF_SCRIPT = 64;
- FF_SWISS = 32;
- { CreateHatchBrush }
- HS_BDIAGONAL = 3;
- HS_CROSS = 4;
- HS_DIAGCROSS = 5;
- HS_FDIAGONAL = 2;
- HS_HORIZONTAL = 0;
- HS_VERTICAL = 1;
- { CreateIconFromResourceEx }
- LR_DEFAULTCOLOR = 0;
- LR_LOADREALSIZE = 128;
- { already defined above !!
- #define LR_MONOCHROME (1)
- }
- { CreateMailslot, GetMailslotInfo }
- MAILSLOT_WAIT_FOREVER = $ffffffff;
- MAILSLOT_NO_MESSAGE = $ffffffff;
- { CreateMappedBitmap }
- CMB_MASKED = 2;
- { CreateNamedPipe }
- PIPE_ACCESS_DUPLEX = 3;
- PIPE_ACCESS_INBOUND = 1;
- PIPE_ACCESS_OUTBOUND = 2;
- //WRITE_DAC = $40000; //~winnt, moved to ACCESS_TYPES
- //WRITE_OWNER = $80000; //~winnt, moved to ACCESS_TYPES
- //ACCESS_SYSTEM_SECURITY = $1000000; //~winnt, moved to ACCESS_TYPES
- PIPE_TYPE_BYTE = 0;
- PIPE_TYPE_MESSAGE = 4;
- PIPE_READMODE_BYTE = 0;
- PIPE_READMODE_MESSAGE = 2;
- PIPE_WAIT = 0;
- PIPE_NOWAIT = 1;
- { CreatePen, ExtCreatePen }
- PS_GEOMETRIC = 65536;
- PS_COSMETIC = 0;
- PS_ALTERNATE = 8;
- PS_SOLID = 0;
- PS_DASH = 1;
- PS_DOT = 2;
- PS_DASHDOT = 3;
- PS_DASHDOTDOT = 4;
- PS_NULL = 5;
- PS_USERSTYLE = 7;
- PS_INSIDEFRAME = 6;
- PS_ENDCAP_ROUND = 0;
- PS_ENDCAP_SQUARE = 256;
- PS_ENDCAP_FLAT = 512;
- PS_JOIN_BEVEL = 4096;
- PS_JOIN_MITER = 8192;
- PS_JOIN_ROUND = 0;
- PS_STYLE_MASK = 15;
- PS_ENDCAP_MASK = 3840;
- PS_TYPE_MASK = 983040;
- { CreatePolygonRgn }
- ALTERNATE = 1;
- WINDING = 2;
- { CreateProcess }
- CREATE_DEFAULT_ERROR_MODE = 67108864;
- CREATE_NEW_CONSOLE = 16;
- CREATE_NEW_PROCESS_GROUP = 512;
- CREATE_SEPARATE_WOW_VDM = 2048;
- CREATE_SUSPENDED = 4;
- CREATE_UNICODE_ENVIRONMENT = 1024;
- DEBUG_PROCESS = 1;
- DEBUG_ONLY_THIS_PROCESS = 2;
- DETACHED_PROCESS = 8;
- HIGH_PRIORITY_CLASS = 128;
- IDLE_PRIORITY_CLASS = 64;
- NORMAL_PRIORITY_CLASS = 32;
- REALTIME_PRIORITY_CLASS = 256;
- { CreateService }
- SERVICE_ALL_ACCESS = $f01ff;
- SERVICE_CHANGE_CONFIG = 2;
- SERVICE_ENUMERATE_DEPENDENTS = 8;
- SERVICE_INTERROGATE = 128;
- SERVICE_PAUSE_CONTINUE = 64;
- SERVICE_QUERY_CONFIG = 1;
- SERVICE_QUERY_STATUS = 4;
- SERVICE_START = 16;
- SERVICE_STOP = 32;
- SERVICE_USER_DEFINED_CONTROL = 256;
- SERVICE_DELETE = $10000;
- SERVICE_READ_CONTROL = $20000;
- SERVICE_GENERIC_EXECUTE = $20000000;
- { already defined above !!
- #define SERVICE_WIN32_OWN_PROCESS (16)
- #define SERVICE_WIN32_SHARE_PROCESS (32)
- #define SERVICE_KERNEL_DRIVER (1)
- #define SERVICE_FILE_SYSTEM_DRIVER (2)
- #define SERVICE_INTERACTIVE_PROCESS (256)
- #define SERVICE_BOOT_START (0)
- #define SERVICE_SYSTEM_START (1)
- #define SERVICE_AUTO_START (2)
- #define SERVICE_DEMAND_START (3)
- #define SERVICE_DISABLED (4)
- }
- SERVICE_ERROR_IGNORE = 0;
- SERVICE_ERROR_NORMAL = 1;
- SERVICE_ERROR_SEVERE = 2;
- SERVICE_ERROR_CRITICAL = 3;
- { CreateTapePartition, WriteTapemark }
- TAPE_FIXED_PARTITIONS = 0;
- TAPE_INITIATOR_PARTITIONS = $2;
- TAPE_SELECT_PARTITIONS = $1;
- TAPE_FILEMARKS = $1;
- TAPE_LONG_FILEMARKS = $3;
- TAPE_SETMARKS = 0;
- TAPE_SHORT_FILEMARKS = $2;
- { CreateWindow }
- CW_USEDEFAULT = $80000000;
- WS_BORDER = $800000;
- WS_CAPTION = $c00000;
- WS_CHILD = $40000000;
- WS_CHILDWINDOW = $40000000;
- WS_CLIPCHILDREN = $2000000;
- WS_CLIPSIBLINGS = $4000000;
- WS_DISABLED = $8000000;
- WS_DLGFRAME = $400000;
- WS_GROUP = $20000;
- WS_HSCROLL = $100000;
- WS_ICONIC = $20000000;
- WS_MAXIMIZE = $1000000;
- WS_MAXIMIZEBOX = $10000;
- WS_MINIMIZE = $20000000;
- WS_MINIMIZEBOX = $20000;
- WS_OVERLAPPED = 0;
- WS_OVERLAPPEDWINDOW = $cf0000;
- WS_POPUP = LONG($80000000);
- WS_POPUPWINDOW = LONG($80880000);
- WS_SIZEBOX = $40000;
- WS_SYSMENU = $80000;
- WS_TABSTOP = $10000;
- WS_THICKFRAME = $40000;
- WS_TILED = 0;
- WS_TILEDWINDOW = $cf0000;
- WS_VISIBLE = $10000000;
- WS_VSCROLL = $200000;
- MDIS_ALLCHILDSTYLES = $1;
- BS_3STATE = $5;
- BS_AUTO3STATE = $6;
- BS_AUTOCHECKBOX = $3;
- BS_AUTORADIOBUTTON = $9;
- BS_BITMAP = $80;
- BS_BOTTOM = $800;
- BS_CENTER = $300;
- BS_CHECKBOX = $2;
- BS_DEFPUSHBUTTON = $1;
- BS_GROUPBOX = $7;
- BS_ICON = $40;
- BS_LEFT = $100;
- BS_LEFTTEXT = $20;
- BS_MULTILINE = $2000;
- BS_NOTIFY = $4000;
- BS_OWNERDRAW = $b;
- BS_PUSHBUTTON = 0;
- BS_PUSHLIKE = $1000;
- BS_RADIOBUTTON = $4;
- BS_RIGHT = $200;
- BS_RIGHTBUTTON = $20;
- BS_TEXT = 0;
- BS_TOP = $400;
- BS_USERBUTTON = $8;
- BS_VCENTER = $c00;
- BS_FLAT = $8000;
- CBS_AUTOHSCROLL = $40;
- CBS_DISABLENOSCROLL = $800;
- CBS_DROPDOWN = $2;
- CBS_DROPDOWNLIST = $3;
- CBS_HASSTRINGS = $200;
- CBS_LOWERCASE = $4000;
- CBS_NOINTEGRALHEIGHT = $400;
- CBS_OEMCONVERT = $80;
- CBS_OWNERDRAWFIXED = $10;
- CBS_OWNERDRAWVARIABLE = $20;
- CBS_SIMPLE = $1;
- CBS_SORT = $100;
- CBS_UPPERCASE = $2000;
- ES_AUTOHSCROLL = $80;
- ES_AUTOVSCROLL = $40;
- ES_CENTER = $1;
- ES_LEFT = 0;
- ES_LOWERCASE = $10;
- ES_MULTILINE = $4;
- ES_NOHIDESEL = $100;
- ES_NUMBER = $2000;
- ES_OEMCONVERT = $400;
- ES_PASSWORD = $20;
- ES_READONLY = $800;
- ES_RIGHT = $2;
- ES_UPPERCASE = $8;
- ES_WANTRETURN = $1000;
- LBS_DISABLENOSCROLL = $1000;
- LBS_EXTENDEDSEL = $800;
- LBS_HASSTRINGS = $40;
- LBS_MULTICOLUMN = $200;
- LBS_MULTIPLESEL = $8;
- LBS_NODATA = $2000;
- LBS_NOINTEGRALHEIGHT = $100;
- LBS_NOREDRAW = $4;
- LBS_NOSEL = $4000;
- LBS_NOTIFY = $1;
- LBS_OWNERDRAWFIXED = $10;
- LBS_OWNERDRAWVARIABLE = $20;
- LBS_SORT = $2;
- LBS_STANDARD = $a00003;
- LBS_USETABSTOPS = $80;
- LBS_WANTKEYBOARDINPUT = $400;
- SBS_BOTTOMALIGN = $4;
- SBS_HORZ = 0;
- SBS_LEFTALIGN = $2;
- SBS_RIGHTALIGN = $4;
- SBS_SIZEBOX = $8;
- SBS_SIZEBOXBOTTOMRIGHTALIGN = $4;
- SBS_SIZEBOXTOPLEFTALIGN = $2;
- SBS_SIZEGRIP = $10;
- SBS_TOPALIGN = $2;
- SBS_VERT = $1;
- SS_BITMAP = $e;
- SS_BLACKFRAME = $7;
- SS_BLACKRECT = $4;
- SS_CENTER = $1;
- SS_CENTERIMAGE = $200;
- SS_ENHMETAFILE = $f;
- SS_ETCHEDFRAME = $12;
- SS_ETCHEDHORZ = $10;
- SS_ETCHEDVERT = $11;
- SS_GRAYFRAME = $8;
- SS_GRAYRECT = $5;
- SS_ICON = $3;
- SS_LEFT = 0;
- SS_LEFTNOWORDWRAP = $c;
- SS_NOPREFIX = $80;
- SS_NOTIFY = $100;
- SS_OWNERDRAW = $d;
- SS_REALSIZEIMAGE = $800;
- SS_RIGHT = $2;
- SS_RIGHTJUST = $400;
- SS_SIMPLE = $b;
- SS_SUNKEN = $1000;
- SS_USERITEM = $a;
- SS_WHITEFRAME = $9;
- SS_WHITERECT = $6;
- DS_3DLOOK = $4;
- DS_ABSALIGN = $1;
- DS_CENTER = $800;
- DS_CENTERMOUSE = $1000;
- DS_CONTEXTHELP = $2000;
- DS_CONTROL = $400;
- DS_FIXEDSYS = $8;
- DS_LOCALEDIT = $20;
- DS_MODALFRAME = $80;
- DS_NOFAILCREATE = $10;
- DS_NOIDLEMSG = $100;
- DS_SETFONT = $40;
- DS_SETFOREGROUND = $200;
- DS_SYSMODAL = $2;
- { CreateWindowEx }
- WS_EX_ACCEPTFILES = $10;
- WS_EX_APPWINDOW = $40000;
- WS_EX_CLIENTEDGE = $200;
- WS_EX_CONTEXTHELP = $400;
- WS_EX_CONTROLPARENT = $10000;
- WS_EX_DLGMODALFRAME = $1;
- WS_EX_LEFT = 0;
- WS_EX_LEFTSCROLLBAR = $4000;
- WS_EX_LTRREADING = 0;
- WS_EX_MDICHILD = $40;
- WS_EX_NOPARENTNOTIFY = $4;
- WS_EX_OVERLAPPEDWINDOW = $300;
- WS_EX_PALETTEWINDOW = $188;
- WS_EX_RIGHT = $1000;
- WS_EX_RIGHTSCROLLBAR = 0;
- WS_EX_RTLREADING = $2000;
- WS_EX_STATICEDGE = $20000;
- WS_EX_TOOLWINDOW = $80;
- WS_EX_TOPMOST = $8;
- WS_EX_TRANSPARENT = $20;
- WS_EX_WINDOWEDGE = $100;
- { CreateWindowStation }
- WINSTA_ACCESSCLIPBOARD = $4;
- WINSTA_ACCESSGLOBALATOMS = $20;
- WINSTA_CREATEDESKTOP = $8;
- WINSTA_ENUMDESKTOPS = $1;
- WINSTA_ENUMERATE = $100;
- WINSTA_EXITWINDOWS = $40;
- WINSTA_READATTRIBUTES = $2;
- WINSTA_READSCREEN = $200;
- WINSTA_WRITEATTRIBUTES = $10;
- { DdeCallback }
- { DdeClientTransaction }
- { DdeEnableCallback }
- { DdeGetLastError }
- { DdeInitialize }
- { DdeNameService }
- { DebugProc }
- WH_CALLWNDPROC = 4;
- WH_CALLWNDPROCRET = 12;
- WH_CBT = 5;
- WH_DEBUG = 9;
- WH_GETMESSAGE = 3;
- WH_JOURNALPLAYBACK = 1;
- WH_JOURNALRECORD = 0;
- WH_KEYBOARD = 2;
- WH_MOUSE = 7;
- WH_MSGFILTER = -(1);
- WH_SHELL = 10;
- WH_SYSMSGFILTER = 6;
- { already defined above !!
- #define WH_MSGFILTER (-1) }
- WH_FOREGROUNDIDLE = 11;
- { DefineDosDevice }
- DDD_RAW_TARGET_PATH = 1;
- DDD_REMOVE_DEFINITION = 2;
- DDD_EXACT_MATCH_ON_REMOVE = 4;
- { DeviceCapbilities }
- DC_BINNAMES = 12; //windef
- DC_BINS = 6; //windef
- DC_COPIES = 18; //windef
- DC_DRIVER = 11; //windef
- DC_DATATYPE_PRODUCED = 21;
- DC_DUPLEX = 7; //windef
- DC_EMF_COMPLIANT = 20;
- DC_ENUMRESOLUTIONS = 13; //windef
- DC_EXTRA = 9; //windef
- DC_FIELDS = 1; //windef
- DC_FILEDEPENDENCIES = 14; //windef
- DC_MAXEXTENT = 5; //windef
- DC_MINEXTENT = 4; //windef
- DC_ORIENTATION = 17; //windef
- DC_PAPERNAMES = 16; //windef
- DC_PAPERS = 2; //windef
- DC_PAPERSIZE = 3; //windef
- DC_SIZE = 8; //windef
- DC_TRUETYPE = 15; //windef
- DCTT_BITMAP = $1;
- DCTT_DOWNLOAD = $2;
- DCTT_SUBDEV = $4;
- DC_VERSION = 10; //windef
- DC_BINADJUST = 19;
- { already defined above !!
- #define DC_DATATYPE_PRODUCED (21)
- }
- { DeviceIoControl }
- { DlgDirList }
- DDL_ARCHIVE = 32;
- DDL_DIRECTORY = 16;
- DDL_DRIVES = 16384;
- DDL_EXCLUSIVE = 32768;
- DDL_HIDDEN = 2;
- DDL_READONLY = 1;
- DDL_READWRITE = 0;
- DDL_SYSTEM = 4;
- DDL_POSTMSGS = 8192;
- { DllEntryPoint }
- DLL_PROCESS_ATTACH = 1;
- DLL_THREAD_ATTACH = 2;
- DLL_PROCESS_DETACH = 0;
- DLL_THREAD_DETACH = 3;
- { DocumentProperties }
- DM_IN_BUFFER = 8; //windef
- DM_MODIFY = 8; //windef
- DM_IN_PROMPT = 4; //windef
- DM_PROMPT = 4; //windef
- DM_OUT_BUFFER = 2; //windef
- DM_COPY = 2; //windef
- DM_UPDATE = 1; //windef
- { DrawAnimatedRects }
- IDANI_OPEN = 1;
- IDANI_CLOSE = 2;
- { DrawCaption }
- DC_ACTIVE = 1;
- DC_SMALLCAP = 2;
- { DrawEdge }
- BDR_RAISEDINNER = 4;
- BDR_SUNKENINNER = 8;
- BDR_RAISEDOUTER = 1;
- BDR_SUNKENOUTER = 1;
- EDGE_BUMP = 9;
- EDGE_ETCHED = 6;
- EDGE_RAISED = 5;
- EDGE_SUNKEN = 10;
- BF_ADJUST = 8192;
- BF_BOTTOM = 8;
- BF_BOTTOMLEFT = 9;
- BF_BOTTOMRIGHT = 12;
- BF_DIAGONAL = 16;
- BF_DIAGONAL_ENDBOTTOMLEFT = 25;
- BF_DIAGONAL_ENDBOTTOMRIGHT = 28;
- BF_DIAGONAL_ENDTOPLEFT = 19;
- BF_DIAGONAL_ENDTOPRIGHT = 22;
- BF_FLAT = 16384;
- BF_LEFT = 1;
- BF_MIDDLE = 2048;
- BF_MONO = 32768;
- BF_RECT = 15;
- BF_RIGHT = 4;
- BF_SOFT = 4096;
- BF_TOP = 2;
- BF_TOPLEFT = 3;
- BF_TOPRIGHT = 6;
- { DrawFrameControl }
- DFC_BUTTON = 4;
- DFC_CAPTION = 1;
- DFC_MENU = 2;
- DFC_SCROLL = 3;
- DFCS_BUTTON3STATE = 8;
- DFCS_BUTTONCHECK = 0;
- DFCS_BUTTONPUSH = 16;
- DFCS_BUTTONRADIO = 4;
- DFCS_BUTTONRADIOIMAGE = 1;
- DFCS_BUTTONRADIOMASK = 2;
- DFCS_CAPTIONCLOSE = 0;
- DFCS_CAPTIONHELP = 4;
- DFCS_CAPTIONMAX = 2;
- DFCS_CAPTIONMIN = 1;
- DFCS_CAPTIONRESTORE = 3;
- DFCS_MENUARROW = 0;
- DFCS_MENUBULLET = 2;
- DFCS_MENUCHECK = 1;
- DFCS_SCROLLCOMBOBOX = 5;
- DFCS_SCROLLDOWN = 1;
- DFCS_SCROLLLEFT = 2;
- DFCS_SCROLLRIGHT = 3;
- DFCS_SCROLLSIZEGRIP = 8;
- DFCS_SCROLLUP = 0;
- DFCS_ADJUSTRECT = 8192;
- DFCS_CHECKED = 1024;
- DFCS_FLAT = 16384;
- DFCS_INACTIVE = 256;
- DFCS_MONO = 32768;
- DFCS_PUSHED = 512;
- { DrawIconEx }
- DI_COMPAT = 4;
- DI_DEFAULTSIZE = 8;
- DI_IMAGE = 2;
- DI_MASK = 1;
- DI_NORMAL = 3;
- { DrawState }
- DST_BITMAP = 4;
- DST_COMPLEX = 0;
- DST_ICON = 3;
- DST_PREFIXTEXT = 2;
- DST_TEXT = 1;
- DSS_NORMAL = 0;
- DSS_UNION = 16;
- DSS_DISABLED = 32;
- DSS_MONO = 128;
- { DrawStatusText }
- SBT_NOBORDERS = 256;
- SBT_OWNERDRAW = 4096;
- SBT_POPOUT = 512;
- SBT_RTLREADING = 1024;
- { DrawText, DrawTextEx }
- DT_BOTTOM = 8;
- DT_CALCRECT = 1024;
- DT_CENTER = 1;
- DT_EDITCONTROL = 8192;
- DT_END_ELLIPSIS = 32768;
- DT_PATH_ELLIPSIS = 16384;
- DT_EXPANDTABS = 64;
- DT_EXTERNALLEADING = 512;
- DT_LEFT = 0;
- DT_MODIFYSTRING = 65536;
- DT_NOCLIP = 256;
- DT_NOPREFIX = 2048;
- DT_RIGHT = 2;
- DT_RTLREADING = 131072;
- DT_SINGLELINE = 32;
- DT_TABSTOP = 128;
- DT_TOP = 0;
- DT_VCENTER = 4;
- DT_WORDBREAK = 16;
- DT_INTERNAL = 4096;
- { DuplicateHandle, MapViewOfFile }
- DUPLICATE_CLOSE_SOURCE = 1;
- DUPLICATE_SAME_ACCESS = 2;
- FILE_MAP_ALL_ACCESS = $f001f;
- FILE_MAP_READ = 4;
- FILE_MAP_WRITE = 2;
- FILE_MAP_COPY = 1;
- MUTEX_ALL_ACCESS = $1f0001;
- MUTEX_MODIFY_STATE = 1;
- //SYNCHRONIZE = $100000; //~winnt, move to ACCESS_TYPE
- SEMAPHORE_ALL_ACCESS = $1f0003;
- SEMAPHORE_MODIFY_STATE = 2;
- EVENT_ALL_ACCESS = $1f0003;
- EVENT_MODIFY_STATE = 2;
- KEY_ALL_ACCESS = $f003f;
- KEY_CREATE_LINK = 32;
- KEY_CREATE_SUB_KEY = 4;
- KEY_ENUMERATE_SUB_KEYS = 8;
- KEY_EXECUTE = $20019;
- KEY_NOTIFY = 16;
- KEY_QUERY_VALUE = 1;
- KEY_READ = $20019;
- KEY_SET_VALUE = 2;
- KEY_WRITE = $20006;
- PROCESS_ALL_ACCESS = $1f0fff;
- PROCESS_CREATE_PROCESS = 128;
- PROCESS_CREATE_THREAD = 2;
- PROCESS_DUP_HANDLE = 64;
- PROCESS_QUERY_INFORMATION = 1024;
- PROCESS_SET_INFORMATION = 512;
- PROCESS_TERMINATE = 1;
- PROCESS_VM_OPERATION = 8;
- PROCESS_VM_READ = 16;
- PROCESS_VM_WRITE = 32;
- THREAD_ALL_ACCESS = $1f03ff;
- THREAD_DIRECT_IMPERSONATION = 512;
- THREAD_GET_CONTEXT = 8;
- THREAD_IMPERSONATE = 256;
- THREAD_QUERY_INFORMATION = 64;
- THREAD_SET_CONTEXT = 16;
- THREAD_SET_INFORMATION = 32;
- THREAD_SET_THREAD_TOKEN = 128;
- THREAD_SUSPEND_RESUME = 2;
- THREAD_TERMINATE = 1;
- { EditWordBreakProc }
- WB_ISDELIMITER = 2;
- WB_LEFT = 0;
- WB_RIGHT = 1;
- { EnableScrollBar }
- SB_BOTH = 3;
- SB_CTL = 2;
- SB_HORZ = 0;
- SB_VERT = 1;
- ESB_DISABLE_BOTH = 3;
- ESB_DISABLE_DOWN = 2;
- ESB_DISABLE_LEFT = 1;
- ESB_DISABLE_LTUP = 1;
- ESB_DISABLE_RIGHT = 2;
- ESB_DISABLE_RTDN = 2;
- ESB_DISABLE_UP = 1;
- ESB_ENABLE_BOTH = 0;
- { Scroll Bar notifications }
- SB_LINEUP = 0;
- SB_LINEDOWN = 1;
- SB_LINELEFT = 0;
- SB_LINERIGHT = 1;
- SB_PAGEUP = 2;
- SB_PAGEDOWN = 3;
- SB_PAGELEFT = 2;
- SB_PAGERIGHT = 3;
- SB_THUMBPOSITION = 4;
- SB_THUMBTRACK = 5;
- SB_ENDSCROLL = 8;
- SB_LEFT = 6;
- SB_RIGHT = 7;
- SB_BOTTOM = 7;
- SB_TOP = 6;
- { EnumCalendarInfo }
- ENUM_ALL_CALENDARS = -(1);
- { EnumDateFormats }
- DATE_SHORTDATE = 1;
- DATE_LONGDATE = 2;
- { EnumDependentServices }
- SERVICE_ACTIVE = 1;
- SERVICE_INACTIVE = 2;
- { EnumFontFamExProc }
- DEVICE_FONTTYPE = 2;
- RASTER_FONTTYPE = 1;
- TRUETYPE_FONTTYPE = 4;
- { EnumObjects, GetCurrentObject, GetObjectType }
- OBJ_BRUSH = 2;
- OBJ_PEN = 1;
- OBJ_PAL = 5;
- OBJ_FONT = 6;
- OBJ_BITMAP = 7;
- OBJ_EXTPEN = 11;
- OBJ_REGION = 8;
- OBJ_DC = 3;
- OBJ_MEMDC = 10;
- OBJ_METAFILE = 9;
- OBJ_METADC = 4;
- OBJ_ENHMETAFILE = 13;
- OBJ_ENHMETADC = 12;
- { EnumPrinters }
- { EnumProtocols }
- { EnumResLangProc }
- { was #define dname def_expr }
- function RT_ACCELERATOR : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function RT_BITMAP : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function RT_DIALOG : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function RT_FONT : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function RT_FONTDIR : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function RT_MENU : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function RT_RCDATA : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function RT_STRING : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function RT_MESSAGETABLE : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function RT_CURSOR : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function RT_GROUP_CURSOR : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function RT_ICON : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function RT_GROUP_ICON : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function RT_VERSION : LPTSTR;
- { return type might be wrong }
-
- { EnumServicesStatus }
-
- const
- SERVICE_WIN32 = 48;
- SERVICE_DRIVER = 11;
- { EnumSystemCodePages }
- CP_INSTALLED = 1;
- CP_SUPPORTED = 2;
- { EnumSystemLocales }
- LCID_INSTALLED = 1;
- LCID_SUPPORTED = 2;
- { EraseTape }
- TAPE_ERASE_LONG = $1;
- TAPE_ERASE_SHORT = 0;
- { Escape }
- SP_ERROR = -(1);
- SP_OUTOFDISK = -(4);
- SP_OUTOFMEMORY = -(5);
- SP_USERABORT = -(3);
- PHYSICALWIDTH = 110;
- PHYSICALHEIGHT = 111;
- PHYSICALOFFSETX = 112;
- PHYSICALOFFSETY = 113;
- SCALINGFACTORX = 114;
- SCALINGFACTORY = 115;
- QUERYESCSUPPORT = 8;
- {ABORTDOC = 2; conflicts with AbortDoc function }
- cABORTDOC = 2;
- {ENDDOC = 11; conflicts with AbortDoc function }
- cENDDOC = 11;
- GETPHYSPAGESIZE = 12;
- GETPRINTINGOFFSET = 13;
- GETSCALINGFACTOR = 14;
- NEWFRAME = 1;
- NEXTBAND = 3;
- PASSTHROUGH = 19;
- {SETABORTPROC = 9; conflicts with AbortDoc function }
- cSETABORTPROC = 9;
- {STARTDOC = 10; conflicts with AbortDoc function }
- cSTARTDOC = 10;
- { EscapeCommFunction }
- CLRDTR = 6; //winbase
- CLRRTS = 4; //winbase
- SETDTR = 5; //winbase
- SETRTS = 3; //winbase
- SETXOFF = 1; //winbase
- SETXON = 2; //winbase
- SETBREAK = 8; //winbase
- CLRBREAK = 9; //winbase
- // Some CE devices share a UART between an IRDA port and a serial port.
- // These escape functions allow control over the mode.
- SETIR = 10; // Set the port to IR mode. //+winbase
- CLRIR = 11; // Set the port to non-IR mode. //+winbase
- { ExitWindowsEx }
- EWX_FORCE = 4;
- EWX_LOGOFF = 0;
- EWX_POWEROFF = 8;
- EWX_REBOOT = 2;
- EWX_SHUTDOWN = 1;
- { ExtFloodFill }
- FLOODFILLBORDER = 0;
- FLOODFILLSURFACE = 1;
- { ExtTextOut }
- ETO_CLIPPED = 4;
- ETO_GLYPH_INDEX = 16;
- ETO_OPAQUE = 2;
- ETO_RTLREADING = 128;
- { FillConsoleOutputAttribute }
- FOREGROUND_BLUE = 1;
- FOREGROUND_GREEN = 2;
- FOREGROUND_RED = 4;
- FOREGROUND_INTENSITY = 8;
- BACKGROUND_BLUE = 16;
- BACKGROUND_GREEN = 32;
- BACKGROUND_RED = 64;
- BACKGROUND_INTENSITY = 128;
- { FindFirstChangeNotification }
- FILE_NOTIFY_CHANGE_FILE_NAME = 1;
- FILE_NOTIFY_CHANGE_DIR_NAME = 2;
- FILE_NOTIFY_CHANGE_ATTRIBUTES = 4;
- FILE_NOTIFY_CHANGE_SIZE = 8;
- FILE_NOTIFY_CHANGE_LAST_WRITE = 16;
- FILE_NOTIFY_CHANGE_SECURITY = 256;
- { FindFirstPrinterChangeNotification }
- { FindNextPrinterNotification }
- { FMExtensionProc }
- { FoldString }
- MAP_FOLDCZONE = 16;
- MAP_FOLDDIGITS = 128;
- MAP_PRECOMPOSED = 32;
- MAP_COMPOSITE = 64;
- { ForegroundIdleProc }
- HC_ACTION = 0;
- { FormatMessage }
- FORMAT_MESSAGE_ALLOCATE_BUFFER = 256;
- FORMAT_MESSAGE_IGNORE_INSERTS = 512;
- FORMAT_MESSAGE_FROM_STRING = 1024;
- FORMAT_MESSAGE_FROM_HMODULE = 2048;
- FORMAT_MESSAGE_FROM_SYSTEM = 4096;
- FORMAT_MESSAGE_ARGUMENT_ARRAY = 8192;
- FORMAT_MESSAGE_MAX_WIDTH_MASK = 255;
- { GdiComment }
- GDICOMMENT_WINDOWS_METAFILE = -(2147483647);
- GDICOMMENT_BEGINGROUP = 2;
- GDICOMMENT_ENDGROUP = 3;
- GDICOMMENT_MULTIFORMATS = 1073741828;
- GDICOMMENT_IDENTIFIER = 1128875079;
- { GenerateConsoleCtrlEvent, HandlerRoutine }
- CTRL_C_EVENT = 0;
- CTRL_BREAK_EVENT = 1;
- CTRL_CLOSE_EVENT = 2;
- CTRL_LOGOFF_EVENT = 5;
- CTRL_SHUTDOWN_EVENT = 6;
- { GetAddressByName }
- { GetArcDirection }
- AD_COUNTERCLOCKWISE = 1;
- AD_CLOCKWISE = 2;
- { GetBinaryTypes }
- SCS_32BIT_BINARY = 0;
- SCS_DOS_BINARY = 1;
- SCS_OS216_BINARY = 5;
- SCS_PIF_BINARY = 3;
- SCS_POSIX_BINARY = 4;
- SCS_WOW_BINARY = 2;
- { GetBoundsRect, SetBoundsRect }
- DCB_DISABLE = 8;
- DCB_ENABLE = 4;
- DCB_RESET = 1;
- DCB_SET = 3;
- DCB_ACCUMULATE = 2;
- { GetCharacterPlacement, GetFontLanguageInfo }
- GCP_DBCS = 1;
- GCP_ERROR = $8000;
- GCP_CLASSIN = $80000;
- GCP_DIACRITIC = 256;
- GCP_DISPLAYZWG = $400000;
- GCP_GLYPHSHAPE = 16;
- GCP_JUSTIFY = $10000;
- GCP_JUSTIFYIN = $200000;
- GCP_KASHIDA = 1024;
- GCP_LIGATE = 32;
- GCP_MAXEXTENT = $100000;
- GCP_NEUTRALOVERRIDE = $2000000;
- GCP_NUMERICOVERRIDE = $1000000;
- GCP_NUMERICSLATIN = $4000000;
- GCP_NUMERICSLOCAL = $8000000;
- GCP_REORDER = 2;
- GCP_SYMSWAPOFF = $800000;
- GCP_USEKERNING = 8;
- FLI_GLYPHS = $40000;
- FLI_MASK = $103b;
- { GetClassLong, GetClassWord }
- GCW_ATOM = -(32);
- GCL_CBCLSEXTRA = -(20);
- GCL_CBWNDEXTRA = -(18);
- GCL_HBRBACKGROUND = -(10);
- GCL_HCURSOR = -(12);
- GCL_HICON = -(14);
- GCL_HICONSM = -(34);
- GCL_HMODULE = -(16);
- GCL_MENUNAME = -(8);
- GCL_STYLE = -(26);
- GCL_WNDPROC = -(24);
- { GetClipboardFormat, SetClipboardData }
- CF_BITMAP = 2;
- CF_DIB = 8;
- CF_PALETTE = 9;
- CF_ENHMETAFILE = 14;
- CF_METAFILEPICT = 3;
- CF_OEMTEXT = 7;
- CF_TEXT = 1;
- CF_UNICODETEXT = 13;
- CF_DIF = 5;
- CF_DSPBITMAP = 130;
- CF_DSPENHMETAFILE = 142;
- CF_DSPMETAFILEPICT = 131;
- CF_DSPTEXT = 129;
- CF_GDIOBJFIRST = 768;
- CF_GDIOBJLAST = 1023;
- CF_HDROP = 15;
- CF_LOCALE = 16;
- CF_OWNERDISPLAY = 128;
- CF_PENDATA = 10;
- CF_PRIVATEFIRST = 512;
- CF_PRIVATELAST = 767;
- CF_RIFF = 11;
- CF_SYLK = 4;
- CF_WAVE = 12;
- CF_TIFF = 6;
- { GetCommMask }
- EV_BREAK = 64;
- EV_CTS = 8;
- EV_DSR = 16;
- EV_ERR = 128;
- EV_EVENT1 = 2048;
- EV_EVENT2 = 4096;
- EV_PERR = 512;
- EV_RING = 256;
- EV_RLSD = 32;
- EV_RX80FULL = 1024;
- EV_RXCHAR = 1;
- EV_RXFLAG = 2;
- EV_TXEMPTY = 4;
- EV_POWER = $2000; // WINCE Power event. //+winbase
-
- { GetCommModemStatus }
- MS_CTS_ON = $10;
- MS_DSR_ON = $20;
- MS_RING_ON = $40;
- MS_RLSD_ON = $80;
- { GetComputerName }
- MAX_COMPUTERNAME_LENGTH = 15;
- { GetConsoleMode }
- ENABLE_LINE_INPUT = 2;
- ENABLE_ECHO_INPUT = 4;
- ENABLE_PROCESSED_INPUT = 1;
- ENABLE_WINDOW_INPUT = 8;
- ENABLE_MOUSE_INPUT = 16;
- ENABLE_PROCESSED_OUTPUT = 1;
- ENABLE_WRAP_AT_EOL_OUTPUT = 2;
- { GetCPInfo }
- CP_ACP = 0;
- CP_MACCP = 2;
- CP_OEMCP = 1;
- { GetDateFormat }
- { already defined above !!
- #define DATE_SHORTDATE (1)
- #define DATE_LONGDATE (2)
- }
- DATE_USE_ALT_CALENDAR = 4;
- { GetDCEx }
- DCX_WINDOW = $1;
- DCX_CACHE = $2;
- DCX_PARENTCLIP = $20;
- DCX_CLIPSIBLINGS = $10;
- DCX_CLIPCHILDREN = $8;
- DCX_NORESETATTRS = $4;
- DCX_LOCKWINDOWUPDATE = $400;
- DCX_EXCLUDERGN = $40;
- DCX_INTERSECTRGN = $80;
- DCX_VALIDATE = $200000;
- { GetDeviceCaps }
- DRIVERVERSION = 0;
- TECHNOLOGY = 2;
- DT_PLOTTER = 0;
- DT_RASDISPLAY = 1;
- DT_RASPRINTER = 2;
- DT_RASCAMERA = 3;
- DT_CHARSTREAM = 4;
- DT_METAFILE = 5;
- DT_DISPFILE = 6;
- HORZSIZE = 4;
- VERTSIZE = 6;
- HORZRES = 8;
- VERTRES = 10;
- LOGPIXELSX = 88;
- LOGPIXELSY = 90;
- BITSPIXEL = 12;
- PLANES = 14;
- NUMBRUSHES = 16;
- NUMPENS = 18;
- NUMFONTS = 22;
- NUMCOLORS = 24;
- ASPECTX = 40;
- ASPECTY = 42;
- ASPECTXY = 44;
- PDEVICESIZE = 26;
- CLIPCAPS = 36;
- SIZEPALETTE = 104;
- NUMRESERVED = 106;
- COLORRES = 108;
- { already defined above !!
- #define PHYSICALWIDTH (110)
- #define PHYSICALHEIGHT (111)
- #define PHYSICALOFFSETX (112)
- #define PHYSICALOFFSETY (113)
- #define SCALINGFACTORX (114)
- #define SCALINGFACTORY (115)
- }
- VREFRESH = 116;
- DESKTOPHORZRES = 118;
- DESKTOPVERTRES = 117;
- BLTALIGNMENT = 119;
- RASTERCAPS = 38;
- RC_BANDING = 2;
- RC_BITBLT = 1;
- RC_BITMAP64 = 8;
- RC_DI_BITMAP = 128;
- RC_DIBTODEV = 512;
- RC_FLOODFILL = 4096;
- RC_GDI20_OUTPUT = 16;
- RC_PALETTE = 256;
- RC_SCALING = 4;
- RC_STRETCHBLT = 2048;
- RC_STRETCHDIB = 8192;
- CURVECAPS = 28;
- CC_NONE = 0;
- CC_CIRCLES = 1;
- CC_PIE = 2;
- CC_CHORD = 4;
- CC_ELLIPSES = 8;
- CC_WIDE = 16;
- CC_STYLED = 32;
- CC_WIDESTYLED = 64;
- CC_INTERIORS = 128;
- CC_ROUNDRECT = 256;
- LINECAPS = 30;
- LC_NONE = 0;
- LC_POLYLINE = 2;
- LC_MARKER = 4;
- LC_POLYMARKER = 8;
- LC_WIDE = 16;
- LC_STYLED = 32;
- LC_WIDESTYLED = 64;
- LC_INTERIORS = 128;
- POLYGONALCAPS = 32;
- PC_NONE = 0;
- PC_POLYGON = 1;
- PC_RECTANGLE = 2;
- PC_WINDPOLYGON = 4;
- PC_SCANLINE = 8;
- PC_WIDE = 16;
- PC_STYLED = 32;
- PC_WIDESTYLED = 64;
- PC_INTERIORS = 128;
- TEXTCAPS = 34;
- TC_OP_CHARACTER = 1;
- TC_OP_STROKE = 2;
- TC_CP_STROKE = 4;
- TC_CR_90 = 8;
- TC_CR_ANY = 16;
- TC_SF_X_YINDEP = 32;
- TC_SA_DOUBLE = 64;
- TC_SA_INTEGER = 128;
- TC_SA_CONTIN = 256;
- TC_EA_DOUBLE = 512;
- TC_IA_ABLE = 1024;
- TC_UA_ABLE = 2048;
- TC_SO_ABLE = 4096;
- TC_RA_ABLE = 8192;
- TC_VA_ABLE = 16384;
- TC_RESERVED = 32768;
- TC_SCROLLBLT = 65536;
- PC_PATHS = 512;
- { GetDriveType }
- DRIVE_REMOVABLE = 2;
- DRIVE_FIXED = 3;
- DRIVE_REMOTE = 4;
- DRIVE_CDROM = 5;
- DRIVE_RAMDISK = 6;
- DRIVE_UNKNOWN = 0;
- DRIVE_NO_ROOT_DIR = 1;
- { GetExceptionCode }
- EXCEPTION_ACCESS_VIOLATION = $c0000005;
- EXCEPTION_BREAKPOINT = $80000003;
- EXCEPTION_DATATYPE_MISALIGNMENT = $80000002;
- EXCEPTION_SINGLE_STEP = $80000004;
- EXCEPTION_ARRAY_BOUNDS_EXCEEDED = $c000008c;
- EXCEPTION_FLT_DENORMAL_OPERAND = $c000008d;
- EXCEPTION_FLT_DIVIDE_BY_ZERO = $c000008e;
- EXCEPTION_FLT_INEXACT_RESULT = $c000008f;
- EXCEPTION_FLT_INVALID_OPERATION = $c0000090;
- EXCEPTION_FLT_OVERFLOW = $c0000091;
- EXCEPTION_FLT_STACK_CHECK = $c0000092;
- EXCEPTION_FLT_UNDERFLOW = $c0000093;
- EXCEPTION_INT_DIVIDE_BY_ZERO = $c0000094;
- EXCEPTION_INT_OVERFLOW = $c0000095;
- EXCEPTION_INVALID_HANDLE = $c0000008;
- EXCEPTION_PRIV_INSTRUCTION = $c0000096;
- EXCEPTION_NONCONTINUABLE_EXCEPTION = $c0000025;
- EXCEPTION_NONCONTINUABLE = $1; //winnt
- EXCEPTION_UNWINDING = $2; //+winnt
- EXCEPTION_EXIT_UNWIND = $4; //+winnt
- EXCEPTION_STACK_INVALID = $8; //+winnt
- EXCEPTION_NESTED_CALL = $10; //+winnt
- EXCEPTION_TARGET_UNWIND = $20; //+winnt
- EXCEPTION_COLLIDED_UNWIND = $40; //+winnt
- EXCEPTION_UNWIND = EXCEPTION_UNWINDING or EXCEPTION_EXIT_UNWIND or
- EXCEPTION_TARGET_UNWIND or EXCEPTION_COLLIDED_UNWIND; //+winnt
- EXCEPTION_STACK_OVERFLOW = $c00000fd;
- EXCEPTION_INVALID_DISPOSITION = $c0000026;
- EXCEPTION_IN_PAGE_ERROR = $c0000006;
- EXCEPTION_ILLEGAL_INSTRUCTION = $c000001d;
- EXCEPTION_POSSIBLE_DEADLOCK = $c0000194;
-
- function IS_UNWINDING( Flag : Longint) : boolean; //+winnt
- function IS_DISPATCHING( Flag : Longint) : boolean; //+winnt
- function IS_TARGET_UNWIND( Flag : Longint) : Longint; //+winnt
-
- { GetFileType }
- const
- FILE_TYPE_UNKNOWN = 0;
- FILE_TYPE_DISK = 1;
- FILE_TYPE_CHAR = 2;
- FILE_TYPE_PIPE = 3;
- { GetGlyphOutline }
- GGO_BITMAP = 1;
- GGO_NATIVE = 2;
- GGO_METRICS = 0;
- GGO_GRAY2_BITMAP = 4;
- GGO_GRAY4_BITMAP = 5;
- GGO_GRAY8_BITMAP = 6;
- GDI_ERROR = $ffffffff;
- { GetGraphicsMode }
- GM_COMPATIBLE = 1;
- GM_ADVANCED = 2;
- { GetHandleInformation }
- HANDLE_FLAG_INHERIT = 1;
- HANDLE_FLAG_PROTECT_FROM_CLOSE = 2;
- { GetIconInfo }
- { was #define dname def_expr }
- function IDC_ARROW : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function IDC_IBEAM : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function IDC_WAIT : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function IDC_CROSS : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function IDC_UPARROW : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function IDC_SIZENWSE : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function IDC_SIZENESW : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function IDC_SIZEWE : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function IDC_SIZENS : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function IDC_SIZEALL : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function IDC_NO : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function IDC_APPSTARTING : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function IDC_HELP : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function IDI_APPLICATION : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function IDI_HAND : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function IDI_QUESTION : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function IDI_EXCLAMATION : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function IDI_ASTERISK : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function IDI_WINLOGO : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function IDC_SIZE : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function IDC_ICON : LPTSTR;
- { return type might be wrong }
-
- { was #define dname def_expr }
- function IDC_HAND : LPTSTR;
- { return type might be wrong }
-
- { GetMapMode }
-
- const
- MM_ANISOTROPIC = 8;
- MM_HIENGLISH = 5;
- MM_HIMETRIC = 3;
- MM_ISOTROPIC = 7;
- MM_LOENGLISH = 4;
- MM_LOMETRIC = 2;
- MM_TEXT = 1;
- MM_TWIPS = 6;
- { GetMenuDefaultItem }
- GMDI_GOINTOPOPUPS = $2;
- GMDI_USEDISABLED = $1;
- { PeekMessage }
- PM_NOREMOVE = 0;
- PM_REMOVE = 1;
- PM_NOYIELD = 2;
- { GetNamedPipeHandleState }
- { PIPE_NOWAIT = 1; already above }
- { PIPE_READMODE_MESSAGE = 2;already above }
- { GetNamedPipeInfo }
- PIPE_CLIENT_END = 0;
- PIPE_SERVER_END = 1;
- { PIPE_TYPE_MESSAGE = 4;already above }
- { GetNextWindow, GetWindow }
- GW_HWNDNEXT = 2;
- GW_HWNDPREV = 3;
- GW_CHILD = 5;
- GW_HWNDFIRST = 0;
- GW_HWNDLAST = 1;
- GW_OWNER = 4;
- GW_MAX = 5; //+winuser
-
- { GetPath }
- PT_MOVETO = 6;
- PT_LINETO = 2;
- PT_BEZIERTO = 4;
- PT_CLOSEFIGURE = 1;
- { GetProcessShutdownParameters }
- SHUTDOWN_NORETRY = 1;
- { GetQueueStatus }
- QS_ALLEVENTS = 191;
- QS_ALLINPUT = 255;
- QS_HOTKEY = 128;
- QS_INPUT = 7;
- QS_KEY = 1;
- QS_MOUSE = 6;
- QS_MOUSEBUTTON = 4;
- QS_MOUSEMOVE = 2;
- QS_PAINT = 32;
- QS_POSTMESSAGE = 8;
- QS_SENDMESSAGE = 64;
- QS_TIMER = 16;
- { GetScrollInfo, SetScrollInfo }
- SIF_ALL = 23;
- SIF_PAGE = 2;
- SIF_POS = 4;
- SIF_RANGE = 1;
- SIF_DISABLENOSCROLL = 8;
- { GetStdHandle }
- { was #define dname def_expr }
- function STD_INPUT_HANDLE : DWORD;
-
- { was #define dname def_expr }
- function STD_OUTPUT_HANDLE : DWORD;
-
- { was #define dname def_expr }
- function STD_ERROR_HANDLE : DWORD;
-
- { was #define dname def_expr }
-Const
- INVALID_HANDLE_VALUE = HANDLE(-1);
-
- { GetStockObject }
-
- const
- BLACK_BRUSH = 4;
- DKGRAY_BRUSH = 3;
- GRAY_BRUSH = 2;
- HOLLOW_BRUSH = 5;
- LTGRAY_BRUSH = 1;
- NULL_BRUSH = 5;
- WHITE_BRUSH = 0;
- BLACK_PEN = 7;
- NULL_PEN = 8;
- WHITE_PEN = 6;
- ANSI_FIXED_FONT = 11;
- ANSI_VAR_FONT = 12;
- DEVICE_DEFAULT_FONT = 14;
- DEFAULT_GUI_FONT = 17;
- OEM_FIXED_FONT = 10;
- SYSTEM_FONT = 13;
- SYSTEM_FIXED_FONT = 16;
- DEFAULT_PALETTE = 15;
- { GetStringTypeA }
- CT_CTYPE1 = 1;
- CT_CTYPE2 = 2;
- CT_CTYPE3 = 4;
- C1_UPPER = 1;
- C1_LOWER = 2;
- C1_DIGIT = 4;
- C1_SPACE = 8;
- C1_PUNCT = 16;
- C1_CNTRL = 32;
- C1_BLANK = 64;
- C1_XDIGIT = 128;
- C1_ALPHA = 256;
- C2_LEFTTORIGHT = 1;
- C2_RIGHTTOLEFT = 2;
- C2_EUROPENUMBER = 3;
- C2_EUROPESEPARATOR = 4;
- C2_EUROPETERMINATOR = 5;
- C2_ARABICNUMBER = 6;
- C2_COMMONSEPARATOR = 7;
- C2_BLOCKSEPARATOR = 8;
- C2_SEGMENTSEPARATOR = 9;
- C2_WHITESPACE = 10;
- C2_OTHERNEUTRAL = 11;
- C2_NOTAPPLICABLE = 0;
- C3_NONSPACING = 1;
- C3_DIACRITIC = 2;
- C3_VOWELMARK = 4;
- C3_SYMBOL = 8;
- C3_KATAKANA = 16;
- C3_HIRAGANA = 32;
- C3_HALFWIDTH = 64;
- C3_FULLWIDTH = 128;
- C3_IDEOGRAPH = 256;
- C3_KASHIDA = 512;
- C3_ALPHA = 32768;
- C3_NOTAPPLICABLE = 0;
- { GetSysColor }
- COLOR_3DDKSHADOW = 21;
- COLOR_3DFACE = 15;
- COLOR_3DHILIGHT = 20;
- COLOR_3DLIGHT = 22;
- COLOR_BTNHILIGHT = 20;
- COLOR_3DSHADOW = 16;
- COLOR_ACTIVEBORDER = 10;
- COLOR_ACTIVECAPTION = 2;
- COLOR_APPWORKSPACE = 12;
- COLOR_BACKGROUND = 1;
- COLOR_DESKTOP = 1;
- COLOR_BTNFACE = 15;
- COLOR_BTNHIGHLIGHT = 20;
- COLOR_BTNSHADOW = 16;
- COLOR_BTNTEXT = 18;
- COLOR_CAPTIONTEXT = 9;
- COLOR_GRAYTEXT = 17;
- COLOR_HIGHLIGHT = 13;
- COLOR_HIGHLIGHTTEXT = 14;
- COLOR_INACTIVEBORDER = 11;
- COLOR_INACTIVECAPTION = 3;
- COLOR_INACTIVECAPTIONTEXT = 19;
- COLOR_INFOBK = 24;
- COLOR_INFOTEXT = 23;
- COLOR_MENU = 4;
- COLOR_MENUTEXT = 7;
- COLOR_SCROLLBAR = 0;
- COLOR_WINDOW = 5;
- COLOR_WINDOWFRAME = 6;
- COLOR_WINDOWTEXT = 8;
- { GetSystemMetrics }
- SM_CYMIN = 29;
- SM_CXMIN = 28;
- SM_ARRANGE = 56;
- SM_CLEANBOOT = 67;
- { The right value for SM_CEMETRICS for NT 3.5 is 75. For Windows 95
- and NT 4.0, it is 76. The meaning is undocumented, anyhow. }
- SM_CMETRICS = 76;
- SM_CMOUSEBUTTONS = 43;
- SM_CXBORDER = 5;
- SM_CYBORDER = 6;
- SM_CXCURSOR = 13;
- SM_CYCURSOR = 14;
- SM_CXDLGFRAME = 7;
- SM_CYDLGFRAME = 8;
- SM_CXDOUBLECLK = 36;
- SM_CYDOUBLECLK = 37;
- SM_CXDRAG = 68;
- SM_CYDRAG = 69;
- SM_CXEDGE = 45;
- SM_CYEDGE = 46;
- SM_CXFIXEDFRAME = 7;
- SM_CYFIXEDFRAME = 8;
- SM_CXFRAME = 32;
- SM_CYFRAME = 33;
- SM_CXFULLSCREEN = 16;
- SM_CYFULLSCREEN = 17;
- SM_CXHSCROLL = 21;
- SM_CYHSCROLL = 3;
- SM_CXHTHUMB = 10;
- SM_CXICON = 11;
- SM_CYICON = 12;
- SM_CXICONSPACING = 38;
- SM_CYICONSPACING = 39;
- SM_CXMAXIMIZED = 61;
- SM_CYMAXIMIZED = 62;
- SM_CXMAXTRACK = 59;
- SM_CYMAXTRACK = 60;
- SM_CXMENUCHECK = 71;
- SM_CYMENUCHECK = 72;
- SM_CXMENUSIZE = 54;
- SM_CYMENUSIZE = 55;
- SM_CXMINIMIZED = 57;
- SM_CYMINIMIZED = 58;
- SM_CXMINSPACING = 47;
- SM_CYMINSPACING = 48;
- SM_CXMINTRACK = 34;
- SM_CYMINTRACK = 35;
- SM_CXSCREEN = 0;
- SM_CYSCREEN = 1;
- SM_CXSIZE = 30;
- SM_CYSIZE = 31;
- SM_CXSIZEFRAME = 32;
- SM_CYSIZEFRAME = 33;
- SM_CXSMICON = 49;
- SM_CYSMICON = 50;
- SM_CXSMSIZE = 52;
- SM_CYSMSIZE = 53;
- SM_CXVSCROLL = 2;
- {SM_CYHSCROLL = 3;already above }
- {SM_CXHSCROLL = 21;already above }
- SM_CYVSCROLL = 20;
- SM_CYVTHUMB = 9;
- SM_CYCAPTION = 4;
- SM_CYKANJIWINDOW = 18;
- SM_CYMENU = 15;
- SM_CYSMCAPTION = 51;
- SM_DBCSENABLED = 42;
- SM_DEBUG = 22;
- SM_MENUDROPALIGNMENT = 40;
- SM_MIDEASTENABLED = 74;
- SM_MOUSEPRESENT = 19;
- SM_MOUSEWHEELPRESENT = 75;
- SM_NETWORK = 63;
- SM_PENWINDOWS = 41;
- SM_SECURE = 44;
- SM_SHOWSOUNDS = 70;
- SM_SLOWMACHINE = 73;
- SM_SWAPBUTTON = 23;
- ARW_BOTTOMLEFT = 0;
- ARW_BOTTOMRIGHT = $1;
- ARW_HIDE = $8;
- ARW_TOPLEFT = $2;
- ARW_TOPRIGHT = $3;
- ARW_DOWN = $4;
- ARW_LEFT = 0;
- ARW_RIGHT = 0;
- ARW_UP = $4;
- { GetSystemPaletteUse }
- SYSPAL_NOSTATIC = 2;
- SYSPAL_STATIC = 1;
- SYSPAL_ERROR = 0;
- { GetTapeParameters, SetTapeParameters }
- GET_TAPE_MEDIA_INFORMATION = 0;
- GET_TAPE_DRIVE_INFORMATION = 1;
- SET_TAPE_MEDIA_INFORMATION = 0;
- SET_TAPE_DRIVE_INFORMATION = 1;
- { GetTapePosition }
- TAPE_ABSOLUTE_POSITION = 0;
- TAPE_LOGICAL_POSITION = $1;
- { GetTextAlign }
- TA_BASELINE = 24;
- TA_BOTTOM = 8;
- TA_TOP = 0;
- TA_CENTER = 6;
- TA_LEFT = 0;
- TA_RIGHT = 2;
- TA_RTLREADING = 256;
- TA_NOUPDATECP = 0;
- TA_UPDATECP = 1;
- VTA_BASELINE = 24;
- VTA_CENTER = 6;
- { GetThreadPriority }
- THREAD_PRIORITY_ABOVE_NORMAL = 1;
- THREAD_PRIORITY_BELOW_NORMAL = -(1);
- THREAD_PRIORITY_HIGHEST = 2;
- THREAD_PRIORITY_IDLE = -(15);
- THREAD_PRIORITY_LOWEST = -(2);
- THREAD_PRIORITY_NORMAL = 0;
- THREAD_PRIORITY_TIME_CRITICAL = 15;
- THREAD_PRIORITY_ERROR_RETURN = 2147483647;
- TLS_MINIMUM_AVAILABLE = 64;
- { GetTimeFormat }
- TIME_NOMINUTESORSECONDS = 1;
- TIME_NOSECONDS = 2;
- TIME_NOTIMEMARKER = 4;
- TIME_FORCE24HOURFORMAT = 8;
- { GetTimeZoneInformation }
- { was #define dname def_expr }
-
-
- const
- TIME_ZONE_ID_INVALID = DWORD(-1);
- TIME_ZONE_ID_UNKNOWN = 0;
- TIME_ZONE_ID_STANDARD = 1;
- TIME_ZONE_ID_DAYLIGHT = 2;
- { GetUserObjectInformation }
- UOI_FLAGS = 1;
- UOI_NAME = 2;
- UOI_TYPE = 3;
- { GetVolumeInformation }
- FS_CASE_IS_PRESERVED = 2;
- FS_CASE_SENSITIVE = 1;
- FS_UNICODE_STORED_ON_DISK = 4;
- FS_PERSISTENT_ACLS = 8;
- FS_FILE_COMPRESSION = 16;
- FS_VOL_IS_COMPRESSED = 32768;
- { GetWindowLong }
- GWL_EXSTYLE = -(20);
- GWL_STYLE = -(16);
- GWL_WNDPROC = -(4);
- GWL_HINSTANCE = -(6);
- GWL_HWNDPARENT = -(8);
- GWL_ID = -(12);
- GWL_USERDATA = -(21);
- DWL_DLGPROC = 4;
- DWL_MSGRESULT = 0;
- DWL_USER = 8;
- { GlobalAlloc, GlobalFlags }
- GMEM_FIXED = 0;
- GMEM_MOVEABLE = 2;
- GPTR = 64;
- GHND = 66;
- GMEM_DDESHARE = 8192;
- GMEM_DISCARDABLE = 256;
- GMEM_LOWER = 4096;
- GMEM_NOCOMPACT = 16;
- GMEM_NODISCARD = 32;
- GMEM_NOT_BANKED = 4096;
- GMEM_NOTIFY = 16384;
- GMEM_SHARE = 8192;
- GMEM_ZEROINIT = 64;
- GMEM_DISCARDED = 16384;
- GMEM_INVALID_HANDLE = 32768;
- GMEM_LOCKCOUNT = 255;
- { HeapAlloc, HeapReAlloc }
- HEAP_GENERATE_EXCEPTIONS = 4;
- HEAP_NO_SERIALIZE = 1;
- HEAP_ZERO_MEMORY = 8;
- STATUS_NO_MEMORY = $c0000017;
- STATUS_ACCESS_VIOLATION = $c0000005;
- HEAP_REALLOC_IN_PLACE_ONLY = 16;
- { ImageList_Create }
- ILC_COLOR = 0;
- ILC_COLOR4 = 4;
- ILC_COLOR8 = 8;
- ILC_COLOR16 = 16;
- ILC_COLOR24 = 24;
- ILC_COLOR32 = 32;
- ILC_COLORDDB = 254;
- ILC_MASK = 1;
- ILC_PALETTE = 2048;
- { ImageList_Draw, ImageList_DrawEx }
- ILD_BLEND25 = 2;
- ILD_BLEND50 = 4;
- ILD_SELECTED = 4;
- ILD_BLEND = 4;
- ILD_FOCUS = 2;
- ILD_MASK = 16;
- ILD_NORMAL = 0;
- ILD_TRANSPARENT = 1;
- CLR_NONE = $ffffffff;
- CLR_DEFAULT = $ff000000;
- CLR_INVALID = $FFFFFFFF;
- { ImageList_LoadImage }
- {LR_DEFAULTCOLOR = 0;already above }
- LR_LOADFROMFILE = 16;
- LR_LOADMAP3DCOLORS = 4096;
- LR_LOADTRANSPARENT = 32;
- {LR_MONOCHROME = 1;already above }
- { ImmConfigureIME }
- IME_CONFIG_GENERAL = 1;
- IME_CONFIG_REGISTERWORD = 2;
- IME_CONFIG_SELECTDICTIONARY = 3;
- { ImmGetConversionList }
- GCL_CONVERSION = 1;
- GCL_REVERSECONVERSION = 2;
- GCL_REVERSE_LENGTH = 3;
- { ImmGetGuideLine }
- GGL_LEVEL = 1;
- GGL_INDEX = 2;
- GGL_STRING = 3;
- GGL_PRIVATE = 4;
- GL_LEVEL_ERROR = 2;
- GL_LEVEL_FATAL = 1;
- GL_LEVEL_INFORMATION = 4;
- GL_LEVEL_NOGUIDELINE = 0;
- GL_LEVEL_WARNING = 3;
- GL_ID_CANNOTSAVE = 17;
- GL_ID_NOCONVERT = 32;
- GL_ID_NODICTIONARY = 16;
- GL_ID_NOMODULE = 1;
- GL_ID_READINGCONFLICT = 35;
- GL_ID_TOOMANYSTROKE = 34;
- GL_ID_TYPINGERROR = 33;
- GL_ID_UNKNOWN = 0;
- GL_ID_INPUTREADING = 36;
- GL_ID_INPUTRADICAL = 37;
- GL_ID_INPUTCODE = 38;
- GL_ID_CHOOSECANDIDATE = 40;
- GL_ID_REVERSECONVERSION = 41;
- { ImmGetProperty }
- IGP_PROPERTY = 4;
- IGP_CONVERSION = 8;
- IGP_SENTENCE = 12;
- IGP_UI = 16;
- IGP_SETCOMPSTR = 20;
- IGP_SELECT = 24;
- IME_PROP_AT_CARET = 65536;
- IME_PROP_SPECIAL_UI = 131072;
- IME_PROP_CANDLIST_START_FROM_1 = 262144;
- IME_PROP_UNICODE = 524288;
- UI_CAP_2700 = 1;
- UI_CAP_ROT90 = 2;
- UI_CAP_ROTANY = 4;
- SCS_CAP_COMPSTR = 1;
- SCS_CAP_MAKEREAD = 2;
- SELECT_CAP_CONVERSION = 1;
- SELECT_CAP_SENTENCE = 2;
- { ImmNotifyIME }
- NI_CHANGECANDIDATELIST = 19;
- NI_CLOSECANDIDATE = 17;
- NI_COMPOSITIONSTR = 21;
- NI_OPENCANDIDATE = 16;
- NI_SELECTCANDIDATESTR = 18;
- NI_SETCANDIDATE_PAGESIZE = 23;
- NI_SETCANDIDATE_PAGESTART = 22;
- CPS_CANCEL = 4;
- CPS_COMPLETE = 1;
- CPS_CONVERT = 2;
- CPS_REVERT = 3;
- { ImmSetCompositionString }
- SCS_SETSTR = 9;
- SCS_CHANGEATTR = 18;
- SCS_CHANGECLAUSE = 36;
- { ImmUnregisterWord }
- IME_REGWORD_STYLE_EUDC = 1;
- IME_REGWORD_STYLE_USER_FIRST = $80000000;
- IME_REGWORD_STYLE_USER_LAST = -(1);
- { InitCommonControlEx } //+commctrl
- ICC_LISTVIEW_CLASSES = $00000001; // listview, header
- ICC_TREEVIEW_CLASSES = $00000002; // treeview, tooltips
- ICC_BAR_CLASSES = $00000004; // toolbar, statusbar, trackbar, tooltips
- ICC_TAB_CLASSES = $00000008; // tab, tooltips
- ICC_UPDOWN_CLASS = $00000010; // updown
- ICC_PROGRESS_CLASS = $00000020; // progress
- ICC_WIN95_CLASSES = $000000FF; //
- ICC_DATE_CLASSES = $00000100; // month picker, date picker, time picker, updown
- ICC_COOL_CLASSES = $00000400; // rebar (coolbar) control
- ICC_INTERNET_CLASSES = $00000800; // IP Address control
- ICC_TOOLTIP_CLASSES = $00001000; // Tooltip static & button
- ICC_CAPEDIT_CLASS = $00002000; // All-caps edit control
- ICC_FE_CLASSES = $40000000; // FE specific input subclasses
-
- { InitializeSecurityDescriptor }
- SECURITY_DESCRIPTOR_REVISION = 1;
- { IsTextUnicode }
- IS_TEXT_UNICODE_ASCII16 = 1;
- IS_TEXT_UNICODE_REVERSE_ASCII16 = 16;
- IS_TEXT_UNICODE_STATISTICS = 2;
- IS_TEXT_UNICODE_REVERSE_STATISTICS = 32;
- IS_TEXT_UNICODE_CONTROLS = 4;
- IS_TEXT_UNICODE_REVERSE_CONTROLS = 64;
- IS_TEXT_UNICODE_SIGNATURE = 8;
- IS_TEXT_UNICODE_REVERSE_SIGNATURE = 128;
- IS_TEXT_UNICODE_ILLEGAL_CHARS = 256;
- IS_TEXT_UNICODE_ODD_LENGTH = 512;
- IS_TEXT_UNICODE_NULL_BYTES = 4096;
- IS_TEXT_UNICODE_UNICODE_MASK = 15;
- IS_TEXT_UNICODE_REVERSE_MASK = 240;
- IS_TEXT_UNICODE_NOT_UNICODE_MASK = 3840;
- IS_TEXT_UNICODE_NOT_ASCII_MASK = 61440;
- { JournalPlaybackProc, KeyboardProc }
- HC_GETNEXT = 1;
- HC_SKIP = 2;
- HC_SYSMODALOFF = 5;
- HC_SYSMODALON = 4;
- HC_NOREMOVE = 3;
- { keybd_event }
- KEYEVENTF_EXTENDEDKEY = 1;
- KEYEVENTF_KEYUP = 2;
- { LoadBitmap }
- OBM_BTNCORNERS = 32758;
- OBM_BTSIZE = 32761;
- OBM_CHECK = 32760;
- OBM_CHECKBOXES = 32759;
- OBM_CLOSE = 32754;
- OBM_COMBO = 32738;
- OBM_DNARROW = 32752;
- OBM_DNARROWD = 32742;
- OBM_DNARROWI = 32736;
- OBM_LFARROW = 32750;
- OBM_LFARROWI = 32734;
- OBM_LFARROWD = 32740;
- OBM_MNARROW = 32739;
- OBM_OLD_CLOSE = 32767;
- OBM_OLD_DNARROW = 32764;
- OBM_OLD_LFARROW = 32762;
- OBM_OLD_REDUCE = 32757;
- OBM_OLD_RESTORE = 32755;
- OBM_OLD_RGARROW = 32763;
- OBM_OLD_UPARROW = 32765;
- OBM_OLD_ZOOM = 32756;
- OBM_REDUCE = 32749;
- OBM_REDUCED = 32746;
- OBM_RESTORE = 32747;
- OBM_RESTORED = 32744;
- OBM_RGARROW = 32751;
- OBM_RGARROWD = 32741;
- OBM_RGARROWI = 32735;
- OBM_SIZE = 32766;
- OBM_UPARROW = 32753;
- OBM_UPARROWD = 32743;
- OBM_UPARROWI = 32737;
- OBM_ZOOM = 32748;
- OBM_ZOOMD = 32745;
- { LoadLibraryEx }
- DONT_RESOLVE_DLL_REFERENCES = 1;
- LOAD_LIBRARY_AS_DATAFILE = 2;
- LOAD_WITH_ALTERED_SEARCH_PATH = 8;
- { LocalAlloc, LocalFlags }
- LPTR = 64;
- LHND = 66;
- NONZEROLHND = 2;
- NONZEROLPTR = 0;
- LMEM_NONZEROLHND = 2;
- LMEM_NONZEROLPTR = 0;
- LMEM_FIXED = 0;
- LMEM_MOVEABLE = 2;
- LMEM_NOCOMPACT = 16;
- LMEM_NODISCARD = 32;
- LMEM_ZEROINIT = 64;
- LMEM_MODIFY = 128;
- LMEM_LOCKCOUNT = 255;
- LMEM_DISCARDABLE = 3840;
- LMEM_DISCARDED = 16384;
- LMEM_INVALID_HANDLE = 32768;
- LMEM_VALID_FLAGS=$0F72; //+winbase
- { LockFileEx }
- LOCKFILE_FAIL_IMMEDIATELY = 1;
- LOCKFILE_EXCLUSIVE_LOCK = 2;
- { LogonUser }
- { LZCopy, LZInit, LZRead }
- { MessageBeep, MessageBox }
- MB_USERICON = $80;
- MB_ICONASTERISK = $40;
- MB_ICONEXCLAMATION = $30;
- MB_ICONWARNING = $30;
- MB_ICONERROR = $10;
- MB_ICONHAND = $10;
- MB_ICONQUESTION = $20;
- MB_OK = 0;
- MB_ABORTRETRYIGNORE = $2;
- MB_APPLMODAL = 0;
- MB_DEFAULT_DESKTOP_ONLY = $20000;
- MB_HELP = $4000;
- MB_RIGHT = $80000;
- MB_RTLREADING = $100000;
- MB_TOPMOST = $40000;
- MB_DEFBUTTON1 = 0;
- MB_DEFBUTTON2 = $100;
- MB_DEFBUTTON3 = $200;
- MB_DEFBUTTON4 = $300;
- MB_ICONINFORMATION = $40;
- MB_ICONSTOP = $10;
- MB_OKCANCEL = $1;
- MB_RETRYCANCEL = $5;
- MB_SERVICE_NOTIFICATION = $40000;
- MB_SETFOREGROUND = $10000;
- MB_SYSTEMMODAL = $1000;
- MB_TASKMODAL = $2000;
- MB_YESNO = $4;
- MB_YESNOCANCEL = $3;
- IDABORT = 3;
- IDCANCEL = 2;
- IDCLOSE = 8;
- IDHELP = 9;
- IDIGNORE = 5;
- IDNO = 7;
- IDOK = 1;
- IDRETRY = 4;
- IDYES = 6;
- { MessageProc }
- MSGF_DIALOGBOX = 0;
- MSGF_MENU = 2;
- MSGF_NEXTWINDOW = 6;
- MSGF_SCROLLBAR = 5;
- MSGF_MAINLOOP = 8;
- MSGF_USER = 4096;
- { ModifyWorldTransform }
- MWT_IDENTITY = 1;
- MWT_LEFTMULTIPLY = 2;
- MWT_RIGHTMULTIPLY = 3;
- { mouse_event }
- MOUSEEVENTF_ABSOLUTE = 32768;
- MOUSEEVENTF_MOVE = 1;
- MOUSEEVENTF_LEFTDOWN = 2;
- MOUSEEVENTF_LEFTUP = 4;
- MOUSEEVENTF_RIGHTDOWN = 8;
- MOUSEEVENTF_RIGHTUP = 16;
- MOUSEEVENTF_MIDDLEDOWN = 32;
- MOUSEEVENTF_MIDDLEUP = 64;
- { MoveFileEx }
- MOVEFILE_REPLACE_EXISTING = 1;
- MOVEFILE_COPY_ALLOWED = 2;
- MOVEFILE_DELAY_UNTIL_REBOOT = 4;
- { MsgWaitForMultipleObjects, WaitForMultipleObjectsEx }
- WAIT_OBJECT_0 = 0;
- WAIT_ABANDONED_0 = $80;
- WAIT_TIMEOUT = $102;
- WAIT_IO_COMPLETION = $c0;
- WAIT_ABANDONED = $80;
- WAIT_FAILED = $ffffffff;
- MAXIMUM_WAIT_OBJECTS = $40; //winnt
- MAXIMUM_SUSPEND_COUNT = MAXCHAR; //~winnt
- { MultiByteToWideChar }
- MB_PRECOMPOSED = 1;
- MB_COMPOSITE = 2;
- MB_ERR_INVALID_CHARS = 8;
- MB_USEGLYPHCHARS = 4;
- { NDdeSetTrustedShare }
- { NetAccessCheck }
- { NetServerEnum }
- { NetServiceControl }
- { NetUserEnum }
- { OpenProcessToken }
- TOKEN_ADJUST_DEFAULT = 128;
- TOKEN_ADJUST_GROUPS = 64;
- TOKEN_ADJUST_PRIVILEGES = 32;
- TOKEN_ALL_ACCESS = $f00ff;
- TOKEN_ASSIGN_PRIMARY = 1;
- TOKEN_DUPLICATE = 2;
- TOKEN_EXECUTE = $20000;
- TOKEN_IMPERSONATE = 4;
- TOKEN_QUERY = 8;
- TOKEN_QUERY_SOURCE = 16;
- TOKEN_READ = $20008;
- TOKEN_WRITE = $200e0;
- { OpenSCManager }
- SC_MANAGER_ALL_ACCESS = $f003f;
- SC_MANAGER_CONNECT = 1;
- SC_MANAGER_CREATE_SERVICE = 2;
- SC_MANAGER_ENUMERATE_SERVICE = 4;
- SC_MANAGER_LOCK = 8;
- SC_MANAGER_QUERY_LOCK_STATUS = 16;
- SC_MANAGER_MODIFY_BOOT_CONFIG = 32;
- { PostMessage }
- { was #define dname def_expr }
- function HWND_BROADCAST : HWND;
-
- { PrepareTape }
-
- const
- TAPE_FORMAT = $5;
- TAPE_LOAD = 0;
- TAPE_LOCK = $3;
- TAPE_TENSION = $2;
- TAPE_UNLOAD = $1;
- TAPE_UNLOCK = $4;
- { PropertySheet }
- IS_PSREBOOTSYSTEM = 3;
- IS_PSRESTARTWINDOWS = 2;
- { PropSheetPageProc }
- PSPCB_CREATE = 2;
- PSPCB_RELEASE = 1;
- { PurgeComm }
- PURGE_TXABORT = 1;
- PURGE_RXABORT = 2;
- PURGE_TXCLEAR = 4;
- PURGE_RXCLEAR = 8;
- { QueryServiceObjectSecurity }
- OWNER_SECURITY_INFORMATION = $1;
- GROUP_SECURITY_INFORMATION = $2;
- DACL_SECURITY_INFORMATION = $4;
- SACL_SECURITY_INFORMATION = $8;
- { ReadEventLog, ReportEvent }
- EVENTLOG_FORWARDS_READ = 4;
- EVENTLOG_BACKWARDS_READ = 8;
- EVENTLOG_SEEK_READ = 2;
- EVENTLOG_SEQUENTIAL_READ = 1;
- EVENTLOG_ERROR_TYPE = 1;
- EVENTLOG_WARNING_TYPE = 2;
- EVENTLOG_INFORMATION_TYPE = 4;
- EVENTLOG_AUDIT_SUCCESS = 8;
- EVENTLOG_AUDIT_FAILURE = 16;
- { RedrawWindow }
- RDW_ERASE = 4;
- RDW_FRAME = 1024;
- RDW_INTERNALPAINT = 2;
- RDW_INVALIDATE = 1;
- RDW_NOERASE = 32;
- RDW_NOFRAME = 2048;
- RDW_NOINTERNALPAINT = 16;
- RDW_VALIDATE = 8;
- RDW_ERASENOW = 512;
- RDW_UPDATENOW = 256;
- RDW_ALLCHILDREN = 128;
- RDW_NOCHILDREN = 64;
- { RegCreateKey }
- { was #define dname def_expr }
- function HKEY_CLASSES_ROOT : HKEY;
-
- { was #define dname def_expr }
- function HKEY_CURRENT_USER : HKEY;
-
- { was #define dname def_expr }
- function HKEY_LOCAL_MACHINE : HKEY;
-
- { was #define dname def_expr }
- function HKEY_USERS : HKEY;
-
- { was #define dname def_expr }
- function HKEY_PERFORMANCE_DATA : HKEY;
-
- { was #define dname def_expr }
- function HKEY_CURRENT_CONFIG : HKEY;
-
- { was #define dname def_expr }
- function HKEY_DYN_DATA : HKEY;
-
- { RegCreateKeyEx }
-
- const
- REG_OPTION_VOLATILE = $1;
- REG_OPTION_NON_VOLATILE = 0;
- REG_CREATED_NEW_KEY = $1;
- REG_OPENED_EXISTING_KEY = $2;
- { RegEnumValue }
- REG_BINARY = 3;
- REG_DWORD = 4;
- REG_DWORD_LITTLE_ENDIAN = 4;
- REG_DWORD_BIG_ENDIAN = 5;
- REG_EXPAND_SZ = 2;
- REG_FULL_RESOURCE_DESCRIPTOR = 9;
- REG_LINK = 6;
- REG_MULTI_SZ = 7;
- REG_NONE = 0;
- REG_RESOURCE_LIST = 8;
- REG_RESOURCE_REQUIREMENTS_LIST = 10;
- REG_SZ = 1;
- { RegisterHotKey }
- MOD_ALT = 1;
- MOD_CONTROL = 2;
- MOD_SHIFT = 4;
- MOD_WIN = 8;
- IDHOT_SNAPDESKTOP = -(2);
- IDHOT_SNAPWINDOW = -(1);
- { RegNotifyChangeKeyValue }
- REG_NOTIFY_CHANGE_NAME = $1;
- REG_NOTIFY_CHANGE_ATTRIBUTES = $2;
- REG_NOTIFY_CHANGE_LAST_SET = $4;
- REG_NOTIFY_CHANGE_SECURITY = $8;
- { ScrollWindowEx }
- SW_ERASE = 4;
- SW_INVALIDATE = 2;
- SW_SCROLLCHILDREN = 1;
- { SendMessageTimeout }
- SMTO_ABORTIFHUNG = 2;
- SMTO_BLOCK = 1;
- SMTO_NORMAL = 0;
- { SetBkMode }
- OPAQUE = 2;
- TRANSPARENT = 1;
- { SetDebugErrorLevel }
- SLE_ERROR = 1;
- SLE_MINORERROR = 2;
- SLE_WARNING = 3;
- { SetErrorMode }
- SEM_FAILCRITICALERRORS = 1;
- SEM_NOALIGNMENTFAULTEXCEPT = 4;
- SEM_NOGPFAULTERRORBOX = 2;
- SEM_NOOPENFILEERRORBOX = 32768;
- { SetICMMode }
- ICM_ON = 2;
- ICM_OFF = 1;
- ICM_QUERY = 3;
- { SetJob }
- { Locale Information }
- LOCALE_ILANGUAGE = 1;
- LOCALE_SLANGUAGE = 2;
- LOCALE_SENGLANGUAGE = 4097;
- LOCALE_SABBREVLANGNAME = 3;
- LOCALE_SNATIVELANGNAME = 4;
- LOCALE_ICOUNTRY = 5;
- LOCALE_SCOUNTRY = 6;
- LOCALE_SENGCOUNTRY = 4098;
- LOCALE_SABBREVCTRYNAME = 7;
- LOCALE_SNATIVECTRYNAME = 8;
- LOCALE_IDEFAULTLANGUAGE = 9;
- LOCALE_IDEFAULTCOUNTRY = 10;
- LOCALE_IDEFAULTANSICODEPAGE = 4100;
- LOCALE_IDEFAULTCODEPAGE = 11;
- LOCALE_SLIST = 12;
- LOCALE_IMEASURE = 13;
- LOCALE_SDECIMAL = 14;
- LOCALE_STHOUSAND = 15;
- LOCALE_SGROUPING = 16;
- LOCALE_IDIGITS = 17;
- LOCALE_ILZERO = 18;
- LOCALE_INEGNUMBER = 4112;
- LOCALE_SCURRENCY = 20;
- LOCALE_SMONDECIMALSEP = 22;
- LOCALE_SMONTHOUSANDSEP = 23;
- LOCALE_SMONGROUPING = 24;
- LOCALE_ICURRDIGITS = 25;
- LOCALE_ICURRENCY = 27;
- LOCALE_INEGCURR = 28;
- LOCALE_SDATE = 29;
- LOCALE_STIME = 30;
- LOCALE_STIMEFORMAT = 4099;
- LOCALE_SSHORTDATE = 31;
- LOCALE_SLONGDATE = 32;
- LOCALE_IDATE = 33;
- LOCALE_ILDATE = 34;
- LOCALE_ITIME = 35;
- LOCALE_ITLZERO = 37;
- LOCALE_IDAYLZERO = 38;
- LOCALE_IMONLZERO = 39;
- LOCALE_S1159 = 40;
- LOCALE_S2359 = 41;
- LOCALE_ICALENDARTYPE = 4105;
- LOCALE_IOPTIONALCALENDAR = 4107;
- LOCALE_IFIRSTDAYOFWEEK = 4108;
- LOCALE_IFIRSTWEEKOFYEAR = 4109;
- LOCALE_SDAYNAME1 = 42;
- LOCALE_SDAYNAME2 = 43;
- LOCALE_SDAYNAME3 = 44;
- LOCALE_SDAYNAME4 = 45;
- LOCALE_SDAYNAME5 = 46;
- LOCALE_SDAYNAME6 = 47;
- LOCALE_SDAYNAME7 = 48;
- LOCALE_SABBREVDAYNAME1 = 49;
- LOCALE_SABBREVDAYNAME2 = 50;
- LOCALE_SABBREVDAYNAME3 = 51;
- LOCALE_SABBREVDAYNAME4 = 52;
- LOCALE_SABBREVDAYNAME5 = 53;
- LOCALE_SABBREVDAYNAME6 = 54;
- LOCALE_SABBREVDAYNAME7 = 55;
- LOCALE_SMONTHNAME1 = 56;
- LOCALE_SMONTHNAME2 = 57;
- LOCALE_SMONTHNAME3 = 58;
- LOCALE_SMONTHNAME4 = 59;
- LOCALE_SMONTHNAME5 = 60;
- LOCALE_SMONTHNAME6 = 61;
- LOCALE_SMONTHNAME7 = 62;
- LOCALE_SMONTHNAME8 = 63;
- LOCALE_SMONTHNAME9 = 64;
- LOCALE_SMONTHNAME10 = 65;
- LOCALE_SMONTHNAME11 = 66;
- LOCALE_SMONTHNAME12 = 67;
- LOCALE_SMONTHNAME13 = 4110;
- LOCALE_SABBREVMONTHNAME1 = 68;
- LOCALE_SABBREVMONTHNAME2 = 69;
- LOCALE_SABBREVMONTHNAME3 = 70;
- LOCALE_SABBREVMONTHNAME4 = 71;
- LOCALE_SABBREVMONTHNAME5 = 72;
- LOCALE_SABBREVMONTHNAME6 = 73;
- LOCALE_SABBREVMONTHNAME7 = 74;
- LOCALE_SABBREVMONTHNAME8 = 75;
- LOCALE_SABBREVMONTHNAME9 = 76;
- LOCALE_SABBREVMONTHNAME10 = 77;
- LOCALE_SABBREVMONTHNAME11 = 78;
- LOCALE_SABBREVMONTHNAME12 = 79;
- LOCALE_SABBREVMONTHNAME13 = 4111;
- LOCALE_SPOSITIVESIGN = 80;
- LOCALE_SNEGATIVESIGN = 81;
- LOCALE_IPOSSIGNPOSN = 82;
- LOCALE_INEGSIGNPOSN = 83;
- LOCALE_IPOSSYMPRECEDES = 84;
- LOCALE_IPOSSEPBYSPACE = 85;
- LOCALE_INEGSYMPRECEDES = 86;
- LOCALE_INEGSEPBYSPACE = 87;
- LOCALE_NOUSEROVERRIDE = $80000000;
- LOCALE_USE_CP_ACP = $40000000; // use the system ACP
- LOCALE_RETURN_NUMBER = $20000000; // return number instead
- { Calendar Type Information }
- CAL_ICALINTVALUE = 1;
- CAL_IYEAROFFSETRANGE = 3;
- CAL_SABBREVDAYNAME1 = 14;
- CAL_SABBREVDAYNAME2 = 15;
- CAL_SABBREVDAYNAME3 = 16;
- CAL_SABBREVDAYNAME4 = 17;
- CAL_SABBREVDAYNAME5 = 18;
- CAL_SABBREVDAYNAME6 = 19;
- CAL_SABBREVDAYNAME7 = 20;
- CAL_SABBREVMONTHNAME1 = 34;
- CAL_SABBREVMONTHNAME2 = 35;
- CAL_SABBREVMONTHNAME3 = 36;
- CAL_SABBREVMONTHNAME4 = 37;
- CAL_SABBREVMONTHNAME5 = 38;
- CAL_SABBREVMONTHNAME6 = 39;
- CAL_SABBREVMONTHNAME7 = 40;
- CAL_SABBREVMONTHNAME8 = 41;
- CAL_SABBREVMONTHNAME9 = 42;
- CAL_SABBREVMONTHNAME10 = 43;
- CAL_SABBREVMONTHNAME11 = 44;
- CAL_SABBREVMONTHNAME12 = 45;
- CAL_SABBREVMONTHNAME13 = 46;
- CAL_SCALNAME = 2;
- CAL_SDAYNAME1 = 7;
- CAL_SDAYNAME2 = 8;
- CAL_SDAYNAME3 = 9;
- CAL_SDAYNAME4 = 10;
- CAL_SDAYNAME5 = 11;
- CAL_SDAYNAME6 = 12;
- CAL_SDAYNAME7 = 13;
- CAL_SERASTRING = 4;
- CAL_SLONGDATE = 6;
- CAL_SMONTHNAME1 = 21;
- CAL_SMONTHNAME2 = 22;
- CAL_SMONTHNAME3 = 23;
- CAL_SMONTHNAME4 = 24;
- CAL_SMONTHNAME5 = 25;
- CAL_SMONTHNAME6 = 26;
- CAL_SMONTHNAME7 = 27;
- CAL_SMONTHNAME8 = 28;
- CAL_SMONTHNAME9 = 29;
- CAL_SMONTHNAME10 = 30;
- CAL_SMONTHNAME11 = 31;
- CAL_SMONTHNAME12 = 32;
- CAL_SMONTHNAME13 = 33;
- CAL_SSHORTDATE = 5;
- { SetProcessWorkingSetSize }
- PROCESS_SET_QUOTA = 256;
- { SetPrinter }
- { SetService }
- { SetStretchBltMode }
- BLACKONWHITE = 1;
- COLORONCOLOR = 3;
- HALFTONE = 4;
- STRETCH_ANDSCANS = 1;
- STRETCH_DELETESCANS = 3;
- STRETCH_HALFTONE = 4;
- STRETCH_ORSCANS = 2;
- WHITEONBLACK = 2;
- { SetSystemCursor }
- OCR_NORMAL = 32512;
- OCR_IBEAM = 32513;
- OCR_WAIT = 32514;
- OCR_CROSS = 32515;
- OCR_UP = 32516;
- OCR_SIZE = 32640;
- OCR_ICON = 32641;
- OCR_SIZENWSE = 32642;
- OCR_SIZENESW = 32643;
- OCR_SIZEWE = 32644;
- OCR_SIZENS = 32645;
- OCR_SIZEALL = 32646;
- OCR_NO = 32648;
- OCR_APPSTARTING = 32650;
- { SetTapePosition }
- TAPE_ABSOLUTE_BLOCK = $1;
- TAPE_LOGICAL_BLOCK = $2;
- TAPE_REWIND = 0;
- TAPE_SPACE_END_OF_DATA = $4;
- TAPE_SPACE_FILEMARKS = $6;
- TAPE_SPACE_RELATIVE_BLOCKS = $5;
- TAPE_SPACE_SEQUENTIAL_FMKS = $7;
- TAPE_SPACE_SEQUENTIAL_SMKS = $9;
- TAPE_SPACE_SETMARKS = $8;
- { SetUnhandledExceptionFilter }
- EXCEPTION_EXECUTE_HANDLER = 1;
- EXCEPTION_CONTINUE_EXECUTION = -(1);
- EXCEPTION_CONTINUE_SEARCH = 0;
- { SetWindowPos, DeferWindowPos }
- { was #define dname def_expr }
- function HWND_BOTTOM : HWND;
-
- { was #define dname def_expr }
- function HWND_NOTOPMOST : HWND;
-
- { was #define dname def_expr }
- function HWND_TOP : HWND;
-
- { was #define dname def_expr }
- function HWND_TOPMOST : HWND;
-
-
- const
- SWP_DRAWFRAME = 32;
- SWP_FRAMECHANGED = 32;
- SWP_HIDEWINDOW = 128;
- SWP_NOACTIVATE = 16;
- SWP_NOCOPYBITS = 256;
- SWP_NOMOVE = 2;
- SWP_NOSIZE = 1;
- SWP_NOREDRAW = 8;
- SWP_NOZORDER = 4;
- SWP_SHOWWINDOW = 64;
- SWP_NOOWNERZORDER = 512;
- SWP_NOREPOSITION = 512;
- SWP_NOSENDCHANGING = 1024;
- { SHAddToRecentDocs }
- { SHAppBarMessage }
- { SHChangeNotify }
- { ShellProc }
- HSHELL_ACTIVATESHELLWINDOW = 3;
- HSHELL_GETMINRECT = 5;
- HSHELL_LANGUAGE = 8;
- HSHELL_REDRAW = 6;
- HSHELL_TASKMAN = 7;
- HSHELL_WINDOWACTIVATED = 4;
- HSHELL_WINDOWCREATED = 1;
- HSHELL_WINDOWDESTROYED = 2;
- { SHGetFileInfo }
- { SHGetSpecialFolderLocation }
- { ShowWindow }
- SW_HIDE = 0;
- SW_MAXIMIZE = 3;
- SW_MINIMIZE = 6;
- SW_NORMAL = 1;
- SW_RESTORE = 9;
- SW_SHOW = 5;
- SW_SHOWDEFAULT = 10;
- SW_SHOWMAXIMIZED = 3;
- SW_SHOWMINIMIZED = 2;
- SW_SHOWMINNOACTIVE = 7;
- SW_SHOWNA = 8;
- SW_SHOWNOACTIVATE = 4;
- SW_SHOWNORMAL = 1;
- WPF_RESTORETOMAXIMIZED = 2;
- WPF_SETMINPOSITION = 1;
- { SID }
- ////////////////////////////////////////////////////////////////////////
- // //
- // Security Id (SID) //
- // //
- ////////////////////////////////////////////////////////////////////////
- //
- //
- // Pictorially the structure of an SID is as follows:
- //
- // 1 1 1 1 1 1
- // 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
- // +---------------------------------------------------------------+
- // | SubAuthorityCount |Reserved1 (SBZ)| Revision |
- // +---------------------------------------------------------------+
- // | IdentifierAuthority[0] |
- // +---------------------------------------------------------------+
- // | IdentifierAuthority[1] |
- // +---------------------------------------------------------------+
- // | IdentifierAuthority[2] |
- // +---------------------------------------------------------------+
- // | |
- // +- - - - - - - - SubAuthority[] - - - - - - - - -+
- // | |
- // +---------------------------------------------------------------+
- //
- //
- SID_REVISION =1; // Current revision level
- SID_MAX_SUB_AUTHORITIES = 15;
- SID_RECOMMENDED_SUB_AUTHORITIES = 1; // Will change to around 6
- // in a future release.
-
-
- { Sleep }
- INFINITE = $FFFFFFFF;
- { SystemParametersInfo }
- SPI_GETACCESSTIMEOUT = 60;
- SPI_GETANIMATION = 72;
- SPI_GETBEEP = 1;
- SPI_GETBORDER = 5;
- SPI_GETDEFAULTINPUTLANG = 89;
- SPI_GETDRAGFULLWINDOWS = 38;
- SPI_GETFASTTASKSWITCH = 35;
- SPI_GETFILTERKEYS = 50;
- SPI_GETFONTSMOOTHING = 74;
- SPI_GETGRIDGRANULARITY = 18;
- SPI_GETHIGHCONTRAST = 66;
- SPI_GETICONMETRICS = 45;
- SPI_GETICONTITLELOGFONT = 31;
- SPI_GETICONTITLEWRAP = 25;
- SPI_GETKEYBOARDDELAY = 22;
- SPI_GETKEYBOARDPREF = 68;
- SPI_GETKEYBOARDSPEED = 10;
- SPI_GETLOWPOWERACTIVE = 83;
- SPI_GETLOWPOWERTIMEOUT = 79;
- SPI_GETMENUDROPALIGNMENT = 27;
- SPI_GETMINIMIZEDMETRICS = 43;
- SPI_GETMOUSE = 3;
- SPI_GETMOUSEKEYS = 54;
- SPI_GETMOUSETRAILS = 94;
- SPI_GETNONCLIENTMETRICS = 41;
- SPI_GETPOWEROFFACTIVE = 84;
- SPI_GETPOWEROFFTIMEOUT = 80;
- SPI_GETSCREENREADER = 70;
- SPI_GETSCREENSAVEACTIVE = 16;
- SPI_GETSCREENSAVETIMEOUT = 14;
- SPI_GETSERIALKEYS = 62;
- SPI_GETSHOWSOUNDS = 56;
- SPI_GETSOUNDSENTRY = 64;
- SPI_GETSTICKYKEYS = 58;
- SPI_GETTOGGLEKEYS = 52;
- SPI_GETWINDOWSEXTENSION = 92;
- SPI_GETWORKAREA = 48;
- SPI_ICONHORIZONTALSPACING = 13;
- SPI_ICONVERTICALSPACING = 24;
- SPI_LANGDRIVER = 12;
- SPI_SCREENSAVERRUNNING = 97;
- SPI_SETACCESSTIMEOUT = 61;
- SPI_SETANIMATION = 73;
- SPI_SETBEEP = 2;
- SPI_SETBORDER = 6;
- SPI_SETDEFAULTINPUTLANG = 90;
- SPI_SETDESKPATTERN = 21;
- SPI_SETDESKWALLPAPER = 20;
- SPI_SETDOUBLECLICKTIME = 32;
- SPI_SETDOUBLECLKHEIGHT = 30;
- SPI_SETDOUBLECLKWIDTH = 29;
- SPI_SETDRAGFULLWINDOWS = 37;
- SPI_SETDRAGHEIGHT = 77;
- SPI_SETDRAGWIDTH = 76;
- SPI_SETFASTTASKSWITCH = 36;
- SPI_SETFILTERKEYS = 51;
- SPI_SETFONTSMOOTHING = 75;
- SPI_SETGRIDGRANULARITY = 19;
- SPI_SETHANDHELD = 78;
- SPI_SETHIGHCONTRAST = 67;
- SPI_SETICONMETRICS = 46;
- SPI_SETICONTITLELOGFONT = 34;
- SPI_SETICONTITLEWRAP = 26;
- SPI_SETKEYBOARDDELAY = 23;
- SPI_SETKEYBOARDPREF = 69;
- SPI_SETKEYBOARDSPEED = 11;
- SPI_SETLANGTOGGLE = 91;
- SPI_SETLOWPOWERACTIVE = 85;
- SPI_SETLOWPOWERTIMEOUT = 81;
- SPI_SETMENUDROPALIGNMENT = 28;
- SPI_SETMINIMIZEDMETRICS = 44;
- SPI_SETMOUSE = 4;
- SPI_SETMOUSEBUTTONSWAP = 33;
- SPI_SETMOUSEKEYS = 55;
- SPI_SETMOUSETRAILS = 93;
- SPI_SETNONCLIENTMETRICS = 42;
- SPI_SETPENWINDOWS = 49;
- SPI_SETPOWEROFFACTIVE = 86;
- SPI_SETPOWEROFFTIMEOUT = 82;
- SPI_SETSCREENREADER = 71;
- SPI_SETSCREENSAVEACTIVE = 17;
- SPI_SETSCREENSAVETIMEOUT = 15;
- SPI_SETSERIALKEYS = 63;
- SPI_SETSHOWSOUNDS = 57;
- SPI_SETSOUNDSENTRY = 65;
- SPI_SETSTICKYKEYS = 59;
- SPI_SETTOGGLEKEYS = 53;
- SPI_SETWORKAREA = 47;
- SPIF_UPDATEINIFILE = 1;
- SPIF_SENDWININICHANGE = 2;
- SPIF_SENDCHANGE = 2;
- { TrackPopupMenu, TrackPopMenuEx }
- TPM_CENTERALIGN = $4;
- TPM_LEFTALIGN = 0;
- TPM_RIGHTALIGN = $8;
- TPM_LEFTBUTTON = 0;
- TPM_RIGHTBUTTON = $2;
- TPM_HORIZONTAL = 0;
- TPM_VERTICAL = $40;
- { TranslateCharsetInfo }
- TCI_SRCCHARSET = 1;
- TCI_SRCCODEPAGE = 2;
- TCI_SRCFONTSIG = 3;
- { VerFindFile }
- VFFF_ISSHAREDFILE = 1;
- VFF_CURNEDEST = 1;
- VFF_FILEINUSE = 2;
- VFF_BUFFTOOSMALL = 4;
- { VerInstallFile }
- VIFF_FORCEINSTALL = 1;
- VIFF_DONTDELETEOLD = 2;
- VIF_TEMPFILE = $1;
- VIF_MISMATCH = $2;
- VIF_SRCOLD = $4;
- VIF_DIFFLANG = $8;
- VIF_DIFFCODEPG = $10;
- VIF_DIFFTYPE = $20;
- VIF_WRITEPROT = $40;
- VIF_FILEINUSE = $80;
- VIF_OUTOFSPACE = $100;
- VIF_ACCESSVIOLATION = $200;
- VIF_SHARINGVIOLATION = $400;
- VIF_CANNOTCREATE = $800;
- VIF_CANNOTDELETE = $1000;
- VIF_CANNOTDELETECUR = $4000;
- VIF_CANNOTRENAME = $2000;
- VIF_OUTOFMEMORY = $8000;
- VIF_CANNOTREADSRC = $10000;
- VIF_CANNOTREADDST = $20000;
- VIF_BUFFTOOSMALL = $40000;
- { WideCharToMultiByte }
- WC_COMPOSITECHECK = 512;
- WC_DISCARDNS = 16;
- WC_SEPCHARS = 32;
- WC_DEFAULTCHAR = 64;
- { WinHelp }
- HELP_COMMAND = $102;
- HELP_CONTENTS = $3;
- HELP_CONTEXT = $1;
- HELP_CONTEXTPOPUP = $8;
- HELP_FORCEFILE = $9;
- HELP_HELPONHELP = $4;
- HELP_INDEX = $3;
- HELP_KEY = $101;
- HELP_MULTIKEY = $201;
- HELP_PARTIALKEY = $105;
- HELP_QUIT = $2;
- HELP_SETCONTENTS = $5;
- HELP_SETINDEX = $5;
- HELP_CONTEXTMENU = $a;
- HELP_FINDER = $b;
- HELP_WM_HELP = $c;
- HELP_TCARD = $8000;
- HELP_TCARD_DATA = $10;
- HELP_TCARD_OTHER_CALLER = $11;
- { WNetAddConnectino2 }
- CONNECT_UPDATE_PROFILE = 1;
- { WNetConnectionDialog, WNetDisconnectDialog, WNetOpenEnum }
- RESOURCETYPE_DISK = 1;
- RESOURCETYPE_PRINT = 2;
- RESOURCETYPE_ANY = 0;
- RESOURCE_CONNECTED = 1;
- RESOURCE_GLOBALNET = 2;
- RESOURCE_REMEMBERED = 3;
- RESOURCEUSAGE_CONNECTABLE = 1;
- RESOURCEUSAGE_CONTAINER = 2;
- { WNetGetResourceInformation, WNetGetResourceParent }
- WN_BAD_NETNAME = $43;
- WN_EXTENDED_ERROR = $4b8;
- WN_MORE_DATA = $ea;
- WN_NO_NETWORK = $4c6;
- WN_SUCCESS = 0;
- WN_ACCESS_DENIED = $5;
- WN_BAD_PROVIDER = $4b4;
- WN_NOT_AUTHENTICATED = $4dc;
- { WNetGetUniversalName }
- UNIVERSAL_NAME_INFO_LEVEL = 1;
- REMOTE_NAME_INFO_LEVEL = 2;
- { GetExitCodeThread }
- STILL_ACTIVE = $103;
-
- { kfuncs consts } //+kfuncs
-
- {$ifdef CPUARM}
- PUserKData = $FFFFC800;
- {$else}
- PUserKData = $00005800;
- {$endif CPUARM}
-
- EVENT_PULSE = 1;
- EVENT_RESET = 2;
- EVENT_SET = 3;
-
- SYSHANDLE_OFFSET = $004;
- NUM_SYS_HANDLES = 32;
- SYS_HANDLE_BASE = 64;
- SH_WIN32 = 0;
- SH_CURTHREAD = 1;
- SH_CURPROC = 2;
- SH_LAST_NOTIFY = 16; // Last set notified on Thread/Process Termination
- SH_GDI = 16;
- SH_WMGR = 17;
- SH_WNET = 18; // WNet APIs for network redirector
- SH_COMM = 19; // Communications not "COM"
- SH_FILESYS_APIS = 20; // File system APIS
- SH_SHELL = 21;
- SH_DEVMGR_APIS = 22; // File system device manager
- SH_TAPI = 23;
- SH_PATCHER = 24;
- SH_SERVICES = 26;
- SH_LASTRESERVED = 26;
-
- TLS_FUNCALLOC = 0;
- TLS_FUNCFREE = 1;
-
- { COMMPROP structure }
- SP_SERIALCOMM = $1;
- BAUD_075 = $1;
- BAUD_110 = $2;
- BAUD_134_5 = $4;
- BAUD_150 = $8;
- BAUD_300 = $10;
- BAUD_600 = $20;
- BAUD_1200 = $40;
- BAUD_1800 = $80;
- BAUD_2400 = $100;
- BAUD_4800 = $200;
- BAUD_7200 = $400;
- BAUD_9600 = $800;
- BAUD_14400 = $1000;
- BAUD_19200 = $2000;
- BAUD_38400 = $4000;
- BAUD_56K = $8000;
- BAUD_57600 = $40000;
- BAUD_115200 = $20000;
- BAUD_128K = $10000;
- BAUD_USER = $10000000;
- PST_FAX = $21;
- PST_LAT = $101;
- PST_MODEM = $6;
- PST_NETWORK_BRIDGE = $100;
- PST_PARALLELPORT = $2;
- PST_RS232 = $1;
- PST_RS422 = $3;
- PST_RS423 = $4;
- PST_RS449 = $5;
- PST_SCANNER = $22;
- PST_TCPIP_TELNET = $102;
- PST_UNSPECIFIED = 0;
- PST_X25 = $103;
- PCF_16BITMODE = $200;
- PCF_DTRDSR = $1;
- PCF_INTTIMEOUTS = $80;
- PCF_PARITY_CHECK = $8;
- PCF_RLSD = $4;
- PCF_RTSCTS = $2;
- PCF_SETXCHAR = $20;
- PCF_SPECIALCHARS = $100;
- PCF_TOTALTIMEOUTS = $40;
- PCF_XONXOFF = $10;
- SP_BAUD = $2;
- SP_DATABITS = $4;
- SP_HANDSHAKING = $10;
- SP_PARITY = $1;
- SP_PARITY_CHECK = $20;
- SP_RLSD = $40;
- SP_STOPBITS = $8;
- DATABITS_5 = 1;
- DATABITS_6 = 2;
- DATABITS_7 = 4;
- DATABITS_8 = 8;
- DATABITS_16 = 16;
- DATABITS_16X = 32;
- STOPBITS_10 = 1;
- STOPBITS_15 = 2;
- STOPBITS_20 = 4;
- PARITY_NONE = 256;
- PARITY_ODD = 512;
- PARITY_EVEN = 1024;
- PARITY_MARK = 2048;
- PARITY_SPACE = 4096;
- COMMPROP_INITIALIZED = $e73cf52e;
- { DCB structure }
- CBR_110 = 110;
- CBR_300 = 300;
- CBR_600 = 600;
- CBR_1200 = 1200;
- CBR_2400 = 2400;
- CBR_4800 = 4800;
- CBR_9600 = 9600;
- CBR_14400 = 14400;
- CBR_19200 = 19200;
- CBR_38400 = 38400;
- CBR_56000 = 56000;
- CBR_57600 = 57600;
- CBR_115200 = 115200;
- CBR_128000 = 128000;
- CBR_256000 = 256000;
- DTR_CONTROL_DISABLE = 0;
- DTR_CONTROL_ENABLE = 1;
- DTR_CONTROL_HANDSHAKE = 2;
- RTS_CONTROL_DISABLE = 0;
- RTS_CONTROL_ENABLE = 1;
- RTS_CONTROL_HANDSHAKE = 2;
- RTS_CONTROL_TOGGLE = 3;
- EVENPARITY = 2;
- MARKPARITY = 3;
- NOPARITY = 0;
- ODDPARITY = 1;
- SPACEPARITY = 4;
- ONESTOPBIT = 0;
- ONE5STOPBITS = 1;
- TWOSTOPBITS = 2;
- { Debugging events }
- CREATE_PROCESS_DEBUG_EVENT = 3;
- CREATE_THREAD_DEBUG_EVENT = 2;
- EXCEPTION_DEBUG_EVENT = 1;
- EXIT_PROCESS_DEBUG_EVENT = 5;
- EXIT_THREAD_DEBUG_EVENT = 4;
- LOAD_DLL_DEBUG_EVENT = 6;
- OUTPUT_DEBUG_STRING_EVENT = 8;
- UNLOAD_DLL_DEBUG_EVENT = 7;
- RIP_EVENT = 9;
- { PROCESS_HEAP_ENTRY structure }
- PROCESS_HEAP_REGION = 1;
- PROCESS_HEAP_UNCOMMITTED_RANGE = 2;
- PROCESS_HEAP_ENTRY_BUSY = 4;
- PROCESS_HEAP_ENTRY_MOVEABLE = 16;
- PROCESS_HEAP_ENTRY_DDESHARE = 32;
- { Win32s }
- HINSTANCE_ERROR = 32;
- { WIN32_STREAM_ID structure }
- BACKUP_DATA = 1;
- BACKUP_EA_DATA = 2;
- BACKUP_SECURITY_DATA = 3;
- BACKUP_ALTERNATE_DATA = 4;
- BACKUP_LINK = 5;
- STREAM_MODIFIED_WHEN_READ = 1;
- STREAM_CONTAINS_SECURITY = 2;
- { STARTUPINFO structure }
- STARTF_USESHOWWINDOW = 1;
- STARTF_USEPOSITION = 4;
- STARTF_USESIZE = 2;
- STARTF_USECOUNTCHARS = 8;
- STARTF_USEFILLATTRIBUTE = 16;
- STARTF_RUNFULLSCREEN = 32;
- STARTF_FORCEONFEEDBACK = 64;
- STARTF_FORCEOFFFEEDBACK = 128;
- STARTF_USESTDHANDLES = 256;
- STARTF_USEHOTKEY = 512;
- { OSVERSIONINFO structure }
- VER_PLATFORM_WIN32s = 0;
- VER_PLATFORM_WIN32_WINDOWS = 1;
- VER_PLATFORM_WIN32_NT = 2;
- { More versions }
- VER_SERVER_NT = $80000000; //winnt
- VER_WORKSTATION_NT = $40000000; //winnt
- VER_SUITE_SMALLBUSINESS = $00000001; //winnt
- VER_SUITE_ENTERPRISE = $00000002; //winnt
- VER_SUITE_BACKOFFICE = $00000004; //winnt
- VER_SUITE_COMMUNICATIONS = $00000008; //winnt
- VER_SUITE_TERMINAL = $00000010; //winnt
- VER_SUITE_SMALLBUSINESS_RESTRICTED = $00000020; //winnt
- VER_SUITE_EMBEDDEDNT = $00000040;
- VER_SUITE_DATACENTER = $00000080;
- VER_SUITE_SINGLEUSERTS = $00000100;
- VER_SUITE_PERSONAL = $00000200;
- VER_SUITE_BLADE = $00000400;
- VER_SUITE_EMBEDDED_RESTRICTED = $00000800;
- { PROPSHEETPAGE structure }
- MAXPROPPAGES = 100;
- PSP_DEFAULT = 0;
- PSP_DLGINDIRECT = 1;
- PSP_HASHELP = 32;
- PSP_USECALLBACK = 128;
- PSP_USEHICON = 2;
- PSP_USEICONID = 4;
- PSP_USEREFPARENT = 64;
- PSP_USETITLE = 8;
- PSP_RTLREADING = 16;
- { PROPSHEETHEADER structure }
- PSH_DEFAULT = 0;
- PSH_HASHELP = 512;
- PSH_MODELESS = 1024;
- PSH_NOAPPLYNOW = 128;
- PSH_PROPSHEETPAGE = 8;
- PSH_PROPTITLE = 1;
- PSH_USECALLBACK = 256;
- PSH_USEHICON = 2;
- PSH_USEICONID = 4;
- PSH_USEPSTARTPAGE = 64;
- PSH_WIZARD = 32;
- PSH_RTLREADING = 2048;
- PSCB_INITIALIZED = 1;
- PSCB_PRECREATE = 2;
- { PSN_APPLY message }
- PSNRET_NOERROR = 0;
- PSNRET_INVALID_NOCHANGEPAGE = 2;
- { Property Sheet }
- PSBTN_APPLYNOW = 4;
- PSBTN_BACK = 0;
- PSBTN_CANCEL = 5;
- PSBTN_FINISH = 2;
- PSBTN_HELP = 6;
- PSBTN_NEXT = 1;
- PSBTN_OK = 3;
- PSWIZB_BACK = 1;
- PSWIZB_NEXT = 2;
- PSWIZB_FINISH = 4;
- PSWIZB_DISABLEDFINISH = 8;
- ID_PSREBOOTSYSTEM = 3;
- ID_PSRESTARTWINDOWS = 2;
- WIZ_BODYCX = 184;
- WIZ_BODYX = 92;
- WIZ_CXBMP = 80;
- WIZ_CXDLG = 276;
- WIZ_CYDLG = 140;
- { VX_FIXEDFILEINFO structure }
- { was #define dname def_expr }
- function VS_FILE_INFO : LPTSTR;
- { return type might be wrong }
-
-
- const
- VS_VERSION_INFO = 1;
- VS_FF_DEBUG = $1;
- VS_FF_INFOINFERRED = $10;
- VS_FF_PATCHED = $4;
- VS_FF_PRERELEASE = $2;
- VS_FF_PRIVATEBUILD = $8;
- VS_FF_SPECIALBUILD = $20;
- VOS_UNKNOWN = 0;
- VOS_DOS = $10000;
- VOS_OS216 = $20000;
- VOS_OS232 = $30000;
- VOS_NT = $40000;
- VOS_DOS_WINDOWS16 = $10001;
- VOS_DOS_WINDOWS32 = $10004;
- VOS_OS216_PM16 = $20002;
- VOS_OS232_PM32 = $30003;
- VOS_NT_WINDOWS32 = $40004;
- VFT_UNKNOWN = 0;
- VFT_APP = $1;
- VFT_DLL = $2;
- VFT_DRV = $3;
- VFT_FONT = $4;
- VFT_VXD = $5;
- VFT_STATIC_LIB = $7;
- VFT2_UNKNOWN = 0;
- VFT2_DRV_PRINTER = $1;
- VFT2_DRV_KEYBOARD = $2;
- VFT2_DRV_LANGUAGE = $3;
- VFT2_DRV_DISPLAY = $4;
- VFT2_DRV_MOUSE = $5;
- VFT2_DRV_NETWORK = $6;
- VFT2_DRV_SYSTEM = $7;
- VFT2_DRV_INSTALLABLE = $8;
- VFT2_DRV_SOUND = $9;
- VFT2_FONT_RASTER = $1;
- VFT2_FONT_VECTOR = $2;
- VFT2_FONT_TRUETYPE = $3;
- { PANOSE structure }
- PAN_ANY = 0;
- PAN_NO_FIT = 1;
- PAN_FAMILY_TEXT_DISPLAY = 2;
- PAN_FAMILY_SCRIPT = 3;
- PAN_FAMILY_DECORATIVE = 4;
- PAN_FAMILY_PICTORIAL = 5;
- PAN_SERIF_COVE = 2;
- PAN_SERIF_OBTUSE_COVE = 3;
- PAN_SERIF_SQUARE_COVE = 4;
- PAN_SERIF_OBTUSE_SQUARE_COVE = 5;
- PAN_SERIF_SQUARE = 6;
- PAN_SERIF_THIN = 7;
- PAN_SERIF_BONE = 8;
- PAN_SERIF_EXAGGERATED = 9;
- PAN_SERIF_TRIANGLE = 10;
- PAN_SERIF_NORMAL_SANS = 11;
- PAN_SERIF_OBTUSE_SANS = 12;
- PAN_SERIF_PERP_SANS = 13;
- PAN_SERIF_FLARED = 14;
- PAN_SERIF_ROUNDED = 15;
- PAN_WEIGHT_VERY_LIGHT = 2;
- PAN_WEIGHT_LIGHT = 3;
- PAN_WEIGHT_THIN = 4;
- PAN_WEIGHT_BOOK = 5;
- PAN_WEIGHT_MEDIUM = 6;
- PAN_WEIGHT_DEMI = 7;
- PAN_WEIGHT_BOLD = 8;
- PAN_WEIGHT_HEAVY = 9;
- PAN_WEIGHT_BLACK = 10;
- PAN_WEIGHT_NORD = 11;
- PAN_PROP_OLD_STYLE = 2;
- PAN_PROP_MODERN = 3;
- PAN_PROP_EVEN_WIDTH = 4;
- PAN_PROP_EXPANDED = 5;
- PAN_PROP_CONDENSED = 6;
- PAN_PROP_VERY_EXPANDED = 7;
- PAN_PROP_VERY_CONDENSED = 8;
- PAN_PROP_MONOSPACED = 9;
- PAN_CONTRAST_NONE = 2;
- PAN_CONTRAST_VERY_LOW = 3;
- PAN_CONTRAST_LOW = 4;
- PAN_CONTRAST_MEDIUM_LOW = 5;
- PAN_CONTRAST_MEDIUM = 6;
- PAN_CONTRAST_MEDIUM_HIGH = 7;
- PAN_CONTRAST_HIGH = 8;
- PAN_CONTRAST_VERY_HIGH = 9;
- PAN_STROKE_GRADUAL_DIAG = 2;
- PAN_STROKE_GRADUAL_TRAN = 3;
- PAN_STROKE_GRADUAL_VERT = 4;
- PAN_STROKE_GRADUAL_HORZ = 5;
- PAN_STROKE_RAPID_VERT = 6;
- PAN_STROKE_RAPID_HORZ = 7;
- PAN_STROKE_INSTANT_VERT = 8;
- PAN_STRAIGHT_ARMS_HORZ = 2;
- PAN_STRAIGHT_ARMS_WEDGE = 3;
- PAN_STRAIGHT_ARMS_VERT = 4;
- PAN_STRAIGHT_ARMS_SINGLE_SERIF = 5;
- PAN_STRAIGHT_ARMS_DOUBLE_SERIF = 6;
- PAN_BENT_ARMS_HORZ = 7;
- PAN_BENT_ARMS_VERT = 9;
- PAN_BENT_ARMS_WEDGE = 8;
- PAN_BENT_ARMS_SINGLE_SERIF = 10;
- PAN_BENT_ARMS_DOUBLE_SERIF = 11;
- PAN_LETT_NORMAL_CONTACT = 2;
- PAN_LETT_NORMAL_WEIGHTED = 3;
- PAN_LETT_NORMAL_BOXED = 4;
- PAN_LETT_NORMAL_FLATTENED = 5;
- PAN_LETT_NORMAL_ROUNDED = 6;
- PAN_LETT_NORMAL_OFF_CENTER = 7;
- PAN_LETT_NORMAL_SQUARE = 8;
- PAN_LETT_OBLIQUE_CONTACT = 9;
- PAN_LETT_OBLIQUE_WEIGHTED = 10;
- PAN_LETT_OBLIQUE_BOXED = 11;
- PAN_LETT_OBLIQUE_FLATTENED = 12;
- PAN_LETT_OBLIQUE_ROUNDED = 13;
- PAN_LETT_OBLIQUE_OFF_CENTER = 14;
- PAN_LETT_OBLIQUE_SQUARE = 15;
- PAN_MIDLINE_STANDARD_TRIMMED = 2;
- PAN_MIDLINE_STANDARD_POINTED = 3;
- PAN_MIDLINE_STANDARD_SERIFED = 4;
- PAN_MIDLINE_HIGH_TRIMMED = 5;
- PAN_MIDLINE_HIGH_POINTED = 6;
- PAN_MIDLINE_HIGH_SERIFED = 7;
- PAN_MIDLINE_CONSTANT_TRIMMED = 8;
- PAN_MIDLINE_CONSTANT_POINTED = 9;
- PAN_MIDLINE_CONSTANT_SERIFED = 10;
- PAN_MIDLINE_LOW_TRIMMED = 11;
- PAN_MIDLINE_LOW_POINTED = 12;
- PAN_MIDLINE_LOW_SERIFED = 13;
- PAN_XHEIGHT_CONSTANT_SMALL = 2;
- PAN_XHEIGHT_CONSTANT_STD = 3;
- PAN_XHEIGHT_CONSTANT_LARGE = 4;
- PAN_XHEIGHT_DUCKING_SMALL = 5;
- PAN_XHEIGHT_DUCKING_STD = 6;
- PAN_XHEIGHT_DUCKING_LARGE = 7;
- { PALETTENTRY structure }
- PC_EXPLICIT = 2;
- PC_NOCOLLAPSE = 4;
- PC_RESERVED = 1;
- { LOGBRUSH structure }
- BS_DIBPATTERN = 5;
- BS_DIBPATTERN8X8 = 8;
- BS_DIBPATTERNPT = 6;
- BS_HATCHED = 2;
- BS_HOLLOW = 1;
- BS_NULL = 1;
- BS_PATTERN = 3;
- BS_PATTERN8X8 = 7;
- BS_SOLID = 0;
- { DEVMODE structure }
- DM_ORIENTATION = $1;
- DM_PAPERSIZE = $2;
- DM_PAPERLENGTH = $4;
- DM_PAPERWIDTH = $8;
- DM_SCALE = $10;
- DM_COPIES = $100;
- DM_DEFAULTSOURCE = $200;
- DM_PRINTQUALITY = $400;
- DM_COLOR = $800;
- DM_DUPLEX = $1000;
- DM_YRESOLUTION = $2000;
- DM_TTOPTION = $4000;
- DM_COLLATE = $8000;
- DM_FORMNAME = $10000;
- DM_LOGPIXELS = $20000;
- {DM_BITSPERPEL = $40000;
- DM_PELSWIDTH = $80000;
- DM_PELSHEIGHT = $100000;
- DM_DISPLAYFLAGS = $200000;
- DM_DISPLAYFREQUENCY = $400000;already above }
- DM_ICMMETHOD = $800000;
- DM_ICMINTENT = $1000000;
- DM_MEDIATYPE = $2000000;
- DM_DITHERTYPE = $4000000;
- DMORIENT_LANDSCAPE = 2;
- DMORIENT_PORTRAIT = 1;
- DMPAPER_LETTER = 1;
- DMPAPER_LEGAL = 5;
- DMPAPER_A4 = 9;
- DMPAPER_CSHEET = 24;
- DMPAPER_DSHEET = 25;
- DMPAPER_ESHEET = 26;
- DMPAPER_LETTERSMALL = 2;
- DMPAPER_TABLOID = 3;
- DMPAPER_LEDGER = 4;
- DMPAPER_STATEMENT = 6;
- DMPAPER_EXECUTIVE = 7;
- DMPAPER_A3 = 8;
- DMPAPER_A4SMALL = 10;
- DMPAPER_A5 = 11;
- DMPAPER_B4 = 12;
- DMPAPER_B5 = 13;
- DMPAPER_FOLIO = 14;
- DMPAPER_QUARTO = 15;
- DMPAPER_10X14 = 16;
- DMPAPER_11X17 = 17;
- DMPAPER_NOTE = 18;
- DMPAPER_ENV_9 = 19;
- DMPAPER_ENV_10 = 20;
- DMPAPER_ENV_11 = 21;
- DMPAPER_ENV_12 = 22;
- DMPAPER_ENV_14 = 23;
- DMPAPER_ENV_DL = 27;
- DMPAPER_ENV_C5 = 28;
- DMPAPER_ENV_C3 = 29;
- DMPAPER_ENV_C4 = 30;
- DMPAPER_ENV_C6 = 31;
- DMPAPER_ENV_C65 = 32;
- DMPAPER_ENV_B4 = 33;
- DMPAPER_ENV_B5 = 34;
- DMPAPER_ENV_B6 = 35;
- DMPAPER_ENV_ITALY = 36;
- DMPAPER_ENV_MONARCH = 37;
- DMPAPER_ENV_PERSONAL = 38;
- DMPAPER_FANFOLD_US = 39;
- DMPAPER_FANFOLD_STD_GERMAN = 40;
- DMPAPER_FANFOLD_LGL_GERMAN = 41;
- DMRES_HIGH = -(4);
- DMRES_MEDIUM = -(3);
- DMRES_LOW = -(2);
- DMRES_DRAFT = -(1);
- DMCOLOR_COLOR = 2;
- DMCOLOR_MONOCHROME = 1;
- DMDUP_SIMPLEX = 1;
- DMDUP_HORIZONTAL = 3;
- DMDUP_VERTICAL = 2;
- DMTT_BITMAP = 1;
- DMTT_DOWNLOAD = 2;
- DMTT_SUBDEV = 3;
- DMCOLLATE_TRUE = 1;
- DMCOLLATE_FALSE = 0;
- DM_GRAYSCALE = 1;
- DM_INTERLACED = 2;
- DMICMMETHOD_NONE = 1;
- DMICMMETHOD_SYSTEM = 2;
- DMICMMETHOD_DRIVER = 3;
- DMICMMETHOD_DEVICE = 4;
- DMICMMETHOD_USER = 256;
- DMICM_SATURATE = 1;
- DMICM_CONTRAST = 2;
- DMICM_COLORMETRIC = 3;
- DMICM_USER = 256;
- DMMEDIA_STANDARD = 1;
- DMMEDIA_GLOSSY = 3;
- DMMEDIA_TRANSPARENCY = 2;
- DMMEDIA_USER = 256;
- DMDITHER_NONE = 1;
- DMDITHER_COARSE = 2;
- DMDITHER_FINE = 3;
- DMDITHER_LINEART = 4;
- DMDITHER_GRAYSCALE = 10;
- DMDITHER_USER = 256;
- { RGNDATAHEADER structure }
- RDH_RECTANGLES = 1;
- { TTPOLYGONHEADER structure }
- TT_POLYGON_TYPE = 24;
- { TTPOLYCURVE structure }
- TT_PRIM_LINE = 1;
- TT_PRIM_QSPLINE = 2;
- { GCP_RESULTS structure }
- GCPCLASS_ARABIC = 2;
- GCPCLASS_HEBREW = 2;
- GCPCLASS_LATIN = 1;
- GCPCLASS_LATINNUMBER = 5;
- GCPCLASS_LOCALNUMBER = 4;
- GCPCLASS_LATINNUMERICSEPARATOR = 7;
- GCPCLASS_LATINNUMERICTERMINATOR = 6;
- GCPCLASS_NEUTRAL = 3;
- GCPCLASS_NUMERICSEPARATOR = 8;
- GCPCLASS_PREBOUNDLTR = 128;
- GCPCLASS_PREBOUNDRTL = 64;
- GCPCLASS_POSTBOUNDLTR = 32;
- GCPCLASS_POSTBOUNDRTL = 16;
- GCPGLYPH_LINKBEFORE = 32768;
- GCPGLYPH_LINKAFTER = 16384;
- { RASTERIZER_STATUS structure }
- TT_AVAILABLE = 1;
- TT_ENABLED = 2;
- { COLORADJUSTMENT structure }
- CA_NEGATIVE = 1;
- CA_LOG_FILTER = 2;
- ILLUMINANT_DEVICE_DEFAULT = 0;
- ILLUMINANT_A = 1;
- ILLUMINANT_B = 2;
- ILLUMINANT_C = 3;
- ILLUMINANT_D50 = 4;
- ILLUMINANT_D55 = 5;
- ILLUMINANT_D65 = 6;
- ILLUMINANT_D75 = 7;
- ILLUMINANT_F2 = 8;
- ILLUMINANT_TUNGSTEN = 1;
- ILLUMINANT_DAYLIGHT = 3;
- ILLUMINANT_FLUORESCENT = 8;
- ILLUMINANT_NTSC = 3;
- { DOCINFO structure }
- DI_APPBANDING = 1;
- { EMRMETAHEADER structure }
- EMR_HEADER = 1;
- ENHMETA_SIGNATURE = 1179469088;
- { RTF event masks }
- ENM_CHANGE = 1;
- ENM_CORRECTTEXT = 4194304;
- ENM_DROPFILES = 1048576;
- ENM_KEYEVENTS = 65536;
- ENM_MOUSEEVENTS = 131072;
- ENM_PROTECTED = 2097152;
- ENM_REQUESTRESIZE = 262144;
- ENM_SCROLL = 4;
- ENM_SELCHANGE = 524288;
- ENM_UPDATE = 2;
- ENM_NONE = 0;
- { RTF styles }
- ES_DISABLENOSCROLL = 8192;
- ES_EX_NOCALLOLEINIT = 16777216;
- ES_NOIME = 524288;
- ES_SAVESEL = 32768;
- ES_SELFIME = 262144;
- ES_SUNKEN = 16384;
- ES_VERTICAL = 4194304;
- ES_SELECTIONBAR = 16777216;
- { EM_SETOPTIONS message }
- ECOOP_SET = 1;
- ECOOP_OR = 2;
- ECOOP_AND = 3;
- ECOOP_XOR = 4;
- ECO_AUTOWORDSELECTION = 1;
- ECO_AUTOVSCROLL = 64;
- ECO_AUTOHSCROLL = 128;
- ECO_NOHIDESEL = 256;
- ECO_READONLY = 2048;
- ECO_WANTRETURN = 4096;
- ECO_SAVESEL = 32768;
- ECO_SELECTIONBAR = 16777216;
- ECO_VERTICAL = 4194304;
- { EM_SETCHARFORMAT message }
- SCF_WORD = 2;
- SCF_SELECTION = 1;
- { EM_STREAMOUT message }
- SF_TEXT = 1;
- SF_RTF = 2;
- SF_RTFNOOBJS = 3;
- SF_TEXTIZED = 4;
- SFF_SELECTION = 32768;
- SFF_PLAINRTF = 16384;
- { EM_FINDWORDBREAK message }
- WB_CLASSIFY = 3;
- {WB_ISDELIMITER = 2;
- WB_LEFT = 0; already above }
- WB_LEFTBREAK = 6;
- WB_PREVBREAK = 6;
- WB_MOVEWORDLEFT = 4;
- WB_MOVEWORDPREV = 4;
- WB_MOVEWORDRIGHT = 5;
- WB_MOVEWORDNEXT = 5;
- {WB_RIGHT = 1;already above }
- WB_RIGHTBREAK = 7;
- WB_NEXTBREAK = 7;
- { EM_GETPUNCTUATION message }
- PC_LEADING = 2;
- PC_FOLLOWING = 1;
- PC_DELIMITER = 4;
- PC_OVERFLOW = 3;
- { EM_SETWORDWRAPMODE message }
- WBF_WORDWRAP = 16;
- WBF_WORDBREAK = 32;
- WBF_OVERFLOW = 64;
- WBF_LEVEL1 = 128;
- WBF_LEVEL2 = 256;
- WBF_CUSTOM = 512;
- WBF_BREAKAFTER = 64;
- WBF_BREAKLINE = 32;
- WBF_ISWHITE = 16;
- { CHARFORMAT structure }
- CFM_BOLD = 1;
- CFM_COLOR = 1073741824;
- CFM_FACE = 536870912;
- CFM_ITALIC = 2;
- CFM_OFFSET = 268435456;
- CFM_PROTECTED = 16;
- CFM_SIZE = $80000000;
- CFM_STRIKEOUT = 8;
- CFM_UNDERLINE = 4;
- CFE_AUTOCOLOR = 1073741824;
- CFE_BOLD = 1;
- CFE_ITALIC = 2;
- CFE_STRIKEOUT = 8;
- CFE_UNDERLINE = 4;
- CFE_PROTECTED = 16;
- { PARAFORMAT structure }
- PFM_ALIGNMENT = 8;
- PFM_NUMBERING = 32;
- PFM_OFFSET = 4;
- PFM_OFFSETINDENT = $80000000;
- PFM_RIGHTINDENT = 2;
- PFM_STARTINDENT = 1;
- PFM_TABSTOPS = 16;
- PFN_BULLET = 1;
- PFA_LEFT = 1;
- PFA_RIGHT = 2;
- PFA_CENTER = 3;
- { SELCHANGE structure }
- SEL_EMPTY = 0;
- SEL_TEXT = 1;
- SEL_OBJECT = 2;
- SEL_MULTICHAR = 4;
- SEL_MULTIOBJECT = 8;
- { RTF clipboard formats }
- CF_RTF = 'Rich Text Format';
- CF_RETEXTOBJ = 'RichEdit Text and Objects';
- { DRAWITEMSTRUCT structure }
- ODT_BUTTON = 4;
- ODT_COMBOBOX = 3;
- ODT_LISTBOX = 2;
- ODT_LISTVIEW = 102;
- ODT_MENU = 1;
- ODT_STATIC = 5;
- ODT_TAB = 101;
- ODT_HEADER = 100;
- ODA_DRAWENTIRE = 1;
- ODA_FOCUS = 4;
- ODA_SELECT = 2;
- ODS_CHECKED = 8;
- ODS_COMBOBOXEDIT = 4096;
- ODS_DEFAULT = 32;
- ODS_DISABLED = 4;
- ODS_FOCUS = 16;
- ODS_GRAYED = 2;
- ODS_SELECTED = 1;
- { Common control window classes }
- ANIMATE_CLASSW = 'SysAnimate32';
- HOTKEY_CLASSW = 'msctls_hotkey32';
- PROGRESS_CLASSW = 'msctls_progress32';
- STATUSCLASSNAMEW = 'msctls_statusbar32';
- TOOLBARCLASSNAMEW = 'ToolbarWindow32';
- TOOLTIPS_CLASSW = 'tooltips_class32';
- TRACKBAR_CLASSW = 'msctls_trackbar32';
- UPDOWN_CLASSW = 'msctls_updown32';
- WC_HEADERW = 'SysHeader32';
- WC_LISTVIEWW = 'SysListView32';
- WC_TABCONTROLW = 'SysTabControl32';
- WC_TREEVIEWW = 'SysTreeView32';
- { Common control styles }
- CCS_ADJUSTABLE = $20;
- CCS_BOTTOM = $3;
- CCS_NODIVIDER = $40;
- CCS_NOMOVEY = $2;
- CCS_NOPARENTALIGN = $8;
- CCS_NORESIZE = $4;
- CCS_TOP = $1;
- ANIMATE_CLASSA = 'SysAnimate32';
- HOTKEY_CLASSA = 'msctls_hotkey32';
- PROGRESS_CLASSA = 'msctls_progress32';
- STATUSCLASSNAMEA = 'msctls_statusbar32';
- TOOLBARCLASSNAMEA = 'ToolbarWindow32';
- TOOLTIPS_CLASSA = 'tooltips_class32';
- TRACKBAR_CLASSA = 'msctls_trackbar32';
- UPDOWN_CLASSA = 'msctls_updown32';
- WC_HEADERA = 'SysHeader32';
- WC_LISTVIEWA = 'SysListView32';
- WC_TABCONTROLA = 'SysTabControl32';
- WC_TREEVIEWA = 'SysTreeView32';
-{$ifdef UNICODE}
-
- const
- ANIMATE_CLASS = ANIMATE_CLASSW;
- HOTKEY_CLASS = HOTKEY_CLASSW;
- PROGRESS_CLASS = PROGRESS_CLASSW;
- STATUSCLASSNAME = STATUSCLASSNAMEW;
- TOOLBARCLASSNAME = TOOLBARCLASSNAMEW;
- TOOLTIPS_CLASS = TOOLTIPS_CLASSW;
- TRACKBAR_CLASS = TRACKBAR_CLASSW;
- UPDOWN_CLASS = UPDOWN_CLASSW;
- WC_HEADER = WC_HEADERW;
- WC_LISTVIEW = WC_LISTVIEWW;
- WC_TABCONTROL = WC_TABCONTROLW;
- WC_TREEVIEW = WC_TREEVIEWW;
-{$else}
-
- const
- ANIMATE_CLASS = ANIMATE_CLASSA;
- HOTKEY_CLASS = HOTKEY_CLASSA;
- PROGRESS_CLASS = PROGRESS_CLASSA;
- STATUSCLASSNAME = STATUSCLASSNAMEA;
- TOOLBARCLASSNAME = TOOLBARCLASSNAMEA;
- TOOLTIPS_CLASS = TOOLTIPS_CLASSA;
- TRACKBAR_CLASS = TRACKBAR_CLASSA;
- UPDOWN_CLASS = UPDOWN_CLASSA;
- WC_HEADER = WC_HEADERA;
- WC_LISTVIEW = WC_LISTVIEWA;
- WC_TABCONTROL = WC_TABCONTROLA;
- WC_TREEVIEW = WC_TREEVIEWA;
-{$endif}
- { UNICODE }
- { Header control styles }
-
- const
- HDS_BUTTONS = 2;
- HDS_HIDDEN = 8;
- HDS_HORZ = 0;
- { HD_ITEM structure }
- HDI_BITMAP = 16;
- HDI_FORMAT = 4;
- HDI_HEIGHT = 1;
- HDI_LPARAM = 8;
- HDI_TEXT = 2;
- HDI_WIDTH = 1;
- HDF_CENTER = 2;
- HDF_LEFT = 0;
- HDF_RIGHT = 1;
- HDF_RTLREADING = 4;
- HDF_BITMAP = 8192;
- HDF_OWNERDRAW = 32768;
- HDF_STRING = 16384;
- HDF_JUSTIFYMASK = 3;
- { HD_HITTESTINFO structure }
- HHT_NOWHERE = 1;
- HHT_ONDIVIDER = 4;
- HHT_ONDIVOPEN = 8;
- HHT_ONHEADER = 2;
- HHT_TOLEFT = 2048;
- HHT_TORIGHT = 1024;
- { TBADDBITMAP structure }
- { was #define dname def_expr }
- function HINST_COMMCTRL : HINST;
-
-
- const
- IDB_STD_LARGE_COLOR = 1;
- IDB_STD_SMALL_COLOR = 0;
- IDB_VIEW_LARGE_COLOR = 5;
- IDB_VIEW_SMALL_COLOR = 4;
- STD_COPY = 1;
- STD_CUT = 0;
- STD_DELETE = 5;
- STD_FILENEW = 6;
- STD_FILEOPEN = 7;
- STD_FILESAVE = 8;
- STD_FIND = 12;
- STD_HELP = 11;
- STD_PASTE = 2;
- STD_PRINT = 14;
- STD_PRINTPRE = 9;
- STD_PROPERTIES = 10;
- STD_REDOW = 4;
- STD_REPLACE = 13;
- STD_UNDO = 3;
- VIEW_LARGEICONS = 0;
- VIEW_SMALLICONS = 1;
- VIEW_LIST = 2;
- VIEW_DETAILS = 3;
- VIEW_SORTNAME = 4;
- VIEW_SORTSIZE = 5;
- VIEW_SORTDATE = 6;
- VIEW_SORTTYPE = 7;
- { Toolbar styles }
- TBSTYLE_ALTDRAG = 1024;
- TBSTYLE_TOOLTIPS = 256;
- TBSTYLE_WRAPABLE = 512;
- TBSTYLE_BUTTON = 0;
- TBSTYLE_CHECK = 2;
- TBSTYLE_CHECKGROUP = 6;
- TBSTYLE_GROUP = 4;
- TBSTYLE_SEP = 1;
- { Toolbar states }
- TBSTATE_CHECKED = 1;
- TBSTATE_ENABLED = 4;
- TBSTATE_HIDDEN = 8;
- TBSTATE_INDETERMINATE = 16;
- TBSTATE_PRESSED = 2;
- TBSTATE_WRAP = 32;
- { Tooltip styles }
- TTS_ALWAYSTIP = 1;
- TTS_NOPREFIX = 2;
- { TOOLINFO structure }
- TTF_IDISHWND = 1;
- TTF_CENTERTIP = 2;
- TTF_RTLREADING = 4;
- TTF_SUBCLASS = 16;
- { TTM_SETDELAYTIME message }
- TTDT_AUTOMATIC = 0;
- TTDT_AUTOPOP = 2;
- TTDT_INITIAL = 3;
- TTDT_RESHOW = 1;
- { Status window }
- SBARS_SIZEGRIP = 256;
- {SBARS_SIZEGRIP = 256;already above }
- { DL_DRAGGING message }
- DL_MOVECURSOR = 3;
- DL_COPYCURSOR = 2;
- DL_STOPCURSOR = 1;
- { Up-down control styles }
- UDS_ALIGNLEFT = 8;
- UDS_ALIGNRIGHT = 4;
- UDS_ARROWKEYS = 32;
- UDS_AUTOBUDDY = 16;
- UDS_HORZ = 64;
- UDS_NOTHOUSANDS = 128;
- UDS_SETBUDDYINT = 2;
- UDS_WRAP = 1;
- { UDM_SETRANGE message }
- UD_MAXVAL = 32767;
- UD_MINVAL = -(32767);
- { HKM_GETHOTKEY message }
- HOTKEYF_ALT = 4;
- HOTKEYF_CONTROL = 2;
- HOTKEYF_EXT = 8;
- HOTKEYF_SHIFT = 1;
- { HKM_SETRULES message }
- HKCOMB_A = 8;
- HKCOMB_C = 4;
- HKCOMB_CA = 64;
- HKCOMB_NONE = 1;
- HKCOMB_S = 2;
- HKCOMB_SA = 32;
- HKCOMB_SC = 16;
- HKCOMB_SCA = 128;
- { Trackbar styles }
- TBS_HORZ = 0;
- TBS_VERT = 2;
- TBS_AUTOTICKS = 1;
- TBS_NOTICKS = 16;
- TBS_TOP = 4;
- TBS_BOTTOM = 0;
- TBS_LEFT = 4;
- TBS_RIGHT = 0;
- TBS_BOTH = 8;
- TBS_ENABLESELRANGE = 32;
- TBS_FIXEDLENGTH = 64;
- TBS_NOTHUMB = 128;
- TB_BOTTOM = 7;
- TB_ENDTRACK = 8;
- TB_LINEDOWN = 1;
- TB_LINEUP = 0;
- TB_PAGEDOWN = 3;
- TB_PAGEUP = 2;
- TB_THUMBPOSITION = 4;
- TB_THUMBTRACK = 5;
- TB_TOP = 6;
- { List view styles }
- LVS_ALIGNLEFT = 2048;
- LVS_ALIGNTOP = 0;
- LVS_AUTOARRANGE = 256;
- LVS_EDITLABELS = 512;
- LVS_ICON = 0;
- LVS_LIST = 3;
- LVS_NOCOLUMNHEADER = 16384;
- LVS_NOLABELWRAP = 128;
- LVS_NOSCROLL = 8192;
- LVS_NOSORTHEADER = 32768;
- LVS_OWNERDRAWFIXED = 1024;
- LVS_REPORT = 1;
- LVS_SHAREIMAGELISTS = 64;
- LVS_SHOWSELALWAYS = 8;
- LVS_SINGLESEL = 4;
- LVS_SMALLICON = 2;
- LVS_SORTASCENDING = 16;
- LVS_SORTDESCENDING = 32;
- LVS_TYPESTYLEMASK = 64512;
- LVSIL_NORMAL = 0;
- LVSIL_SMALL = 1;
- LVSIL_STATE = 2;
- LVIS_CUT = 4;
- LVIS_DROPHILITED = 8;
- LVIS_FOCUSED = 1;
- LVIS_SELECTED = 2;
- LVIS_OVERLAYMASK = 3840;
- LVIS_STATEIMAGEMASK = 61440;
- { was #define dname def_expr }
- function LPSTR_TEXTCALLBACKW : LPWSTR;
-
- { was #define dname def_expr }
- function LPSTR_TEXTCALLBACKA : LPSTR;
-
-{$ifdef UNICODE}
-
- {const this is a function in fact !!
- LPSTR_TEXTCALLBACK = LPSTR_TEXTCALLBACKW;}
- function LPSTR_TEXTCALLBACK : LPWSTR;
-
-{$else}
-
- {const
- LPSTR_TEXTCALLBACK = LPSTR_TEXTCALLBACKA; }
- function LPSTR_TEXTCALLBACK : LPSTR;
-{$endif}
- { UNICODE }
- { LV_ITEM structure }
-
- const
- LVIF_TEXT = 1;
- LVIF_IMAGE = 2;
- LVIF_PARAM = 4;
- LVIF_STATE = 8;
- LVIF_DI_SETITEM = 4096;
- { LVM_GETNEXTITEM structure }
- LVNI_ABOVE = 256;
- LVNI_ALL = 0;
- LVNI_BELOW = 512;
- LVNI_TOLEFT = 1024;
- LVNI_TORIGHT = 2048;
- LVNI_CUT = 4;
- LVNI_DROPHILITED = 8;
- LVNI_FOCUSED = 1;
- LVNI_SELECTED = 2;
- { LV_FINDINFO structure }
- LVFI_PARAM = 1;
- LVFI_PARTIAL = 8;
- LVFI_STRING = 2;
- LVFI_WRAP = 32;
- LVFI_NEARESTXY = 64;
- { LV_HITTESTINFO structure }
- LVHT_ABOVE = 8;
- LVHT_BELOW = 16;
- LVHT_NOWHERE = 1;
- LVHT_ONITEMICON = 2;
- LVHT_ONITEMLABEL = 4;
- LVHT_ONITEMSTATEICON = 8;
- LVHT_TOLEFT = 64;
- LVHT_TORIGHT = 32;
- { LV_COLUMN structure }
- LVCF_FMT = 1;
- LVCF_SUBITEM = 8;
- LVCF_TEXT = 4;
- LVCF_WIDTH = 2;
- LVCFMT_CENTER = 2;
- LVCFMT_LEFT = 0;
- LVCFMT_RIGHT = 1;
- { ListView_GetItemRect }
- LVIR_BOUNDS = 0;
- LVIR_ICON = 1;
- LVIR_LABEL = 2;
- LVIR_SELECTBOUNDS = 3;
- { LVM_ARRANGE message }
- LVA_ALIGNLEFT = 1;
- LVA_ALIGNTOP = 2;
- LVA_DEFAULT = 0;
- LVA_SNAPTOGRID = 5;
- { LVM_SETCOLUMNWIDTH message }
- LVSCW_AUTOSIZE = -(1);
- LVSCW_AUTOSIZE_USEHEADER = -(2);
- { Tree View styles }
- TVS_DISABLEDRAGDROP = 16;
- TVS_EDITLABELS = 8;
- TVS_HASBUTTONS = 1;
- TVS_HASLINES = 2;
- TVS_LINESATROOT = 4;
- TVS_SHOWSELALWAYS = 32;
- { Tree View states }
- TVIS_BOLD = 16;
- TVIS_CUT = 4;
- TVIS_DROPHILITED = 8;
- TVIS_EXPANDED = 32;
- TVIS_EXPANDEDONCE = 64;
- TVIS_FOCUSED = 1;
- TVIS_OVERLAYMASK = 3840;
- TVIS_SELECTED = 2;
- TVIS_STATEIMAGEMASK = 61440;
- TVIS_USERMASK = 61440;
- { TV_ITEM structure }
- TVIF_CHILDREN = 64;
- TVIF_HANDLE = 16;
- TVIF_IMAGE = 2;
- TVIF_PARAM = 4;
- TVIF_SELECTEDIMAGE = 32;
- TVIF_STATE = 8;
- TVIF_TEXT = 1;
- I_CHILDRENCALLBACK = -(1);
- I_IMAGECALLBACK = -(1);
- { TV_INSERTSTRUCT structure }
- { added manually PM, TREEITEM is not defined in the C headers }
- type
- TREEITEM = record
- end;
- HTREEITEM = ^TREEITEM;
- TTREEITEM = TREEITEM;
- PTREEITEM = ^TREEITEM;
-
- { was #define dname def_expr }
- function TVI_ROOT : HTREEITEM;
-
- { was #define dname def_expr }
- function TVI_FIRST : HTREEITEM;
-
- { was #define dname def_expr }
- function TVI_LAST : HTREEITEM;
-
- { was #define dname def_expr }
- function TVI_SORT : HTREEITEM;
-
- { TV_HITTESTINFO structure }
-
- const
- TVHT_ABOVE = 256;
- TVHT_BELOW = 512;
- TVHT_NOWHERE = 1;
- TVHT_ONITEM = 70;
- TVHT_ONITEMBUTTON = 16;
- TVHT_ONITEMICON = 2;
- TVHT_ONITEMINDENT = 8;
- TVHT_ONITEMLABEL = 4;
- TVHT_ONITEMRIGHT = 32;
- TVHT_ONITEMSTATEICON = 64;
- TVHT_TOLEFT = 2048;
- TVHT_TORIGHT = 1024;
- { TVM_EXPAND message }
- TVE_COLLAPSE = 1;
- TVE_COLLAPSERESET = 32768;
- TVE_EXPAND = 2;
- TVE_TOGGLE = 3;
- { TVM_GETIMAGELIST message }
- TVSIL_NORMAL = 0;
- TVSIL_STATE = 2;
- { TVM_GETNEXTITEM message }
- TVGN_CARET = 9;
- TVGN_CHILD = 4;
- TVGN_DROPHILITE = 8;
- TVGN_FIRSTVISIBLE = 5;
- TVGN_NEXT = 1;
- TVGN_NEXTVISIBLE = 6;
- TVGN_PARENT = 3;
- TVGN_PREVIOUS = 2;
- TVGN_PREVIOUSVISIBLE = 7;
- TVGN_ROOT = 0;
- { TVN_SELCHANGED message }
- TVC_BYKEYBOARD = 2;
- TVC_BYMOUSE = 1;
- TVC_UNKNOWN = 0;
- { Tab control styles }
- TCS_BUTTONS = 256;
- TCS_FIXEDWIDTH = 1024;
- TCS_FOCUSNEVER = 32768;
- TCS_FOCUSONBUTTONDOWN = 4096;
- TCS_FORCEICONLEFT = 16;
- TCS_FORCELABELLEFT = 32;
- TCS_MULTILINE = 512;
- TCS_OWNERDRAWFIXED = 8192;
- TCS_RAGGEDRIGHT = 2048;
- TCS_RIGHTJUSTIFY = 0;
- TCS_SINGLELINE = 0;
- TCS_TABS = 0;
- TCS_TOOLTIPS = 16384;
- { TC_ITEM structure }
- TCIF_TEXT = 1;
- TCIF_IMAGE = 2;
- TCIF_PARAM = 8;
- TCIF_RTLREADING = 4;
- { TC_HITTESTINFO structure }
- TCHT_NOWHERE = 1;
- TCHT_ONITEM = 6;
- TCHT_ONITEMICON = 2;
- TCHT_ONITEMLABEL = 4;
- { Animation control styles }
- ACS_AUTOPLAY = 4;
- ACS_CENTER = 1;
- ACS_TRANSPARENT = 2;
- { MODEMDEVCAPS structure }
- DIALOPTION_BILLING = 64;
- DIALOPTION_QUIET = 128;
- DIALOPTION_DIALTONE = 256;
- MDMVOLFLAG_LOW = 1;
- MDMVOLFLAG_MEDIUM = 2;
- MDMVOLFLAG_HIGH = 4;
- MDMVOL_LOW = 0;
- MDMVOL_MEDIUM = 1;
- MDMVOL_HIGH = 2;
- MDMSPKRFLAG_OFF = 1;
- MDMSPKRFLAG_DIAL = 2;
- MDMSPKRFLAG_ON = 4;
- MDMSPKRFLAG_CALLSETUP = 8;
- MDMSPKR_OFF = 0;
- MDMSPKR_DIAL = 1;
- MDMSPKR_ON = 2;
- MDMSPKR_CALLSETUP = 3;
- MDM_BLIND_DIAL = 512;
- MDM_CCITT_OVERRIDE = 64;
- MDM_CELLULAR = 8;
- MDM_COMPRESSION = 1;
- MDM_ERROR_CONTROL = 2;
- MDM_FLOWCONTROL_HARD = 16;
- MDM_FLOWCONTROL_SOFT = 32;
- MDM_FORCED_EC = 4;
- MDM_SPEED_ADJUST = 128;
- MDM_TONE_DIAL = 256;
- MDM_V23_OVERRIDE = 1024;
- { Languages }
- //
- // Language IDs.
- //
- // The following two combinations of primary language ID and
- // sublanguage ID have special semantics:
- //
- // Primary Language ID Sublanguage ID Result
- // ------------------- --------------- ------------------------
- // LANG_NEUTRAL SUBLANG_NEUTRAL Language neutral
- // LANG_NEUTRAL SUBLANG_DEFAULT User default language
- // LANG_NEUTRAL SUBLANG_SYS_DEFAULT System default language
- // LANG_INVARIANT SUBLANG_NEUTRAL Invariant locale
- //
-
- //
- // Primary language IDs.
- //
-
- LANG_NEUTRAL = $00;
- LANG_INVARIANT = $7f;
-
- LANG_AFRIKAANS = $36;
- LANG_ALBANIAN = $1c;
- LANG_ARABIC = $01;
- LANG_ARMENIAN = $2b;
- LANG_ASSAMESE = $4d;
- LANG_AZERI = $2c;
- LANG_BASQUE = $2d;
- LANG_BELARUSIAN = $23;
- LANG_BENGALI = $45;
- LANG_BULGARIAN = $02;
- LANG_CATALAN = $03;
- LANG_CHINESE = $04;
- LANG_CROATIAN = $1a;
- LANG_CZECH = $05;
- LANG_DANISH = $06;
- LANG_DIVEHI = $65;
- LANG_DUTCH = $13;
- LANG_ENGLISH = $09;
- LANG_ESTONIAN = $25;
- LANG_FAEROESE = $38;
- LANG_FARSI = $29;
- LANG_FINNISH = $0b;
- LANG_FRENCH = $0c;
- LANG_GALICIAN = $56;
- LANG_GEORGIAN = $37;
- LANG_GERMAN = $07;
- LANG_GREEK = $08;
- LANG_GUJARATI = $47;
- LANG_HEBREW = $0d;
- LANG_HINDI = $39;
- LANG_HUNGARIAN = $0e;
- LANG_ICELANDIC = $0f;
- LANG_INDONESIAN = $21;
- LANG_ITALIAN = $10;
- LANG_JAPANESE = $11;
- LANG_KANNADA = $4b;
- LANG_KASHMIRI = $60;
- LANG_KAZAK = $3f;
- LANG_KONKANI = $57;
- LANG_KOREAN = $12;
- LANG_KYRGYZ = $40;
- LANG_LATVIAN = $26;
- LANG_LITHUANIAN = $27;
- LANG_MACEDONIAN = $2f; // the Former Yugoslav Republic of Macedonia
- LANG_MALAY = $3e;
- LANG_MALAYALAM = $4c;
- LANG_MANIPURI = $58;
- LANG_MARATHI = $4e;
- LANG_MONGOLIAN = $50;
- LANG_NEPALI = $61;
- LANG_NORWEGIAN = $14;
- LANG_ORIYA = $48;
- LANG_POLISH = $15;
- LANG_PORTUGUESE = $16;
- LANG_PUNJABI = $46;
- LANG_ROMANIAN = $18;
- LANG_RUSSIAN = $19;
- LANG_SANSKRIT = $4f;
- LANG_SERBIAN = $1a;
- LANG_SINDHI = $59;
- LANG_SLOVAK = $1b;
- LANG_SLOVENIAN = $24;
- LANG_SPANISH = $0a;
- LANG_SWAHILI = $41;
- LANG_SWEDISH = $1d;
- LANG_SYRIAC = $5a;
- LANG_TAMIL = $49;
- LANG_TATAR = $44;
- LANG_TELUGU = $4a;
- LANG_THAI = $1e;
- LANG_TURKISH = $1f;
- LANG_UKRAINIAN = $22;
- LANG_URDU = $20;
- LANG_UZBEK = $43;
- LANG_VIETNAMESE = $2a;
-
- //
- // Sublanguage IDs.
- //
- // The name immediately following SUBLANG_ dictates which primary
- // language ID that sublanguage ID can be combined with to form a
- // valid language ID.
- //
-
- SUBLANG_NEUTRAL = $00; // language neutral
- SUBLANG_DEFAULT = $01; // user default
- SUBLANG_SYS_DEFAULT = $02; // system default
-
- SUBLANG_ARABIC_SAUDI_ARABIA = $01; // Arabic (Saudi Arabia)
- SUBLANG_ARABIC_IRAQ = $02; // Arabic (Iraq)
- SUBLANG_ARABIC_EGYPT = $03; // Arabic (Egypt)
- SUBLANG_ARABIC_LIBYA = $04; // Arabic (Libya)
- SUBLANG_ARABIC_ALGERIA = $05; // Arabic (Algeria)
- SUBLANG_ARABIC_MOROCCO = $06; // Arabic (Morocco)
- SUBLANG_ARABIC_TUNISIA = $07; // Arabic (Tunisia)
- SUBLANG_ARABIC_OMAN = $08; // Arabic (Oman)
- SUBLANG_ARABIC_YEMEN = $09; // Arabic (Yemen)
- SUBLANG_ARABIC_SYRIA = $0a; // Arabic (Syria)
- SUBLANG_ARABIC_JORDAN = $0b; // Arabic (Jordan)
- SUBLANG_ARABIC_LEBANON = $0c; // Arabic (Lebanon)
- SUBLANG_ARABIC_KUWAIT = $0d; // Arabic (Kuwait)
- SUBLANG_ARABIC_UAE = $0e; // Arabic (U.A.E)
- SUBLANG_ARABIC_BAHRAIN = $0f; // Arabic (Bahrain)
- SUBLANG_ARABIC_QATAR = $10; // Arabic (Qatar)
- SUBLANG_AZERI_LATIN = $01; // Azeri (Latin)
- SUBLANG_AZERI_CYRILLIC = $02; // Azeri (Cyrillic)
- SUBLANG_CHINESE_TRADITIONAL = $01; // Chinese (Taiwan)
- SUBLANG_CHINESE_SIMPLIFIED = $02; // Chinese (PR China)
- SUBLANG_CHINESE_HONGKONG = $03; // Chinese (Hong Kong S.A.R., P.R.C.)
- SUBLANG_CHINESE_SINGAPORE = $04; // Chinese (Singapore)
- SUBLANG_CHINESE_MACAU = $05; // Chinese (Macau S.A.R.)
- SUBLANG_DUTCH = $01; // Dutch
- SUBLANG_DUTCH_BELGIAN = $02; // Dutch (Belgian)
- SUBLANG_ENGLISH_US = $01; // English (USA)
- SUBLANG_ENGLISH_UK = $02; // English (UK)
- SUBLANG_ENGLISH_AUS = $03; // English (Australian)
- SUBLANG_ENGLISH_CAN = $04; // English (Canadian)
- SUBLANG_ENGLISH_NZ = $05; // English (New Zealand)
- SUBLANG_ENGLISH_EIRE = $06; // English (Irish)
- SUBLANG_ENGLISH_SOUTH_AFRICA = $07; // English (South Africa)
- SUBLANG_ENGLISH_JAMAICA = $08; // English (Jamaica)
- SUBLANG_ENGLISH_CARIBBEAN = $09; // English (Caribbean)
- SUBLANG_ENGLISH_BELIZE = $0a; // English (Belize)
- SUBLANG_ENGLISH_TRINIDAD = $0b; // English (Trinidad)
- SUBLANG_ENGLISH_ZIMBABWE = $0c; // English (Zimbabwe)
- SUBLANG_ENGLISH_PHILIPPINES = $0d; // English (Philippines)
- SUBLANG_FRENCH = $01; // French
- SUBLANG_FRENCH_BELGIAN = $02; // French (Belgian)
- SUBLANG_FRENCH_CANADIAN = $03; // French (Canadian)
- SUBLANG_FRENCH_SWISS = $04; // French (Swiss)
- SUBLANG_FRENCH_LUXEMBOURG = $05; // French (Luxembourg)
- SUBLANG_FRENCH_MONACO = $06; // French (Monaco)
- SUBLANG_GERMAN = $01; // German
- SUBLANG_GERMAN_SWISS = $02; // German (Swiss)
- SUBLANG_GERMAN_AUSTRIAN = $03; // German (Austrian)
- SUBLANG_GERMAN_LUXEMBOURG = $04; // German (Luxembourg)
- SUBLANG_GERMAN_LIECHTENSTEIN = $05; // German (Liechtenstein)
- SUBLANG_ITALIAN = $01; // Italian
- SUBLANG_ITALIAN_SWISS = $02; // Italian (Swiss)
- SUBLANG_KASHMIRI_SASIA = $02; // Kashmiri (South Asia)
- SUBLANG_KASHMIRI_INDIA = $02; // For app compatibility only
- SUBLANG_KOREAN = $01; // Korean (Extended Wansung)
- SUBLANG_LITHUANIAN = $01; // Lithuanian
- SUBLANG_MALAY_MALAYSIA = $01; // Malay (Malaysia)
- SUBLANG_MALAY_BRUNEI_DARUSSALAM = $02; // Malay (Brunei Darussalam)
- SUBLANG_NEPALI_INDIA = $02; // Nepali (India)
- SUBLANG_NORWEGIAN_BOKMAL = $01; // Norwegian (Bokmal)
- SUBLANG_NORWEGIAN_NYNORSK = $02; // Norwegian (Nynorsk)
- SUBLANG_PORTUGUESE = $02; // Portuguese
- SUBLANG_PORTUGUESE_BRAZILIAN = $01; // Portuguese (Brazilian)
- SUBLANG_SERBIAN_LATIN = $02; // Serbian (Latin)
- SUBLANG_SERBIAN_CYRILLIC = $03; // Serbian (Cyrillic)
- SUBLANG_SPANISH = $01; // Spanish (Castilian)
- SUBLANG_SPANISH_MEXICAN = $02; // Spanish (Mexican)
- SUBLANG_SPANISH_MODERN = $03; // Spanish (Spain)
- SUBLANG_SPANISH_GUATEMALA = $04; // Spanish (Guatemala)
- SUBLANG_SPANISH_COSTA_RICA = $05; // Spanish (Costa Rica)
- SUBLANG_SPANISH_PANAMA = $06; // Spanish (Panama)
- SUBLANG_SPANISH_DOMINICAN_REPUBLIC = $07; // Spanish (Dominican Republic)
- SUBLANG_SPANISH_VENEZUELA = $08; // Spanish (Venezuela)
- SUBLANG_SPANISH_COLOMBIA = $09; // Spanish (Colombia)
- SUBLANG_SPANISH_PERU = $0a; // Spanish (Peru)
- SUBLANG_SPANISH_ARGENTINA = $0b; // Spanish (Argentina)
- SUBLANG_SPANISH_ECUADOR = $0c; // Spanish (Ecuador)
- SUBLANG_SPANISH_CHILE = $0d; // Spanish (Chile)
- SUBLANG_SPANISH_URUGUAY = $0e; // Spanish (Uruguay)
- SUBLANG_SPANISH_PARAGUAY = $0f; // Spanish (Paraguay)
- SUBLANG_SPANISH_BOLIVIA = $10; // Spanish (Bolivia)
- SUBLANG_SPANISH_EL_SALVADOR = $11; // Spanish (El Salvador)
- SUBLANG_SPANISH_HONDURAS = $12; // Spanish (Honduras)
- SUBLANG_SPANISH_NICARAGUA = $13; // Spanish (Nicaragua)
- SUBLANG_SPANISH_PUERTO_RICO = $14; // Spanish (Puerto Rico)
- SUBLANG_SWEDISH = $01; // Swedish
- SUBLANG_SWEDISH_FINLAND = $02; // Swedish (Finland)
- SUBLANG_URDU_PAKISTAN = $01; // Urdu (Pakistan)
- SUBLANG_URDU_INDIA = $02; // Urdu (India)
- SUBLANG_UZBEK_LATIN = $01; // Uzbek (Latin)
- SUBLANG_UZBEK_CYRILLIC = $02; // Uzbek (Cyrillic)
-
- //
- // Sorting IDs.
- //
-
- SORT_DEFAULT = $0; // sorting default
-
- SORT_JAPANESE_XJIS = $0; // Japanese XJIS order
- SORT_JAPANESE_UNICODE = $1; // Japanese Unicode order
-
- SORT_CHINESE_BIG5 = $0; // Chinese BIG5 order
- SORT_CHINESE_PRCP = $0; // PRC Chinese Phonetic order
- SORT_CHINESE_UNICODE = $1; // Chinese Unicode order
- SORT_CHINESE_PRC = $2; // PRC Chinese Stroke Count order
- SORT_CHINESE_BOPOMOFO = $3; // Traditional Chinese Bopomofo order
-
- SORT_KOREAN_KSC = $0; // Korean KSC order
- SORT_KOREAN_UNICODE = $1; // Korean Unicode order
-
- SORT_GERMAN_PHONE_BOOK = $1; // German Phone Book order
-
- SORT_HUNGARIAN_DEFAULT = $0; // Hungarian Default order
- SORT_HUNGARIAN_TECHNICAL = $1; // Hungarian Technical order
-
- SORT_GEORGIAN_TRADITIONAL = $0; // Georgian Traditional order
- SORT_GEORGIAN_MODERN = $1; // Georgian Modern order
-
-
- { SYSTEM_INFO structure }
- PROCESSOR_INTEL_386 = 386;
- PROCESSOR_INTEL_486 = 486;
- PROCESSOR_INTEL_PENTIUM = 586;
- PROCESSOR_MIPS_R4000 = 4000;
- PROCESSOR_ALPHA_21064 = 21064;
- { FSCTL_SET_COMPRESSION }
- COMPRESSION_FORMAT_NONE = 0;
- COMPRESSION_FORMAT_DEFAULT = 1;
- COMPRESSION_FORMAT_LZNT1 = 2;
- { TAPE_GET_DRIVE_PARAMETERS structure }
- TAPE_DRIVE_COMPRESSION = 131072;
- TAPE_DRIVE_ECC = 65536;
- TAPE_DRIVE_ERASE_BOP_ONLY = 64;
- TAPE_DRIVE_ERASE_LONG = 32;
- TAPE_DRIVE_ERASE_IMMEDIATE = 128;
- TAPE_DRIVE_ERASE_SHORT = 16;
- TAPE_DRIVE_FIXED = 1;
- TAPE_DRIVE_FIXED_BLOCK = 1024;
- TAPE_DRIVE_INITIATOR = 4;
- TAPE_DRIVE_PADDING = 262144;
- TAPE_DRIVE_GET_ABSOLUTE_BLK = 1048576;
- TAPE_DRIVE_GET_LOGICAL_BLK = 2097152;
- TAPE_DRIVE_REPORT_SMKS = 524288;
- TAPE_DRIVE_SELECT = 2;
- TAPE_DRIVE_SET_EOT_WZ_SIZE = 4194304;
- TAPE_DRIVE_TAPE_CAPACITY = 256;
- TAPE_DRIVE_TAPE_REMAINING = 512;
- TAPE_DRIVE_VARIABLE_BLOCK = 2048;
- TAPE_DRIVE_WRITE_PROTECT = 4096;
- TAPE_DRIVE_ABS_BLK_IMMED = -(2147475456);
- TAPE_DRIVE_ABSOLUTE_BLK = -(2147479552);
- TAPE_DRIVE_END_OF_DATA = -(2147418112);
- TAPE_DRIVE_FILEMARKS = -(2147221504);
- TAPE_DRIVE_LOAD_UNLOAD = -(2147483647);
- TAPE_DRIVE_LOAD_UNLD_IMMED = -(2147483616);
- TAPE_DRIVE_LOCK_UNLOCK = -(2147483644);
- TAPE_DRIVE_LOCK_UNLK_IMMED = -(2147483520);
- TAPE_DRIVE_LOG_BLK_IMMED = -(2147450880);
- TAPE_DRIVE_LOGICAL_BLK = -(2147467264);
- TAPE_DRIVE_RELATIVE_BLKS = -(2147352576);
- TAPE_DRIVE_REVERSE_POSITION = -(2143289344);
- TAPE_DRIVE_REWIND_IMMEDIATE = -(2147483640);
- TAPE_DRIVE_SEQUENTIAL_FMKS = -(2146959360);
- TAPE_DRIVE_SEQUENTIAL_SMKS = -(2145386496);
- TAPE_DRIVE_SET_BLOCK_SIZE = -(2147483632);
- TAPE_DRIVE_SET_COMPRESSION = -(2147483136);
- TAPE_DRIVE_SET_ECC = -(2147483392);
- TAPE_DRIVE_SET_PADDING = -(2147482624);
- TAPE_DRIVE_SET_REPORT_SMKS = -(2147481600);
- TAPE_DRIVE_SETMARKS = -(2146435072);
- TAPE_DRIVE_SPACE_IMMEDIATE = -(2139095040);
- TAPE_DRIVE_TENSION = -(2147483646);
- TAPE_DRIVE_TENSION_IMMED = -(2147483584);
- TAPE_DRIVE_WRITE_FILEMARKS = -(2113929216);
- TAPE_DRIVE_WRITE_LONG_FMKS = -(2013265920);
- TAPE_DRIVE_WRITE_MARK_IMMED = -(1879048192);
- TAPE_DRIVE_WRITE_SETMARKS = -(2130706432);
- TAPE_DRIVE_WRITE_SHORT_FMKS = -(2080374784);
- { ACCESS_MASK, ACCESS TYPES }
-// DELETE = $00010000; //+winnt // The name conflicts with Delete procedure
- READ_CONTROL = $00020000; //+winnt
- WRITE_DAC = $00040000; //winnt
- WRITE_OWNER = $00080000; //winnt
- SYNCHRONIZE = $00100000; //winnt
- //
- // MaximumAllowed access type
- //
- MAXIMUM_ALLOWED = $2000000; //winnt
- GENERIC_READ = $80000000; //winnt
- GENERIC_WRITE = $40000000; //winnt
- GENERIC_EXECUTE = $20000000; //+winnt
- GENERIC_ALL = $10000000; //winnt
- { Standard rights }
- STANDARD_RIGHTS_REQUIRED = $f0000; //winnt
- STANDARD_RIGHTS_WRITE = READ_CONTROL; //~winnt
- STANDARD_RIGHTS_READ = READ_CONTROL; //~winnt
- STANDARD_RIGHTS_EXECUTE = READ_CONTROL; //~winnt
- STANDARD_RIGHTS_ALL = $1f0000;
- SPECIFIC_RIGHTS_ALL = $ffff;
- //
- // AccessSystemAcl access type
- //
- ACCESS_SYSTEM_SECURITY = $1000000;
- { SID }
- /////////////////////////////////////////////////////////////////////////////
- // //
- // Universal well-known SIDs //
- // //
- // Null SID S-1-0-0 //
- // World S-1-1-0 //
- // Local S-1-2-0 //
- // Creator Owner ID S-1-3-0 //
- // Creator Group ID S-1-3-1 //
- // Creator Owner Server ID S-1-3-2 //
- // Creator Group Server ID S-1-3-3 //
- // //
- // (Non-unique IDs) S-1-4 //
- // //
- /////////////////////////////////////////////////////////////////////////////
-
- SECURITY_NULL_SID_AUTHORITY : SID_IDENTIFIER_AUTHORITY_REC = ( 0,0,0,0,0,0); //+winnt
- SECURITY_WORLD_SID_AUTHORITY : SID_IDENTIFIER_AUTHORITY_REC = (0,0,0,0,0,1); //+winnt
- SECURITY_LOCAL_SID_AUTHORITY : SID_IDENTIFIER_AUTHORITY_REC = (0,0,0,0,0,2); //+winnt
- SECURITY_CREATOR_SID_AUTHORITY : SID_IDENTIFIER_AUTHORITY_REC = (0,0,0,0,0,3);//+winnt
- SECURITY_NON_UNIQUE_AUTHORITY : SID_IDENTIFIER_AUTHORITY_REC = (0,0,0,0,0,4); //+winnt
- SECURITY_NULL_RID = 0; //winnt
- SECURITY_WORLD_RID = 0; //winnt
- SECURITY_LOCAL_RID = 0; //winnt
- SECURITY_CREATOR_OWNER_RID = 0; //winnt
- SECURITY_CREATOR_GROUP_RID = $1; //winnt
- SECURITY_CREATOR_OWNER_SERVER_RID = $2; //+winnt
- SECURITY_CREATOR_GROUP_SERVER_RID = $3; //+winnt
- /////////////////////////////////////////////////////////////////////////////
- // //
- // NT well-known SIDs //
- // //
- // NT Authority S-1-5 //
- // Dialup S-1-5-1 //
- // //
- // Network S-1-5-2 //
- // Batch S-1-5-3 //
- // Interactive S-1-5-4 //
- // Service S-1-5-6 //
- // AnonymousLogon S-1-5-7 (aka null logon session) //
- // Proxy S-1-5-8 //
- // ServerLogon S-1-5-9 (aka domain controller account) //
- // Self S-1-5-10 (self RID) //
- // Authenticated User S-1-5-11 (Authenticated user somewhere) //
- // Restricted Code S-1-5-12 (Running restricted code) //
- // //
- // (Logon IDs) S-1-5-5-X-Y //
- // //
- // (NT non-unique IDs) S-1-5-0x15-... //
- // //
- // (Built-in domain) s-1-5-0x20 //
- // //
- /////////////////////////////////////////////////////////////////////////////
- SECURITY_NT_AUTHORITY : SID_IDENTIFIER_AUTHORITY_REC = (0,0,0,0,0,5); //+winnt
-
- SECURITY_DIALUP_RID = $1; //winnt
- SECURITY_NETWORK_RID = $2; //winnt
- SECURITY_BATCH_RID = $3; //winnt
- SECURITY_INTERACTIVE_RID = $4; //winnt
- SECURITY_LOGON_IDS_RID = $5; //winnt
- SECURITY_LOGON_IDS_RID_COUNT = $3; //winnt
- SECURITY_SERVICE_RID = $6; //winnt
- SECURITY_ANONYMOUS_LOGON_RID = $00000007; //+winnt
- SECURITY_PROXY_RID = $00000008; //+winnt
- SECURITY_ENTERPRISE_CONTROLLERS_RID = $00000009; //+winnt
- SECURITY_SERVER_LOGON_RID = SECURITY_ENTERPRISE_CONTROLLERS_RID; //+winnt
- SECURITY_PRINCIPAL_SELF_RID = $0000000A; //+winnt
- SECURITY_AUTHENTICATED_USER_RID = $0000000B; //+winnt
- SECURITY_RESTRICTED_CODE_RID = $0000000C; //+winnt
-
- SECURITY_LOCAL_SYSTEM_RID = $12; //winnt
- SECURITY_NT_NON_UNIQUE = $00000015; //+winnt
- SECURITY_BUILTIN_DOMAIN_RID = $20; //winnt
- // Well-known users ...
- DOMAIN_USER_RID_ADMIN = $1f4; //winnt
- DOMAIN_USER_RID_GUEST = $1f5; //winnt
- DOMAIN_USER_RID_KRBTGT = $000001F6; //+winnt
- // well-known groups ...
- DOMAIN_GROUP_RID_ADMINS = $200; //winnt
- DOMAIN_GROUP_RID_USERS = $201; //winnt
- DOMAIN_GROUP_RID_GUESTS = $00000202; //+winnt
- DOMAIN_GROUP_RID_COMPUTERS = $00000203; //+winnt
- DOMAIN_GROUP_RID_CONTROLLERS = $00000204; //+winnt
- DOMAIN_GROUP_RID_CERT_ADMINS = $00000205; //+winnt
- DOMAIN_GROUP_RID_SCHEMA_ADMINS = $00000206; //+winnt
- DOMAIN_GROUP_RID_ENTERPRISE_ADMINS = $00000207; //+winnt
- // well-known aliases ...
- DOMAIN_ALIAS_RID_ADMINS = $220; //winnt
- DOMAIN_ALIAS_RID_USERS = $221; //winnt
- DOMAIN_ALIAS_RID_GUESTS = $222; //winnt
- DOMAIN_ALIAS_RID_POWER_USERS = $223; //winnt
- DOMAIN_ALIAS_RID_ACCOUNT_OPS = $224; //winnt
- DOMAIN_ALIAS_RID_SYSTEM_OPS = $225; //winnt
- DOMAIN_ALIAS_RID_PRINT_OPS = $226; //winnt
- DOMAIN_ALIAS_RID_BACKUP_OPS = $227; //winnt
- DOMAIN_ALIAS_RID_REPLICATOR = $228; //winnt
-
- //
- // Allocate the System Luid. The first 1000 LUIDs are reserved.
- // Use #999 here (0x3E7 = 999)
- //
- SYSTEM_LUID : LUID = ( LowPart: $3E7; HighPart: $0 );
- ANONYMOUS_LOGON_LUID : LUID = (LowPart: $3e6; HighPart: $0 );
-
- //
- // Group attributes
- //
- SE_GROUP_MANDATORY = $1; //winnt
- SE_GROUP_ENABLED_BY_DEFAULT = $2; //winnt
- SE_GROUP_ENABLED = $4; //winnt
- SE_GROUP_OWNER = $8; //winnt
- SE_GROUP_USE_FOR_DENY_ONLY = $00000010; //+winnt
- SE_GROUP_LOGON_ID = $c0000000; //winnt
-
- { ACL Defines }
- ACL_REVISION = 2;
- ACL_REVISION_DS = 4; //+winnt
- // This is the history of ACL revisions. Add a new one whenever
- // ACL_REVISION is updated
- ACL_REVISION1=1; //+winnt
- ACL_REVISION2=2; //+winnt
- ACL_REVISION3=3; //+winnt
- ACL_REVISION4=4; //+winnt
- MIN_ACL_REVISION=ACL_REVISION2; //+winnt
- MAX_ACL_REVISION=ACL_REVISION4; //+winnt
- { ACE_HEADER structure }
- ACCESS_MIN_MS_ACE_TYPE = $0; //+winnt
- ACCESS_ALLOWED_ACE_TYPE = $0;
- ACCESS_DENIED_ACE_TYPE = $1;
- SYSTEM_AUDIT_ACE_TYPE = $2;
- SYSTEM_ALARM_ACE_TYPE = $3;
- ACCESS_MAX_MS_V2_ACE_TYPE = $3; //+winnt
- ACCESS_ALLOWED_COMPOUND_ACE_TYPE = $4; //+winnt
- ACCESS_MAX_MS_V3_ACE_TYPE = $4;
-
- ACCESS_MIN_MS_OBJECT_ACE_TYPE = $5; //+winnt
- ACCESS_ALLOWED_OBJECT_ACE_TYPE = $5; //+winnt
- ACCESS_DENIED_OBJECT_ACE_TYPE = $6; //+winnt
- SYSTEM_AUDIT_OBJECT_ACE_TYPE = $7; //+winnt
- SYSTEM_ALARM_OBJECT_ACE_TYPE = $8; //+winnt
- ACCESS_MAX_MS_OBJECT_ACE_TYPE = $8; //+winnt
-
- ACCESS_MAX_MS_V4_ACE_TYPE = $8; //+winnt
- ACCESS_MAX_MS_ACE_TYPE = $8; //+winnt
-
- { ACE flags in the ACE_HEADER structure }
- //
- // The following are the inherit flags that go into the AceFlags field
- // of an Ace header.
- //
- OBJECT_INHERIT_ACE = $1; //winnt
- CONTAINER_INHERIT_ACE = $2; //winnt
- NO_PROPAGATE_INHERIT_ACE = $4; //winnt
- INHERIT_ONLY_ACE = $8; //winnt
- INHERITED_ACE = $10; //+winnt
- VALID_INHERIT_FLAGS = $1F; //+winnt
- // The following are the currently defined ACE flags that go into the
- // AceFlags field of an ACE header. Each ACE type has its own set of
- // AceFlags.
- //
- // SUCCESSFUL_ACCESS_ACE_FLAG - used only with system audit and alarm ACE
- // types to indicate that a message is generated for successful accesses.
- //
- // FAILED_ACCESS_ACE_FLAG - used only with system audit and alarm ACE types
- // to indicate that a message is generated for failed accesses.
- //
- //
- // SYSTEM_AUDIT and SYSTEM_ALARM AceFlags
- //
- // These control the signaling of audit and alarms for success or failure.
- //
- SUCCESSFUL_ACCESS_ACE_FLAG = $40; //winnt
- FAILED_ACCESS_ACE_FLAG = $80; //winnt
- { SECURITY_DESCRIPTOR_CONTROL }
- {SECURITY_DESCRIPTOR_REVISION = 1;already defined above }
- SECURITY_DESCRIPTOR_MIN_LENGTH = 20;
- SE_OWNER_DEFAULTED = 1;
- SE_GROUP_DEFAULTED = 2;
- SE_DACL_PRESENT = 4;
- SE_DACL_DEFAULTED = 8;
- SE_SACL_PRESENT = 16;
- SE_SACL_DEFAULTED = 32;
- SE_SELF_RELATIVE = 32768;
- { PRIVILEGE_SET }
- SE_PRIVILEGE_ENABLED_BY_DEFAULT = $1;
- SE_PRIVILEGE_ENABLED = $2;
- SE_PRIVILEGE_USED_FOR_ACCESS = $80000000;
- PRIVILEGE_SET_ALL_NECESSARY = $1;
- { OPENFILENAME structure }
- OFN_ALLOWMULTISELECT = $200;
- OFN_CREATEPROMPT = $2000;
- OFN_ENABLEHOOK = $20;
- OFN_ENABLETEMPLATE = $40;
- OFN_ENABLETEMPLATEHANDLE = $80;
- OFN_EXPLORER = $80000;
- OFN_EXTENSIONDIFFERENT = $400;
- OFN_FILEMUSTEXIST = $1000;
- OFN_HIDEREADONLY = $4;
- OFN_LONGNAMES = $200000;
- OFN_NOCHANGEDIR = $8;
- OFN_NODEREFERENCELINKS = $100000;
- OFN_NOLONGNAMES = $40000;
- OFN_NONETWORKBUTTON = $20000;
- OFN_NOREADONLYRETURN = $8000;
- OFN_NOTESTFILECREATE = $10000;
- OFN_NOVALIDATE = $100;
- OFN_OVERWRITEPROMPT = $2;
- OFN_PATHMUSTEXIST = $800;
- OFN_READONLY = $1;
- OFN_SHAREAWARE = $4000;
- OFN_SHOWHELP = $10;
- { SHAREVISTRING message }
- OFN_SHAREFALLTHROUGH = $2;
- OFN_SHARENOWARN = $1;
- OFN_SHAREWARN = 0;
- { Open/Save notifications }
- CDN_INITDONE = $fffffda7;
- CDN_SELCHANGE = $fffffda6;
- CDN_FOLDERCHANGE = $fffffda5;
- CDN_SHAREVIOLATION = $fffffda4;
- CDN_HELP = $fffffda3;
- CDN_FILEOK = $fffffda2;
- CDN_TYPECHANGE = $fffffda1;
- { Open/Save messages }
- CDM_GETFILEPATH = $465;
- CDM_GETFOLDERIDLIST = $467;
- CDM_GETFOLDERPATH = $466;
- CDM_GETSPEC = $464;
- CDM_HIDECONTROL = $469;
- CDM_SETCONTROLTEXT = $468;
- CDM_SETDEFEXT = $46a;
- { CHOOSECOLOR structure }
- CC_ENABLEHOOK = $10;
- CC_ENABLETEMPLATE = $20;
- CC_ENABLETEMPLATEHANDLE = $40;
- CC_FULLOPEN = $2;
- CC_PREVENTFULLOPEN = $4;
- CC_RGBINIT = $1;
- CC_SHOWHELP = $8;
- CC_SOLIDCOLOR = $80;
- { FINDREPLACE structure }
- FR_DIALOGTERM = $40;
- FR_DOWN = $1;
- FR_ENABLEHOOK = $100;
- FR_ENABLETEMPLATE = $200;
- FR_ENABLETEMPLATEHANDLE = $2000;
- FR_FINDNEXT = $8;
- FR_HIDEUPDOWN = $4000;
- FR_HIDEMATCHCASE = $8000;
- FR_HIDEWHOLEWORD = $10000;
- FR_MATCHCASE = $4;
- FR_NOMATCHCASE = $800;
- FR_NOUPDOWN = $400;
- FR_NOWHOLEWORD = $1000;
- FR_REPLACE = $10;
- FR_REPLACEALL = $20;
- FR_SHOWHELP = $80;
- FR_WHOLEWORD = $2;
- { CHOOSEFONT structure }
- CF_APPLY = $200;
- CF_ANSIONLY = $400;
- CF_BOTH = $3;
- CF_TTONLY = $40000;
- CF_EFFECTS = $100;
- CF_ENABLEHOOK = $8;
- CF_ENABLETEMPLATE = $10;
- CF_ENABLETEMPLATEHANDLE = $20;
- CF_FIXEDPITCHONLY = $4000;
- CF_FORCEFONTEXIST = $10000;
- CF_INITTOLOGFONTSTRUCT = $40;
- CF_LIMITSIZE = $2000;
- CF_NOOEMFONTS = $800;
- CF_NOFACESEL = $80000;
- CF_NOSCRIPTSEL = $800000;
- CF_NOSTYLESEL = $100000;
- CF_NOSIZESEL = $200000;
- CF_NOSIMULATIONS = $1000;
- CF_NOVECTORFONTS = $800;
- CF_NOVERTFONTS = $1000000;
- CF_PRINTERFONTS = $2;
- CF_SCALABLEONLY = $20000;
- CF_SCREENFONTS = $1;
- CF_SCRIPTSONLY = $400;
- CF_SELECTSCRIPT = $400000;
- CF_SHOWHELP = $4;
- CF_USESTYLE = $80;
- CF_WYSIWYG = $8000;
- BOLD_FONTTYPE = $100;
- ITALIC_FONTTYPE = $200;
- PRINTER_FONTTYPE = $4000;
- REGULAR_FONTTYPE = $400;
- SCREEN_FONTTYPE = $2000;
- SIMULATED_FONTTYPE = $8000;
- { Common dialog messages }
- COLOROKSTRINGW = 'commdlg_ColorOK';
- FILEOKSTRINGW = 'commdlg_FileNameOK';
- FINDMSGSTRINGW = 'commdlg_FindReplace';
- HELPMSGSTRINGW = 'commdlg_help';
- LBSELCHSTRINGW = 'commdlg_LBSelChangedNotify';
- SETRGBSTRINGW = 'commdlg_SetRGBColor';
- SHAREVISTRINGW = 'commdlg_ShareViolation';
- COLOROKSTRINGA = 'commdlg_ColorOK';
- FILEOKSTRINGA = 'commdlg_FileNameOK';
- FINDMSGSTRINGA = 'commdlg_FindReplace';
- HELPMSGSTRINGA = 'commdlg_help';
- LBSELCHSTRINGA = 'commdlg_LBSelChangedNotify';
- SETRGBSTRINGA = 'commdlg_SetRGBColor';
- SHAREVISTRINGA = 'commdlg_ShareViolation';
-{$ifdef UNICODE}
-
- const
- COLOROKSTRING = COLOROKSTRINGW;
- FILEOKSTRING = FILEOKSTRINGW;
- FINDMSGSTRING = FINDMSGSTRINGW;
- HELPMSGSTRING = HELPMSGSTRINGW;
- LBSELCHSTRING = LBSELCHSTRINGW;
- SETRGBSTRING = SETRGBSTRINGW;
- SHAREVISTRING = SHAREVISTRINGW;
-{$else}
-
- const
- COLOROKSTRING = COLOROKSTRINGA;
- FILEOKSTRING = FILEOKSTRINGA;
- FINDMSGSTRING = FINDMSGSTRINGA;
- HELPMSGSTRING = HELPMSGSTRINGA;
- LBSELCHSTRING = LBSELCHSTRINGA;
- SETRGBSTRING = SETRGBSTRINGA;
- SHAREVISTRING = SHAREVISTRINGA;
-{$endif}
- { LBSELCHSTRING message }
-
- const
- CD_LBSELCHANGE = 0;
- CD_LBSELADD = 2;
- CD_LBSELSUB = 1;
- CD_LBSELNOITEMS = -(1);
- { DEVNAMES structure }
- DN_DEFAULTPRN = 1;
- { PRINTDLG structure }
- PD_ALLPAGES = 0;
- PD_COLLATE = 16;
- PD_DISABLEPRINTTOFILE = 524288;
- PD_ENABLEPRINTHOOK = 4096;
- PD_ENABLEPRINTTEMPLATE = 16384;
- PD_ENABLEPRINTTEMPLATEHANDLE = 65536;
- PD_ENABLESETUPHOOK = 8192;
- PD_ENABLESETUPTEMPLATE = 32768;
- PD_ENABLESETUPTEMPLATEHANDLE = 131072;
- PD_HIDEPRINTTOFILE = 1048576;
- PD_NOPAGENUMS = 8;
- PD_NOSELECTION = 4;
- PD_NOWARNING = 128;
- PD_PAGENUMS = 2;
- PD_PRINTSETUP = 64;
- PD_PRINTTOFILE = 32;
- PD_RETURNDC = 256;
- PD_RETURNDEFAULT = 1024;
- PD_RETURNIC = 512;
- PD_SELECTION = 1;
- PD_SHOWHELP = 2048;
- PD_USEDEVMODECOPIES = 262144;
- PD_USEDEVMODECOPIESANDCOLLATE = 262144;
- { PAGESETUPDLG structure }
- PSD_DEFAULTMINMARGINS = 0;
- PSD_DISABLEMARGINS = 16;
- PSD_DISABLEORIENTATION = 256;
- PSD_DISABLEPAGEPAINTING = 524288;
- PSD_DISABLEPAPER = 512;
- PSD_DISABLEPRINTER = 32;
- PSD_ENABLEPAGEPAINTHOOK = 262144;
- PSD_ENABLEPAGESETUPHOOK = 8192;
- PSD_ENABLEPAGESETUPTEMPLATE = 32768;
- PSD_ENABLEPAGESETUPTEMPLATEHANDLE = 131072;
- PSD_INHUNDREDTHSOFMILLIMETERS = 8;
- PSD_INTHOUSANDTHSOFINCHES = 4;
- PSD_INWININIINTLMEASURE = 0;
- PSD_MARGINS = 2;
- PSD_MINMARGINS = 1;
- PSD_NOWARNING = 128;
- PSD_RETURNDEFAULT = 1024;
- PSD_SHOWHELP = 2048;
- { WM_SHOWWINDOW message }
- SW_OTHERUNZOOM = 4;
- SW_OTHERZOOM = 2;
- SW_PARENTCLOSING = 1;
- SW_PARENTOPENING = 3;
- { Virtual Key codes }
- VK_LBUTTON = 1;
- VK_RBUTTON = 2;
- VK_CANCEL = 3;
- VK_MBUTTON = 4;
- VK_BACK = 8;
- VK_TAB = 9;
- VK_CLEAR = 12;
- VK_RETURN = 13;
- VK_SHIFT = 16;
- VK_CONTROL = 17;
- VK_MENU = 18;
- VK_PAUSE = 19;
- VK_CAPITAL = 20;
- VK_ESCAPE = 27;
- VK_SPACE = 32;
- VK_PRIOR = 33;
- VK_NEXT = 34;
- VK_END = 35;
- VK_HOME = 36;
- VK_LEFT = 37;
- VK_UP = 38;
- VK_RIGHT = 39;
- VK_DOWN = 40;
- VK_SELECT = 41;
- VK_PRINT = 42;
- VK_EXECUTE = 43;
- VK_SNAPSHOT = 44;
- VK_INSERT = 45;
- VK_DELETE = 46;
- VK_HELP = 47;
- VK_0 = 48;
- VK_1 = 49;
- VK_2 = 50;
- VK_3 = 51;
- VK_4 = 52;
- VK_5 = 53;
- VK_6 = 54;
- VK_7 = 55;
- VK_8 = 56;
- VK_9 = 57;
- VK_A = 65;
- VK_B = 66;
- VK_C = 67;
- VK_D = 68;
- VK_E = 69;
- VK_F = 70;
- VK_G = 71;
- VK_H = 72;
- VK_I = 73;
- VK_J = 74;
- VK_K = 75;
- VK_L = 76;
- VK_M = 77;
- VK_N = 78;
- VK_O = 79;
- VK_P = 80;
- VK_Q = 81;
- VK_R = 82;
- VK_S = 83;
- VK_T = 84;
- VK_U = 85;
- VK_V = 86;
- VK_W = 87;
- VK_X = 88;
- VK_Y = 89;
- VK_Z = 90;
- VK_LWIN = 91;
- VK_RWIN = 92;
- VK_APPS = 93;
- VK_NUMPAD0 = 96;
- VK_NUMPAD1 = 97;
- VK_NUMPAD2 = 98;
- VK_NUMPAD3 = 99;
- VK_NUMPAD4 = 100;
- VK_NUMPAD5 = 101;
- VK_NUMPAD6 = 102;
- VK_NUMPAD7 = 103;
- VK_NUMPAD8 = 104;
- VK_NUMPAD9 = 105;
- VK_MULTIPLY = 106;
- VK_ADD = 107;
- VK_SEPARATOR = 108;
- VK_SUBTRACT = 109;
- VK_DECIMAL = 110;
- VK_DIVIDE = 111;
- VK_F1 = 112;
- VK_F2 = 113;
- VK_F3 = 114;
- VK_F4 = 115;
- VK_F5 = 116;
- VK_F6 = 117;
- VK_F7 = 118;
- VK_F8 = 119;
- VK_F9 = 120;
- VK_F10 = 121;
- VK_F11 = 122;
- VK_F12 = 123;
- VK_F13 = 124;
- VK_F14 = 125;
- VK_F15 = 126;
- VK_F16 = 127;
- VK_F17 = 128;
- VK_F18 = 129;
- VK_F19 = 130;
- VK_F20 = 131;
- VK_F21 = 132;
- VK_F22 = 133;
- VK_F23 = 134;
- VK_F24 = 135;
- { GetAsyncKeyState }
- VK_NUMLOCK = 144;
- VK_SCROLL = 145;
- VK_LSHIFT = 160;
- VK_LCONTROL = 162;
- VK_LMENU = 164;
- VK_RSHIFT = 161;
- VK_RCONTROL = 163;
- VK_RMENU = 165;
- { ImmGetVirtualKey }
- VK_PROCESSKEY = 229;
- { Keystroke Message Flags }
- KF_ALTDOWN = 8192;
- KF_DLGMODE = 2048;
- KF_EXTENDED = 256;
- KF_MENUMODE = 4096;
- KF_REPEAT = 16384;
- KF_UP = 32768;
- { GetKeyboardLayoutName }
- KL_NAMELENGTH = 9;
- { WM_ACTIVATE message }
- WA_ACTIVE = 1;
- WA_CLICKACTIVE = 2;
- WA_INACTIVE = 0;
- { WM_ACTIVATE message }
- PWR_CRITICALRESUME = 3;
- PWR_SUSPENDREQUEST = 1;
- PWR_SUSPENDRESUME = 2;
- PWR_FAIL = -(1);
- PWR_OK = 1;
- { WM_NOTIFYFORMAT message }
- NF_QUERY = 3;
- NF_REQUERY = 4;
- NFR_ANSI = 1;
- NFR_UNICODE = 2;
- { WM_SIZING message }
- WMSZ_BOTTOM = 6;
- WMSZ_BOTTOMLEFT = 7;
- WMSZ_BOTTOMRIGHT = 8;
- WMSZ_LEFT = 1;
- WMSZ_RIGHT = 2;
- WMSZ_TOP = 3;
- WMSZ_TOPLEFT = 4;
- WMSZ_TOPRIGHT = 5;
- { WM_MOUSEACTIVATE message }
- MA_ACTIVATE = 1;
- MA_ACTIVATEANDEAT = 2;
- MA_NOACTIVATE = 3;
- MA_NOACTIVATEANDEAT = 4;
- { WM_SIZE message }
- SIZE_MAXHIDE = 4;
- SIZE_MAXIMIZED = 2;
- SIZE_MAXSHOW = 3;
- SIZE_MINIMIZED = 1;
- SIZE_RESTORED = 0;
- { WM_NCCALCSIZE message }
- WVR_ALIGNTOP = 16;
- WVR_ALIGNLEFT = 32;
- WVR_ALIGNBOTTOM = 64;
- WVR_ALIGNRIGHT = 128;
- WVR_HREDRAW = 256;
- WVR_VREDRAW = 512;
- WVR_REDRAW = 768;
- WVR_VALIDRECTS = 1024;
- { WM_NCHITTEST message }
- HTBOTTOM = 15;
- HTBOTTOMLEFT = 16;
- HTBOTTOMRIGHT = 17;
- HTCAPTION = 2;
- HTCLIENT = 1;
- HTERROR = -(2);
- HTGROWBOX = 4;
- HTHSCROLL = 6;
- HTLEFT = 10;
- HTMENU = 5;
- HTNOWHERE = 0;
- HTREDUCE = 8;
- HTRIGHT = 11;
- HTSIZE = 4;
- HTSYSMENU = 3;
- HTTOP = 12;
- HTTOPLEFT = 13;
- HTTOPRIGHT = 14;
- HTTRANSPARENT = -(1);
- HTVSCROLL = 7;
- HTZOOM = 9;
- { Mouse messages }
- MK_CONTROL = 8;
- MK_LBUTTON = 1;
- MK_MBUTTON = 16;
- MK_RBUTTON = 2;
- MK_SHIFT = 4;
- { WNDCLASS structure }
- CS_BYTEALIGNCLIENT = 4096;
- CS_BYTEALIGNWINDOW = 8192;
- CS_CLASSDC = 64;
- CS_DBLCLKS = 8;
- CS_GLOBALCLASS = 16384;
- CS_HREDRAW = 2;
- CS_KEYCVTWINDOW = 4;
- CS_NOCLOSE = 512;
- CS_NOKEYCVT = 256;
- CS_OWNDC = 32;
- CS_PARENTDC = 128;
- CS_SAVEBITS = 2048;
- CS_VREDRAW = 1;
- DLGWINDOWEXTRA = 30;
- { ACCEL structure }
- FALT = 16;
- FCONTROL = 8;
- FNOINVERT = 2;
- FSHIFT = 4;
- FVIRTKEY = 1;
- { MENUITEMINFO structure }
- MIIM_CHECKMARKS = 8;
- MIIM_DATA = 32;
- MIIM_ID = 2;
- MIIM_STATE = 1;
- MIIM_SUBMENU = 4;
- MIIM_TYPE = 16;
- MFT_BITMAP = $4;
- MFT_MENUBARBREAK = $20;
- MFT_MENUBREAK = $40;
- MFT_OWNERDRAW = $100;
- MFT_RADIOCHECK = $200;
- MFT_RIGHTJUSTIFY = $4000;
- MFT_SEPARATOR = $800;
- MFT_STRING = 0;
- MFS_CHECKED = $8;
- MFS_DEFAULT = $1000;
- MFS_DISABLED = $3;
- MFS_ENABLED = 0;
- MFS_GRAYED = $3;
- MFS_HILITE = $80;
- MFS_UNCHECKED = 0;
- MFS_UNHILITE = 0;
- { SERIALKEYS structure }
- SERKF_AVAILABLE = 2;
- SERKF_INDICATOR = 4;
- SERKF_SERIALKEYSON = 1;
- { FILTERKEYS structure }
- FKF_AVAILABLE = 2;
- FKF_CLICKON = 64;
- FKF_FILTERKEYSON = 1;
- FKF_HOTKEYACTIVE = 4;
- FKF_HOTKEYSOUND = 16;
- FKF_CONFIRMHOTKEY = 8;
- FKF_INDICATOR = 32;
- { HELPINFO structure }
- HELPINFO_MENUITEM = 2;
- HELPINFO_WINDOW = 1;
- { WM_PRINT message }
- PRF_CHECKVISIBLE = $1;
- PRF_CHILDREN = $10;
- PRF_CLIENT = $4;
- PRF_ERASEBKGND = $8;
- PRF_NONCLIENT = $2;
- PRF_OWNED = $20;
- { MapWindowPoints }
- { was #define dname def_expr }
- function HWND_DESKTOP : HWND;
-
- { WM_SYSCOMMAND message }
-
- const
- SC_CLOSE = 61536;
- SC_CONTEXTHELP = 61824;
- SC_DEFAULT = 61792;
- SC_HOTKEY = 61776;
- SC_HSCROLL = 61568;
- SC_KEYMENU = 61696;
- SC_MAXIMIZE = 61488;
- SC_ZOOM = 61488;
- SC_MINIMIZE = 61472;
- SC_ICON = 61472;
- SC_MONITORPOWER = 61808;
- SC_MOUSEMENU = 61584;
- SC_MOVE = 61456;
- SC_NEXTWINDOW = 61504;
- SC_PREVWINDOW = 61520;
- SC_RESTORE = 61728;
- SC_SCREENSAVE = 61760;
- SC_SIZE = 61440;
- SC_TASKLIST = 61744;
- SC_VSCROLL = 61552;
- { DM_GETDEFID message }
- DC_HASDEFID = 21323;
- { WM_GETDLGCODE message }
- DLGC_BUTTON = 8192;
- DLGC_DEFPUSHBUTTON = 16;
- DLGC_HASSETSEL = 8;
- DLGC_RADIOBUTTON = 64;
- DLGC_STATIC = 256;
- DLGC_UNDEFPUSHBUTTON = 32;
- DLGC_WANTALLKEYS = 4;
- DLGC_WANTARROWS = 1;
- DLGC_WANTCHARS = 128;
- DLGC_WANTMESSAGE = 4;
- DLGC_WANTTAB = 2;
- { EM_SETMARGINS message }
- EC_LEFTMARGIN = 1;
- EC_RIGHTMARGIN = 2;
- EC_USEFONTINFO = 65535;
- { LB_SETCOUNT message }
- LB_ERR = -(1);
- LB_ERRSPACE = -(2);
- LB_OKAY = 0;
- { CB_DIR message }
- CB_ERR = -(1);
- CB_ERRSPACE = -(2);
- { WM_IME_CONTROL message }
- IMC_GETCANDIDATEPOS = 7;
- IMC_GETCOMPOSITIONFONT = 9;
- IMC_GETCOMPOSITIONWINDOW = 11;
- IMC_GETSTATUSWINDOWPOS = 15;
- IMC_CLOSESTATUSWINDOW = 33;
- IMC_OPENSTATUSWINDOW = 34;
- IMC_SETCANDIDATEPOS = 8;
- IMC_SETCOMPOSITIONFONT = 10;
- IMC_SETCOMPOSITIONWINDOW = 12;
- IMC_SETSTATUSWINDOWPOS = 16;
- { WM_IME_CONTROL message }
- IMN_CHANGECANDIDATE = 3;
- IMN_CLOSECANDIDATE = 4;
- IMN_CLOSESTATUSWINDOW = 1;
- IMN_GUIDELINE = 13;
- IMN_OPENCANDIDATE = 5;
- IMN_OPENSTATUSWINDOW = 2;
- IMN_SETCANDIDATEPOS = 9;
- IMN_SETCOMPOSITIONFONT = 10;
- IMN_SETCOMPOSITIONWINDOW = 11;
- IMN_SETCONVERSIONMODE = 6;
- IMN_SETOPENSTATUS = 8;
- IMN_SETSENTENCEMODE = 7;
- IMN_SETSTATUSWINDOWPOS = 12;
- IMN_PRIVATE = 14;
- { STICKYKEYS structure }
- SKF_AUDIBLEFEEDBACK = 64;
- SKF_AVAILABLE = 2;
- SKF_CONFIRMHOTKEY = 8;
- SKF_HOTKEYACTIVE = 4;
- SKF_HOTKEYSOUND = 16;
- SKF_INDICATOR = 32;
- SKF_STICKYKEYSON = 1;
- SKF_TRISTATE = 128;
- SKF_TWOKEYSOFF = 256;
- { MOUSEKEYS structure }
- MKF_AVAILABLE = 2;
- MKF_CONFIRMHOTKEY = 8;
- MKF_HOTKEYACTIVE = 4;
- MKF_HOTKEYSOUND = 16;
- MKF_INDICATOR = 32;
- MKF_MOUSEKEYSON = 1;
- MKF_MODIFIERS = 64;
- MKF_REPLACENUMBERS = 128;
- { SOUNDSENTRY structure }
- SSF_AVAILABLE = 2;
- SSF_SOUNDSENTRYON = 1;
- SSTF_BORDER = 2;
- SSTF_CHARS = 1;
- SSTF_DISPLAY = 3;
- SSTF_NONE = 0;
- SSGF_DISPLAY = 3;
- SSGF_NONE = 0;
- SSWF_CUSTOM = 4;
- SSWF_DISPLAY = 3;
- SSWF_NONE = 0;
- SSWF_TITLE = 1;
- SSWF_WINDOW = 2;
- { ACCESSTIMEOUT structure }
- ATF_ONOFFFEEDBACK = 2;
- ATF_TIMEOUTON = 1;
- { HIGHCONTRAST structure }
- HCF_AVAILABLE = 2;
- HCF_CONFIRMHOTKEY = 8;
- HCF_HIGHCONTRASTON = 1;
- HCF_HOTKEYACTIVE = 4;
- HCF_HOTKEYAVAILABLE = 64;
- HCF_HOTKEYSOUND = 16;
- HCF_INDICATOR = 32;
- { TOGGLEKEYS structure }
- TKF_AVAILABLE = 2;
- TKF_CONFIRMHOTKEY = 8;
- TKF_HOTKEYACTIVE = 4;
- TKF_HOTKEYSOUND = 16;
- TKF_TOGGLEKEYSON = 1;
- { Installable Policy }
- PP_DISPLAYERRORS = 1;
- { SERVICE_INFO structure }
- RESOURCEDISPLAYTYPE_DOMAIN = 1;
- RESOURCEDISPLAYTYPE_FILE = 4;
- RESOURCEDISPLAYTYPE_GENERIC = 0;
- RESOURCEDISPLAYTYPE_GROUP = 5;
- RESOURCEDISPLAYTYPE_SERVER = 2;
- RESOURCEDISPLAYTYPE_SHARE = 3;
- { KEY_EVENT_RECORD structure }
- CAPSLOCK_ON = 128;
- ENHANCED_KEY = 256;
- LEFT_ALT_PRESSED = 2;
- LEFT_CTRL_PRESSED = 8;
- NUMLOCK_ON = 32;
- RIGHT_ALT_PRESSED = 1;
- RIGHT_CTRL_PRESSED = 4;
- SCROLLLOCK_ON = 64;
- SHIFT_PRESSED = 16;
- { MOUSE_EVENT_RECORD structure }
- FROM_LEFT_1ST_BUTTON_PRESSED = 1;
- RIGHTMOST_BUTTON_PRESSED = 2;
- FROM_LEFT_2ND_BUTTON_PRESSED = 4;
- FROM_LEFT_3RD_BUTTON_PRESSED = 8;
- FROM_LEFT_4TH_BUTTON_PRESSED = 16;
- DOUBLE_CLICK = 2;
- MOUSE_MOVED = 1;
- { INPUT_RECORD structure }
- KEY_EVENT = 1;
- _MOUSE_EVENT = 2; {conflict with function mouse_event}
- cMOUSE_EVENT = 2;
- WINDOW_BUFFER_SIZE_EVENT = 4;
- MENU_EVENT = 8;
- FOCUS_EVENT = 16;
- { BITMAPINFOHEADER structure }
- BI_RGB = 0;
- BI_RLE8 = 1;
- BI_RLE4 = 2;
- BI_BITFIELDS = 3;
- { Extensions to OpenGL }
- { ChoosePixelFormat }
- PFD_DOUBLEBUFFER = $1;
- PFD_STEREO = $2;
- PFD_DRAW_TO_WINDOW = $4;
- PFD_DRAW_TO_BITMAP = $8;
- PFD_SUPPORT_GDI = $10;
- PFD_SUPPORT_OPENGL = $20;
- PFD_DEPTH_DONTCARE = $20000000;
- PFD_DOUBLEBUFFER_DONTCARE = $40000000;
- PFD_STEREO_DONTCARE = $80000000;
- PFD_TYPE_RGBA = 0;
- PFD_TYPE_COLORINDEX = 1;
- PFD_MAIN_PLANE = 0;
- PFD_OVERLAY_PLANE = 1;
- PFD_UNDERLAY_PLANE = -(1);
- { wglUseFontOutlines }
- WGL_FONT_LINES = 0;
- WGL_FONT_POLYGONS = 1;
- { LAYERPLANEDESCRIPTOR structure }
- { PIXELFORMATDESCRIPTOR structure }
- PFD_GENERIC_FORMAT = $40;
- PFD_NEED_PALETTE = $80;
- PFD_NEED_SYSTEM_PALETTE = $100;
- PFD_SWAP_EXCHANGE = $200;
- PFD_SWAP_COPY = $400;
- PFD_SWAP_LAYER_BUFFERS = $800;
- PFD_GENERIC_ACCELERATED = $1000;
- PFD_SUPPORT_DIRECTDRAW = $2000;
- { TEXTMETRIC structure }
- TMPF_FIXED_PITCH = $1;
- TMPF_VECTOR = $2;
- TMPF_TRUETYPE = $4;
- TMPF_DEVICE = $8;
- WM_CTLCOLOR = 25;
-
- { --------------------- old stuff, need to organize! --------------- }
- { BEGINNING of windowsx.h stuff from old headers: }
- { Not convertable by H2PAS
- #define __CRACK_VOID_F(fn,args) (void)(fn args)
- #define __CRACK_BOOL_F(fn,args) (BOOL)(fn args)
- #define __CRACK_HMENU_F(fn,args) (HMENU)(fn args)
- #define __CRACK_HWND_F(fn,args) (HWND)(fn args)
- #define __CRACK_LONG_F(fn, args) (LRESULT)(fn args)
- #define __CRACK_ZERO_F(fn, args) (fn args,0)
- }
- { was #define dname(params) def_expr }
- function GetFirstChild(h:HWND):HWND;
-
- { was #define dname(params) def_expr }
- function GetNextSibling(h:HWND):HWND;
-
- { was #define dname(params) def_expr }
- function GetWindowID(h:HWND):longint;
-
- { was #define dname(params) def_expr }
- function SubclassWindow(h:HWND; p:LONG):LONG;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- { return type might be wrong }
- function GET_WM_COMMAND_CMD(w,l : longint) : longint;
- { return type might be wrong }
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- { return type might be wrong }
- function GET_WM_COMMAND_ID(w,l : longint) : longint;
- { return type might be wrong }
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- function GET_WM_CTLCOLOR_HDC(w,l,msg : longint) : HDC;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- function GET_WM_CTLCOLOR_HWND(w,l,msg : longint) : HWND;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- { return type might be wrong }
- function GET_WM_HSCROLL_CODE(w,l : longint) : longint;
- { return type might be wrong }
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- function GET_WM_HSCROLL_HWND(w,l : longint) : HWND;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- { return type might be wrong }
- function GET_WM_HSCROLL_POS(w,l : longint) : longint;
- { return type might be wrong }
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- { return type might be wrong }
- function GET_WM_MDIACTIVATE_FACTIVATE(h,a,b : longint) : longint;
- { return type might be wrong }
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- function GET_WM_MDIACTIVATE_HWNDACTIVATE(a,b : longint) : HWND;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- function GET_WM_MDIACTIVATE_HWNDDEACT(a,b : longint) : HWND;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- { return type might be wrong }
- function GET_WM_VSCROLL_CODE(w,l : longint) : longint;
- { return type might be wrong }
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- function GET_WM_VSCROLL_HWND(w,l : longint) : HWND;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- { return type might be wrong }
- function GET_WM_VSCROLL_POS(w,l : longint) : longint;
- { return type might be wrong }
-
- { Not convertable by H2PAS
- #define FORWARD_WM_CLOSE(h, fn) __CRACK_VOID_F(fn,(h, WM_CLOSE, 0, 0))
- #define FORWARD_WM_COMMAND(h, id, c, n, fn) __CRACK_VOID_F(fn,(h, WM_COMMAND, MAKEWPARAM(id,n), (LPARAM)c))
- #define FORWARD_WM_CREATE(h, p, fn) __CRACK_BOOL_F(fn,(h, WM_CREATE, 0, (LPARAM)p))
- #define FORWARD_WM_DESTROY(h, fn) __CRACK_VOID_F(fn,(h, WM_DESTROY, 0, 0))
- #define FORWARD_WM_ENABLE(h, e, fn) __CRACK_VOID_F(fn,(h, WM_ENABLE, (WPARAM)e, 0))
- #define FORWARD_WM_INITDIALOG(h, c, l, fn) __CRACK_BOOL_F(fn,(h, WM_INITDIALOG, (WPARAM)c, l))
- #define FORWARD_WM_MDICASCADE(h, c, fn) __CRACK_BOOL_F(fn,(h, WM_MDICASCADE, (WPARAM)c, 0))
- #define FORWARD_WM_MDIDESTROY(h, d, fn) __CRACK_VOID_F(fn,(h, WM_MDIDESTROY, (WPARAM)d, 0))
- #define FORWARD_WM_MDIGETACTIVE(h, fn) __CRACK_HWND_F(fn,(h, WM_MDIGETACTIVE, 0, 0))
- #define FORWARD_WM_MDIICONARRANGE(h, fn) __CRACK_VOID_F(fn,(h, WM_MDIICONARRANGE, 0, 0))
- #define FORWARD_WM_MDISETMENU(h, fr, hf, hw, fn) __CRACK_HMENU_F(fn,(h, WM_MDISETMENU, (WPARAM)((fr) ? (hf) : 0), (LPARAM)(hw)))
- #define FORWARD_WM_MDITILE(h, c, fn) __CRACK_BOOL_F(fn,(h, WM_MDITILE, (WPARAM)(c), 0))
- #define FORWARD_WM_PAINT(h, fn) __CRACK_VOID_F(fn,(h, WM_PAINT, 0, 0))
- #define FORWARD_WM_QUERYENDSESSION(h, fn) __CRACK_BOOL_F(fn,(h, WM_QUERYENDSESSION, 0, 0))
- #define FORWARD_WM_SIZE(h, state, cx, cy, fn) __CRACK_VOID_F(fn,(h, WM_SIZE, (WPARAM)state, MAKELPARAM(cx, cy)))
- #define FORWARD_WM_SYSCOMMAND(h, c, x, y, fn) __CRACK_VOID_F(fn,(h, WM_SYSCOMMAND, (WPARAM)c, MAKELPARAM(x, y)))
-
- #define HANDLE_WM_CLOSE(h, w, l, fn) __CRACK_ZERO_F(fn,(h));
- #define HANDLE_WM_COMMAND(h, w, l, fn) __CRACK_ZERO_F(fn,(h, SEXT_LOWORD(w), (HWND)l, HIWORD(w)))
- #define HANDLE_WM_CREATE(h, w, l, fn) (LRESULT)((fn(h, (CREATESTRUCT )l)) ? 0 : -1)
- #define HANDLE_WM_DESTROY(h, w, l, fn) __CRACK_ZERO_F(fn,(h))
- #define HANDLE_WM_ENABLE(h, w, l, fn) __CRACK_ZERO_F(fn,(h, (BOOL)w))
- #define HANDLE_WM_INITDIALOG(h, w, l, fn) __CRACK_LONG_F(fn,(h, (HWND)w, l))
- #define HANDLE_WM_MDICASCADE(h, w, l, fn) __CRACK_LONG_F(fn, (h, (UINT)w)
- #define HANDLE_WM_MDIDESTROY(h, w, l, fn) __CRACK_ZERO_F(fn,(h, (HWND)w))
- #define HANDLE_WM_MDIGETACTIVE(h, w, l, fn) __CRACK_LONG_F(fn,(h))
- #define HANDLE_WM_MDIICONARRANGE(h, w, l, fn) __CRACK_ZERO_F(fn,(h))
- #define HANDLE_WM_MDISETMENU(h, w, l, fn) __CRACK_LONG_F(fn,(h, (BOOL)w, (HMENU)w, (HMENU)l)
- #define HANDLE_WM_MDITILE(h, w, l, fn) __CRACK_LONG_F(fn,(h, (UINT)w))
- #define HANDLE_WM_PAINT(h, w, l, fn) __CRACK_ZERO_F(fn,(h))
- #define HANDLE_WM_QUERYENDSESSION(h, w, l, fn) MAKELRESULT(fn(h), 0)
- #define HANDLE_WM_SIZE(h, w, l, fn) __CRACK_ZERO_F(fn,(h, (UINT)w, SEXT_LOWORD(l), SEXT_HIWORD(l)))
- #define HANDLE_WM_SYSCOMMAND(h, w, l, fn) __CRACK_ZERO_F(fn,(h, (UINT)w, SEXT_LOWORD(l), SEXT_HIWORD(l)))
- }
- { Totally disgusting! get wParam and lParam from the environment ! }
- { Not convertable by H2PAS
- #define HANDLE_MSG(h, message, fn) case message: return HANDLE_##message(h, wParam, lParam, fn)
- }
- { END OF windowsx.h stuff from old headers }
- { ------------------------------------------------------------------ }
- { BEGINNING of shellapi.h stuff from old headers }
-
- const
- SE_ERR_SHARE = 26;
- SE_ERR_ASSOCINCOMPLETE = 27;
- SE_ERR_DDETIMEOUT = 28;
- SE_ERR_DDEFAIL = 29;
- SE_ERR_DDEBUSY = 30;
- SE_ERR_NOASSOC = 31;
- { END OF shellapi.h stuff from old headers }
- { ------------------------------------------------------------------ }
- { From ddeml.h in old Cygnus headers }
- XCLASS_BOOL = $1000;
- XCLASS_DATA = $2000;
- XCLASS_FLAGS = $4000;
- XCLASS_MASK = $fc00;
- XCLASS_NOTIFICATION = $8000;
- XTYPF_NOBLOCK = $0002;
- XTYP_ADVDATA = $4010;
- XTYP_ADVREQ = $2022;
- XTYP_ADVSTART = $1030;
- XTYP_ADVSTOP = $8040;
- XTYP_CONNECT = $1062;
- XTYP_CONNECT_CONFIRM = $8072;
- XTYP_DISCONNECT = $80c2;
- XTYP_EXECUTE = $4050;
- XTYP_POKE = $4090;
- XTYP_REQUEST = $20b0;
- XTYP_WILDCONNECT = $20E2;
- XTYP_REGISTER = $80A2;
- XTYP_ERROR = $8002;
- XTYP_XACT_COMPLETE = $8080;
- XTYP_UNREGISTER = $80D2;
- DMLERR_DLL_USAGE = $4004;
- DMLERR_INVALIDPARAMETER = $4006;
- DMLERR_NOTPROCESSED = $4009;
- DMLERR_POSTMSG_FAILED = $400c;
- DMLERR_SERVER_DIED = $400e;
- DMLERR_SYS_ERROR = $400f;
- DMLERR_BUSY = $4001;
- DMLERR_DATAACKTIMEOUT = $4002;
- DMLERR_ADVACKTIMEOUT = $4000;
- DMLERR_DLL_NOT_INITIALIZED = $4003;
- DMLERR_LOW_MEMORY = $4007;
- DMLERR_MEMORY_ERROR = $4008;
- DMLERR_POKEACKTIMEOUT = $400b;
- DMLERR_NO_CONV_ESTABLISHED = $400a;
- DMLERR_REENTRANCY = $400d;
- DMLERR_UNFOUND_QUEUE_ID = $4011;
- DMLERR_UNADVACKTIMEOUT = $4010;
- DMLERR_EXECACKTIMEOUT = $4005;
- DDE_FACK = $8000;
- DDE_FNOTPROCESSED = $0000;
- DNS_REGISTER = $0001;
- DNS_UNREGISTER = $0002;
- CP_WINANSI = 1004;
- CP_WINUNICODE = 1200;
- { Not convertable by H2PAS
- #define EXPENTRY CALLBACK
- }
- APPCLASS_STANDARD = $00000000;
- { End of stuff from ddeml.h in old Cygnus headers }
- { ----------------------------------------------- }
- BKMODE_LAST = 2;
- CTLCOLOR_MSGBOX = 0;
- CTLCOLOR_EDIT = 1;
- CTLCOLOR_LISTBOX = 2;
- CTLCOLOR_BTN = 3;
- CTLCOLOR_DLG = 4;
- CTLCOLOR_SCROLLBAR = 5;
- CTLCOLOR_STATIC = 6;
- CTLCOLOR_MAX = 7;
- META_SETMAPMODE = $0103;
- META_SETWINDOWORG = $020B;
- META_SETWINDOWEXT = $020C;
- POLYFILL_LAST = 2;
- STATUS_WAIT_0 = $00000000;
- STATUS_ABANDONED_WAIT_0 = $00000080;
- STATUS_USER_APC = $000000C0;
- STATUS_TIMEOUT = $00000102;
- STATUS_PENDING = $00000103;
- STATUS_GUARD_PAGE_VIOLATION = $80000001;
- STATUS_DATATYPE_MISALIGNMENT = $80000002;
- STATUS_BREAKPOINT = $80000003;
- STATUS_SINGLE_STEP = $80000004;
- STATUS_IN_PAGE_ERROR = $C0000006;
- STATUS_INVALID_HANDLE = $C0000008;
- STATUS_ILLEGAL_INSTRUCTION = $C000001D;
- STATUS_NONCONTINUABLE_EXCEPTION = $C0000025;
- STATUS_INVALID_DISPOSITION = $C0000026;
- STATUS_ARRAY_BOUNDS_EXCEEDED = $C000008C;
- STATUS_FLOAT_DENORMAL_OPERAND = $C000008D;
- STATUS_FLOAT_DIVIDE_BY_ZERO = $C000008E;
- STATUS_FLOAT_INEXACT_RESULT = $C000008F;
- STATUS_FLOAT_INVALID_OPERATION = $C0000090;
- STATUS_FLOAT_OVERFLOW = $C0000091;
- STATUS_FLOAT_STACK_CHECK = $C0000092;
- STATUS_FLOAT_UNDERFLOW = $C0000093;
- STATUS_INTEGER_DIVIDE_BY_ZERO = $C0000094;
- STATUS_INTEGER_OVERFLOW = $C0000095;
- STATUS_PRIVILEGED_INSTRUCTION = $C0000096;
- STATUS_STACK_OVERFLOW = $C00000FD;
- STATUS_CONTROL_C_EXIT = $C000013A;
-{$define EXCEPTION_CTRL_C}
- PROCESSOR_ARCHITECTURE_INTEL = 0;
- PROCESSOR_ARCHITECTURE_MIPS = 1;
- PROCESSOR_ARCHITECTURE_ALPHA = 2;
- PROCESSOR_ARCHITECTURE_PPC = 3;
- { was #define dname(params) def_expr }
- function FreeModule(h:HINST):WINBOOL;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- { return type might be wrong }
- function MakeProcInstance(p,i : longint) : longint;
- { return type might be wrong }
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- { return type might be wrong }
- function FreeProcInstance(p : longint) : longint;
- { return type might be wrong }
-
-
- const
- { _fmemcpy = memcpy; these are functions }
- { Used by wxwindows. }
- SIZEFULLSCREEN = SIZE_MAXIMIZED;
- SIZENORMAL = SIZE_RESTORED;
- SIZEICONIC = SIZE_MINIMIZED;
- { NPLOGPALETTE = PLOGPALETTE; probably a type }
- { In the old winnt.h }
- (* Not convertable by H2PAS anyhow with if 0
- #if 0
- #ifdef __ANAL__
- #define DECLARE_HANDLE(h) struct h##__ { int dummy; }; typedef struct h##__ h
- #else
- #define DECLARE_HANDLE(h) typedef void h
- #endif
- DECLARE_HANDLE(HANDLE);
- #endif
- *)
-
-{$ifdef i386} //+winnt
-
- { x86 }
- { The doc refered me to winnt.h, so I had to look... }
-
- const
- SIZE_OF_80387_REGISTERS = 80; //winnt
- MAXIMUM_SUPPORTED_EXTENSION = 512; //winnt
- { Values for contextflags }
- CONTEXT_i386 = $10000;
- CONTEXT_i486 = $10000; //+winnt
- CONTEXT_CONTROL = CONTEXT_i386 or 1;
- CONTEXT_INTEGER = CONTEXT_i386 or 2;
- CONTEXT_SEGMENTS = CONTEXT_i386 or 4;
- CONTEXT_FLOATING_POINT = CONTEXT_i386 or 8;
- CONTEXT_DEBUG_REGISTERS = CONTEXT_i386 or $10;
- CONTEXT_EXTENDED_REGISTERS = CONTEXT_i386 or $20; //+winnt
- CONTEXT_FULL = (CONTEXT_CONTROL or CONTEXT_INTEGER) or CONTEXT_SEGMENTS;
- { our own invention }
- FLAG_TRACE_BIT = $100;
- CONTEXT_DEBUGGER = CONTEXT_FULL or CONTEXT_FLOATING_POINT;
-{$endif i386}
-
-{$ifdef _MIPS_} //+winnt all block added
-//
-// Processor Feature Values used in IsProcessorFeaturePresent API
-//
- PF_MIPS_MIPSII = $81000001; // MIPSII instruction set
- PF_MIPS_MIPSIII = $81000002; // MIPSIII instruction set
- PF_MIPS_MIPSIV = $81000003; // MIPSIV instruction set
- PF_MIPS_SMART_ASE = $81000004; // MIPS smart card arch. specific ext.
- PF_MIPS_MIPS16 = $81000005; // MIPS16 instruction set
- PF_MIPS_MIPS32 = $81000006; // MIPS32 instruction set
- PF_MIPS_MIPS64 = $81000007; // MIPS64 instruction set
- PF_MIPS_FPU = $81000008; // FPU support
- PF_MIPS_CPU_4KEX = $81000009; // "R4K" exception model
- PF_MIPS_CPU_4KTLB = $8100000A; // "R4K" TLB handler
- PF_MIPS_CPU_32FPR = $8100000B; // 32 dbl. prec. FP registers
- PF_MIPS_CPU_COUNTER = $8100000C; // Cycle count/compare
- PF_MIPS_CPU_WATCH = $8100000D; // watchpoint registers
- PF_MIPS_CPU_DIVEC = $8100000E; // dedicated interrupt vector
- PF_MIPS_CPU_VCE = $8100000F; // virt. coherence conflict possible
- PF_MIPS_CPU_CACHE_CDEX = $81000010; // Create_Dirty_Exclusive CACHE op
- PF_MIPS_CPU_MCHECK = $81000011; // Machine check exception
- PF_MIPS_CPU_EJTAG = $81000012; // EJTAG exception
- PF_MIPS_PERF_COUNTER = $81000013; // perf counter
- PF_MIPS_ARCH_2 = $81000014; // arch. release 2
-
- CONTEXT_R4000 = $00010000; // r4000 context
-
- CONTEXT_CONTROL = CONTEXT_R4000 or $00000001;
- CONTEXT_FLOATING_POINT = CONTEXT_R4000 or $00000002;
- CONTEXT_INTEGER = CONTEXT_R4000 or $00000004;
- CONTEXT_EXTENDED_FLOAT = CONTEXT_FLOATING_POINT or $00000008;
- CONTEXT_EXTENDED_INTEGER = CONTEXT_INTEGER or $00000010;
- CONTEXT_FULL = CONTEXT_CONTROL or CONTEXT_FLOATING_POINT or
- CONTEXT_INTEGER or CONTEXT_EXTENDED_INTEGER;
-{$ifdef _MIPS64} //+winnt
- CONTEXT32_LENGTH=$1B8;
-{$else}
- CONTEXT32_LENGTH=$130; // The original 32-bit Context length (pre NT 4.0)
-{$endif _MIPS64}
-
-{$endif _MIPS_} //+winnt
-
-{$ifdef _PPC_} //~winnt, now _PPC_ instead of __PPC__, moved after mips
- const
- CONTEXT_CONTROL = 1;
- CONTEXT_FLOATING_POINT = 2;
- CONTEXT_INTEGER = 4;
- CONTEXT_DEBUG_REGISTERS = 8;
- CONTEXT_FULL = (CONTEXT_CONTROL or CONTEXT_FLOATING_POINT) or CONTEXT_INTEGER;
- CONTEXT_DEBUGGER = CONTEXT_FULL;
-{$endif _PPC_} //~winnt
-
-{$ifdef _MPPC_} //+winnt all block
- const
- CONTEXT_CONTROL = 1;
- CONTEXT_FLOATING_POINT = 2;
- CONTEXT_INTEGER = 4;
- CONTEXT_DEBUG_REGISTERS = 8;
- CONTEXT_FULL = (CONTEXT_CONTROL or CONTEXT_FLOATING_POINT) or CONTEXT_INTEGER;
-{$endif _MPPC_} //+winnt
-
-{$ifdef _IA64_} //+winnt all block
- SIZE_OF_80387_REGISTERS = 80;
- CONTEXT_IA64 = $00080000; // IA64 context
- CONTEXT_CONTROL = CONTEXT_IA64 or $00000001;
- CONTEXT_LOWER_FLOATING_POINT = CONTEXT_IA64 or $00000002;
- CONTEXT_HIGHER_FLOATING_POINT = CONTEXT_IA64 or $00000004;
- CONTEXT_INTEGER = CONTEXT_IA64 or $00000008;
- CONTEXT_DEBUG = CONTEXT_IA64 or $00000010;
-
- CONTEXT_FLOATING_POINT = CONTEXT_LOWER_FLOATING_POINT or CONTEXT_HIGHER_FLOATING_POINT;
- CONTEXT_FULL = CONTEXT_CONTROL or CONTEXT_FLOATING_POINT or CONTEXT_INTEGER;
-
- CONTEXT_i386 = $00010000; // this assumes that i386 and
- CONTEXT_i486 = $00010000; // i486 have identical context records
- CONTEXT_X86 = $00010000; // X86 have identical context records
-
- CONTEXT86_CONTROL = CONTEXT_i386 or $00000001; // SS:SP, CS:IP, FLAGS, BP
- CONTEXT86_INTEGER = CONTEXT_i386 or $00000002; // AX, BX, CX, DX, SI, DI
- CONTEXT86_SEGMENTS = CONTEXT_i386 or $00000004; // DS, ES, FS, GS
- CONTEXT86_FLOATING_POINT = CONTEXT_i386 or $00000008; // 387 state
- CONTEXT86_DEBUG_REGISTERS = CONTEXT_i386 or $00000010; // DB 0-3,6,7
-
- CONTEXT86_FULL = CONTEXT86_CONTROL or CONTEXT86_INTEGER or CONTEXT86_SEGMENTS; // context corresponding to set flags will be returned.
-{$endif _IA64_} //+winnt
-
-{$ifdef SHx} //+winnt all block added
-//
-// Processor Feature Values used in IsProcessorFeaturePresent API
-//
- PF_SHX_SH3 = $82000001;
- PF_SHX_SH4 = $82000002;
- PF_SHX_SH5 = $82000003;
- PF_SHX_DSP = $82000004;
- PF_SHX_FPU = $82000005;
-//
-// The following flags control the contents of the CONTEXT structure.
-//
- CONTEXT_SH3 = $00000040;
- CONTEXT_SH4 = $000000c0; // CONTEXT_SH3 | 0x80 - must contain the SH3 bits
-
-{$ifdef SH3}
- CONTEXT_CONTROL = CONTEXT_SH3 or $00000001;
- CONTEXT_INTEGER = CONTEXT_SH3 or $00000002;
- CONTEXT_DEBUG_REGISTERS = CONTEXT_SH3 or $00000008;
- CONTEXT_DSP_REGISTERS = CONTEXT_SH3 or $00000010;
- CONTEXT_FULL = CONTEXT_CONTROL or CONTEXT_INTEGER or CONTEXT_DEBUG_REGISTERS or CONTEXT_DSP_REGISTERS;
-{$else} // SH4
- CONTEXT_CONTROL = CONTEXT_SH4 or $00000001;
- CONTEXT_INTEGER = CONTEXT_SH4 or $00000002;
- CONTEXT_DEBUG_REGISTERS = CONTEXT_SH4 or $00000008;
- CONTEXT_FLOATING_POINT = CONTEXT_SH4 or $00000004;
- CONTEXT_FULL = CONTEXT_CONTROL or CONTEXT_INTEGER or CONTEXT_DEBUG_REGISTERS or CONTEXT_FLOATING_POINT;
-{$endif SH3}
-
-{$endif SHx} //+winnt
-
-{$ifdef CPUARM} //+winnt all block added
-//
-// Processor Feature Values used in IsProcessorFeaturePresent API
-//
- PF_ARM_V4 = $80000001;
- PF_ARM_V5 = $80000002;
- PF_ARM_V6 = $80000003;
- PF_ARM_V7 = $80000004;
- PF_ARM_THUMB = $80000005;
- PF_ARM_JAZELLE = $80000006;
- PF_ARM_DSP = $80000007;
- PF_ARM_MOVE_CP = $80000008;
- PF_ARM_VFP10 = $80000009;
- PF_ARM_MPU = $8000000A;
- PF_ARM_WRITE_BUFFER = $8000000B;
- PF_ARM_MBX = $8000000C;
- PF_ARM_L2CACHE = $8000000D;
- PF_ARM_PHYSICALLY_TAGGED_CACHE = $8000000E;
- PF_ARM_VFP_SINGLE_PRECISION = $8000000F;
- PF_ARM_VFP_DOUBLE_PRECISION = $80000010;
- PF_ARM_ITCM = $80000011;
- PF_ARM_DTCM = $80000012;
- PF_ARM_UNIFIED_CACHE = $80000013;
- PF_ARM_WRITE_BACK_CACHE = $80000014;
- PF_ARM_CACHE_CAN_BE_LOCKED_DOWN = $80000015;
- PF_ARM_L2CACHE_MEMORY_MAPPED = $80000016;
- PF_ARM_L2CACHE_COPROC = $80000017;
-
-
-// Specific OEM extentions
- PF_ARM_INTEL_XSCALE = $80010001;
- PF_ARM_INTEL_PMU = $80010002;
- PF_ARM_INTEL_WMMX = $80010003;
-
- CONTEXT_ARM = $0000040;
- CONTEXT_CONTROL = CONTEXT_ARM or $00000001;
- CONTEXT_INTEGER = CONTEXT_ARM or $00000002;
- CONTEXT_FLOATING_POINT = CONTEXT_ARM or $00000004;
-
- CONTEXT_FULL = CONTEXT_CONTROL or CONTEXT_INTEGER or CONTEXT_FLOATING_POINT;
-
- NUM_VFP_REGS = 32;
- NUM_EXTRA_CONTROL_REGS = 8;
-
-{$endif CPUARM} //+winnt
-
- const
- { ASCIICHAR = AsciiChar; this is the kind of thing that can
- make problems for FPC !! }
- { ignored in H2PAS
- #define FAR
- handled in H2PAS
- #define PACKED __attribute__((packed))
- }
- FILTER_TEMP_DUPLICATE_ACCOUNT = $0001;
- FILTER_NORMAL_ACCOUNT = $0002;
- FILTER_INTERDOMAIN_TRUST_ACCOUNT = $0008;
- FILTER_WORKSTATION_TRUST_ACCOUNT = $0010;
- FILTER_SERVER_TRUST_ACCOUNT = $0020;
- LOGON32_LOGON_INTERACTIVE = $02;
- LOGON32_LOGON_BATCH = $04;
- LOGON32_LOGON_SERVICE = $05;
- LOGON32_PROVIDER_DEFAULT = $00;
- LOGON32_PROVIDER_WINNT35 = $01;
- QID_SYNC = $FFFFFFFF;
- { Magic numbers in PE executable header. }
- { e_magic field }
- IMAGE_DOS_SIGNATURE = $5a4d;
- { nt_signature field }
- IMAGE_NT_SIGNATURE = $4550;
-
-
- { Severity values }
- SEVERITY_SUCCESS = 0;
- SEVERITY_ERROR = 1;
-
- { Variant type codes (wtypes.h).
- Some, not all though }
- VT_EMPTY = 0;
- VT_NULL = 1;
- VT_I2 = 2;
- VT_I4 = 3;
- VT_R4 = 4;
- VT_R8 = 5;
- VT_BSTR = 8;
- VT_ERROR = 10;
- VT_BOOL = 11;
- VT_UI1 = 17;
- VT_BYREF = $4000;
- VT_RESERVED = $8000;
-
-{ Define the facility codes }
-
-const
- FACILITY_WINDOWS = 8;
- FACILITY_STORAGE = 3;
- FACILITY_RPC = 1;
- FACILITY_SSPI = 9;
- FACILITY_WIN32 = 7;
- FACILITY_CONTROL = 10;
- FACILITY_NULL = 0;
- FACILITY_INTERNET = 12;
- FACILITY_ITF = 4;
- FACILITY_DISPATCH = 2;
- FACILITY_CERT = 11;
-
-{ Manually added, bug 2672}
- ICON_SMALL = 0;
- ICON_BIG = 1;
-
- // For the TRackMouseEvent
- TME_HOVER = $00000001;
- TME_LEAVE = $00000002;
- TME_QUERY = $40000000;
- TME_CANCEL = DWORD($80000000);
- HOVER_DEFAULT = DWORD($FFFFFFFF);
-
-// Manually added, bug 3270
- COLOR_HOTLIGHT = 26;
- COLOR_GRADIENTACTIVECAPTION = 27;
- COLOR_GRADIENTINACTIVECAPTION = 28;
- COLOR_MENUHILIGHT = 29;
- COLOR_MENUBAR = 30;
-
- WM_APP = $8000;
-
-
-
-{$endif read_interface}
-
-
-{$ifdef read_implementation}
-
- { was #define dname def_expr }
- function UNICODE_NULL : WCHAR;
- begin
- UNICODE_NULL:=#0;
- end;
-
- { was #define dname def_expr }
- function RT_ACCELERATOR : LPTSTR;
- { return type might be wrong }
- begin
- RT_ACCELERATOR:=MAKEINTRESOURCE(9);
- end;
-
- { was #define dname def_expr }
- function RT_BITMAP : LPTSTR;
- { return type might be wrong }
- begin
- RT_BITMAP:=MAKEINTRESOURCE(2);
- end;
-
- { was #define dname def_expr }
- function RT_DIALOG : LPTSTR;
- { return type might be wrong }
- begin
- RT_DIALOG:=MAKEINTRESOURCE(5);
- end;
-
- { was #define dname def_expr }
- function RT_FONT : LPTSTR;
- { return type might be wrong }
- begin
- RT_FONT:=MAKEINTRESOURCE(8);
- end;
-
- { was #define dname def_expr }
- function RT_FONTDIR : LPTSTR;
- { return type might be wrong }
- begin
- RT_FONTDIR:=MAKEINTRESOURCE(7);
- end;
-
- { was #define dname def_expr }
- function RT_MENU : LPTSTR;
- { return type might be wrong }
- begin
- RT_MENU:=MAKEINTRESOURCE(4);
- end;
-
- { was #define dname def_expr }
- function RT_RCDATA : LPTSTR;
- { return type might be wrong }
- begin
- RT_RCDATA:=MAKEINTRESOURCE(10);
- end;
-
- { was #define dname def_expr }
- function RT_STRING : LPTSTR;
- { return type might be wrong }
- begin
- RT_STRING:=MAKEINTRESOURCE(6);
- end;
-
- { was #define dname def_expr }
- function RT_MESSAGETABLE : LPTSTR;
- { return type might be wrong }
- begin
- RT_MESSAGETABLE:=MAKEINTRESOURCE(11);
- end;
-
- { was #define dname def_expr }
- function RT_CURSOR : LPTSTR;
- { return type might be wrong }
- begin
- RT_CURSOR:=MAKEINTRESOURCE(1);
- end;
-
- { was #define dname def_expr }
- function RT_GROUP_CURSOR : LPTSTR;
- { return type might be wrong }
- begin
- RT_GROUP_CURSOR:=MAKEINTRESOURCE(12);
- end;
-
- { was #define dname def_expr }
- function RT_ICON : LPTSTR;
- { return type might be wrong }
- begin
- RT_ICON:=MAKEINTRESOURCE(3);
- end;
-
- { was #define dname def_expr }
- function RT_GROUP_ICON : LPTSTR;
- { return type might be wrong }
- begin
- RT_GROUP_ICON:=MAKEINTRESOURCE(13);
- end;
-
- { was #define dname def_expr }
- function RT_VERSION : LPTSTR;
- { return type might be wrong }
- begin
- RT_VERSION:=MAKEINTRESOURCE(16);
- end;
-
- { was #define dname def_expr }
- function IDC_ARROW : LPTSTR;
- { return type might be wrong }
- begin
- IDC_ARROW:=MAKEINTRESOURCE(32512);
- end;
-
- { was #define dname def_expr }
- function IDC_IBEAM : LPTSTR;
- { return type might be wrong }
- begin
- IDC_IBEAM:=MAKEINTRESOURCE(32513);
- end;
-
- { was #define dname def_expr }
- function IDC_WAIT : LPTSTR;
- { return type might be wrong }
- begin
- IDC_WAIT:=MAKEINTRESOURCE(32514);
- end;
-
- { was #define dname def_expr }
- function IDC_CROSS : LPTSTR;
- { return type might be wrong }
- begin
- IDC_CROSS:=MAKEINTRESOURCE(32515);
- end;
-
- { was #define dname def_expr }
- function IDC_UPARROW : LPTSTR;
- { return type might be wrong }
- begin
- IDC_UPARROW:=MAKEINTRESOURCE(32516);
- end;
-
- { was #define dname def_expr }
- function IDC_SIZENWSE : LPTSTR;
- { return type might be wrong }
- begin
- IDC_SIZENWSE:=MAKEINTRESOURCE(32642);
- end;
-
- { was #define dname def_expr }
- function IDC_SIZENESW : LPTSTR;
- { return type might be wrong }
- begin
- IDC_SIZENESW:=MAKEINTRESOURCE(32643);
- end;
-
- { was #define dname def_expr }
- function IDC_SIZEWE : LPTSTR;
- { return type might be wrong }
- begin
- IDC_SIZEWE:=MAKEINTRESOURCE(32644);
- end;
-
- { was #define dname def_expr }
- function IDC_SIZENS : LPTSTR;
- { return type might be wrong }
- begin
- IDC_SIZENS:=MAKEINTRESOURCE(32645);
- end;
-
- { was #define dname def_expr }
- function IDC_SIZEALL : LPTSTR;
- { return type might be wrong }
- begin
- IDC_SIZEALL:=MAKEINTRESOURCE(32646);
- end;
-
- { was #define dname def_expr }
- function IDC_NO : LPTSTR;
- { return type might be wrong }
- begin
- IDC_NO:=MAKEINTRESOURCE(32648);
- end;
-
- { was #define dname def_expr }
- function IDC_APPSTARTING : LPTSTR;
- { return type might be wrong }
- begin
- IDC_APPSTARTING:=MAKEINTRESOURCE(32650);
- end;
-
- { was #define dname def_expr }
- function IDC_HELP : LPTSTR;
- { return type might be wrong }
- begin
- IDC_HELP:=MAKEINTRESOURCE(32651);
- end;
-
- { was #define dname def_expr }
- function IDI_APPLICATION : LPTSTR;
- { return type might be wrong }
- begin
- IDI_APPLICATION:=MAKEINTRESOURCE(32512);
- end;
-
- { was #define dname def_expr }
- function IDI_HAND : LPTSTR;
- { return type might be wrong }
- begin
- IDI_HAND:=MAKEINTRESOURCE(32513);
- end;
-
- { was #define dname def_expr }
- function IDI_QUESTION : LPTSTR;
- { return type might be wrong }
- begin
- IDI_QUESTION:=MAKEINTRESOURCE(32514);
- end;
-
- { was #define dname def_expr }
- function IDI_EXCLAMATION : LPTSTR;
- { return type might be wrong }
- begin
- IDI_EXCLAMATION:=MAKEINTRESOURCE(32515);
- end;
-
- { was #define dname def_expr }
- function IDI_ASTERISK : LPTSTR;
- { return type might be wrong }
- begin
- IDI_ASTERISK:=MAKEINTRESOURCE(32516);
- end;
-
- { was #define dname def_expr }
- function IDI_WINLOGO : LPTSTR;
- { return type might be wrong }
- begin
- IDI_WINLOGO:=MAKEINTRESOURCE(32517);
- end;
-
- { was #define dname def_expr }
- function IDC_SIZE : LPTSTR;
- { return type might be wrong }
- begin
- IDC_SIZE:=MAKEINTRESOURCE(32640);
- end;
-
- { was #define dname def_expr }
- function IDC_ICON : LPTSTR;
- { return type might be wrong }
- begin
- IDC_ICON:=MAKEINTRESOURCE(32641);
- end;
-
- { was #define dname def_expr }
- function IDC_HAND : LPTSTR;
- { return type might be wrong }
- begin
- IDC_HAND:=MAKEINTRESOURCE(32649);
- end;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- { return type might be wrong }
- function IS_UNWINDING( Flag : Longint) : boolean;
- begin
- IS_UNWINDING:=(Flag and EXCEPTION_UNWIND)<>0;
- end;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- { return type might be wrong }
- function IS_DISPATCHING( Flag : Longint) : boolean;
- begin
- IS_DISPATCHING:=(Flag and EXCEPTION_UNWIND)=0;
- end;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- { return type might be wrong }
- function IS_TARGET_UNWIND( Flag : Longint) : Longint;
- begin
- IS_TARGET_UNWIND:=(Flag and EXCEPTION_TARGET_UNWIND);
- end;
-
-
- { was #define dname def_expr }
- function STD_INPUT_HANDLE : DWORD;
- begin
- STD_INPUT_HANDLE:=DWORD(-(10));
- end;
-
- { was #define dname def_expr }
- function STD_OUTPUT_HANDLE : DWORD;
- begin
- STD_OUTPUT_HANDLE:=DWORD(-(11));
- end;
-
- { was #define dname def_expr }
- function STD_ERROR_HANDLE : DWORD;
- begin
- STD_ERROR_HANDLE:=DWORD(-(12));
- end;
-
- { was #define dname def_expr }
-{
- function INVALID_HANDLE_VALUE : HANDLE;
- begin
- INVALID_HANDLE_VALUE:=HANDLE(-(1));
- end;
-}
-
- { was #define dname def_expr }
- function HWND_BROADCAST : HWND;
- begin
- HWND_BROADCAST:=HWND($FFFF);
- end;
-
- { was #define dname def_expr }
- function HKEY_CLASSES_ROOT : HKEY;
- begin
- HKEY_CLASSES_ROOT:=HKEY($80000000);
- end;
-
- { was #define dname def_expr }
- function HKEY_CURRENT_USER : HKEY;
- begin
- HKEY_CURRENT_USER:=HKEY($80000001);
- end;
-
- { was #define dname def_expr }
- function HKEY_LOCAL_MACHINE : HKEY;
- begin
- HKEY_LOCAL_MACHINE:=HKEY($80000002);
- end;
-
- { was #define dname def_expr }
- function HKEY_USERS : HKEY;
- begin
- HKEY_USERS:=HKEY($80000003);
- end;
-
- { was #define dname def_expr }
- function HKEY_PERFORMANCE_DATA : HKEY;
- begin
- HKEY_PERFORMANCE_DATA:=HKEY($80000004);
- end;
-
- { was #define dname def_expr }
- function HKEY_CURRENT_CONFIG : HKEY;
- begin
- HKEY_CURRENT_CONFIG:=HKEY($80000005);
- end;
-
- { was #define dname def_expr }
- function HKEY_DYN_DATA : HKEY;
- begin
- HKEY_DYN_DATA:=HKEY($80000006);
- end;
-
- { was #define dname def_expr }
- function HWND_BOTTOM : HWND;
- begin
- HWND_BOTTOM:=HWND(1);
- end;
-
- { was #define dname def_expr }
- function HWND_NOTOPMOST : HWND;
- begin
- HWND_NOTOPMOST:=HWND(-(2));
- end;
-
- { was #define dname def_expr }
- function HWND_TOP : HWND;
- begin
- HWND_TOP:=HWND(0);
- end;
-
- { was #define dname def_expr }
- function HWND_TOPMOST : HWND;
- begin
- HWND_TOPMOST:=HWND(-(1));
- end;
-
- { was #define dname def_expr }
- function VS_FILE_INFO : LPTSTR;
- { return type might be wrong }
- begin
- VS_FILE_INFO:=MAKEINTRESOURCE(16);
- end;
-
- { was #define dname def_expr }
- function HINST_COMMCTRL : HINST;
- begin
- HINST_COMMCTRL:=HINST(-(1));
- end;
-
- { was #define dname def_expr }
- function LPSTR_TEXTCALLBACKW : LPWSTR;
- begin
- LPSTR_TEXTCALLBACKW:=LPWSTR(-(1));
- end;
-
- { was #define dname def_expr }
- function LPSTR_TEXTCALLBACKA : LPSTR;
- begin
- LPSTR_TEXTCALLBACKA:=LPSTR(-(1));
- end;
-{$ifdef UNICODE}
-
- {const this is a function in fact !!
- LPSTR_TEXTCALLBACK = LPSTR_TEXTCALLBACKW;}
- function LPSTR_TEXTCALLBACK : LPWSTR;
- begin
- LPSTR_TEXTCALLBACK:=LPWSTR(-(1));
- end;
-
-{$else}
-
- {const
- LPSTR_TEXTCALLBACK = LPSTR_TEXTCALLBACKA; }
- function LPSTR_TEXTCALLBACK : LPSTR;
- begin
- LPSTR_TEXTCALLBACK:=LPSTR(-(1));
- end;
-{$endif}
-
- { was #define dname def_expr }
- function TVI_ROOT : HTREEITEM;
- begin
- TVI_ROOT:=HTREEITEM($FFFF0000);
- end;
-
- { was #define dname def_expr }
- function TVI_FIRST : HTREEITEM;
- begin
- TVI_FIRST:=HTREEITEM($FFFF0001);
- end;
-
- { was #define dname def_expr }
- function TVI_LAST : HTREEITEM;
- begin
- TVI_LAST:=HTREEITEM($FFFF0002);
- end;
-
- { was #define dname def_expr }
- function TVI_SORT : HTREEITEM;
- begin
- TVI_SORT:=HTREEITEM($FFFF0003);
- end;
-
- { was #define dname def_expr }
- function HWND_DESKTOP : HWND;
- begin
- HWND_DESKTOP:=HWND(0);
- end;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- { return type might be wrong }
- function MakeProcInstance(p,i : longint) : longint;
- { return type might be wrong }
- begin
- MakeProcInstance:=p;
- end;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- { return type might be wrong }
- function FreeProcInstance(p : longint) : longint;
- { return type might be wrong }
- begin
- FreeProcInstance:=p;
- end;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- { return type might be wrong }
- function GET_WM_COMMAND_CMD(w,l : longint) : longint;
- { return type might be wrong }
- begin
- GET_WM_COMMAND_CMD:=HIWORD(w);
- end;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- { return type might be wrong }
- function GET_WM_COMMAND_ID(w,l : longint) : longint;
- { return type might be wrong }
- begin
- GET_WM_COMMAND_ID:=LOWORD(w);
- end;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- function GET_WM_CTLCOLOR_HDC(w,l,msg : longint) : HDC;
- begin
- GET_WM_CTLCOLOR_HDC:=HDC(w);
- end;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- function GET_WM_CTLCOLOR_HWND(w,l,msg : longint) : HWND;
- begin
- GET_WM_CTLCOLOR_HWND:=HWND(l);
- end;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- { return type might be wrong }
- function GET_WM_HSCROLL_CODE(w,l : longint) : longint;
- { return type might be wrong }
- begin
- GET_WM_HSCROLL_CODE:=LOWORD(w);
- end;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- function GET_WM_HSCROLL_HWND(w,l : longint) : HWND;
- begin
- GET_WM_HSCROLL_HWND:=HWND(l);
- end;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- { return type might be wrong }
- function GET_WM_HSCROLL_POS(w,l : longint) : longint;
- { return type might be wrong }
- begin
- GET_WM_HSCROLL_POS:=HIWORD(w);
- end;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- { return type might be wrong }
- function GET_WM_MDIACTIVATE_FACTIVATE(h,a,b : longint) : longint;
- { return type might be wrong }
- begin
- GET_WM_MDIACTIVATE_FACTIVATE:=longint(b = LONG(h));
- end;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- function GET_WM_MDIACTIVATE_HWNDACTIVATE(a,b : longint) : HWND;
- begin
- GET_WM_MDIACTIVATE_HWNDACTIVATE:=HWND(b);
- end;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- function GET_WM_MDIACTIVATE_HWNDDEACT(a,b : longint) : HWND;
- begin
- GET_WM_MDIACTIVATE_HWNDDEACT:=HWND(a);
- end;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- { return type might be wrong }
- function GET_WM_VSCROLL_CODE(w,l : longint) : longint;
- { return type might be wrong }
- begin
- GET_WM_VSCROLL_CODE:=LOWORD(w);
- end;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- function GET_WM_VSCROLL_HWND(w,l : longint) : HWND;
- begin
- GET_WM_VSCROLL_HWND:=HWND(l);
- end;
-
- { was #define dname(params) def_expr }
- { argument types are unknown }
- { return type might be wrong }
- function GET_WM_VSCROLL_POS(w,l : longint) : longint;
- { return type might be wrong }
- begin
- GET_WM_VSCROLL_POS:=HIWORD(w);
- end;
-
- { was #define dname(params) def_expr }
- function FreeModule(h:HINST):WINBOOL;
- begin
- FreeModule:=FreeLibrary(h);
- end;
-
- { was #define dname(params) def_expr }
- function GetNextSibling(h:HWND):HWND;
- begin
- GetNextSibling:=GetWindow(h,GW_HWNDNEXT);
- end;
- { was #define dname(params) def_expr }
- function GetWindowID(h:HWND):longint;
- begin
- GetWindowID:=GetDlgCtrlID(h);
- end;
-
- { was #define dname(params) def_expr }
- function SubclassWindow(h:HWND; p:LONG):LONG;
- begin
- SubclassWindow:=SetWindowLong(h,GWL_WNDPROC,p);
- end;
-
- { was #define dname(params) def_expr }
- function GetFirstChild(h:HWND):HWND;
- begin
- //GetFirstChild:=GetTopWindow(h);
- GetFirstChild:=GetWindow(h,GW_CHILD);
- end;
-
-{$ifdef WINCE}
-{$endif WINCE}
-
-{$ifdef WIN32}
-{$endif WIN32}
-
-{$endif read_implementation}
-
diff --git a/rtl/wince/wininc/errors.inc b/rtl/wince/wininc/errors.inc deleted file mode 100644 index ae2e14d7cb..0000000000 --- a/rtl/wince/wininc/errors.inc +++ /dev/null @@ -1,1174 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - This unit contains the error code definition for the Win32 API - - Copyright (c) 1999-2001 by Florian Klaempfl, - member of the Free Pascal development team. - - 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. - - **********************************************************************} - -{ - - Errors.h - - - Windows32 API error codes - - - Copyright (C) 1996 Free Software Foundation, Inc. - - - Author: Scott Christley <scottc@net-community.com> - - - This file is part of the Windows32 API Library. - - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Library General Public - License as published by the Free Software Foundation; either - version 2 of the License, or (at your option) any later version. - - - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Library General Public License for more details. - - - If you are interested in a warranty or support for this source code, - contact Scott Christley <scottc@net-community.com> for more information. - - - You should have received a copy of the GNU Library General Public - License along with this library; see the file COPYING.LIB. - If not, write to the Free Software Foundation, - - 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - - Changes : - - 08/15/2005 update for wince4.2 port,ORO06 -} - -{$ifdef read_interface} - - const - APPLICATION_ERROR_MASK = $20000000; //+winnt - LZERROR_UNKNOWNALG = -(8);
- LZERROR_BADVALUE = -(7); - LZERROR_GLOBLOCK = -(6); - LZERROR_GLOBALLOC = -(5); - LZERROR_WRITE = -(4); - LZERROR_READ = -(3); - LZERROR_BADOUTHANDLE = -(2); - LZERROR_BADINHANDLE = -(1); - NO_ERROR = 0; - ERROR_SUCCESS = 0; - ERROR_INVALID_FUNCTION = 1; - ERROR_FILE_NOT_FOUND = 2; - ERROR_PATH_NOT_FOUND = 3; - ERROR_TOO_MANY_OPEN_FILES = 4; - ERROR_ACCESS_DENIED = 5; - ERROR_INVALID_HANDLE = 6; - ERROR_ARENA_TRASHED = 7; - ERROR_NOT_ENOUGH_MEMORY = 8; - ERROR_INVALID_BLOCK = 9; - ERROR_BAD_ENVIRONMENT = 10; - ERROR_BAD_FORMAT = 11; - ERROR_INVALID_ACCESS = 12; - ERROR_INVALID_DATA = 13; - ERROR_OUTOFMEMORY = 14; - ERROR_INVALID_DRIVE = 15; - ERROR_CURRENT_DIRECTORY = 16; - ERROR_NOT_SAME_DEVICE = 17; - ERROR_NO_MORE_FILES = 18; - ERROR_WRITE_PROTECT = 19; - ERROR_BAD_UNIT = 20; - ERROR_NOT_READY = 21; - ERROR_BAD_COMMAND = 22; - ERROR_CRC = 23; - ERROR_BAD_LENGTH = 24; - ERROR_SEEK = 25; - ERROR_NOT_DOS_DISK = 26; - ERROR_SECTOR_NOT_FOUND = 27; - ERROR_OUT_OF_PAPER = 28; - ERROR_WRITE_FAULT = 29; - ERROR_READ_FAULT = 30; - ERROR_GEN_FAILURE = 31; - ERROR_SHARING_VIOLATION = 32; - ERROR_LOCK_VIOLATION = 33; - ERROR_WRONG_DISK = 34; - ERROR_SHARING_BUFFER_EXCEEDED = 36; - ERROR_HANDLE_EOF = 38; - ERROR_HANDLE_DISK_FULL = 39; - ERROR_NOT_SUPPORTED = 50; - ERROR_REM_NOT_LIST = 51; - ERROR_DUP_NAME = 52; - ERROR_BAD_NETPATH = 53; - ERROR_NETWORK_BUSY = 54; - ERROR_DEV_NOT_EXIST = 55; - ERROR_TOO_MANY_CMDS = 56; - ERROR_ADAP_HDW_ERR = 57; - ERROR_BAD_NET_RESP = 58; - ERROR_UNEXP_NET_ERR = 59; - ERROR_BAD_REM_ADAP = 60; - ERROR_PRINTQ_FULL = 61; - ERROR_NO_SPOOL_SPACE = 62; - ERROR_PRINT_CANCELLED = 63; - ERROR_NETNAME_DELETED = 64; - ERROR_NETWORK_ACCESS_DENIED = 65; - ERROR_BAD_DEV_TYPE = 66; - ERROR_BAD_NET_NAME = 67; - ERROR_TOO_MANY_NAMES = 68; - ERROR_TOO_MANY_SESS = 69; - ERROR_SHARING_PAUSED = 70; - ERROR_REQ_NOT_ACCEP = 71; - ERROR_REDIR_PAUSED = 72; - ERROR_FILE_EXISTS = 80; - ERROR_CANNOT_MAKE = 82; - ERROR_FAIL_I24 = 83; - ERROR_OUT_OF_STRUCTURES = 84; - ERROR_ALREADY_ASSIGNED = 85; - ERROR_INVALID_PASSWORD = 86; - ERROR_INVALID_PARAMETER = 87; - ERROR_NET_WRITE_FAULT = 88; - ERROR_NO_PROC_SLOTS = 89; - ERROR_TOO_MANY_SEMAPHORES = 100; - ERROR_EXCL_SEM_ALREADY_OWNED = 101; - ERROR_SEM_IS_SET = 102; - ERROR_TOO_MANY_SEM_REQUESTS = 103; - ERROR_INVALID_AT_INTERRUPT_TIME = 104; - ERROR_SEM_OWNER_DIED = 105; - ERROR_SEM_USER_LIMIT = 106; - ERROR_DISK_CHANGE = 107; - ERROR_DRIVE_LOCKED = 108; - ERROR_BROKEN_PIPE = 109; - ERROR_OPEN_FAILED = 110; - ERROR_BUFFER_OVERFLOW = 111; - ERROR_DISK_FULL = 112; - ERROR_NO_MORE_SEARCH_HANDLES = 113; - ERROR_INVALID_TARGET_HANDLE = 114; - ERROR_INVALID_CATEGORY = 117; - ERROR_INVALID_VERIFY_SWITCH = 118; - ERROR_BAD_DRIVER_LEVEL = 119; - ERROR_CALL_NOT_IMPLEMENTED = 120; - ERROR_SEM_TIMEOUT = 121; - ERROR_INSUFFICIENT_BUFFER = 122; - ERROR_INVALID_NAME = 123; - ERROR_INVALID_LEVEL = 124; - ERROR_NO_VOLUME_LABEL = 125; - ERROR_MOD_NOT_FOUND = 126; - ERROR_PROC_NOT_FOUND = 127; - ERROR_WAIT_NO_CHILDREN = 128; - ERROR_CHILD_NOT_COMPLETE = 129; - ERROR_DIRECT_ACCESS_HANDLE = 130; - ERROR_NEGATIVE_SEEK = 131; - ERROR_SEEK_ON_DEVICE = 132; - ERROR_IS_JOIN_TARGET = 133; - ERROR_IS_JOINED = 134; - ERROR_IS_SUBSTED = 135; - ERROR_NOT_JOINED = 136; - ERROR_NOT_SUBSTED = 137; - ERROR_JOIN_TO_JOIN = 138; - ERROR_SUBST_TO_SUBST = 139; - ERROR_JOIN_TO_SUBST = 140; - ERROR_SUBST_TO_JOIN = 141; - ERROR_BUSY_DRIVE = 142; - ERROR_SAME_DRIVE = 143; - ERROR_DIR_NOT_ROOT = 144; - ERROR_DIR_NOT_EMPTY = 145; - ERROR_IS_SUBST_PATH = 146; - ERROR_IS_JOIN_PATH = 147; - ERROR_PATH_BUSY = 148; - ERROR_IS_SUBST_TARGET = 149; - ERROR_SYSTEM_TRACE = 150; - ERROR_INVALID_EVENT_COUNT = 151; - ERROR_TOO_MANY_MUXWAITERS = 152; - ERROR_INVALID_LIST_FORMAT = 153; - ERROR_LABEL_TOO_LONG = 154; - ERROR_TOO_MANY_TCBS = 155; - ERROR_SIGNAL_REFUSED = 156; - ERROR_DISCARDED = 157; - ERROR_NOT_LOCKED = 158; - ERROR_BAD_THREADID_ADDR = 159; - ERROR_BAD_ARGUMENTS = 160; - ERROR_BAD_PATHNAME = 161; - ERROR_SIGNAL_PENDING = 162; - ERROR_MAX_THRDS_REACHED = 164; - ERROR_LOCK_FAILED = 167; - ERROR_BUSY = 170; - ERROR_CANCEL_VIOLATION = 173; - ERROR_ATOMIC_LOCKS_NOT_SUPPORTED = 174; - ERROR_INVALID_SEGMENT_NUMBER = 180; - ERROR_INVALID_ORDINAL = 182; - ERROR_ALREADY_EXISTS = 183; - ERROR_INVALID_FLAG_NUMBER = 186; - ERROR_SEM_NOT_FOUND = 187; - ERROR_INVALID_STARTING_CODESEG = 188; - ERROR_INVALID_STACKSEG = 189; - ERROR_INVALID_MODULETYPE = 190; - ERROR_INVALID_EXE_SIGNATURE = 191; - ERROR_EXE_MARKED_INVALID = 192; - ERROR_BAD_EXE_FORMAT = 193; - ERROR_ITERATED_DATA_EXCEEDS_64k = 194; - ERROR_INVALID_MINALLOCSIZE = 195; - ERROR_DYNLINK_FROM_INVALID_RING = 196; - ERROR_IOPL_NOT_ENABLED = 197; - ERROR_INVALID_SEGDPL = 198; - ERROR_AUTODATASEG_EXCEEDS_64k = 199; - ERROR_RING2SEG_MUST_BE_MOVABLE = 200; - ERROR_RELOC_CHAIN_XEEDS_SEGLIM = 201; - ERROR_INFLOOP_IN_RELOC_CHAIN = 202; - ERROR_ENVVAR_NOT_FOUND = 203; - ERROR_NO_SIGNAL_SENT = 205; - ERROR_FILENAME_EXCED_RANGE = 206; - ERROR_RING2_STACK_IN_USE = 207; - ERROR_META_EXPANSION_TOO_LONG = 208; - ERROR_INVALID_SIGNAL_NUMBER = 209; - ERROR_THREAD_1_INACTIVE = 210; - ERROR_LOCKED = 212; - ERROR_TOO_MANY_MODULES = 214; - ERROR_NESTING_NOT_ALLOWED = 215; - ERROR_BAD_PIPE = 230; - ERROR_PIPE_BUSY = 231; - ERROR_NO_DATA = 232; - ERROR_PIPE_NOT_CONNECTED = 233; - ERROR_MORE_DATA = 234; - ERROR_VC_DISCONNECTED = 240; - ERROR_INVALID_EA_NAME = 254; - ERROR_EA_LIST_INCONSISTENT = 255; - ERROR_NO_MORE_ITEMS = 259; - ERROR_CANNOT_COPY = 266; - ERROR_DIRECTORY = 267; - ERROR_EAS_DIDNT_FIT = 275; - ERROR_EA_FILE_CORRUPT = 276; - ERROR_EA_TABLE_FULL = 277; - ERROR_INVALID_EA_HANDLE = 278; - ERROR_EAS_NOT_SUPPORTED = 282; - ERROR_NOT_OWNER = 288; - ERROR_TOO_MANY_POSTS = 298; - ERROR_PARTIAL_COPY = 299; - ERROR_MR_MID_NOT_FOUND = 317; - ERROR_INVALID_ADDRESS = 487; - ERROR_ARITHMETIC_OVERFLOW = 534; - ERROR_PIPE_CONNECTED = 535; - ERROR_PIPE_LISTENING = 536; - ERROR_EA_ACCESS_DENIED = 994; - ERROR_OPERATION_ABORTED = 995; - ERROR_IO_INCOMPLETE = 996; - ERROR_IO_PENDING = 997; - ERROR_NOACCESS = 998; - ERROR_SWAPERROR = 999; - ERROR_STACK_OVERFLOW = 1001; - ERROR_INVALID_MESSAGE = 1002; - ERROR_CAN_NOT_COMPLETE = 1003; - ERROR_INVALID_FLAGS = 1004; - ERROR_UNRECOGNIZED_VOLUME = 1005; - ERROR_FILE_INVALID = 1006; - ERROR_FULLSCREEN_MODE = 1007; - ERROR_NO_TOKEN = 1008; - ERROR_BADDB = 1009; - ERROR_BADKEY = 1010; - ERROR_CANTOPEN = 1011; - ERROR_CANTREAD = 1012; - ERROR_CANTWRITE = 1013; - ERROR_REGISTRY_RECOVERED = 1014; - ERROR_REGISTRY_CORRUPT = 1015; - ERROR_REGISTRY_IO_FAILED = 1016; - ERROR_NOT_REGISTRY_FILE = 1017; - ERROR_KEY_DELETED = 1018; - ERROR_NO_LOG_SPACE = 1019; - ERROR_KEY_HAS_CHILDREN = 1020; - ERROR_CHILD_MUST_BE_VOLATILE = 1021; - ERROR_NOTIFY_ENUM_DIR = 1022; - ERROR_DEPENDENT_SERVICES_RUNNING = 1051; - ERROR_INVALID_SERVICE_CONTROL = 1052; - ERROR_SERVICE_REQUEST_TIMEOUT = 1053; - ERROR_SERVICE_NO_THREAD = 1054; - ERROR_SERVICE_DATABASE_LOCKED = 1055; - ERROR_SERVICE_ALREADY_RUNNING = 1056; - ERROR_INVALID_SERVICE_ACCOUNT = 1057; - ERROR_SERVICE_DISABLED = 1058; - ERROR_CIRCULAR_DEPENDENCY = 1059; - ERROR_SERVICE_DOES_NOT_EXIST = 1060; - ERROR_SERVICE_CANNOT_ACCEPT_CTRL = 1061; - ERROR_SERVICE_NOT_ACTIVE = 1062; - ERROR_FAILED_SERVICE_CONTROLLER_CONNECT = 1063; - ERROR_EXCEPTION_IN_SERVICE = 1064; - ERROR_DATABASE_DOES_NOT_EXIST = 1065; - ERROR_SERVICE_SPECIFIC_ERROR = 1066; - ERROR_PROCESS_ABORTED = 1067; - ERROR_SERVICE_DEPENDENCY_FAIL = 1068; - ERROR_SERVICE_LOGON_FAILED = 1069; - ERROR_SERVICE_START_HANG = 1070; - ERROR_INVALID_SERVICE_LOCK = 1071; - ERROR_SERVICE_MARKED_FOR_DELETE = 1072; - ERROR_SERVICE_EXISTS = 1073; - ERROR_ALREADY_RUNNING_LKG = 1074; - ERROR_SERVICE_DEPENDENCY_DELETED = 1075; - ERROR_BOOT_ALREADY_ACCEPTED = 1076; - ERROR_SERVICE_NEVER_STARTED = 1077; - ERROR_DUPLICATE_SERVICE_NAME = 1078; - ERROR_END_OF_MEDIA = 1100; - ERROR_FILEMARK_DETECTED = 1101; - ERROR_BEGINNING_OF_MEDIA = 1102; - ERROR_SETMARK_DETECTED = 1103; - ERROR_NO_DATA_DETECTED = 1104; - ERROR_PARTITION_FAILURE = 1105; - ERROR_INVALID_BLOCK_LENGTH = 1106; - ERROR_DEVICE_NOT_PARTITIONED = 1107; - ERROR_UNABLE_TO_LOCK_MEDIA = 1108; - ERROR_UNABLE_TO_UNLOAD_MEDIA = 1109; - ERROR_MEDIA_CHANGED = 1110; - ERROR_BUS_RESET = 1111; - ERROR_NO_MEDIA_IN_DRIVE = 1112; - ERROR_NO_UNICODE_TRANSLATION = 1113; - ERROR_DLL_INIT_FAILED = 1114; - ERROR_SHUTDOWN_IN_PROGRESS = 1115; - ERROR_NO_SHUTDOWN_IN_PROGRESS = 1116; - ERROR_IO_DEVICE = 1117; - ERROR_SERIAL_NO_DEVICE = 1118; - ERROR_IRQ_BUSY = 1119; - ERROR_MORE_WRITES = 1120; - ERROR_COUNTER_TIMEOUT = 1121; - ERROR_FLOPPY_ID_MARK_NOT_FOUND = 1122; - ERROR_FLOPPY_WRONG_CYLINDER = 1123; - ERROR_FLOPPY_UNKNOWN_ERROR = 1124; - ERROR_FLOPPY_BAD_REGISTERS = 1125; - ERROR_DISK_RECALIBRATE_FAILED = 1126; - ERROR_DISK_OPERATION_FAILED = 1127; - ERROR_DISK_RESET_FAILED = 1128; - ERROR_EOM_OVERFLOW = 1129; - ERROR_NOT_ENOUGH_SERVER_MEMORY = 1130; - ERROR_POSSIBLE_DEADLOCK = 1131; - ERROR_MAPPED_ALIGNMENT = 1132; - ERROR_SET_POWER_STATE_VETOED = 1140; - ERROR_SET_POWER_STATE_FAILED = 1141; - ERROR_OLD_WIN_VERSION = 1150; - ERROR_APP_WRONG_OS = 1151; - ERROR_SINGLE_INSTANCE_APP = 1152; - ERROR_RMODE_APP = 1153; - ERROR_INVALID_DLL = 1154; - ERROR_NO_ASSOCIATION = 1155; - ERROR_DDE_FAIL = 1156; - ERROR_DLL_NOT_FOUND = 1157; - ERROR_BAD_USERNAME = 2202; - ERROR_NOT_CONNECTED = 2250; - ERROR_OPEN_FILES = 2401; - ERROR_ACTIVE_CONNECTIONS = 2402; - ERROR_DEVICE_IN_USE = 2404; - ERROR_BAD_DEVICE = 1200; - ERROR_CONNECTION_UNAVAIL = 1201; - ERROR_DEVICE_ALREADY_REMEMBERED = 1202; - ERROR_NO_NET_OR_BAD_PATH = 1203; - ERROR_BAD_PROVIDER = 1204; - ERROR_CANNOT_OPEN_PROFILE = 1205; - ERROR_BAD_PROFILE = 1206; - ERROR_NOT_CONTAINER = 1207; - ERROR_EXTENDED_ERROR = 1208; - ERROR_INVALID_GROUPNAME = 1209; - ERROR_INVALID_COMPUTERNAME = 1210; - ERROR_INVALID_EVENTNAME = 1211; - ERROR_INVALID_DOMAINNAME = 1212; - ERROR_INVALID_SERVICENAME = 1213; - ERROR_INVALID_NETNAME = 1214; - ERROR_INVALID_SHARENAME = 1215; - ERROR_INVALID_PASSWORDNAME = 1216; - ERROR_INVALID_MESSAGENAME = 1217; - ERROR_INVALID_MESSAGEDEST = 1218; - ERROR_SESSION_CREDENTIAL_CONFLICT = 1219; - ERROR_REMOTE_SESSION_LIMIT_EXCEEDED = 1220; - ERROR_DUP_DOMAINNAME = 1221; - ERROR_NO_NETWORK = 1222; - ERROR_CANCELLED = 1223; - ERROR_USER_MAPPED_FILE = 1224; - ERROR_CONNECTION_REFUSED = 1225; - ERROR_GRACEFUL_DISCONNECT = 1226; - ERROR_ADDRESS_ALREADY_ASSOCIATED = 1227; - ERROR_ADDRESS_NOT_ASSOCIATED = 1228; - ERROR_CONNECTION_INVALID = 1229; - ERROR_CONNECTION_ACTIVE = 1230; - ERROR_NETWORK_UNREACHABLE = 1231; - ERROR_HOST_UNREACHABLE = 1232; - ERROR_PROTOCOL_UNREACHABLE = 1233; - ERROR_PORT_UNREACHABLE = 1234; - ERROR_REQUEST_ABORTED = 1235; - ERROR_CONNECTION_ABORTED = 1236; - ERROR_RETRY = 1237; - ERROR_CONNECTION_COUNT_LIMIT = 1238; - ERROR_LOGIN_TIME_RESTRICTION = 1239; - ERROR_LOGIN_WKSTA_RESTRICTION = 1240; - ERROR_INCORRECT_ADDRESS = 1241; - ERROR_ALREADY_REGISTERED = 1242; - ERROR_SERVICE_NOT_FOUND = 1243; - ERROR_NOT_AUTHENTICATED = 1244; - ERROR_NOT_LOGGED_ON = 1245; - ERROR_CONTINUE = 1246; - ERROR_ALREADY_INITIALIZED = 1247; - ERROR_NO_MORE_DEVICES = 1248; - ERROR_NOT_ALL_ASSIGNED = 1300; - ERROR_SOME_NOT_MAPPED = 1301; - ERROR_NO_QUOTAS_FOR_ACCOUNT = 1302; - ERROR_LOCAL_USER_SESSION_KEY = 1303; - ERROR_NULL_LM_PASSWORD = 1304; - ERROR_UNKNOWN_REVISION = 1305; - ERROR_REVISION_MISMATCH = 1306; - ERROR_INVALID_OWNER = 1307; - ERROR_INVALID_PRIMARY_GROUP = 1308; - ERROR_NO_IMPERSONATION_TOKEN = 1309; - ERROR_CANT_DISABLE_MANDATORY = 1310; - ERROR_NO_LOGON_SERVERS = 1311; - ERROR_NO_SUCH_LOGON_SESSION = 1312; - ERROR_NO_SUCH_PRIVILEGE = 1313; - ERROR_PRIVILEGE_NOT_HELD = 1314; - ERROR_INVALID_ACCOUNT_NAME = 1315; - ERROR_USER_EXISTS = 1316; - ERROR_NO_SUCH_USER = 1317; - ERROR_GROUP_EXISTS = 1318; - ERROR_NO_SUCH_GROUP = 1319; - ERROR_MEMBER_IN_GROUP = 1320; - ERROR_MEMBER_NOT_IN_GROUP = 1321; - ERROR_LAST_ADMIN = 1322; - ERROR_WRONG_PASSWORD = 1323; - ERROR_ILL_FORMED_PASSWORD = 1324; - ERROR_PASSWORD_RESTRICTION = 1325; - ERROR_LOGON_FAILURE = 1326; - ERROR_ACCOUNT_RESTRICTION = 1327; - ERROR_INVALID_LOGON_HOURS = 1328; - ERROR_INVALID_WORKSTATION = 1329; - ERROR_PASSWORD_EXPIRED = 1330; - ERROR_ACCOUNT_DISABLED = 1331; - ERROR_NONE_MAPPED = 1332; - ERROR_TOO_MANY_LUIDS_REQUESTED = 1333; - ERROR_LUIDS_EXHAUSTED = 1334; - ERROR_INVALID_SUB_AUTHORITY = 1335; - ERROR_INVALID_ACL = 1336; - ERROR_INVALID_SID = 1337; - ERROR_INVALID_SECURITY_DESCR = 1338; - ERROR_BAD_INHERITANCE_ACL = 1340; - ERROR_SERVER_DISABLED = 1341; - ERROR_SERVER_NOT_DISABLED = 1342; - ERROR_INVALID_ID_AUTHORITY = 1343; - ERROR_ALLOTTED_SPACE_EXCEEDED = 1344; - ERROR_INVALID_GROUP_ATTRIBUTES = 1345; - ERROR_BAD_IMPERSONATION_LEVEL = 1346; - ERROR_CANT_OPEN_ANONYMOUS = 1347; - ERROR_BAD_VALIDATION_CLASS = 1348; - ERROR_BAD_TOKEN_TYPE = 1349; - ERROR_NO_SECURITY_ON_OBJECT = 1350; - ERROR_CANT_ACCESS_DOMAIN_INFO = 1351; - ERROR_INVALID_SERVER_STATE = 1352; - ERROR_INVALID_DOMAIN_STATE = 1353; - ERROR_INVALID_DOMAIN_ROLE = 1354; - ERROR_NO_SUCH_DOMAIN = 1355; - ERROR_DOMAIN_EXISTS = 1356; - ERROR_DOMAIN_LIMIT_EXCEEDED = 1357; - ERROR_INTERNAL_DB_CORRUPTION = 1358; - ERROR_INTERNAL_ERROR = 1359; - ERROR_GENERIC_NOT_MAPPED = 1360; - ERROR_BAD_DESCRIPTOR_FORMAT = 1361; - ERROR_NOT_LOGON_PROCESS = 1362; - ERROR_LOGON_SESSION_EXISTS = 1363; - ERROR_NO_SUCH_PACKAGE = 1364; - ERROR_BAD_LOGON_SESSION_STATE = 1365; - ERROR_LOGON_SESSION_COLLISION = 1366; - ERROR_INVALID_LOGON_TYPE = 1367; - ERROR_CANNOT_IMPERSONATE = 1368; - ERROR_RXACT_INVALID_STATE = 1369; - ERROR_RXACT_COMMIT_FAILURE = 1370; - ERROR_SPECIAL_ACCOUNT = 1371; - ERROR_SPECIAL_GROUP = 1372; - ERROR_SPECIAL_USER = 1373; - ERROR_MEMBERS_PRIMARY_GROUP = 1374; - ERROR_TOKEN_ALREADY_IN_USE = 1375; - ERROR_NO_SUCH_ALIAS = 1376; - ERROR_MEMBER_NOT_IN_ALIAS = 1377; - ERROR_MEMBER_IN_ALIAS = 1378; - ERROR_ALIAS_EXISTS = 1379; - ERROR_LOGON_NOT_GRANTED = 1380; - ERROR_TOO_MANY_SECRETS = 1381; - ERROR_SECRET_TOO_LONG = 1382; - ERROR_INTERNAL_DB_ERROR = 1383; - ERROR_TOO_MANY_CONTEXT_IDS = 1384; - ERROR_LOGON_TYPE_NOT_GRANTED = 1385; - ERROR_NT_CROSS_ENCRYPTION_REQUIRED = 1386; - ERROR_NO_SUCH_MEMBER = 1387; - ERROR_INVALID_MEMBER = 1388; - ERROR_TOO_MANY_SIDS = 1389; - ERROR_LM_CROSS_ENCRYPTION_REQUIRED = 1390; - ERROR_NO_INHERITANCE = 1391; - ERROR_FILE_CORRUPT = 1392; - ERROR_DISK_CORRUPT = 1393; - ERROR_NO_USER_SESSION_KEY = 1394; - ERROR_LICENSE_QUOTA_EXCEEDED = 1395; - ERROR_INVALID_WINDOW_HANDLE = 1400; - ERROR_INVALID_MENU_HANDLE = 1401; - ERROR_INVALID_CURSOR_HANDLE = 1402; - ERROR_INVALID_ACCEL_HANDLE = 1403; - ERROR_INVALID_HOOK_HANDLE = 1404; - ERROR_INVALID_DWP_HANDLE = 1405; - ERROR_TLW_WITH_WSCHILD = 1406; - ERROR_CANNOT_FIND_WND_CLASS = 1407; - ERROR_WINDOW_OF_OTHER_THREAD = 1408; - ERROR_HOTKEY_ALREADY_REGISTERED = 1409; - ERROR_CLASS_ALREADY_EXISTS = 1410; - ERROR_CLASS_DOES_NOT_EXIST = 1411; - ERROR_CLASS_HAS_WINDOWS = 1412; - ERROR_INVALID_INDEX = 1413; - ERROR_INVALID_ICON_HANDLE = 1414; - ERROR_PRIVATE_DIALOG_INDEX = 1415; - ERROR_LISTBOX_ID_NOT_FOUND = 1416; - ERROR_NO_WILDCARD_CHARACTERS = 1417; - ERROR_CLIPBOARD_NOT_OPEN = 1418; - ERROR_HOTKEY_NOT_REGISTERED = 1419; - ERROR_WINDOW_NOT_DIALOG = 1420; - ERROR_CONTROL_ID_NOT_FOUND = 1421; - ERROR_INVALID_COMBOBOX_MESSAGE = 1422; - ERROR_WINDOW_NOT_COMBOBOX = 1423; - ERROR_INVALID_EDIT_HEIGHT = 1424; - ERROR_DC_NOT_FOUND = 1425; - ERROR_INVALID_HOOK_FILTER = 1426; - ERROR_INVALID_FILTER_PROC = 1427; - ERROR_HOOK_NEEDS_HMOD = 1428; - ERROR_GLOBAL_ONLY_HOOK = 1429; - ERROR_JOURNAL_HOOK_SET = 1430; - ERROR_HOOK_NOT_INSTALLED = 1431; - ERROR_INVALID_LB_MESSAGE = 1432; - ERROR_SETCOUNT_ON_BAD_LB = 1433; - ERROR_LB_WITHOUT_TABSTOPS = 1434; - ERROR_DESTROY_OBJECT_OF_OTHER_THREAD = 1435; - ERROR_CHILD_WINDOW_MENU = 1436; - ERROR_NO_SYSTEM_MENU = 1437; - ERROR_INVALID_MSGBOX_STYLE = 1438; - ERROR_INVALID_SPI_VALUE = 1439; - ERROR_SCREEN_ALREADY_LOCKED = 1440; - ERROR_HWNDS_HAVE_DIFF_PARENT = 1441; - ERROR_NOT_CHILD_WINDOW = 1442; - ERROR_INVALID_GW_COMMAND = 1443; - ERROR_INVALID_THREAD_ID = 1444; - ERROR_NON_MDICHILD_WINDOW = 1445; - ERROR_POPUP_ALREADY_ACTIVE = 1446; - ERROR_NO_SCROLLBARS = 1447; - ERROR_INVALID_SCROLLBAR_RANGE = 1448; - ERROR_INVALID_SHOWWIN_COMMAND = 1449; - ERROR_NO_SYSTEM_RESOURCES = 1450; - ERROR_NONPAGED_SYSTEM_RESOURCES = 1451; - ERROR_PAGED_SYSTEM_RESOURCES = 1452; - ERROR_WORKING_SET_QUOTA = 1453; - ERROR_PAGEFILE_QUOTA = 1454; - ERROR_COMMITMENT_LIMIT = 1455; - ERROR_MENU_ITEM_NOT_FOUND = 1456; - ERROR_INVALID_KEYBOARD_HANDLE = 1457; - ERROR_HOOK_TYPE_NOT_ALLOWED = 1458; - ERROR_REQUIRES_INTERACTIVE_WINDOWSTATION = 1459; - ERROR_TIMEOUT = 1460; - ERROR_EVENTLOG_FILE_CORRUPT = 1500; - ERROR_EVENTLOG_CANT_START = 1501; - ERROR_LOG_FILE_FULL = 1502; - ERROR_EVENTLOG_FILE_CHANGED = 1503; - RPC_S_INVALID_STRING_BINDING = 1700; - RPC_S_WRONG_KIND_OF_BINDING = 1701; - RPC_S_INVALID_BINDING = 1702; - RPC_S_PROTSEQ_NOT_SUPPORTED = 1703; - RPC_S_INVALID_RPC_PROTSEQ = 1704; - RPC_S_INVALID_STRING_UUID = 1705; - RPC_S_INVALID_ENDPOINT_FORMAT = 1706; - RPC_S_INVALID_NET_ADDR = 1707; - RPC_S_NO_ENDPOINT_FOUND = 1708; - RPC_S_INVALID_TIMEOUT = 1709; - RPC_S_OBJECT_NOT_FOUND = 1710; - RPC_S_ALREADY_REGISTERED = 1711; - RPC_S_TYPE_ALREADY_REGISTERED = 1712; - RPC_S_ALREADY_LISTENING = 1713; - RPC_S_NO_PROTSEQS_REGISTERED = 1714; - RPC_S_NOT_LISTENING = 1715; - RPC_S_UNKNOWN_MGR_TYPE = 1716; - RPC_S_UNKNOWN_IF = 1717; - RPC_S_NO_BINDINGS = 1718; - RPC_S_NO_PROTSEQS = 1719; - RPC_S_CANT_CREATE_ENDPOINT = 1720; - RPC_S_OUT_OF_RESOURCES = 1721; - RPC_S_SERVER_UNAVAILABLE = 1722; - RPC_S_SERVER_TOO_BUSY = 1723; - RPC_S_INVALID_NETWORK_OPTIONS = 1724; - RPC_S_NO_CALL_ACTIVE = 1725; - RPC_S_CALL_FAILED = 1726; - RPC_S_CALL_FAILED_DNE = 1727; - RPC_S_PROTOCOL_ERROR = 1728; - RPC_S_UNSUPPORTED_TRANS_SYN = 1730; - RPC_S_UNSUPPORTED_TYPE = 1732; - RPC_S_INVALID_TAG = 1733; - RPC_S_INVALID_BOUND = 1734; - RPC_S_NO_ENTRY_NAME = 1735; - RPC_S_INVALID_NAME_SYNTAX = 1736; - RPC_S_UNSUPPORTED_NAME_SYNTAX = 1737; - RPC_S_UUID_NO_ADDRESS = 1739; - RPC_S_DUPLICATE_ENDPOINT = 1740; - RPC_S_UNKNOWN_AUTHN_TYPE = 1741; - RPC_S_MAX_CALLS_TOO_SMALL = 1742; - RPC_S_STRING_TOO_LONG = 1743; - RPC_S_PROTSEQ_NOT_FOUND = 1744; - RPC_S_PROCNUM_OUT_OF_RANGE = 1745; - RPC_S_BINDING_HAS_NO_AUTH = 1746; - RPC_S_UNKNOWN_AUTHN_SERVICE = 1747; - RPC_S_UNKNOWN_AUTHN_LEVEL = 1748; - RPC_S_INVALID_AUTH_IDENTITY = 1749; - RPC_S_UNKNOWN_AUTHZ_SERVICE = 1750; - EPT_S_INVALID_ENTRY = 1751; - EPT_S_CANT_PERFORM_OP = 1752; - EPT_S_NOT_REGISTERED = 1753; - RPC_S_NOTHING_TO_EXPORT = 1754; - RPC_S_INCOMPLETE_NAME = 1755; - RPC_S_INVALID_VERS_OPTION = 1756; - RPC_S_NO_MORE_MEMBERS = 1757; - RPC_S_NOT_ALL_OBJS_UNEXPORTED = 1758; - RPC_S_INTERFACE_NOT_FOUND = 1759; - RPC_S_ENTRY_ALREADY_EXISTS = 1760; - RPC_S_ENTRY_NOT_FOUND = 1761; - RPC_S_NAME_SERVICE_UNAVAILABLE = 1762; - RPC_S_INVALID_NAF_ID = 1763; - RPC_S_CANNOT_SUPPORT = 1764; - RPC_S_NO_CONTEXT_AVAILABLE = 1765; - RPC_S_INTERNAL_ERROR = 1766; - RPC_S_ZERO_DIVIDE = 1767; - RPC_S_ADDRESS_ERROR = 1768; - RPC_S_FP_DIV_ZERO = 1769; - RPC_S_FP_UNDERFLOW = 1770; - RPC_S_FP_OVERFLOW = 1771; - RPC_X_NO_MORE_ENTRIES = 1772; - RPC_X_SS_CHAR_TRANS_OPEN_FAIL = 1773; - RPC_X_SS_CHAR_TRANS_SHORT_FILE = 1774; - RPC_X_SS_IN_NULL_CONTEXT = 1775; - RPC_X_SS_CONTEXT_DAMAGED = 1777; - RPC_X_SS_HANDLES_MISMATCH = 1778; - RPC_X_SS_CANNOT_GET_CALL_HANDLE = 1779; - RPC_X_NULL_REF_POINTER = 1780; - RPC_X_ENUM_VALUE_OUT_OF_RANGE = 1781; - RPC_X_BYTE_COUNT_TOO_SMALL = 1782; - RPC_X_BAD_STUB_DATA = 1783; - ERROR_INVALID_USER_BUFFER = 1784; - ERROR_UNRECOGNIZED_MEDIA = 1785; - ERROR_NO_TRUST_LSA_SECRET = 1786; - ERROR_NO_TRUST_SAM_ACCOUNT = 1787; - ERROR_TRUSTED_DOMAIN_FAILURE = 1788; - ERROR_TRUSTED_RELATIONSHIP_FAILURE = 1789; - ERROR_TRUST_FAILURE = 1790; - RPC_S_CALL_IN_PROGRESS = 1791; - ERROR_NETLOGON_NOT_STARTED = 1792; - ERROR_ACCOUNT_EXPIRED = 1793; - ERROR_REDIRECTOR_HAS_OPEN_HANDLES = 1794; - ERROR_PRINTER_DRIVER_ALREADY_INSTALLED = 1795; - ERROR_UNKNOWN_PORT = 1796; - ERROR_UNKNOWN_PRINTER_DRIVER = 1797; - ERROR_UNKNOWN_PRINTPROCESSOR = 1798; - ERROR_INVALID_SEPARATOR_FILE = 1799; - ERROR_INVALID_PRIORITY = 1800; - ERROR_INVALID_PRINTER_NAME = 1801; - ERROR_PRINTER_ALREADY_EXISTS = 1802; - ERROR_INVALID_PRINTER_COMMAND = 1803; - ERROR_INVALID_DATATYPE = 1804; - ERROR_INVALID_ENVIRONMENT = 1805; - RPC_S_NO_MORE_BINDINGS = 1806; - ERROR_NOLOGON_INTERDOMAIN_TRUST_ACCOUNT = 1807; - ERROR_NOLOGON_WORKSTATION_TRUST_ACCOUNT = 1808; - ERROR_NOLOGON_SERVER_TRUST_ACCOUNT = 1809; - ERROR_DOMAIN_TRUST_INCONSISTENT = 1810; - ERROR_SERVER_HAS_OPEN_HANDLES = 1811; - ERROR_RESOURCE_DATA_NOT_FOUND = 1812; - ERROR_RESOURCE_TYPE_NOT_FOUND = 1813; - ERROR_RESOURCE_NAME_NOT_FOUND = 1814; - ERROR_RESOURCE_LANG_NOT_FOUND = 1815; - ERROR_NOT_ENOUGH_QUOTA = 1816; - RPC_S_NO_INTERFACES = 1817; - RPC_S_CALL_CANCELLED = 1818; - RPC_S_BINDING_INCOMPLETE = 1819; - RPC_S_COMM_FAILURE = 1820; - RPC_S_UNSUPPORTED_AUTHN_LEVEL = 1821; - RPC_S_NO_PRINC_NAME = 1822; - RPC_S_NOT_RPC_ERROR = 1823; - RPC_S_UUID_LOCAL_ONLY = 1824; - RPC_S_SEC_PKG_ERROR = 1825; - RPC_S_NOT_CANCELLED = 1826; - RPC_X_INVALID_ES_ACTION = 1827; - RPC_X_WRONG_ES_VERSION = 1828; - RPC_X_WRONG_STUB_VERSION = 1829; - RPC_X_INVALID_PIPE_OBJECT = 1830; - RPC_X_INVALID_PIPE_OPERATION = 1831; - RPC_S_GROUP_MEMBER_NOT_FOUND = 1898; - EPT_S_CANT_CREATE = 1899; - RPC_S_INVALID_OBJECT = 1900; - ERROR_INVALID_TIME = 1901; - ERROR_INVALID_FORM_NAME = 1902; - ERROR_INVALID_FORM_SIZE = 1903; - ERROR_ALREADY_WAITING = 1904; - ERROR_PRINTER_DELETED = 1905; - ERROR_INVALID_PRINTER_STATE = 1906; - ERROR_PASSWORD_MUST_CHANGE = 1907; - ERROR_DOMAIN_CONTROLLER_NOT_FOUND = 1908; - ERROR_ACCOUNT_LOCKED_OUT = 1909; - OR_INVALID_OXID = 1910; - OR_INVALID_OID = 1911; - OR_INVALID_SET = 1912; - RPC_S_SEND_INCOMPLETE = 1913; - ERROR_NO_BROWSER_SERVERS_FOUND = 6118; - ERROR_INVALID_PIXEL_FORMAT = 2000; - ERROR_BAD_DRIVER = 2001; - ERROR_INVALID_WINDOW_STYLE = 2002; - ERROR_METAFILE_NOT_SUPPORTED = 2003; - ERROR_TRANSFORM_NOT_SUPPORTED = 2004; - ERROR_CLIPPING_NOT_SUPPORTED = 2005; - ERROR_UNKNOWN_PRINT_MONITOR = 3000; - ERROR_PRINTER_DRIVER_IN_USE = 3001; - ERROR_SPOOL_FILE_NOT_FOUND = 3002; - ERROR_SPL_NO_STARTDOC = 3003; - ERROR_SPL_NO_ADDJOB = 3004; - ERROR_PRINT_PROCESSOR_ALREADY_INSTALLED = 3005; - ERROR_PRINT_MONITOR_ALREADY_INSTALLED = 3006; - ERROR_INVALID_PRINT_MONITOR = 3007; - ERROR_PRINT_MONITOR_IN_USE = 3008; - ERROR_PRINTER_HAS_JOBS_QUEUED = 3009; - ERROR_SUCCESS_REBOOT_REQUIRED = 3010; - ERROR_SUCCESS_RESTART_REQUIRED = 3011; - ERROR_WINS_INTERNAL = 4000; - ERROR_CAN_NOT_DEL_LOCAL_WINS = 4001; - ERROR_STATIC_INIT = 4002; - ERROR_INC_BACKUP = 4003; - ERROR_FULL_BACKUP = 4004; - ERROR_REC_NON_EXISTENT = 4005; - ERROR_RPL_NOT_ALLOWED = 4006; - ERROR_SEVERITY_SUCCESS = $00000000; //+winnt - ERROR_SEVERITY_INFORMATIONAL = $40000000; //+winnt
- ERROR_SEVERITY_WARNING = $80000000; //+winnt
- ERROR_SEVERITY_ERROR = $C0000000; //+winnt
- {ERROR_NO_BROWSER_SERVERS_FOUND = 6118; already above } - - E_UNEXPECTED = DWORD($8000FFFF); - E_NOTIMPL = DWORD($80004001); - E_OUTOFMEMORY = DWORD($8007000E); - E_INVALIDARG = DWORD($80070057); - E_NOINTERFACE = HRESULT($80004002); - E_POINTER = DWORD($80004003); - E_HANDLE = DWORD($80070006); - E_ABORT = DWORD($80004004); - E_FAIL = DWORD($80004005); - E_ACCESSDENIED = DWORD($80070005); - E_PENDING = DWORD($8000000A); - CO_E_INIT_TLS = DWORD($80004006); - CO_E_INIT_SHARED_ALLOCATOR = DWORD($80004007); - CO_E_INIT_MEMORY_ALLOCATOR = DWORD($80004008); - CO_E_INIT_CLASS_CACHE = DWORD($80004009); - CO_E_INIT_RPC_CHANNEL = DWORD($8000400A); - CO_E_INIT_TLS_SET_CHANNEL_CONTROL = DWORD($8000400B); - CO_E_INIT_TLS_CHANNEL_CONTROL = DWORD($8000400C); - CO_E_INIT_UNACCEPTED_USER_ALLOCATOR = DWORD($8000400D); - CO_E_INIT_SCM_MUTEX_EXISTS = DWORD($8000400E); - CO_E_INIT_SCM_FILE_MAPPING_EXISTS = DWORD($8000400F); - CO_E_INIT_SCM_MAP_VIEW_OF_FILE = DWORD($80004010); - CO_E_INIT_SCM_EXEC_FAILURE = DWORD($80004011); - CO_E_INIT_ONLY_SINGLE_THREADED = DWORD($80004012); - CO_E_CANT_REMOTE = DWORD($80004013); - CO_E_BAD_SERVER_NAME = DWORD($80004014); - CO_E_WRONG_SERVER_IDENTITY = DWORD($80004015); - CO_E_OLE1DDE_DISABLED = DWORD($80004016); - CO_E_RUNAS_SYNTAX = DWORD($80004017); - CO_E_CREATEPROCESS_FAILURE = DWORD($80004018); - CO_E_RUNAS_CREATEPROCESS_FAILURE = DWORD($80004019); - CO_E_RUNAS_LOGON_FAILURE = DWORD($8000401A); - CO_E_LAUNCH_PERMSSION_DENIED = DWORD($8000401B); - CO_E_START_SERVICE_FAILURE = DWORD($8000401C); - CO_E_REMOTE_COMMUNICATION_FAILURE = DWORD($8000401D); - CO_E_SERVER_START_TIMEOUT = DWORD($8000401E); - CO_E_CLSREG_INCONSISTENT = DWORD($8000401F); - CO_E_IIDREG_INCONSISTENT = DWORD($80004020); - CO_E_NOT_SUPPORTED = DWORD($80004021); - - CO_E_FIRST = DWORD($800401F0); - CO_E_LAST = DWORD($800401FF); - CO_S_FIRST = $401F0; - CO_S_LAST = $401FF; - S_OK = $00000000; - S_FALSE = $00000001; - - CO_E_NOTINITIALIZED = DWORD($800401F0); - CO_E_ALREADYINITIALIZED = DWORD($800401F1); - CO_E_CANTDETERMINECLASS = DWORD($800401F2); - CO_E_CLASSSTRING = DWORD($800401F3); - CO_E_IIDSTRING = DWORD($800401F4); - CO_E_APPNOTFOUND = DWORD($800401F5); - CO_E_APPSINGLEUSE = DWORD($800401F6); - CO_E_ERRORINAPP = DWORD($800401F7); - CO_E_DLLNOTFOUND = DWORD($800401F8); - CO_E_ERRORINDLL = DWORD($800401F9); - CO_E_WRONGOSFORAPP = DWORD($800401FA); - CO_E_OBJNOTREG = DWORD($800401FB); - CO_E_OBJISREG = DWORD($800401FC); - CO_E_OBJNOTCONNECTED = DWORD($800401FD); - CO_E_APPDIDNTREG = DWORD($800401FE); - CO_E_RELEASED = DWORD($800401FF); - - OLE_E_FIRST = $80040000; - OLE_E_LAST = $800400FF; - OLE_S_FIRST = $00040000; - OLE_S_LAST = $000400FF; - OLE_E_OLEVERB = $80040000; - OLE_E_ADVF = $80040001; - OLE_E_ENUM_NOMORE = $80040002; - OLE_E_ADVISENOTSUPPORTED = $80040003; - OLE_E_NOCONNECTION = $80040004; - OLE_E_NOTRUNNING = $80040005; - OLE_E_NOCACHE = $80040006; - OLE_E_BLANK = $80040007; - OLE_E_CLASSDIFF = $80040008; - OLE_E_CANT_GETMONIKER = $80040009; - OLE_E_CANT_BINDTOSOURCE = $8004000A; - OLE_E_STATIC = $8004000B; - OLE_E_PROMPTSAVECANCELLED = $8004000C; - OLE_E_INVALIDRECT = $8004000D; - OLE_E_WRONGCOMPOBJ = $8004000E; - OLE_E_INVALIDHWND = $8004000F; - OLE_E_NOT_INPLACEACTIVE = $80040010; - OLE_E_CANTCONVERT = $80040011; - OLE_E_NOSTORAGE = $80040012; - DV_E_FORMATETC = $80040064; - DV_E_DVTARGETDEVICE = $80040065; - DV_E_STGMEDIUM = $80040066; - DV_E_STATDATA = $80040067; - DV_E_LINDEX = $80040068; - DV_E_TYMED = $80040069; - DV_E_CLIPFORMAT = $8004006A; - DV_E_DVASPECT = $8004006B; - DV_E_DVTARGETDEVICE_SIZE = $8004006C; - DV_E_NOIVIEWOBJECT = $8004006D; - DRAGDROP_E_FIRST = $80040100; - DRAGDROP_E_LAST = $8004010F; - DRAGDROP_S_FIRST = $00040100; - DRAGDROP_S_LAST = $0004010F; - DRAGDROP_E_NOTREGISTERED = $80040100; - DRAGDROP_E_ALREADYREGISTERED = $80040101; - DRAGDROP_E_INVALIDHWND = $80040102; - CLASSFACTORY_E_FIRST = $80040110; - CLASSFACTORY_E_LAST = $8004011F; - CLASSFACTORY_S_FIRST = $00040110; - CLASSFACTORY_S_LAST = $0004011F; - CLASS_E_NOAGGREGATION = $80040110; - CLASS_E_CLASSNOTAVAILABLE = $80040111; - MARSHAL_E_FIRST = $80040120; - MARSHAL_E_LAST = $8004012F; - MARSHAL_S_FIRST = $00040120; - MARSHAL_S_LAST = $0004012F; - DATA_E_FIRST = $80040130; - DATA_E_LAST = $8004013F; - DATA_S_FIRST = $00040130; - DATA_S_LAST = $0004013F; - VIEW_E_FIRST = $80040140; - VIEW_E_LAST = $8004014F; - VIEW_S_FIRST = $00040140; - VIEW_S_LAST = $0004014F; - VIEW_E_DRAW = $80040140; - REGDB_E_FIRST = $80040150; - REGDB_E_LAST = $8004015F; - REGDB_S_FIRST = $00040150; - REGDB_S_LAST = $0004015F; - REGDB_E_READREGDB = $80040150; - REGDB_E_WRITEREGDB = $80040151; - REGDB_E_KEYMISSING = $80040152; - REGDB_E_INVALIDVALUE = $80040153; - REGDB_E_CLASSNOTREG = $80040154; - REGDB_E_IIDNOTREG = $80040155; - CACHE_E_FIRST = $80040170; - CACHE_E_LAST = $8004017F; - CACHE_S_FIRST = $00040170; - CACHE_S_LAST = $0004017F; - CACHE_E_NOCACHE_UPDATED = $80040170; - OLEOBJ_E_FIRST = $80040180; - OLEOBJ_E_LAST = $8004018F; - OLEOBJ_S_FIRST = $00040180; - OLEOBJ_S_LAST = $0004018F; - OLEOBJ_E_NOVERBS = $80040180; - OLEOBJ_E_INVALIDVERB = $80040181; - CLIENTSITE_E_FIRST = $80040190; - CLIENTSITE_E_LAST = $8004019F; - CLIENTSITE_S_FIRST = $00040190; - CLIENTSITE_S_LAST = $0004019F; - INPLACE_E_NOTUNDOABLE = $800401A0; - INPLACE_E_NOTOOLSPACE = $800401A1; - INPLACE_E_FIRST = $800401A0; - INPLACE_E_LAST = $800401AF; - INPLACE_S_FIRST = $000401A0; - INPLACE_S_LAST = $000401AF; - ENUM_E_FIRST = $800401B0; - ENUM_E_LAST = $800401BF; - ENUM_S_FIRST = $000401B0; - ENUM_S_LAST = $000401BF; - CONVERT10_E_FIRST = $800401C0; - CONVERT10_E_LAST = $800401CF; - CONVERT10_S_FIRST = $000401C0; - CONVERT10_S_LAST = $000401CF; - CONVERT10_E_OLESTREAM_GET = $800401C0; - CONVERT10_E_OLESTREAM_PUT = $800401C1; - CONVERT10_E_OLESTREAM_FMT = $800401C2; - CONVERT10_E_OLESTREAM_BITMAP_TO_DIB = $800401C3; - CONVERT10_E_STG_FMT = $800401C4; - CONVERT10_E_STG_NO_STD_STREAM = $800401C5; - CONVERT10_E_STG_DIB_TO_BITMAP = $800401C6; - CLIPBRD_E_FIRST = $800401D0; - CLIPBRD_E_LAST = $800401DF; - CLIPBRD_S_FIRST = $000401D0; - CLIPBRD_S_LAST = $000401DF; - CLIPBRD_E_CANT_OPEN = $800401D0; - CLIPBRD_E_CANT_EMPTY = $800401D1; - CLIPBRD_E_CANT_SET = $800401D2; - CLIPBRD_E_BAD_DATA = $800401D3; - CLIPBRD_E_CANT_CLOSE = $800401D4; - MK_E_FIRST = $800401E0; - MK_E_LAST = $800401EF; - MK_S_FIRST = $000401E0; - MK_S_LAST = $000401EF; - MK_E_CONNECTMANUALLY = $800401E0; - MK_E_EXCEEDEDDEADLINE = $800401E1; - MK_E_NEEDGENERIC = $800401E2; - MK_E_UNAVAILABLE = $800401E3; - MK_E_SYNTAX = $800401E4; - MK_E_NOOBJECT = $800401E5; - MK_E_INVALIDEXTENSION = $800401E6; - MK_E_INTERMEDIATEINTERFACENOTSUPPORTED = $800401E7; - MK_E_NOTBINDABLE = $800401E8; - MK_E_NOTBOUND = $800401E9; - MK_E_CANTOPENFILE = $800401EA; - MK_E_MUSTBOTHERUSER = $800401EB; - MK_E_NOINVERSE = $800401EC; - MK_E_NOSTORAGE = $800401ED; - MK_E_NOPREFIX = $800401EE; - MK_E_ENUMERATION_FAILED = $800401EF; - OLE_S_USEREG = $00040000; - OLE_S_STATIC = $00040001; - OLE_S_MAC_CLIPFORMAT = $00040002; - DRAGDROP_S_DROP = $00040100; - DRAGDROP_S_CANCEL = $00040101; - DRAGDROP_S_USEDEFAULTCURSORS = $00040102; - DATA_S_SAMEFORMATETC = $00040130; - VIEW_S_ALREADY_FROZEN = $00040140; - CACHE_S_FORMATETC_NOTSUPPORTED = $00040170; - CACHE_S_SAMECACHE = $00040171; - CACHE_S_SOMECACHES_NOTUPDATED = $00040172; - OLEOBJ_S_INVALIDVERB = $00040180; - OLEOBJ_S_CANNOT_DOVERB_NOW = $00040181; - OLEOBJ_S_INVALIDHWND = $00040182; - INPLACE_S_TRUNCATED = $000401A0; - CONVERT10_S_NO_PRESENTATION = $000401C0; - MK_S_REDUCED_TO_SELF = $000401E2; - MK_S_ME = $000401E4; - MK_S_HIM = $000401E5; - MK_S_US = $000401E6; - MK_S_MONIKERALREADYREGISTERED = $000401E7; - CO_E_CLASS_CREATE_FAILED = $80080001; - CO_E_SCM_ERROR = $80080002; - CO_E_SCM_RPC_FAILURE = $80080003; - CO_E_BAD_PATH = $80080004; - CO_E_SERVER_EXEC_FAILURE = $80080005; - CO_E_OBJSRV_RPC_FAILURE = $80080006; - MK_E_NO_NORMALIZED = $80080007; - CO_E_SERVER_STOPPING = $80080008; - MEM_E_INVALID_ROOT = $80080009; - MEM_E_INVALID_LINK = $80080010; - MEM_E_INVALID_SIZE = $80080011; - CO_S_NOTALLINTERFACES = $00080012; - DISP_E_UNKNOWNINTERFACE = $80020001; - DISP_E_MEMBERNOTFOUND = $80020003; - DISP_E_PARAMNOTFOUND = $80020004; - DISP_E_TYPEMISMATCH = $80020005; - DISP_E_UNKNOWNNAME = $80020006; - DISP_E_NONAMEDARGS = $80020007; - DISP_E_BADVARTYPE = $80020008; - DISP_E_EXCEPTION = $80020009; - DISP_E_OVERFLOW = $8002000A; - DISP_E_BADINDEX = $8002000B; - DISP_E_UNKNOWNLCID = $8002000C; - DISP_E_ARRAYISLOCKED = $8002000D; - DISP_E_BADPARAMCOUNT = $8002000E; - DISP_E_PARAMNOTOPTIONAL = $8002000F; - DISP_E_BADCALLEE = $80020010; - DISP_E_NOTACOLLECTION = $80020011; - TYPE_E_BUFFERTOOSMALL = $80028016; - TYPE_E_INVDATAREAD = $80028018; - TYPE_E_UNSUPFORMAT = $80028019; - TYPE_E_REGISTRYACCESS = $8002801C; - TYPE_E_LIBNOTREGISTERED = $8002801D; - TYPE_E_UNDEFINEDTYPE = $80028027; - TYPE_E_QUALIFIEDNAMEDISALLOWED = $80028028; - TYPE_E_INVALIDSTATE = $80028029; - TYPE_E_WRONGTYPEKIND = $8002802A; - TYPE_E_ELEMENTNOTFOUND = $8002802B; - TYPE_E_AMBIGUOUSNAME = $8002802C; - TYPE_E_NAMECONFLICT = $8002802D; - TYPE_E_UNKNOWNLCID = $8002802E; - TYPE_E_DLLFUNCTIONNOTFOUND = $8002802F; - TYPE_E_BADMODULEKIND = $800288BD; - TYPE_E_SIZETOOBIG = $800288C5; - TYPE_E_DUPLICATEID = $800288C6; - TYPE_E_INVALIDID = $800288CF; - TYPE_E_TYPEMISMATCH = $80028CA0; - TYPE_E_OUTOFBOUNDS = $80028CA1; - TYPE_E_IOERROR = $80028CA2; - TYPE_E_CANTCREATETMPFILE = $80028CA3; - TYPE_E_CANTLOADLIBRARY = $80029C4A; - TYPE_E_INCONSISTENTPROPFUNCS = $80029C83; - TYPE_E_CIRCULARTYPE = $80029C84; - STG_E_INVALIDFUNCTION = $80030001; - STG_E_FILENOTFOUND = $80030002; - STG_E_PATHNOTFOUND = $80030003; - STG_E_TOOMANYOPENFILES = $80030004; - STG_E_ACCESSDENIED = $80030005; - STG_E_INVALIDHANDLE = $80030006; - STG_E_INSUFFICIENTMEMORY = $80030008; - STG_E_INVALIDPOINTER = $80030009; - STG_E_NOMOREFILES = $80030012; - STG_E_DISKISWRITEPROTECTED = $80030013; - STG_E_SEEKERROR = $80030019; - STG_E_WRITEFAULT = $8003001D; - STG_E_READFAULT = $8003001E; - STG_E_SHAREVIOLATION = $80030020; - STG_E_LOCKVIOLATION = $80030021; - STG_E_FILEALREADYEXISTS = $80030050; - STG_E_INVALIDPARAMETER = $80030057; - STG_E_MEDIUMFULL = $80030070; - STG_E_PROPSETMISMATCHED = $800300F0; - STG_E_ABNORMALAPIEXIT = $800300FA; - STG_E_INVALIDHEADER = $800300FB; - STG_E_INVALIDNAME = $800300FC; - STG_E_UNKNOWN = $800300FD; - STG_E_UNIMPLEMENTEDFUNCTION = $800300FE; - STG_E_INVALIDFLAG = $800300FF; - STG_E_INUSE = $80030100; - STG_E_NOTCURRENT = $80030101; - STG_E_REVERTED = $80030102; - STG_E_CANTSAVE = $80030103; - STG_E_OLDFORMAT = $80030104; - STG_E_OLDDLL = $80030105; - STG_E_SHAREREQUIRED = $80030106; - STG_E_NOTFILEBASEDSTORAGE = $80030107; - STG_E_EXTANTMARSHALLINGS = $80030108; - STG_E_DOCFILECORRUPT = $80030109; - STG_E_BADBASEADDRESS = $80030110; - STG_E_INCOMPLETE = $80030201; - STG_E_TERMINATED = $80030202; - STG_S_CONVERTED = $00030200; - STG_S_BLOCK = $00030201; - STG_S_RETRYNOW = $00030202; - STG_S_MONITORING = $00030203; - RPC_E_CALL_REJECTED = $80010001; - RPC_E_CALL_CANCELED = $80010002; - RPC_E_CANTPOST_INSENDCALL = $80010003; - RPC_E_CANTCALLOUT_INASYNCCALL = $80010004; - RPC_E_CANTCALLOUT_INEXTERNALCALL = $80010005; - RPC_E_CONNECTION_TERMINATED = $80010006; - RPC_E_SERVER_DIED = $80010007; - RPC_E_CLIENT_DIED = $80010008; - RPC_E_INVALID_DATAPACKET = $80010009; - RPC_E_CANTTRANSMIT_CALL = $8001000A; - RPC_E_CLIENT_CANTMARSHAL_DATA = $8001000B; - RPC_E_CLIENT_CANTUNMARSHAL_DATA = $8001000C; - RPC_E_SERVER_CANTMARSHAL_DATA = $8001000D; - RPC_E_SERVER_CANTUNMARSHAL_DATA = $8001000E; - RPC_E_INVALID_DATA = $8001000F; - RPC_E_INVALID_PARAMETER = $80010010; - RPC_E_CANTCALLOUT_AGAIN = $80010011; - RPC_E_SERVER_DIED_DNE = $80010012; - RPC_E_SYS_CALL_FAILED = $80010100; - RPC_E_OUT_OF_RESOURCES = $80010101; - RPC_E_ATTEMPTED_MULTITHREAD = $80010102; - RPC_E_NOT_REGISTERED = $80010103; - RPC_E_FAULT = $80010104; - RPC_E_SERVERFAULT = $80010105; - RPC_E_CHANGED_MODE = $80010106; - RPC_E_INVALIDMETHOD = $80010107; - RPC_E_DISCONNECTED = $80010108; - RPC_E_RETRY = $80010109; - RPC_E_SERVERCALL_RETRYLATER = $8001010A; - RPC_E_SERVERCALL_REJECTED = $8001010B; - RPC_E_INVALID_CALLDATA = $8001010C; - RPC_E_CANTCALLOUT_ININPUTSYNCCALL = $8001010D; - RPC_E_WRONG_THREAD = $8001010E; - RPC_E_THREAD_NOT_INIT = $8001010F; - RPC_E_VERSION_MISMATCH = $80010110; - RPC_E_INVALID_HEADER = $80010111; - RPC_E_INVALID_EXTENSION = $80010112; - RPC_E_INVALID_IPID = $80010113; - RPC_E_INVALID_OBJECT = $80010114; - RPC_S_CALLPENDING = $80010115; - RPC_S_WAITONTIMER = $80010116; - RPC_E_CALL_COMPLETE = $80010117; - RPC_E_UNSECURE_CALL = $80010118; - RPC_E_TOO_LATE = $80010119; - RPC_E_NO_GOOD_SECURITY_PACKAGES = $8001011A; - RPC_E_ACCESS_DENIED = $8001011B; - RPC_E_REMOTE_DISABLED = $8001011C; - RPC_E_INVALID_OBJREF = $8001011D; - RPC_E_UNEXPECTED = $8001FFFF; - NTE_BAD_UID = $80090001; - NTE_BAD_HASH = $80090002; - NTE_BAD_KEY = $80090003; - NTE_BAD_LEN = $80090004; - NTE_BAD_DATA = $80090005; - NTE_BAD_SIGNATURE = $80090006; - NTE_BAD_VER = $80090007; - NTE_BAD_ALGID = $80090008; - NTE_BAD_FLAGS = $80090009; - NTE_BAD_TYPE = $8009000A; - NTE_BAD_KEY_STATE = $8009000B; - NTE_BAD_HASH_STATE = $8009000C; - NTE_NO_KEY = $8009000D; - NTE_NO_MEMORY = $8009000E; - NTE_EXISTS = $8009000F; - NTE_PERM = $80090010; - NTE_NOT_FOUND = $80090011; - NTE_DOUBLE_ENCRYPT = $80090012; - NTE_BAD_PROVIDER = $80090013; - NTE_BAD_PROV_TYPE = $80090014; - NTE_BAD_PUBLIC_KEY = $80090015; - NTE_BAD_KEYSET = $80090016; - NTE_PROV_TYPE_NOT_DEF = $80090017; - NTE_PROV_TYPE_ENTRY_BAD = $80090018; - NTE_KEYSET_NOT_DEF = $80090019; - NTE_KEYSET_ENTRY_BAD = $8009001A; - NTE_PROV_TYPE_NO_MATCH = $8009001B; - NTE_SIGNATURE_FILE_BAD = $8009001C; - NTE_PROVIDER_DLL_FAIL = $8009001D; - NTE_PROV_DLL_NOT_FOUND = $8009001E; - NTE_BAD_KEYSET_PARAM = $8009001F; - NTE_FAIL = $80090020; - NTE_SYS_ERR = $80090021; - NTE_OP_OK = 0; - TRUST_E_PROVIDER_UNKNOWN = $800B0001; - TRUST_E_ACTION_UNKNOWN = $800B0002; - TRUST_E_SUBJECT_FORM_UNKNOWN = $800B0003; - TRUST_E_SUBJECT_NOT_TRUSTED = $800B0004; - DIGSIG_E_ENCODE = $800B0005; - DIGSIG_E_DECODE = $800B0006; - DIGSIG_E_EXTENSIBILITY = $800B0007; - DIGSIG_E_CRYPTO = $800B0008; - PERSIST_E_SIZEDEFINITE = $800B0009; - PERSIST_E_SIZEINDEFINITE = $800B000A; - PERSIST_E_NOTSELFSIZING = $800B000B; - TRUST_E_NOSIGNATURE = $800B0100; - CERT_E_EXPIRED = $800B0101; - CERT_E_VALIDIYPERIODNESTING = $800B0102; - CERT_E_ROLE = $800B0103; - CERT_E_PATHLENCONST = $800B0104; - CERT_E_CRITICAL = $800B0105; - CERT_E_PURPOSE = $800B0106; - CERT_E_ISSUERCHAINING = $800B0107; - CERT_E_MALFORMED = $800B0108; - CERT_E_UNTRUSTEDROOT = $800B0109; - CERT_E_CHAINING = $800B010A; - -{$endif read_interface} - diff --git a/rtl/wince/wininc/func.inc b/rtl/wince/wininc/func.inc deleted file mode 100644 index 69eea5b969..0000000000 --- a/rtl/wince/wininc/func.inc +++ /dev/null @@ -1,2545 +0,0 @@ -{
- This file is part of the Free Pascal run time library.
- This unit contains the record definition for the Win32 API
- Copyright (c) 1999-2000 by Florian KLaempfl,
- member of the Free Pascal development team.
-
- 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.
-
- **********************************************************************}
-
-
-{
- Functions.h
-
- Declarations for all the Windows32 API Functions
-
- Copyright (C) 1996, 1997 Free Software Foundation, Inc.
-
- Author: Scott Christley <scottc@net-community.com>
-
- This file is part of the Windows32 API Library.
-
- This library is free software; you can redistribute it and/or
- modify it under the terms of the GNU Library General Public
- License as published by the Free Software Foundation; either
- version 2 of the License, or (at your option) any later version.
-
- This library is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
-
- If you are interested in a warranty or support for this source code,
- contact Scott Christley <scottc@net-community.com> for more information.
-
- You should have received a copy of the GNU Library General Public
- License along with this library; see the file COPYING.LIB.
- If not, write to the Free Software Foundation,
- 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
- Changes :
-
- 08/22/2005 update for wince4.2 port, orinaudo@gmail.com
-}
-
-{$ifdef read_interface}
-//begin common win32 & wince
-function AbortDoc(_para1:HDC):Integer; external GdiDLL name 'AbortDoc';
-function AdjustWindowRectEx(lpRect:LPRECT; dwStyle:DWORD; bMenu:WINBOOL; dwExStyle:DWORD):WINBOOL; external UserDLLCore name 'AdjustWindowRectEx';
-function BeginDeferWindowPos(nNumWindows:Integer):HDWP; external UserDLLCore name 'BeginDeferWindowPos';
-function BeginPaint(hWnd:HWND; lpPaint:LPPAINTSTRUCT):HDC; external UserDLLCore name 'BeginPaint';
-function BitBlt(_para1:HDC; _para2:Integer; _para3:Integer; _para4:Integer; _para5:Integer;_para6:HDC; _para7:Integer; _para8:Integer; _para9:DWORD):WINBOOL; external GdiDLL name 'BitBlt';
-function BringWindowToTop(hWnd:HWND):WINBOOL; external UserDLLCore name 'BringWindowToTop';
-function CallNextHookEx(hhk:HHOOK; nCode:Integer; wParam:WPARAM; lParam:LPARAM):LRESULT; external UserDLLCore name 'CallNextHookEx';
-function CheckMenuItem(hMenu:HMENU; uIDCheckItem:UINT; uCheck:UINT):DWORD; external UserDLLCore name 'CheckMenuItem';
-function CheckMenuRadioItem(_para1:HMENU; _para2:UINT; _para3:UINT; _para4:UINT; _para5:UINT):WINBOOL; external UserDLLCore name 'CheckMenuRadioItem';
-function CheckRadioButton(hDlg:HWND; nIDFirstButton:Integer; nIDLastButton:Integer; nIDCheckButton:Integer):WINBOOL; external UserDLLCore name 'CheckRadioButton';
-function ClearCommBreak(hFile:HANDLE):WINBOOL; external KernelDLL name 'ClearCommBreak';
-function ClearCommError(hFile:HANDLE; lpErrors:LPDWORD; lpStat:LPCOMSTAT):WINBOOL; external KernelDLL name 'ClearCommError';
-function ClientToScreen(hWnd:HWND; lpPoint:LPPOINT):WINBOOL; external UserDLLCore name 'ClientToScreen';
-function ClipCursor(lpRect:LPRECT):WINBOOL; external UserDLLCore name 'ClipCursor';
-function CloseClipboard:WINBOOL; external UserDLLCore name 'CloseClipboard';
-function CloseEnhMetaFile(_para1:HDC):HENHMETAFILE; external GdiDLL name 'CloseEnhMetaFile';
-function CloseHandle(hObject:HANDLE):WINBOOL; external KernelDLL name 'CloseHandle';
-function CombineRgn(_para1:HRGN; _para2:HRGN; _para3:HRGN; _para4:Integer):Integer; external GdiDLL name 'CombineRgn';
-function CommDlgExtendedError : DWORD; external ComdlgDLL name 'CommDlgExtendedError';
-//to move to ascfun
-function CommDlg_OpenSave_GetSpecA(_hdlg:HWND;_psz:LPSTR;_cbmax : Integer) : LRESULT;
-//to move to unifun
-function CommDlg_OpenSave_GetSpecW(_hdlg:HWND;_psz:LPWSTR;_cbmax : Integer) : LRESULT;
-{$ifndef Unicode}
-//to move to ascdef
-function CommDlg_OpenSave_GetSpec(_hdlg:HWND;_psz:LPSTR;_cbmax : Integer) : LRESULT;
-{$endif Unicode}
-//to move to ascfun
-function CommDlg_OpenSave_GetFilePathA(_hdlg:HWND;_psz:LPSTR;_cbmax : Integer) : LRESULT;
-//to move to unifun
-function CommDlg_OpenSave_GetFilePathW(_hdlg:HWND;_psz:LPWSTR;_cbmax : Integer) : LRESULT;
-{$ifndef Unicode}
-//to move to ascdef
-function CommDlg_OpenSave_GetFilePath(_hdlg:HWND;_psz:LPSTR;_cbmax : Integer) : LRESULT;
-{$endif Unicode}
-//to move to ascfun
-function CommDlg_OpenSave_GetFolderPathA(_hdlg:HWND;_psz:LPSTR;_cbmax : Integer) : LRESULT;
-//to move to unifun
-function CommDlg_OpenSave_GetFolderPathW(_hdlg:HWND;_psz:LPWSTR;_cbmax : Integer) : LRESULT;
-{$ifndef Unicode}
-//to move to ascdef
-function CommDlg_OpenSave_GetFolderPath(_hdlg:HWND;_psz:LPSTR;_cbmax : Integer) : LRESULT;
-{$endif Unicode}
-//begin moved to unidef
-//function CommDlg_OpenSave_GetSpec(_hdlg:HWND;_psz:LPWSTR;_cbmax : Integer) : LRESULT;
-//function CommDlg_OpenSave_GetFilePath(_hdlg:HWND;_psz:LPWSTR;_cbmax : Integer) : LRESULT;
-//function CommDlg_OpenSave_GetFolderPath(_hdlg:HWND;_psz:LPWSTR;_cbmax : Integer) : LRESULT;
-//end moved to unidef
-function CommDlg_OpenSave_GetFolderIDList(_hdlg:HWND;_pidl:LPVOID;_cbmax : Integer) : LRESULT;
-function CommDlg_OpenSave_SetControlText(_hdlg:HWND;_id : Integer;_text : LPSTR) : LRESULT;
-function CommDlg_OpenSave_HideControl(_hdlg:HWND;_id : Integer) : LRESULT;
-function CommDlg_OpenSave_SetDefExt(_hdlg:HWND;_pszext : LPSTR) : LRESULT;
-function CompareFileTime(lpFileTime1:LPFILETIME; lpFileTime2:LPFILETIME):LONG; external KernelDLL name 'CompareFileTime';
-function ContinueDebugEvent(dwProcessId:DWORD; dwThreadId:DWORD; dwContinueStatus:DWORD):WINBOOL; external KernelDLL name 'ContinueDebugEvent';
-function ConvertDefaultLocale(Locale:LCID):LCID; external KernelDLL name 'ConvertDefaultLocale';
-procedure CopyMemory(Destination:PVOID; Source:pointer; Length:DWORD);
-function CopyRect(lprcDst:LPRECT; var lprcSrc:RECT):WINBOOL; external UserDLLCore name 'CopyRect';
-function CountClipboardFormats:Integer; external UserDLLCore name 'CountClipboardFormats';
-function CreateBitmap(_para1:Integer; _para2:Integer; _para3:UINT; _para4:UINT; _para5:pointer):HBITMAP; external GdiDLL name 'CreateBitmap';
-function CreateCaret(hWnd:HWND; hBitmap:HBITMAP; nWidth:Integer; nHeight:Integer):WINBOOL; external UserDLLCore name 'CreateCaret';
-function CreateCompatibleBitmap(_para1:HDC; _para2:Integer; _para3:Integer):HBITMAP; external GdiDLL name 'CreateCompatibleBitmap';
-function CreateCompatibleDC(_para1:HDC):HDC; external GdiDLL name 'CreateCompatibleDC';
-function CreateDIBPatternBrushPt(_para1:pointer; _para2:UINT):HBRUSH; external GdiDLL name 'CreateDIBPatternBrushPt';
-function CreateDIBSection(_para1:HDC; var _para2:BITMAPINFO; _para3:UINT; var _para4:pointer; _para5:HANDLE;_para6:DWORD):HBITMAP; external GdiDLL name 'CreateDIBSection';
-function CreateIconIndirect(piconinfo:PICONINFO):HICON; external UserDLLCore name 'CreateIconIndirect';
-function CreateMenu:HMENU; external UserDLLCore name 'CreateMenu';
-function CreatePopupMenu:HMENU; external UserDLLCore name 'CreatePopupMenu';
-function CreatePalette(var _para1:LOGPALETTE):HPALETTE; external GdiDLL name 'CreatePalette';
-function CreatePatternBrush(_para1:HBITMAP):HBRUSH; external GdiDLL name 'CreatePatternBrush';
-function CreatePen(_para1:Integer; _para2:Integer; _para3:COLORREF):HPEN; external GdiDLL name 'CreatePen';
-function CreatePenIndirect(var _para1:LOGPEN):HPEN; external GdiDLL name 'CreatePenIndirect';
-function CreateRectRgn(_para1:Integer; _para2:Integer; _para3:Integer; _para4:Integer):HRGN; external GdiDLL name 'CreateRectRgn';
-function CreateRectRgnIndirect(var _para1:RECT):HRGN; external GdiDLL name 'CreateRectRgnIndirect';
-function CreateSolidBrush(_para1:COLORREF):HBRUSH; external GdiDLL name 'CreateSolidBrush';
-function CreateToolbarEx(hwnd:HWND; ws:DWORD; wID:UINT; nBitmaps:Integer; hBMInst:HINST;wBMID:UINT; lpButtons:LPCTBBUTTON; iNumButtons:Integer; dxButton:Integer; dyButton:Integer;dxBitmap:Integer;
- dyBitmap:Integer; uStructSize:UINT):HWND; external ComctlDLL name 'CreateToolbarEx';
-function CreateUpDownControl(dwStyle:DWORD; x:Integer; y:Integer; cx:Integer; cy:Integer;hParent:HWND; nID:Integer; hInst:HINST; hBuddy:HWND; nUpper:Integer;nLower:Integer; nPos:Integer):HWND; external ComctlDLL name 'CreateUpDownControl';
-function DebugActiveProcess(dwProcessId:DWORD):WINBOOL; external KernelDLL name 'DebugActiveProcess';
-function DeferWindowPos(hWinPosInfo:HDWP; hWnd:HWND; hWndInsertAfter:HWND; x:Integer; y:Integer;cx:Integer; cy:Integer; uFlags:UINT):HDWP; external UserDLLCore name 'DeferWindowPos';
-procedure DeleteCriticalSection(lpCriticalSection:LPCRITICAL_SECTION); external KernelDLL name 'DeleteCriticalSection';
-function DeleteDC(_para1:HDC):WINBOOL; external GdiDLL name 'DeleteDC';
-function DeleteEnhMetaFile(_para1:HENHMETAFILE):WINBOOL; external GdiDLL name 'DeleteEnhMetaFile';
-function DeleteMenu(hMenu:HMENU; uPosition:UINT; uFlags:UINT):WINBOOL; external UserDLLCore name 'DeleteMenu';
-function DeleteObject(_para1:HGDIOBJ):WINBOOL; external GdiDLL name 'DeleteObject';
-function DestroyAcceleratorTable(hAccel:HACCEL):WINBOOL; external UserDLLCore name 'DestroyAcceleratorTable';
-function DestroyCaret:WINBOOL; external UserDLLCore name 'DestroyCaret';
-function DestroyIcon(hIcon:HICON):WINBOOL; external UserDLLCore name 'DestroyIcon';
-function DestroyMenu(hMenu:HMENU):WINBOOL; external UserDLLCore name 'DestroyMenu';
-function DestroyPropertySheetPage(hPSPage:HPROPSHEETPAGE):WINBOOL; external ComctlDLL name 'DestroyPropertySheetPage';
-function DestroyWindow(hWnd:HWND):WINBOOL; external UserDLLCore name 'DestroyWindow';
-function DeviceIoControl(hDevice:HANDLE; dwIoControlCode:DWORD; lpInBuffer:LPVOID; nInBufferSize:DWORD; lpOutBuffer:LPVOID;nOutBufferSize:DWORD; lpBytesReturned:LPDWORD; lpOverlapped:LPOVERLAPPED):WINBOOL; external KernelDLL name 'DeviceIoControl';
-function DisableThreadLibraryCalls(hLibModule:HMODULE):WINBOOL; external KernelDLL name 'DisableThreadLibraryCalls';
-function DrawEdge(hdc:HDC; qrc:LPRECT; edge:UINT; grfFlags:UINT):WINBOOL; external UserDLLCore name 'DrawEdge';
-function DrawFocusRect(hDC:HDC; var lprc:RECT):WINBOOL; external UserDLLCore name 'DrawFocusRect';
-function DrawFrameControl(_para1:HDC; _para2:LPRECT; _para3:UINT; _para4:UINT):WINBOOL; external UserDLLCore name 'DrawFrameControl';
-function DrawIconEx(hdc:HDC; xLeft:Integer; yTop:Integer; hIcon:HICON; cxWidth:Integer;cyWidth:Integer; istepIfAniCur:UINT; hbrFlickerFreeDraw:HBRUSH; diFlags:UINT):WINBOOL; external UserDLLCore name 'DrawIconEx';
-function DrawMenuBar(hWnd:HWND):WINBOOL; external UserDLLCore name 'DrawMenuBar';
-function DuplicateHandle(hSourceProcessHandle:HANDLE; hSourceHandle:HANDLE; hTargetProcessHandle:HANDLE; lpTargetHandle:LPHANDLE; dwDesiredAccess:DWORD;bInheritHandle:WINBOOL; dwOptions:DWORD):WINBOOL; external KernelDLL name 'DuplicateHandle';
-function Ellipse(_para1:HDC; _para2:Integer; _para3:Integer; _para4:Integer; _para5:Integer):WINBOOL; external GdiDLL name 'Ellipse';
-function EqualRgn(_para1:HRGN; _para2:HRGN):WINBOOL; external GdiDLL name 'EqualRgn';
-function EmptyClipboard:WINBOOL; external UserDLLCore name 'EmptyClipboard';
-function EnableMenuItem(hMenu:HMENU; uIDEnableItem:UINT; uEnable:UINT):WINBOOL; external UserDLLCore name 'EnableMenuItem';
-function EnableWindow(hWnd:HWND; bEnable:WINBOOL):WINBOOL; external UserDLLCore name 'EnableWindow';
-function EndDeferWindowPos(hWinPosInfo:HDWP):WINBOOL; external UserDLLCore name 'EndDeferWindowPos';
-function EndDialog(hDlg:HWND; nResult:Integer):WINBOOL; external UserDLLCore name 'EndDialog';
-function EndDoc(_para1:HDC):Integer; external GdiDLL name 'EndDoc';
-function EndPage(_para1:HDC):Integer; external GdiDLL name 'EndPage';
-function EndPaint(hWnd:HWND; lpPaint:LPPAINTSTRUCT):WINBOOL; external UserDLLCore name 'EndPaint';
-procedure EnterCriticalSection(lpCriticalSection:LPCRITICAL_SECTION); external KernelDLL name 'EnterCriticalSection';
-function EnumClipboardFormats(format:UINT):UINT; external UserDLLCore name 'EnumClipboardFormats';
-function EnumWindows(lpEnumFunc:ENUMWINDOWSPROC; lParam:LPARAM):WINBOOL; external UserDLLCore name 'EnumWindows';
-function EqualRect(var lprc1:RECT; var lprc2:RECT):WINBOOL; external UserDLLCore name 'EqualRect';
-function EscapeCommFunction(hFile:HANDLE; dwFunc:DWORD):WINBOOL; external KernelDLL name 'EscapeCommFunction';
-procedure ExitThread(dwExitCode:DWORD); external KernelDLL name 'ExitThread';
-function ExitWindowsEx(uFlags:UINT; dwReserved:DWORD):WINBOOL; external UserDLLAyg name 'ExitWindowsEx';
-function ExtCreateRegion(var _para1:XFORM; _para2:DWORD; var _para3:RGNDATA):HRGN; external GdiDLL name 'ExtCreateRegion';
-function ExtEscape(_para1:HDC; _para2:Integer; _para3:Integer; _para4:LPCSTR; _para5:Integer;_para6:LPSTR):Integer; external GdiDLL name 'ExtEscape';
-function ExcludeClipRect(_para1:HDC; _para2:Integer; _para3:Integer; _para4:Integer; _para5:Integer):Integer; external GdiDLL name 'ExcludeClipRect';
-function FileTimeToLocalFileTime(lpFileTime:LPFILETIME; lpLocalFileTime:LPFILETIME):WINBOOL; external KernelDLL name 'FileTimeToLocalFileTime';
-function FileTimeToSystemTime(lpFileTime:LPFILETIME; lpSystemTime:LPSYSTEMTIME):WINBOOL; external KernelDLL name 'FileTimeToSystemTime';
-procedure FillMemory(Destination:PVOID; Length:DWORD; Fill:BYTE);
-function FillRect(hDC:HDC; const lprc:RECT; hbr:HBRUSH):Integer; external UserDLLCore name 'FillRect';
-function FindClose(hFindFile:HANDLE):WINBOOL; external KernelDLL name 'FindClose';
-function FindCloseChangeNotification(hChangeHandle:HANDLE):WINBOOL; external KernelDLL name 'FindCloseChangeNotification';
-function FindNextChangeNotification(hChangeHandle:HANDLE):WINBOOL; external KernelDLL name 'FindNextChangeNotification';
-function FlushFileBuffers(hFile:HANDLE):WINBOOL; external KernelDLL name 'FlushFileBuffers';
-function FlushInstructionCache(hProcess:HANDLE; lpBaseAddress:LPCVOID; dwSize:DWORD):WINBOOL; external KernelDLL name 'FlushInstructionCache';
-function FlushViewOfFile(lpBaseAddress:LPCVOID; dwNumberOfBytesToFlush:DWORD):WINBOOL; external KernelDLL name 'FlushViewOfFile';
-function FreeLibrary(hLibModule:HMODULE):WINBOOL; external KernelDLL name 'FreeLibrary';
-procedure FreeLibraryAndExitThread(hLibModule:HMODULE; dwExitCode:DWORD); external KernelDLL name 'FreeLibraryAndExitThread';
-function GetActiveWindow:HWND; external UserDLLCore name 'GetActiveWindow';
-function GetACP:UINT; external KernelDLL name 'GetACP';
-function GetAsyncKeyState(vKey:Integer):SHORT; external UserDLLCore name 'GetAsyncKeyState';
-function GetBkColor(_para1:HDC):COLORREF; external GdiDLL name 'GetBkColor';
-function GetBkMode(_para1:HDC):Integer; external GdiDLL name 'GetBkMode';
-function GetCapture:HWND; external UserDLLCore name 'GetCapture';
-function GetCaretBlinkTime:UINT; external UserDLLCore name 'GetCaretBlinkTime';
-function GetCaretPos(lpPoint:LPPOINT):WINBOOL; external UserDLLCore name 'GetCaretPos';
-function GetClientRect(hWnd:HWND; lpRect:LPRECT):WINBOOL; external UserDLLCore name 'GetClientRect';
-function GetClipboardOwner:HWND; external UserDLLCore name 'GetClipboardOwner';
-function GetClipboardData(uFormat:UINT):HANDLE; external UserDLLCore name 'GetClipboardData';
-function GetClipBox(_para1:HDC; _para2:LPRECT):Integer; external GdiDLL name 'GetClipBox';
-function GetClipCursor(lpRect:LPRECT):WINBOOL; external UserDLLCore name 'GetClipCursor';
-function GetClipRgn(_para1:HDC; _para2:HRGN):Integer; external GdiDLL name 'GetClipRgn';
-function GetCommProperties(hFile:HANDLE; lpCommProp:LPCOMMPROP):WINBOOL; external KernelDLL name 'GetCommProperties';
-function GetCommModemStatus(hFile:HANDLE; lpModemStat:PDWORD):WINBOOL; external KernelDLL name 'GetCommModemStatus';
-function GetCommState(hFile:HANDLE; lpDCB:PDCB):WINBOOL; external KernelDLL name 'GetCommState';
-function GetCommTimeouts(hFile:HANDLE; lpCommTimeouts:PCOMMTIMEOUTS):WINBOOL; external KernelDLL name 'GetCommTimeouts';
-function GetCPInfo(_para1:UINT; _para2:LPCPINFO):WINBOOL; external KernelDLL name 'GetCPInfo';
-function GetCursor:HCURSOR; external UserDLLCore name 'GetCursor';
-function GetCursorPos(lpPoint:LPPOINT):WINBOOL; external UserDLLCore name 'GetCursorPos';
-function GetCurrentObject(_para1:HDC; _para2:UINT):HGDIOBJ; external GdiDLL name 'GetCurrentObject';
-function GetCurrentPositionEx(_para1:HDC; _para2:LPPOINT):WINBOOL; external GdiDLL name 'GetCurrentPositionEx';
-function GetDC(hWnd:HWND):HDC; external UserDLLCore name 'GetDC';
-function GetDCEx(hWnd:HWND; hrgnClip:HRGN; flags:DWORD):HDC; external UserDLLCore name 'GetDCEx';
-function GetDesktopWindow:HWND; external UserDLLCore name 'GetDesktopWindow';
-function GetDeviceCaps(_para1:HDC; _para2:Integer):Integer; external GdiDLL name 'GetDeviceCaps';
-function GetDialogBaseUnits:Integer; external UserDLLCore name 'GetDialogBaseUnits';
-function GetDIBColorTable(_para1:HDC; _para2:UINT; _para3:UINT; var _para4:RGBQUAD):UINT; external GdiDLL name 'GetDIBColorTable';
-function GetDlgCtrlID(hWnd:HWND):Integer; external UserDLLCore name 'GetDlgCtrlID';
-function GetDlgItem(hDlg:HWND; nIDDlgItem:Integer):HWND; external UserDLLCore name 'GetDlgItem';
-function GetDlgItemInt(hDlg:HWND; nIDDlgItem:Integer; var lpTranslated:WINBOOL; bSigned:WINBOOL):UINT; external UserDLLCore name 'GetDlgItemInt';
-function GetDoubleClickTime:UINT; external UserDLLCore name 'GetDoubleClickTime';
-function GetExitCodeProcess(hProcess:HANDLE; lpExitCode:LPDWORD):WINBOOL; external KernelDLL name 'GetExitCodeProcess';
-function GetExitCodeThread(hThread:HANDLE; lpExitCode:LPDWORD):WINBOOL; external KernelDLL name 'GetExitCodeThread';
-function GetFocus:HWND; external UserDLLCore name 'GetFocus';
-function GetForegroundWindow:HWND; external UserDLLCore name 'GetForegroundWindow';
-function GetFileInformationByHandle(hFile:HANDLE; lpFileInformation:LPBY_HANDLE_FILE_INFORMATION):WINBOOL; external KernelDLL name 'GetFileInformationByHandle';
-function GetFileTime(hFile:HANDLE; lpCreationTime:LPFILETIME; lpLastAccessTime:LPFILETIME; lpLastWriteTime:LPFILETIME):WINBOOL; external KernelDLL name 'GetFileTime';
-function GetFileSize(hFile:HANDLE; lpFileSizeHigh:LPDWORD):DWORD; external KernelDLL name 'GetFileSize';
-function GetKeyboardLayout(dwLayout:DWORD):HKL; external UserDLLCore name 'GetKeyboardLayout';
-function GetKeyboardLayoutList(nBuff:Integer; var lpList:HKL):UINT; external UserDLLCore name 'GetKeyboardLayoutList';
-function GetKeyboardType(nTypeFlag:Integer):Integer; external UserDLLCore name 'GetKeyboardType';
-function GetKeyState(nVirtKey:Integer):SHORT; external UserDLLCore name 'GetKeyState';
-function GetLastError:DWORD; external KernelDLL name 'GetLastError';
-procedure GetLocalTime(lpSystemTime:LPSYSTEMTIME); external KernelDLL name 'GetLocalTime';
-function GetMessagePos:DWORD; external UserDLLCore name 'GetMessagePos';
-function GetNearestColor(_para1:HDC; _para2:COLORREF):COLORREF; external GdiDLL name 'GetNearestColor';
-function GetNearestPaletteIndex(_para1:HPALETTE; _para2:COLORREF):UINT; external GdiDLL name 'GetNearestPaletteIndex';
-function GetNextDlgGroupItem(hDlg:HWND; hCtl:HWND; bPrevious:WINBOOL):HWND; external UserDLLCore name 'GetNextDlgGroupItem';
-function GetNextDlgTabItem(hDlg:HWND; hCtl:HWND; bPrevious:WINBOOL):HWND; external UserDLLCore name 'GetNextDlgTabItem';
-function GetObjectType(h:HGDIOBJ):DWORD; external GdiDLL name 'GetObjectType';
-function GetOEMCP:UINT; external KernelDLL name 'GetOEMCP';
-function GetOpenClipboardWindow:HWND; external UserDLLCore name 'GetOpenClipboardWindow';
-function GetPaletteEntries(_para1:HPALETTE; _para2:UINT; _para3:UINT; _para4:LPPALETTEENTRY):UINT; external GdiDLL name 'GetPaletteEntries';
-function GetParent(hWnd:HWND):HWND; external UserDLLCore name 'GetParent';
-function GetPriorityClipboardFormat(var paFormatPriorityList:UINT; cFormats:Integer):Integer; external UserDLLCore name 'GetPriorityClipboardFormat';
-function GetPixel(_para1:HDC; _para2:Integer; _para3:Integer):COLORREF; external GdiDLL name 'GetPixel';
-function GetProcessHeap:HANDLE; external KernelDLL name 'GetProcessHeap';
-function GetQueueStatus(flags:UINT):DWORD; external UserDLLCore name 'GetQueueStatus';
-function GetRegionData(_para1:HRGN; _para2:DWORD; _para3:LPRGNDATA):DWORD; external GdiDLL name 'GetRegionData';
-function GetRgnBox(_para1:HRGN; _para2:LPRECT):Integer; external GdiDLL name 'GetRgnBox';
-function GetScrollInfo(_para1:HWND; _para2:Integer; _para3:LPSCROLLINFO):WINBOOL; external UserDLLCore name 'GetScrollInfo';
-function GetStockObject(_para1:Integer):HGDIOBJ; external GdiDLL name 'GetStockObject';
-function GetSubMenu(hMenu:HMENU; nPos:Integer):HMENU; external UserDLLCore name 'GetSubMenu';
-function GetSysColor(nIndex:Integer):DWORD; external UserDLLCore name 'GetSysColor';
-function GetSysColorBrush(nIndex:Integer):HBRUSH; external UserDLLCore name 'GetSysColorBrush';
-function GetSystemDefaultLangID:LANGID; external KernelDLL name 'GetSystemDefaultLangID';
-function GetSystemDefaultLCID:LCID; external KernelDLL name 'GetSystemDefaultLCID';
-procedure GetSystemInfo(lpSystemInfo:LPSYSTEM_INFO); external KernelDLL name 'GetSystemInfo';
-function GetSystemMetrics(nIndex:Integer):Integer; external UserDLLCore name 'GetSystemMetrics';
-procedure GetSystemTime(lpSystemTime:LPSYSTEMTIME); external KernelDLL name 'GetSystemTime';
-function GetSystemPaletteEntries(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPPALETTEENTRY):UINT; external GdiDLL name 'GetSystemPaletteEntries';
-function GetTextAlign(_para1:HDC):UINT; external GdiDLL name 'GetTextAlign';
-function GetTextColor(_para1:HDC):COLORREF; external GdiDLL name 'GetTextColor';
-function GetThreadContext(hThread:HANDLE; lpContext:LPCONTEXT):WINBOOL; external KernelDLL name 'GetThreadContext';
-function GetThreadPriority(hThread:HANDLE):Integer; external KernelDLL name 'GetThreadPriority';
-function GetThreadTimes(hThread:HANDLE; lpCreationTime:LPFILETIME; lpExitTime:LPFILETIME; lpKernelTime:LPFILETIME; lpUserTime:LPFILETIME):WINBOOL; external KernelDLL name 'GetThreadTimes';
-function GetTickCount:DWORD; external KernelDLL name 'GetTickCount';
-function GetTimeZoneInformation(lpTimeZoneInformation:LPTIME_ZONE_INFORMATION):DWORD; external KernelDLL name 'GetTimeZoneInformation';
-function GetUpdateRect(hWnd:HWND; lpRect:LPRECT; bErase:WINBOOL):WINBOOL; external UserDLLCore name 'GetUpdateRect';
-function GetUpdateRgn(hWnd:HWND; hRgn:HRGN; bErase:WINBOOL):Integer; external UserDLLCore name 'GetUpdateRgn';
-function GetUserDefaultLangID:LANGID; external KernelDLL name 'GetUserDefaultLangID';
-function GetUserDefaultLCID:LCID; external KernelDLL name 'GetUserDefaultLCID';
-function GetWindow(hWnd:HWND; uCmd:UINT):HWND; external UserDLLCore name 'GetWindow';
-function GetWindowDC(hWnd:HWND):HDC; external UserDLLCore name 'GetWindowDC';
-function GetWindowRgn(hWnd:HWND; hRgn:HRGN):Integer; external UserDLLCore name 'GetWindowRgn';
-function GetWindowRect(hWnd:HWND; lpRect:LPRECT):WINBOOL; external UserDLLCore name 'GetWindowRect';
-function GetWindowThreadProcessId(hWnd:HWND; lpdwProcessId:LPDWORD):DWORD; external UserDLLCore name 'GetWindowThreadProcessId';
-function GlobalAllocPtr(flags,cb:DWord):Pointer;
-function GlobalFreePtr(lp:Pointer):Pointer;
-function GlobalDiscard(hglbMem:HGLOBAL):HGLOBAL;
-function GlobalLockPtr(lp:pointer):Pointer;
-function GlobalPtrHandle(lp:pointer):Pointer;
-function GlobalUnlockPtr(lp:pointer):Pointer;
-function GlobalDeleteAtom(nAtom:ATOM):ATOM; external KernelDLL name 'GlobalDeleteAtom';
-procedure GlobalMemoryStatus(lpBuffer:LPMEMORYSTATUS); external KernelDLL name 'GlobalMemoryStatus';
-function Header_DeleteItem(hwndHD:HWND;index : Integer) : WINBOOL;
-function Header_GetItem(hwndHD:HWND;index:Integer;var hdi : HD_ITEM) : WINBOOL;
-function Header_GetItemCount(hwndHD : HWND) : Integer;
-function Header_InsertItem(hwndHD:HWND;index : Integer;var hdi : HD_ITEM) : Integer;
-function Header_Layout(hwndHD:HWND;var layout : HD_LAYOUT) : WINBOOL;
-function Header_SetItem(hwndHD:HWND;index : Integer;var hdi : HD_ITEM) : WINBOOL;
-function HeapAlloc(hHeap:HANDLE; dwFlags:DWORD; dwBytes:DWORD):LPVOID; external KernelDLL name 'HeapAlloc';
-function HeapAllocTrace(hHeap:HANDLE; dwFlags:DWORD; dwBytes:DWORD; dwLineNum:DWORD; szFileName:PCHAR):LPVOID; external KernelDLL name 'HeapAllocTrace'; //+winbase
-function HeapCreate(flOptions:DWORD; dwInitialSize:DWORD; dwMaximumSize:DWORD):HANDLE; external KernelDLL name 'HeapCreate';
-function HeapDestroy(hHeap:HANDLE):WINBOOL; external KernelDLL name 'HeapDestroy';
-function HeapFree(hHeap:HANDLE; dwFlags:DWORD; lpMem:LPVOID):WINBOOL; external KernelDLL name 'HeapFree';
-function HeapReAlloc(hHeap:HANDLE; dwFlags:DWORD; lpMem:LPVOID; dwBytes:DWORD):LPVOID; external KernelDLL name 'HeapReAlloc';
-function HeapSize(hHeap:HANDLE; dwFlags:DWORD; lpMem:LPCVOID):DWORD; external KernelDLL name 'HeapSize';
-function HeapValidate(hHeap:HANDLE; dwFlags:DWORD; lpMem:LPCVOID):WINBOOL; external KernelDLL name 'HeapValidate';
-function HideCaret(hWnd:HWND):WINBOOL; external UserDLLCore name 'HideCaret';
-function ImageList_Add(himl:HIMAGELIST; hbmImage:HBITMAP; hbmMask:HBITMAP):Integer; external ComctlDLLCore name 'ImageList_Add';
-function ImageList_AddIcon(himl:HIMAGELIST; hicon:HICON):Integer;
-function ImageList_AddMasked(himl:HIMAGELIST; hbmImage:HBITMAP; crMask:COLORREF):Integer; external ComctlDLLCore name 'ImageList_AddMasked';
-function ImageList_BeginDrag(himlTrack:HIMAGELIST; iTrack:Integer; dxHotspot:Integer; dyHotspot:Integer):WINBOOL; external ComctlDLLCore name 'ImageList_BeginDrag';
-function ImageList_Create(cx:Integer; cy:Integer; flags:UINT; cInitial:Integer; cGrow:Integer):HIMAGELIST; external ComctlDLLCore name 'ImageList_Create';
-function ImageList_Destroy(himl:HIMAGELIST):WINBOOL; external ComctlDLLCore name 'ImageList_Destroy';
-function ImageList_DragEnter(hwndLock:HWND; x:Integer; y:Integer):WINBOOL; external ComctlDLLCore name 'ImageList_DragEnter';
-function ImageList_DragLeave(hwndLock:HWND):WINBOOL; external ComctlDLLCore name 'ImageList_DragLeave';
-function ImageList_DragMove(x:Integer; y:Integer):WINBOOL; external ComctlDLLCore name 'ImageList_DragMove';
-function ImageList_DragShowNolock(fShow:WINBOOL):WINBOOL; external ComctlDLLCore name 'ImageList_DragShowNolock';
-function ImageList_Draw(himl:HIMAGELIST; i:Integer; hdcDst:HDC; x:Integer; y:Integer;fStyle:UINT):WINBOOL; external ComctlDLLCore name 'ImageList_Draw';
-function ImageList_DrawEx(himl:HIMAGELIST; i:Integer; hdcDst:HDC; x:Integer; y:Integer;dx:Integer; dy:Integer; rgbBk:COLORREF; rgbFg:COLORREF; fStyle:UINT):WINBOOL; external ComctlDLLCore name 'ImageList_DrawEx';
-function ImageList_DrawIndirect(pimldp:PIMAGELISTDRAWPARAMS):WINBOOL; external ComctlDLLCore name 'ImageList_DrawIndirect'; //+commctrl
-procedure ImageList_EndDrag; external ComctlDLLCore name 'ImageList_EndDrag';
-function ImageList_GetBkColor(himl:HIMAGELIST):COLORREF; external ComctlDLLCore name 'ImageList_GetBkColor';
-function ImageList_GetDragImage(ppt:LPPOINT; pptHotspot:LPPOINT):HIMAGELIST; external ComctlDLLCore name 'ImageList_GetDragImage';
-function ImageList_GetIcon(himl:HIMAGELIST; i:Integer; flags:UINT):HICON; external ComctlDLLCore name 'ImageList_GetIcon';
-function ImageList_GetIconSize(himl:HIMAGELIST; var cx:Integer; var cy:Integer):WINBOOL; external ComctlDLLCore name 'ImageList_GetIconSize';
-function ImageList_GetImageCount(himl:HIMAGELIST):Integer; external ComctlDLLCore name 'ImageList_GetImageCount';
-function ImageList_GetImageInfo(himl:HIMAGELIST; i:Integer; var pImageInfo:IMAGEINFO):WINBOOL; external ComctlDLLCore name 'ImageList_GetImageInfo';
-function ImageList_Merge(himl1:HIMAGELIST; i1:Integer; himl2:HIMAGELIST; i2:Integer; dx:Integer;dy:Integer):HIMAGELIST; external ComctlDLLCore name 'ImageList_Merge';
-function ImageList_Replace(himl:HIMAGELIST; i:Integer; hbmImage:HBITMAP; hbmMask:HBITMAP):WINBOOL; external ComctlDLLCore name 'ImageList_Replace';
-function ImageList_ReplaceIcon(himl:HIMAGELIST; i:Integer; hicon:HICON):Integer; external ComctlDLLCore name 'ImageList_ReplaceIcon';
-function ImageList_Remove(himl:HIMAGELIST; i:Integer):WINBOOL; external ComctlDLLCore name 'ImageList_Remove';
-function ImageList_SetBkColor(himl:HIMAGELIST; clrBk:COLORREF):COLORREF; external ComctlDLLCore name 'ImageList_SetBkColor';
-function ImageList_SetDragCursorImage(himlDrag:HIMAGELIST; iDrag:Integer; dxHotspot:Integer; dyHotspot:Integer):WINBOOL; external ComctlDLLCore name 'ImageList_SetDragCursorImage';
-function ImageList_SetIconSize(himl:HIMAGELIST; cx:Integer; cy:Integer):WINBOOL; external ComctlDLLCore name 'ImageList_SetIconSize';
-function ImageList_SetImageCount(himl: HIMAGELIST; uNewCount: UINT): Integer; external ComctlDLLCore name 'ImageList_SetImageCount';
-function ImageList_SetOverlayImage(himl:HIMAGELIST; iImage:Integer; iOverlay:Integer):WINBOOL; external ComctlDLLCore name 'ImageList_SetOverlayImage';
-function InflateRect(lprc:LPRECT; dx:Integer; dy:Integer):WINBOOL; external UserDLLCore name 'InflateRect';
-procedure InitCommonControls; external ComctlDLL name 'InitCommonControls';
-//function InitCommonControlsEx(_para1:LPINITCOMMONCONTROLSEX):WINBOOL; external ComctlDLL name 'InitCommonControlsEx'; //- conflict with other def
-procedure InitializeCriticalSection(lpCriticalSection:LPCRITICAL_SECTION); external KernelDLL name 'InitializeCriticalSection';
-function InSendMessage:WINBOOL; external UserDLLCore name 'InSendMessage';
-function InterlockedIncrement(lpAddend:LPLONG):LONG; external KernelDLL name 'InterlockedIncrement';
-function InterlockedDecrement(lpAddend:LPLONG):LONG; external KernelDLL name 'InterlockedDecrement';
-function InterlockedCompareExchange( var Destination:LPLONG; Exchange:LONG; Comperand:LONG):LONG; external KernelDLL name 'InterlockedCompareExchange';
-function InterlockedExchange(Target:LPLONG; Value:LONG):LONG; external KernelDLL name 'InterlockedExchange';
-function InterlockedExchangeAdd( Addend:LPLONG; Value:LONG):LONG; external KernelDLL name 'InterlockedExchangeAdd';
-function InterlockedTestExchange( Target:LPLONG; oldValue:LONG; newValue:LONG):LONG; external KernelDLL name 'InterlockedTestExchange';
-function IntersectClipRect(_para1:HDC; _para2:Integer; _para3:Integer; _para4:Integer; _para5:Integer):Integer; external GdiDLL name 'IntersectClipRect';
-function IntersectRect(lprcDst:LPRECT; var lprcSrc1:RECT; var lprcSrc2:RECT):WINBOOL; external UserDLLCore name 'IntersectRect';
-function InvalidateRect(hWnd:HWND; var lpRect:RECT; bErase:WINBOOL):WINBOOL; external UserDLLCore name 'InvalidateRect';
-function InvalidateRect(hWnd:HWND;lpRect:LPRECT; bErase:WINBOOL):WINBOOL; external UserDLLCore name 'InvalidateRect';
-function InvalidateRgn(hWnd:HWND; hRgn:HRGN; bErase:WINBOOL):WINBOOL; external UserDLLCore name 'InvalidateRgn';
-function InvertRect(hDC:HDC; var lprc:RECT):WINBOOL; external UserDLLCore name 'InvertRect';
-function IsBadReadPtr(lp:LPVOID; ucb:UINT):WINBOOL; external Kerneldll name 'IsBadReadPtr';
-function IsBadWritePtr(lp:LPVOID; ucb:UINT):WINBOOL; external Kerneldll name 'IsBadWritePtr';
-function IsBadCodePtr(lpfn:FARPROC):WINBOOL; external Kerneldll name 'IsBadCodePtr';
-function IsChild(hWndParent:HWND; hWnd:HWND):WINBOOL; external UserDLLCore name 'IsChild';
-function IsClipboardFormatAvailable(format:UINT):WINBOOL; external UserDLLCore name 'IsClipboardFormatAvailable';
-function IsDBCSLeadByte(TestChar:BYTE):WINBOOL; external KernelDLL name 'IsDBCSLeadByte';
-function IsDBCSLeadByteEx(CodePage:UINT; TestChar:BYTE):WINBOOL; external KernelDLL name 'IsDBCSLeadByteEx';
-function IsRectEmpty(var lprc:RECT):WINBOOL; external UserDLLCore name 'IsRectEmpty';
-function IsValidCodePage(CodePage:UINT):WINBOOL; external KernelDLL name 'IsValidCodePage';
-function IsValidLocale(Locale:LCID; dwFlags:DWORD):WINBOOL; external KernelDLL name 'IsValidLocale';
-function IsWindow(hWnd:HWND):WINBOOL; external UserDLLCore name 'IsWindow';
-function IsWindowEnabled(hWnd:HWND):WINBOOL; external UserDLLCore name 'IsWindowEnabled';
-function IsWindowVisible(hWnd:HWND):WINBOOL; external UserDLLCore name 'IsWindowVisible';
-procedure keybd_event(bVk:BYTE; bScan:BYTE; dwFlags:DWORD; dwExtraInfo:DWORD); external UserDLLCore name 'keybd_event';
-function KillTimer(hWnd:HWND; uIDEvent:UINT):WINBOOL; external UserDLLCore name 'KillTimer';
-procedure LeaveCriticalSection(lpCriticalSection:LPCRITICAL_SECTION); external KernelDLL name 'LeaveCriticalSection';
-function LineTo(_para1:HDC; _para2:Integer; _para3:Integer):WINBOOL; external GdiDLL name 'LineTo';
-function ListView_Arrange(hwndLV:HWND;code : UINT) : LRESULT;
-function ListView_CreateDragImage(hwnd:HWND;i : Integer;lpptUpLeft : LPPOINT) : LRESULT;
-function ListView_DeleteAllItems(hwnd : HWND) : LRESULT;
-function ListView_DeleteColumn(hwnd:HWND;iCol : Integer) : LRESULT;
-function ListView_DeleteItem(hwnd:HWND;iItem : Integer) : LRESULT;
-function ListView_EditLabel(hwndLV:HWND;i : Integer) : LRESULT;
-function ListView_EnsureVisible(hwndLV:HWND;i,fPartialOK : Integer) : LRESULT;
-function ListView_FindItem(hwnd:HWND;iStart : Integer;var lvfi : LV_FINDINFO) : Integer;
-function ListView_GetBkColor(hwnd : HWND) : LRESULT;
-function ListView_GetCallbackMask(hwnd : HWND) : LRESULT;
-function ListView_GetColumn(hwnd:HWND;iCol : Integer;var col : LV_COLUMN) : LRESULT;
-function ListView_GetColumnWidth(hwnd:HWND;iCol : Integer) : LRESULT;
-function ListView_GetCountPerPage(hwndLV : HWND) : LRESULT;
-function ListView_GetEditControl(hwndLV : HWND) : LRESULT;
-function ListView_GetImageList(hwnd:HWND;iImageList : wINT) : LRESULT;
-function ListView_GetISearchString(hwndLV:HWND;lpsz : LPTSTR) : LRESULT;
-function ListView_GetItem(hwnd:HWND;var item : LV_ITEM) : LRESULT;
-function ListView_GetItemCount(hwnd : HWND) : LRESULT;
-function ListView_GetItemPosition(hwndLV:HWND;i : Integer;var pt : POINT) : Integer;
-function ListView_GetItemSpacing(hwndLV:HWND;fSmall : Integer) : LRESULT;
-function ListView_GetItemState(hwndLV:HWND;i,mask : Integer) : LRESULT;
-function ListView_GetNextItem(hwnd:HWND; iStart, flags : Integer) : LRESULT;
-function ListView_GetOrigin(hwndLV:HWND;var pt : POINT) : LRESULT;
-function ListView_GetSelectedCount(hwndLV : HWND) : LRESULT;
-function ListView_GetStringWidth(hwndLV:HWND;psz : LPCTSTR) : LRESULT;
-function ListView_GetTextBkColor(hwnd : HWND) : LRESULT;
-function ListView_GetTextColor(hwnd : HWND) : LRESULT;
-function ListView_GetTopIndex(hwndLV : HWND) : LRESULT;
-function ListView_GetViewRect(hwnd:HWND;var rc : RECT) : LRESULT;
-function ListView_HitTest(hwndLV:HWND;var info : LV_HITTESTINFO) : LRESULT;
-function ListView_InsertColumn(hwnd:HWND;iCol : Integer;var col : LV_COLUMN) : LRESULT;
-function ListView_InsertItem(hwnd:HWND;var item : LV_ITEM) : LRESULT;
-function ListView_RedrawItems(hwndLV:HWND;iFirst,iLast : Integer) : LRESULT;
-function ListView_Scroll(hwndLV:HWND;dx,dy : Integer) : LRESULT;
-function ListView_SetBkColor(hwnd:HWND;clrBk : COLORREF) : LRESULT;
-function ListView_SetCallbackMask(hwnd:HWND;mask : UINT) : LRESULT;
-function ListView_SetColumn(hwnd:HWND;iCol : Integer; var col : LV_COLUMN) : LRESULT;
-function ListView_SetColumnWidth(hwnd:HWND;iCol,cx : Integer) : LRESULT;
-function ListView_SetImageList(hwnd:HWND;himl : Integer;iImageList : HIMAGELIST) : LRESULT;
-function ListView_SetItem(hwnd:HWND;var item : LV_ITEM) : LRESULT;
-function ListView_SetItemCount(hwndLV:HWND;cItems : Integer) : LRESULT;
-function ListView_SetItemPosition(hwndLV:HWND;i,x,y : Integer) : LRESULT;
-function ListView_SetItemPosition32(hwndLV:HWND;i,x,y : Integer) : LRESULT;
-function ListView_SetItemState(hwndLV:HWND; i, data, mask:Integer) : LRESULT;
-function ListView_SetItemText(hwndLV:HWND; i, iSubItem_:Integer;pszText_ : LPTSTR) : LRESULT;
-function ListView_SetTextBkColor(hwnd:HWND;clrTextBk : COLORREF) : LRESULT;
-function ListView_SetTextColor(hwnd:HWND;clrText : COLORREF) : LRESULT;
-function ListView_SortItems(hwndLV:HWND;_pfnCompare:PFNLVCOMPARE;_lPrm : LPARAM) : LRESULT;
-function ListView_Update(hwndLV:HWND;i : Integer) : LRESULT;
-function LoadResource(hModule:HINST; hResInfo:HRSRC):HGLOBAL; external KernelDLL name 'LoadResource';
-function LocalAlloc(uFlags:UINT; uBytes:UINT):HLOCAL; external KernelDLL name 'LocalAlloc';
-function LocalDiscard(hlocMem:HLOCAL):HLOCAL;
-function LocalFileTimeToFileTime(lpLocalFileTime:LPFILETIME; lpFileTime:LPFILETIME):WINBOOL; external KernelDLL name 'LocalFileTimeToFileTime';
-function LocalFree(hMem:HLOCAL):HLOCAL; external KernelDLL name 'LocalFree';
-function LocalReAlloc(hMem:HLOCAL; uBytes:UINT; uFlags:UINT):HLOCAL; external KernelDLL name 'LocalReAlloc';
-function LocalSize(hMem:HLOCAL):UINT; external KernelDLL name 'LocalSize';
-function MapDialogRect(hDlg:HWND; lpRect:LPRECT):WINBOOL; external UserDLLCore name 'MapDialogRect';
-function MapWindowPoints(hWndFrom:HWND; hWndTo:HWND; lpPoints:LPPOINT; cPoints:UINT):Integer; external UserDLLCore name 'MapWindowPoints';
-function MaskBlt(_para1:HDC; _para2:Integer; _para3:Integer; _para4:Integer; _para5:Integer;_para6:HDC; _para7:Integer; _para8:Integer; _para9:HBITMAP; _para10:Integer;_para11:Integer; _para12:DWORD):WINBOOL; external GdiDLL name 'MaskBlt';
-function MessageBeep(uType:UINT):WINBOOL; external UserDLLCore name 'MessageBeep';
-procedure mouse_event(dwFlags:DWORD; dx:DWORD; dy:DWORD; cButtons:DWORD; dwExtraInfo:DWORD); external UserDLLCore name 'mouse_event';
-function MoveToEx(_para1:HDC; _para2:Integer; _para3:Integer; _para4:LPPOINT):WINBOOL; external GdiDLL name 'MoveToEx';
-procedure MoveMemory(Destination:PVOID; Source:pointer; Length:DWORD);
-function MoveWindow(hWnd:HWND; X:Integer; Y:Integer; nWidth:Integer; nHeight:Integer;bRepaint:WINBOOL):WINBOOL; external UserDLLCore name 'MoveWindow';
-function MsgWaitForMultipleObjectsEx(nCount:DWORD; pHandles:LPHANDLE ; dwMilliseconds:DWORD; dwWakeMask:DWORD; dwFlags:DWORD):DWORD; external UserDLLCore name 'MsgWaitForMultipleObjectsEx'; //+winuser
-function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:LPCSTR; cchMultiByte:Integer; lpWideCharStr:LPWSTR;cchWideChar:Integer):Integer; external KernelDLL name 'MultiByteToWideChar';
-function OffsetRect(lprc:LPRECT; dx:Integer; dy:Integer):WINBOOL; external UserDLLCore name 'OffsetRect';
-function OffsetRgn(_para1:HRGN; _para2:Integer; _para3:Integer):Integer; external GdiDLL name 'OffsetRgn';
-function OpenClipboard(hWndNewOwner:HWND):WINBOOL; external UserDLLCore name 'OpenClipboard';
-function OpenProcess(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; dwProcessId:DWORD):HANDLE; external KernelDLL name 'OpenProcess';
-function PatBlt(_para1:HDC; _para2:Integer; _para3:Integer; _para4:Integer; _para5:Integer;_para6:DWORD):WINBOOL; external GdiDLL name 'PatBlt';
-procedure PostQuitMessage(nExitCode:Integer); external UserDLLCore name 'PostQuitMessage';
-function PlayEnhMetaFile(_para1:HDC; _para2:HENHMETAFILE; var _para3:RECT):WINBOOL; external GdiDLL name 'PlayEnhMetaFile';
-function Polygon(_para1:HDC; _para2:LPPOINT; _para3:Integer):WINBOOL; external GdiDLL name 'Polygon';
-function Polyline(_para1:HDC; _para2:LPPOINT; _para3:Integer):WINBOOL; external GdiDLL name 'Polyline';
-function PropSheet_AddPage(hPropSheetDlg : HWND;hpage : HPROPSHEETPAGE) : LRESULT;
-function PropSheet_Apply(hPropSheetDlg : HWND) : LRESULT;
-function PropSheet_CancelToClose(hPropSheetDlg : HWND) : LRESULT;
-function PropSheet_Changed(hPropSheetDlg,hwndPage : HWND) : LRESULT;
-function PropSheet_GetCurrentPageHwnd(hDlg : HWND) : LRESULT;
-function PropSheet_GetTabControl(hPropSheetDlg : HWND) : LRESULT;
-function PropSheet_IsDialogMessage(hDlg : HWND;pMsg : Integer) : LRESULT;
-function PropSheet_PressButton(hPropSheetDlg : HWND;iButton : Integer) : LRESULT;
-function PropSheet_QuerySiblings(hPropSheetDlg : HWND;param1,param2 : Integer) : LRESULT;
-function PropSheet_RebootSystem(hPropSheetDlg : HWND) : LRESULT;
-function PropSheet_RemovePage(hPropSheetDlg : HWND;hpage : HPROPSHEETPAGE; index : Integer) : LRESULT;
-function PropSheet_RestartWindows(hPropSheetDlg : HWND) : LRESULT;
-function PropSheet_SetCurSel(hPropSheetDlg : HWND;hpage : HPROPSHEETPAGE; index : Integer) : LRESULT;
-function PropSheet_SetCurSelByID(hPropSheetDlg : HWND; id : Integer) : LRESULT;
-function PropSheet_SetFinishText(hPropSheetDlg:HWND;lpszText : LPTSTR) : LRESULT;
-function PropSheet_SetTitle(hPropSheetDlg:HWND;dwStyle:DWORD;lpszText : LPCTSTR) : LRESULT;
-function PropSheet_SetWizButtons(hPropSheetDlg:HWND;dwFlags : DWORD) : LRESULT;
-function PropSheet_UnChanged(hPropSheetDlg:HWND;hwndPage : HWND) : LRESULT;
-function PtInRect(lprc:LPRECT; pt:POINT):WINBOOL; external UserDLLCore name 'PtInRect';
-function PtInRegion(_para1:HRGN; _para2:Integer; _para3:Integer):WINBOOL; external GdiDLL name 'PtInRegion';
-function PurgeComm(hFile:HANDLE; dwFlags:DWORD):WINBOOL; external KernelDLL name 'PurgeComm';
-function QueryPerformanceCounter(lpPerformanceCount:PLARGE_INTEGER):WINBOOL; external Kerneldll name 'QueryPerformanceCounter';
-function QueryPerformanceFrequency(lpFrequency:PLARGE_INTEGER):WINBOOL; external Kerneldll name 'QueryPerformanceFrequency';
-procedure RaiseException(dwExceptionCode:DWORD; dwExceptionFlags:DWORD; nNumberOfArguments:DWORD; lpArguments:LPDWORD); external KernelDLL name 'RaiseException';
-function ReadProcessMemory(hProcess:HANDLE; lpBaseAddress:LPCVOID; lpBuffer:LPVOID; nSize:DWORD; lpNumberOfBytesRead:LPDWORD):WINBOOL; external KernelDLL name 'ReadProcessMemory';
-function RealizePalette(_para1:HDC):UINT; external GdiDLL name 'RealizePalette';
-function RectInRegion(_para1:HRGN; var _para2:RECT):WINBOOL; external GdiDLL name 'RectInRegion';
-function RectVisible(_para1:HDC; var _para2:RECT):WINBOOL; external GdiDLL name 'RectVisible';
-function Rectangle(_para1:HDC; _para2:Integer; _para3:Integer; _para4:Integer; _para5:Integer):WINBOOL; external GdiDLL name 'Rectangle';
-function RedrawWindow(hWnd:HWND; var lprcUpdate:RECT; hrgnUpdate:HRGN; flags:UINT):WINBOOL; external UserDLLCore name 'RedrawWindow';
-function RedrawWindow(hWnd:HWND; lprcUpdate:LPRECT; hrgnUpdate:HRGN; flags:UINT):WINBOOL; external UserDLLCore name 'RedrawWindow';
-function RegisterHotKey(hWnd:HWND; anID:Integer; fsModifiers:UINT; vk:UINT):WINBOOL; external UserDLLCore name 'RegisterHotKey';
-function RegCloseKey(hKey:HKEY):LONG; external AdvApiDLLCore name 'RegCloseKey';
-function RegFlushKey(hKey:HKEY):LONG; external AdvApiDLLCore name 'RegFlushKey';
-function ReleaseCapture:WINBOOL; external UserDLLCore name 'ReleaseCapture';
-function ReleaseDC(hWnd:HWND; hDC:HDC):Integer; external UserDLLCore name 'ReleaseDC';
-function ReleaseSemaphore(hSemaphore:HANDLE; lReleaseCount:LONG; lpPreviousCount:LPLONG):WINBOOL; external KernelDLL name 'ReleaseSemaphore';
-function ReleaseMutex(hMutex:HANDLE):WINBOOL; external KernelDLL name 'ReleaseMutex';
-function RemoveMenu(hMenu:HMENU; uPosition:UINT; uFlags:UINT):WINBOOL; external UserDLLCore name 'RemoveMenu';
-function RestoreDC(_para1:HDC; _para2:Integer):WINBOOL; external GdiDLL name 'RestoreDC';
-function ResumeThread(hThread:HANDLE):DWORD; external KernelDLL name 'ResumeThread';
-function RoundRect(_para1:HDC; _para2:Integer; _para3:Integer; _para4:Integer; _para5:Integer;_para6:Integer; _para7:Integer):WINBOOL; external GdiDLL name 'RoundRect';
-function SaveDC(_para1:HDC):Integer; external GdiDLL name 'SaveDC';
-function ScreenToClient(hWnd:HWND; lpPoint:LPPOINT):WINBOOL; external UserDLLCore name 'ScreenToClient';
-function ScrollDC(hDC:HDC; dx:Integer; dy:Integer; var lprcScroll:RECT; var lprcClip:RECT;hrgnUpdate:HRGN; lprcUpdate:LPRECT):WINBOOL; external UserDLLCore name 'ScrollDC';
-function ScrollWindowEx(hWnd:HWND; dx:Integer; dy:Integer; var prcScroll:RECT; var prcClip:RECT;hrgnUpdate:HRGN; prcUpdate:LPRECT; flags:UINT):Integer; external UserDLLCore name 'ScrollWindowEx';
-function SelectClipRgn(_para1:HDC; _para2:HRGN):Integer; external GdiDLL name 'SelectClipRgn';
-function SelectObject(_para1:HDC; _para2:HGDIOBJ):HGDIOBJ; external GdiDLL name 'SelectObject';
-function SelectPalette(_para1:HDC; _para2:HPALETTE; _para3:WINBOOL):HPALETTE; external GdiDLL name 'SelectPalette';
-function SNDMSG(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT;
-function SetAbortProc(_para1:HDC; _para2:TABORTPROC):Integer; external GdiDLL name 'SetAbortProc';
-function SetActiveWindow(hWnd:HWND):HWND; external UserDLLCore name 'SetActiveWindow';
-function SetBkColor(_para1:HDC; _para2:COLORREF):COLORREF; external GdiDLL name 'SetBkColor';
-function SetBkMode(_para1:HDC; _para2:Integer):Integer; external GdiDLL name 'SetBkMode';
-function SetBitmapBits(_para1:HBITMAP; _para2:DWORD; _para3:pointer):LONG; external GdiDLL name 'SetBitmapBits';
-function SetBrushOrgEx(_para1:HDC; _para2:Integer; _para3:Integer; _para4:LPPOINT):WINBOOL; external GdiDLL name 'SetBrushOrgEx';
-function SetCapture(hWnd:HWND):HWND; external UserDLLCore name 'SetCapture';
-function SetCaretBlinkTime(uMSeconds:UINT):WINBOOL; external UserDLLCore name 'SetCaretBlinkTime';
-function SetCaretPos(X:Integer; Y:Integer):WINBOOL; external UserDLLCore name 'SetCaretPos';
-function SetClipboardData(uFormat:UINT; hMem:HANDLE):HANDLE; external UserDLLCore name 'SetClipboardData';
-function SetCommBreak(hFile:HANDLE):WINBOOL; external KernelDLL name 'SetCommBreak';
-function SetCommMask(hFile:HANDLE; dwEvtMask:DWORD):WINBOOL; external KernelDLL name 'SetCommMask';
-function SetCommState(hFile:HANDLE; lpDCB:LPDCB):WINBOOL; external KernelDLL name 'SetCommState';
-function SetCommTimeouts(hFile:HANDLE; lpCommTimeouts:LPCOMMTIMEOUTS):WINBOOL; external KernelDLL name 'SetCommTimeouts';
-function SetCursor(hCursor:HCURSOR):HCURSOR; external UserDLLCore name 'SetCursor';
-function SetCursorPos(X:Integer; Y:Integer):WINBOOL; external UserDLLCore name 'SetCursorPos';
-function SetDIBColorTable(_para1:HDC; _para2:UINT; _para3:UINT; var _para4:RGBQUAD):UINT; external GdiDLL name 'SetDIBColorTable';
-function SetDIBitsToDevice(_para1:HDC; _para2:Integer; _para3:Integer; _para4:DWORD; _para5:DWORD;_para6:Integer; _para7:Integer; _para8:UINT; _para9:UINT; _para10:pointer;var _para11:BITMAPINFO; _para12:UINT):Integer;
- external GdiDLL name 'SetDIBitsToDevice';
-function SetDlgItemInt(hDlg:HWND; nIDDlgItem:Integer; uValue:UINT; bSigned:WINBOOL):WINBOOL; external UserDLLCore name 'SetDlgItemInt';
-function SetEndOfFile(hFile:HANDLE):WINBOOL; external KernelDLL name 'SetEndOfFile';
-function SetFilePointer(hFile:HANDLE; lDistanceToMove:LONG; lpDistanceToMoveHigh:PLONG; dwMoveMethod:DWORD):DWORD; external KernelDLL name 'SetFilePointer';
-function SetFileTime(hFile:HANDLE; lpCreationTime:LPFILETIME; lpLastAccessTime:LPFILETIME; lpLastWriteTime:LPFILETIME):WINBOOL; external KernelDLL name 'SetFileTime';
-function SetFocus(hWnd:HWND):HWND; external UserDLLCore name 'SetFocus';
-function SetForegroundWindow(hWnd:HWND):WINBOOL; external UserDLLCore name 'SetForegroundWindow';
-procedure SetLastError(dwErrCode:DWORD); external KernelDLL name 'SetLastError';
-function SetLocalTime(lpSystemTime:LPSYSTEMTIME):WINBOOL; external KernelDLL name 'SetLocalTime';
-function SetPaletteEntries(_para1:HPALETTE; _para2:UINT; _para3:UINT; var _para4:PALETTEENTRY):UINT; external GdiDLL name 'SetPaletteEntries';
-function SetParent(hWndChild:HWND; hWndNewParent:HWND):HWND; external UserDLLCore name 'SetParent';
-function SetPixel(_para1:HDC; _para2:Integer; _para3:Integer; _para4:COLORREF):COLORREF; external GdiDLL name 'SetPixel';
-function SetRect(lprc:LPRECT; xLeft:Integer; yTop:Integer; xRight:Integer; yBottom:Integer):WINBOOL; external UserDLLCore name 'SetRect';
-function SetRectEmpty(lprc:LPRECT):WINBOOL; external UserDLLCore name 'SetRectEmpty';
-function SetRectRgn(_para1:HRGN; _para2:Integer; _para3:Integer; _para4:Integer; _para5:Integer):WINBOOL; external GdiDLL name 'SetRectRgn';
-function SetROP2(_para1:HDC; _para2:Integer):Integer; external GdiDLL name 'SetROP2';
-function SetScrollInfo(_para1:HWND; _para2:Integer; _para3:LPCSCROLLINFO; _para4:WINBOOL):Integer; external UserDLLCore name 'SetScrollInfo';
-function SetScrollPos(hWnd:HWND; nBar:Integer; nPos:Integer; bRedraw:WINBOOL):Integer; external UserDLLCore name 'SetScrollPos';
-function SetScrollRange(hWnd:HWND; nBar:Integer; nMinPos:Integer; nMaxPos:Integer; bRedraw:WINBOOL):WINBOOL; external UserDLLCore name 'SetScrollRange';
-function SetSysColors(cElements:Integer; var lpaElements:wINT; var lpaRgbValues:COLORREF):WINBOOL; external UserDLLCore name 'SetSysColors';
-function SetSystemTime(lpSystemTime:LPSYSTEMTIME):WINBOOL; external KernelDLL name 'SetSystemTime';
-function SetTextColor(_para1:HDC; _para2:COLORREF):COLORREF; external GdiDLL name 'SetTextColor';
-function SetTextAlign(_para1:HDC; _para2:UINT):UINT; external GdiDLL name 'SetTextAlign';
-function SetTimer(hWnd:HWND; nIDEvent:UINT; uElapse:UINT; lpTimerFunc:TIMERPROC):UINT; external UserDLLCore name 'SetTimer';
-function SetTimeZoneInformation(lpTimeZoneInformation:LPTIME_ZONE_INFORMATION):WINBOOL; external KernelDLL name 'SetTimeZoneInformation';
-function SetThreadPriority(hThread:HANDLE; nPriority:Integer):WINBOOL; external KernelDLL name 'SetThreadPriority';
-function SetupComm(hFile:HANDLE; dwInQueue:DWORD; dwOutQueue:DWORD):WINBOOL; external KernelDLL name 'SetupComm';
-function SetViewportOrgEx(_para1:HDC; _para2:Integer; _para3:Integer; _para4:LPPOINT):WINBOOL; external GdiDLL name 'SetViewportOrgEx';
-function SetWindowPos(hWnd:HWND; hWndInsertAfter:HWND; X:Integer; Y:Integer; cx:Integer;cy:Integer; uFlags:UINT):WINBOOL; external UserDLLCore name 'SetWindowPos';
-function SetWindowRgn(hWnd:HWND; hRgn:HRGN; bRedraw:WINBOOL):Integer; external UserDLLCore name 'SetWindowRgn';
-procedure SHAddToRecentDocs(_para1:UINT; _para2:LPCVOID); external ShellDLLCore name 'SHAddToRecentDocs';
-function SHGetFileInfo(_para1:LPCTSTR; _para2:DWORD; var _para3:SHFILEINFO; _para4:UINT; _para5:UINT):DWORD; external ShellDLLCore name 'SHGetFileInfo';
-function SHGetPathFromIDList(_para1:LPCITEMIDLIST; _para2:LPTSTR):WINBOOL; external ShellDLL name 'SHGetPathFromIDList';
-function SHGetSpecialFolderLocation(_para1:HWND; _para2:Integer; var _para3:LPITEMIDLIST):HRESULT; external ShellDLL name 'SHGetSpecialFolderLocation';
-function ShowCursor(bShow:WINBOOL):Integer; external UserDLLCore name 'ShowCursor';
-function ShowCaret(hWnd:HWND):WINBOOL; external UserDLLCore name 'ShowCaret';
-function ShowWindow(hWnd:HWND; nCmdShow:Integer):WINBOOL; external UserDLLCore name 'ShowWindow';
-function SizeofResource(hModule:HINST; hResInfo:HRSRC):DWORD; external KernelDLL name 'SizeofResource';
-procedure Sleep(dwMilliseconds:DWORD); external KernelDLL name 'Sleep';
-function StartPage(_para1:HDC):Integer; external GdiDLL name 'StartPage';
-function StretchBlt(_para1:HDC; _para2:Integer; _para3:Integer; _para4:Integer; _para5:Integer;_para6:HDC; _para7:Integer; _para8:Integer; _para9:Integer; _para10:Integer;_para11:DWORD):WINBOOL; external GdiDLL name 'StretchBlt';
-function StretchDIBits(_para1:HDC; _para2:Integer; _para3:Integer; _para4:Integer; _para5:Integer;_para6:Integer; _para7:Integer; _para8:Integer; _para9:Integer; _para10:pointer;var _para11:BITMAPINFO; _para12:UINT; _para13:DWORD):Integer;
- external GdiDLL name 'StretchDIBits';
-function SubtractRect(lprcDst:LPRECT; var lprcSrc1:RECT; var lprcSrc2:RECT):WINBOOL; external UserDLLCore name 'SubtractRect';
-function SuspendThread(hThread:HANDLE):DWORD; external KernelDLL name 'SuspendThread';
-function SystemTimeToFileTime(lpSystemTime:LPSYSTEMTIME; lpFileTime:LPFILETIME):WINBOOL; external KernelDLL name 'SystemTimeToFileTime';
-function TabCtrl_GetImageList(hwnd : HWND) : LRESULT;
-function TabCtrl_SetImageList(hwnd:HWND;himl : HIMAGELIST) : LRESULT;
-function TabCtrl_GetItemCount(hwnd : HWND) : LRESULT;
-function TabCtrl_GetItem(hwnd:HWND;iItem : Integer;var item : TC_ITEM) : LRESULT;
-function TabCtrl_SetItem(hwnd:HWND;iItem : Integer;var item : TC_ITEM) : LRESULT;
-function TabCtrl_InsertItem(hwnd:HWND;iItem : Integer;var item : TC_ITEM) : LRESULT;
-function TabCtrl_DeleteItem(hwnd:HWND;i : Integer) : LRESULT;
-function TabCtrl_DeleteAllItems(hwnd : HWND) : LRESULT;
-function TabCtrl_GetItemRect(hwnd:HWND;i : Integer;var rc : RECT) : LRESULT;
-function TabCtrl_GetCurSel(hwnd : HWND) : LRESULT;
-function TabCtrl_SetCurSel(hwnd:HWND;i : Integer) : LRESULT;
-function TabCtrl_HitTest(hwndTC:HWND;var info : TC_HITTESTINFO) : LRESULT;
-function TabCtrl_SetItemExtra(hwndTC:HWND;cb : Integer) : LRESULT;
-function TabCtrl_AdjustRect(hwnd:HWND;bLarger:WINBOOL;var rc : RECT) : LRESULT;
-function TabCtrl_SetItemSize(hwnd:HWND;x,y : Integer) : LRESULT;
-function TabCtrl_RemoveImage(hwnd:HWND;i : WPARAM) : LRESULT;
-function TabCtrl_SetPadding(hwnd:HWND;cx,cy : Integer) : LRESULT;
-function TabCtrl_GetRowCount(hwnd : HWND) : LRESULT;
-function TabCtrl_GetToolTips(hwnd : HWND) : LRESULT;
-function TabCtrl_SetToolTips(hwnd:HWND;hwndTT : Integer) : LRESULT;
-function TabCtrl_GetCurFocus(hwnd : HWND) : LRESULT;
-function TabCtrl_SetCurFocus(hwnd:HWND;i : Integer) : LRESULT;
-function TerminateProcess(hProcess:HANDLE; uExitCode:UINT):WINBOOL; external KernelDLL name 'TerminateProcess';
-function TerminateThread(hThread:HANDLE; dwExitCode:DWORD):WINBOOL; external KernelDLL name 'TerminateThread';
-function TlsGetValue(dwTlsIndex:DWORD):LPVOID; external KernelDLL name 'TlsGetValue';
-function TlsSetValue(dwTlsIndex:DWORD; lpTlsValue:LPVOID):WINBOOL; external KernelDLL name 'TlsSetValue';
-function TrackPopupMenuEx(_para1:HMENU; _para2:UINT; _para3:Integer; _para4:Integer; _para5:HWND;_para6:LPTPMPARAMS):WINBOOL; external UserDLLCore name 'TrackPopupMenuEx';
-function TranslateCharsetInfo(var lpSrc:DWORD; lpCs:LPCHARSETINFO; dwFlags:DWORD):WINBOOL; external GdiDLL name 'TranslateCharsetInfo';
-function TranslateMessage(lpMsg:LPMSG):WINBOOL; external UserDLLCore name 'TranslateMessage';
-function TransmitCommChar(hFile:HANDLE; cChar:char):WINBOOL; external KernelDLL name 'TransmitCommChar';
-function TreeView_InsertItem(hwnd:HWND;lpis : LPTV_INSERTSTRUCT) : LRESULT;
-function TreeView_DeleteItem(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-function TreeView_DeleteAllItems(hwnd : HWND) : LRESULT;
-function TreeView_Expand(hwnd:HWND;hitem:HTREEITEM;code : Integer) : LRESULT;
-function TreeView_GetCount(hwnd : HWND) : LRESULT;
-function TreeView_GetIndent(hwnd : HWND) : LRESULT;
-function TreeView_SetIndent(hwnd:HWND;indent : Integer) : LRESULT;
-function TreeView_GetImageList(hwnd:HWND;iImage : WPARAM) : LRESULT;
-function TreeView_SetImageList(hwnd:HWND;himl:HIMAGELIST;iImage : WPARAM) : LRESULT;
-function TreeView_GetNextItem(hwnd:HWND;hitem:HTREEITEM;code : Integer) : LRESULT;
-function TreeView_GetChild(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-function TreeView_GetNextSibling(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-function TreeView_GetPrevSibling(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-function TreeView_GetParent(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-function TreeView_GetFirstVisible(hwnd : HWND) : LRESULT;
-function TreeView_GetNextVisible(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-function TreeView_GetPrevVisible(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-function TreeView_GetSelection(hwnd : HWND) : LRESULT;
-function TreeView_GetDropHilight(hwnd : HWND) : LRESULT;
-function TreeView_GetRoot(hwnd : HWND) : LRESULT;
-function TreeView_Select(hwnd:HWND;hitem:HTREEITEM;code : Integer) : LRESULT;
-function TreeView_SelectItem(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-function TreeView_SelectDropTarget(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-function TreeView_SelectSetFirstVisible(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-function TreeView_GetItem(hwnd:HWND;var item : TV_ITEM) : LRESULT;
-function TreeView_SetItem(hwnd:HWND;var item : TV_ITEM) : LRESULT;
-function TreeView_EditLabel(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-function TreeView_GetEditControl(hwnd : HWND) : LRESULT;
-function TreeView_GetVisibleCount(hwnd : HWND) : LRESULT;
-function TreeView_HitTest(hwnd:HWND;lpht : LPTV_HITTESTINFO) : LRESULT;
-function TreeView_CreateDragImage(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-function TreeView_SortChildren(hwnd:HWND;hitem:HTREEITEM;recurse : Integer) : LRESULT;
-function TreeView_EnsureVisible(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-function TreeView_SortChildrenCB(hwnd:HWND;psort:LPTV_SORTCB;recurse : Integer) : LRESULT;
-function TreeView_EndEditLabelNow(hwnd:HWND;fCancel : Integer) : LRESULT;
-function TreeView_GetISearchString(hwndTV:HWND;lpsz : LPTSTR) : LRESULT;
-function TryEnterCriticalSection(lpCriticalSection:LPCRITICAL_SECTION):WINBOOL; external KernelDLL name 'TryEnterCriticalSection'; //+winbase
-function UnhookWindowsHookEx(hhk:HHOOK):WINBOOL; external UserDLLCore name 'UnhookWindowsHookEx';
-function UnionRect(lprcDst:LPRECT; var lprcSrc1:RECT; var lprcSrc2:RECT):WINBOOL; external UserDLLCore name 'UnionRect';
-function UnmapViewOfFile(lpBaseAddress:LPVOID):WINBOOL; external KernelDLL name 'UnmapViewOfFile';
-function UnregisterHotKey(hWnd:HWND; anID:iNTEGER):WINBOOL; external UserDLLCore name 'UnregisterHotKey';
-function UpdateWindow(hWnd:HWND):WINBOOL; external UserDLLCore name 'UpdateWindow';
-function ValidateRect(hWnd:HWND; var lpRect:RECT):WINBOOL; external UserDLLCore name 'ValidateRect';
-function ValidateRect(hWnd:HWND;lpRect:LPRECT):WINBOOL; external UserDLLCore name 'ValidateRect';
-function ValidateRgn(hWnd:HWND; hRgn:HRGN):WINBOOL; external UserDLLCore name 'ValidateRgn';
-function VirtualAlloc(lpAddress:LPVOID; dwSize:DWORD; flAllocationType:DWORD; flProtect:DWORD):LPVOID; external KernelDLL name 'VirtualAlloc';
-function VirtualProtect(lpAddress:LPVOID; dwSize:DWORD; flNewProtect:DWORD; lpflOldProtect:PDWORD):WINBOOL; external KernelDLL name 'VirtualProtect';
-function VirtualQuery(lpAddress:LPCVOID; lpBuffer:PMEMORY_BASIC_INFORMATION; dwLength:DWORD):DWORD; external KernelDLL name 'VirtualQuery';
-function VirtualFree(lpAddress:LPVOID; dwSize:DWORD; dwFreeType:DWORD):WINBOOL; external KernelDLL name 'VirtualFree';
-function WriteProcessMemory(hProcess:HANDLE; lpBaseAddress:LPVOID; lpBuffer:LPVOID; nSize:DWORD; lpNumberOfBytesWritten:LPDWORD):WINBOOL; external KernelDLL name 'WriteProcessMemory';
-function WaitCommEvent(hFile:HANDLE; lpEvtMask:LPDWORD; lpOverlapped:LPOVERLAPPED):WINBOOL; external KernelDLL name 'WaitCommEvent';
-function WaitForDebugEvent(lpDebugEvent:LPDEBUG_EVENT; dwMilliseconds:DWORD):WINBOOL; external KernelDLL name 'WaitForDebugEvent';
-function WaitForSingleObject(hHandle:HANDLE; dwMilliseconds:DWORD):DWORD; external KernelDLL name 'WaitForSingleObject';
-function WaitForMultipleObjects(nCount:DWORD; lpHandles : PWOHandleArray; bWaitAll:WINBOOL; dwMilliseconds:DWORD):DWORD; external KernelDLL name 'WaitForMultipleObjects';
-function WideCharToMultiByte(CodePage:UINT; dwFlags:DWORD; lpWideCharStr:LPCWSTR; cchWideChar:Integer; lpMultiByteStr:LPSTR;cchMultiByte:Integer; lpDefaultChar:LPCSTR; lpUsedDefaultChar:LPBOOL):Integer; external KernelDLL name 'WideCharToMultiByte';
-function WNetCloseEnum(hEnum:HANDLE):DWORD; external MprDLLCore name 'WNetCloseEnum';
-function WNetDisconnectDialog(hwnd:HWND; dwType:DWORD):DWORD; external MprDLLCore name 'WNetDisconnectDialog';
-procedure ZeroMemory(Destination:PVOID; Length:DWORD);
-
-//end common win32 & wince
-
-{$ifdef WINCE}
-//begin wince only
-function ActivateKeyboardLayout(hkl:HKL; Flags:UINT):HKL; external UserDLLCore name 'ActivateKeyboardLayout';
-//redirected to SendDlgItemMessage
-function CheckDlgButton(hDlg:HWND; nIDButton:Integer; uCheck:UINT):WINBOOL;
-//win32 version redirected
-function ChildWindowFromPoint(hWndParent:HWND; Point:POINT):HWND; external UserDLLCore name 'ChildWindowFromPoint';
-
-//redirected to DrawInconEx
-function DrawIcon(hDC:HDC; X:Integer; Y:Integer; hIcon:HICON):WINBOOL;
-function EventModify(hEvent:HANDLE; func:DWORD ):WINBOOL; external KernelDLL name 'EventModify'; //+kfuncs
-//redirected to TerminateProcess
-procedure ExitProcess(uExitCode:UINT);
-//calculated value
-function GetCurrentProcess:HANDLE;
-//calculated value
-function GetCurrentProcessId:DWORD;
-//calculated value
-function GetCurrentThread:HANDLE;
-//calculated value
-function GetCurrentThreadId:DWORD;
-//redirected to LocalAlloc
-function GlobalAlloc(uFlags:UINT; dwBytes:DWORD):HGLOBAL;
-//redirected to LocalHandle
-function GlobalHandle(pMem:LPCVOID):HGLOBAL;
-//redirected to LocalFree
-function GlobalFree(hMem:HGLOBAL):HGLOBAL;
-//redirected to LocalLock
-function GlobalLock(hMem:HGLOBAL):LPVOID;
-//redirected to LocalRealloc
-function GlobalReAlloc(hMem:HGLOBAL; dwBytes:DWORD; uFlags:UINT):HGLOBAL;
-//redirected to LocalSize
-function GlobalSize(hMem:HGLOBAL):DWORD;
-//redirected to LocalUnlock
-function GlobalUnlock(hMem:HGLOBAL):WINBOOL;
-//empty
-function LocalLock(hMem:HLOCAL):LPVOID;
-//empty
-function LocalUnlock(hMem:HLOCAL):WINBOOL;
-//empty
-function LocalHandle(pMem:LPCVOID):HLOCAL;
-//redirected to TlsCall
-function TlsAlloc:DWORD;
-function TlsCall(p1:DWORD; p2:DWORD):DWORD; external KernelDLL name 'TlsCall';
-//redirected to TlsCall
-function TlsFree(dwTlsIndex:DWORD):WINBOOL;
-//redirected to MsgWaitForMultipleObjectsEx
-function MsgWaitForMultipleObjects(nCount:DWORD; pHandles:LPHANDLE; fWaitAll:WINBOOL; dwMilliseconds:DWORD; dwWakeMask:DWORD):DWORD;
-//redirected to TrackPopupMenuEx
-function TrackPopupMenu(hMenu:HMENU; uFlags:UINT; x:Integer; y:Integer; nReserved:Integer;hWnd:HWND; var prcRect:RECT):WINBOOL;
-//redirected to EventModify
-function PulseEvent(hEvent:HANDLE):WINBOOL;
-//redirected to EventModify
-function ResetEvent(hEvent:HANDLE):WINBOOL;
-//redirected to EventModify
-function SetEvent(hEvent:HANDLE):WINBOOL;
-//win32 version redirected
-function WindowFromPoint(Point:POINT):HWND; external UserDLLCore name 'WindowFromPoint';
-
-// SHGetSpecialFolderPath consts
-const
- CSIDL_PROGRAMS = $0002;
- CSIDL_CONTROLS = $0003;
- CSIDL_PRINTERS = $0004;
- CSIDL_PERSONAL = $0005;
- CSIDL_FAVORITES = $0006;
- CSIDL_STARTUP = $0007;
- CSIDL_RECENT = $0008;
- CSIDL_SENDTO = $0009;
- CSIDL_BITBUCKET = $000a;
- CSIDL_STARTMENU = $000b;
- CSIDL_DESKTOPDIRECTORY = $0010;
- CSIDL_DRIVES = $0011;
- CSIDL_NETWORK = $0012;
- CSIDL_NETHOOD = $0013;
- CSIDL_FONTS = $0014;
- CSIDL_TEMPLATES = $0015;
- CSIDL_APPDATA = $001a;
-
-function SHGetSpecialFolderPath(hwndOwner: HWND; lpszPath: LPTSTR; nFolder: LongInt; fCreate: BOOL): BOOL;
- external 'coredll' name 'SHGetSpecialFolderPath';
-
-//end wince only
-{$endif WINCE}
-
-{$ifdef WIN32}
-//begin win32 only
-{function AbortPath(_para1:HDC):WINBOOL; external 'gdi32' name 'AbortPath';}
-function AccessCheck(pSecurityDescriptor:PSECURITY_DESCRIPTOR; ClientToken:HANDLE; DesiredAccess:DWORD; GenericMapping:PGENERIC_MAPPING; PrivilegeSet:PPRIVILEGE_SET;PrivilegeSetLength:LPDWORD;
- GrantedAccess:LPDWORD; AccessStatus:LPBOOL):WINBOOL; external 'advapi32' name 'AccessCheck';
-{$ifdef WIN95}
-function ActivateKeyboardLayout(hkl:HKL; Flags:UINT):HKL; external 'user32' name 'ActivateKeyboardLayout';
-{$else}
-function ActivateKeyboardLayout(hkl:HKL; Flags:UINT):WINBOOL; external 'user32' name 'ActivateKeyboardLayout';
-{$endif}
-function AddAccessAllowedAce(pAcl:PACL; dwAceRevision:DWORD; AccessMask:DWORD; pSid:PSID):WINBOOL; external 'advapi32' name 'AddAccessAllowedAce';
-function AddAccessDeniedAce(pAcl:PACL; dwAceRevision:DWORD; AccessMask:DWORD; pSid:PSID):WINBOOL; external 'advapi32' name 'AddAccessDeniedAce';
-function AddAce(pAcl:PACL; dwAceRevision:DWORD; dwStartingAceIndex:DWORD; pAceList:LPVOID; nAceListLength:DWORD):WINBOOL; external 'advapi32' name 'AddAce';
-function AddAuditAccessAce(pAcl:PACL; dwAceRevision:DWORD; dwAccessMask:DWORD; pSid:PSID; bAuditSuccess:WINBOOL;bAuditFailure:WINBOOL):WINBOOL; external 'advapi32' name 'AddAuditAccessAce';
-function AdjustTokenPrivileges(TokenHandle:HANDLE; DisableAllPrivileges:WINBOOL; NewState:PTOKEN_PRIVILEGES; BufferLength:DWORD; PreviousState:PTOKEN_PRIVILEGES;ReturnLength:PDWORD):WINBOOL; external 'advapi32' name 'AdjustTokenPrivileges';
-function AdjustTokenGroups(TokenHandle:HANDLE; ResetToDefault:WINBOOL; NewState:PTOKEN_GROUPS; BufferLength:DWORD; PreviousState:PTOKEN_GROUPS;ReturnLength:PDWORD):WINBOOL; external 'advapi32' name 'AdjustTokenGroups';
-function AdjustWindowRect(lpRect:LPRECT; dwStyle:DWORD; bMenu:WINBOOL):WINBOOL; external 'user32' name 'AdjustWindowRect';
-function AllocateAndInitializeSid(pIdentifierAuthority:PSID_IDENTIFIER_AUTHORITY; nSubAuthorityCount:BYTE; nSubAuthority0:DWORD; nSubAuthority1:DWORD; nSubAuthority2:DWORD;nSubAuthority3:DWORD; nSubAuthority4:DWORD;
- nSubAuthority5:DWORD; nSubAuthority6:DWORD; nSubAuthority7:DWORD;var pSid:PSID):WINBOOL; external 'advapi32' name 'AllocateAndInitializeSid';
-function AllocateLocallyUniqueId(Luid:PLUID):WINBOOL; external 'advapi32' name 'AllocateLocallyUniqueId';
-function AllocConsole:WINBOOL; external 'kernel32' name 'AllocConsole';
-function AngleArc(_para1:HDC; _para2:Integer; _para3:Integer; _para4:DWORD; _para5:Single;_para6:Single):WINBOOL; external 'gdi32' name 'AngleArc';
-function AnimatePalette(_para1:HPALETTE; _para2:UINT; _para3:UINT; var _para4:PALETTEENTRY):WINBOOL; external 'gdi32' name 'AnimatePalette';
-function Animate_Create(hWndP:HWND; id:HMENU;dwStyle:DWORD;hInstance:HINST):HWND;
-function Animate_Open(hwnd : HWND;szName : LPTSTR) : LRESULT;
-function Animate_Play(hwnd : HWND;from,_to : Integer;rep : UINT) : LRESULT;
-function Animate_Stop(hwnd : HWND) : LRESULT;
-function Animate_Close(hwnd : HWND) : LRESULT;
-function Animate_Seek(hwnd : HWND;frame : Integer) : LRESULT;
-function AnyPopup:WINBOOL; external 'user32' name 'AnyPopup';
-function Arc(_para1:HDC; _para2:Integer; _para3:Integer; _para4:Integer; _para5:Integer;_para6:Integer; _para7:Integer; _para8:Integer; _para9:Integer):WINBOOL; external 'gdi32' name 'Arc';
-function ArcTo(_para1:HDC; _para2:Integer; _para3:Integer; _para4:Integer; _para5:Integer;_para6:Integer; _para7:Integer; _para8:Integer; _para9:Integer):WINBOOL; external 'gdi32' name 'ArcTo';
-function AreAllAccessesGranted(GrantedAccess:DWORD; DesiredAccess:DWORD):WINBOOL; external 'advapi32' name 'AreAllAccessesGranted';
-function AreAnyAccessesGranted(GrantedAccess:DWORD; DesiredAccess:DWORD):WINBOOL; external 'advapi32' name 'AreAnyAccessesGranted';
-function AreFileApisANSI:WINBOOL; external 'kernel32' name 'AreFileApisANSI';
-function ArrangeIconicWindows(hWnd:HWND):UINT; external 'user32' name 'ArrangeIconicWindows';
-function AttachThreadInput(idAttach:DWORD; idAttachTo:DWORD; fAttach:WINBOOL):WINBOOL; external 'user32' name 'AttachThreadInput';
-function BackupRead(hFile:HANDLE; lpBuffer:LPBYTE; nNumberOfBytesToRead:DWORD; lpNumberOfBytesRead:LPDWORD; bAbort:WINBOOL;bProcessSecurity:WINBOOL; var lpContext:LPVOID):WINBOOL; external 'kernel32' name 'BackupRead';
-function BackupSeek(hFile:HANDLE; dwLowBytesToSeek:DWORD; dwHighBytesToSeek:DWORD; lpdwLowByteSeeked:LPDWORD; lpdwHighByteSeeked:LPDWORD;var lpContext:LPVOID):WINBOOL; external 'kernel32' name 'BackupSeek';
-function BackupWrite(hFile:HANDLE; lpBuffer:LPBYTE; nNumberOfBytesToWrite:DWORD; lpNumberOfBytesWritten:LPDWORD; bAbort:WINBOOL;bProcessSecurity:WINBOOL; var lpContext:LPVOID):WINBOOL; external 'kernel32' name 'BackupWrite';
-function Beep(dwFreq:DWORD; dwDuration:DWORD):WINBOOL; external 'kernel32' name 'Beep';
-function BeginPath(_para1:HDC):WINBOOL; external 'gdi32' name 'BeginPath';
-function BroadcastSystemMessage(_para1:DWORD; _para2:LPDWORD; _para3:UINT; _para4:WPARAM; _para5:LPARAM):Integer; external 'user32' name 'BroadcastSystemMessage';
-function CancelDC(_para1:HDC):WINBOOL; external 'gdi32' name 'CancelDC';
-function CascadeWindows(hwndParent:HWND; wHow:UINT; var lpRect:RECT; cKids:UINT; var lpKids:HWND):WORD; external 'user32' name 'CascadeWindows';
-function ChangeClipboardChain(hWndRemove:HWND; hWndNewNext:HWND):WINBOOL; external 'user32' name 'ChangeClipboardChain';
-//to move in ascfun.inc
-function CharNextExA(CodePage:WORD; lpCurrentChar:LPCSTR; dwFlags:DWORD):LPSTR; external 'user32' name 'CharNextExA';
-//to move in ascfun.inc
-function CharPrevExA(CodePage:WORD; lpStart:LPCSTR; lpCurrentChar:LPCSTR; dwFlags:DWORD):LPSTR; external 'user32' name 'CharPrevExA';
-function CheckColorsInGamut(_para1:HDC; _para2:LPVOID; _para3:LPVOID; _para4:DWORD):WINBOOL; external 'gdi32' name 'CheckColorsInGamut';
-function CheckDlgButton(hDlg:HWND; nIDButton:Integer; uCheck:UINT):WINBOOL; external 'user32' name 'CheckDlgButton';
-function ChildWindowFromPoint(hWndParent:HWND; Point:POINT):HWND; { external 'user32' name 'ChildWindowFromPoint';bug 1807 }
-function ChildWindowFromPointEx(_para1:HWND; _para2:POINT; _para3:UINT):HWND; {external 'user32' name 'ChildWindowFromPointEx';}
-function ChoosePixelFormat(_para1:HDC; _para2:PPIXELFORMATDESCRIPTOR):Integer; external 'gdi32' name 'ChoosePixelFormat';
-function Chord(_para1:HDC; _para2:Integer; _para3:Integer; _para4:Integer; _para5:Integer;_para6:Integer; _para7:Integer; _para8:Integer; _para9:Integer):WINBOOL; external 'gdi32' name 'Chord';
-function CloseDesktop(hDesktop:HDESK):WINBOOL; external 'user32' name 'CloseDesktop';
-function CloseEventLog(hEventLog:HANDLE):WINBOOL; external 'advapi32' name 'CloseEventLog';
-function CloseFigure(_para1:HDC):WINBOOL; external 'gdi32' name 'CloseFigure';
-function CloseMetaFile(_para1:HDC):HMETAFILE; external 'gdi32' name 'CloseMetaFile';
-function CloseServiceHandle(hSCObject:SC_HANDLE):WINBOOL; external 'advapi32' name 'CloseServiceHandle';
-function CloseWindow(hWnd:HWND):WINBOOL; external 'user32' name 'CloseWindow';
-function CloseWindowStation(hWinSta:HWINSTA):WINBOOL; external 'user32' name 'CloseWindowStation';
-function ColorMatchToTarget(_para1:HDC; _para2:HDC; _para3:DWORD):WINBOOL; external 'gdi32' name 'ColorMatchToTarget';
-function CombineTransform(_para1:LPXFORM; var _para2:XFORM; var _para3:XFORM):WINBOOL; external 'gdi32' name 'CombineTransform';
-function ConnectNamedPipe(hNamedPipe:HANDLE; lpOverlapped:LPOVERLAPPED):WINBOOL; external 'kernel32' name 'ConnectNamedPipe';
-function ControlService(hService:SC_HANDLE; dwControl:DWORD; lpServiceStatus:LPSERVICE_STATUS):WINBOOL; external 'advapi32' name 'ControlService';
-function CopyIcon(hIcon:HICON):HICON; external 'user32' name 'CopyIcon';
-function CopyImage(_para1:HANDLE; _para2:UINT; _para3:Integer; _para4:Integer; _para5:UINT):HICON; external 'user32' name 'CopyImage';
-function CopySid(nDestinationSidLength:DWORD; pDestinationSid:PSID; pSourceSid:PSID):WINBOOL; external 'advapi32' name 'CopySid';
-function CreateBitmapIndirect(var _para1:BITMAP):HBITMAP; external 'gdi32' name 'CreateBitmapIndirect';
-function CreateBrushIndirect(var _para1:LOGBRUSH):HBRUSH; external 'gdi32' name 'CreateBrushIndirect';
-function CreateCursor(hInst:HINST; xHotSpot:Integer; yHotSpot:Integer; nWidth:Integer; nHeight:Integer;pvANDPlane:pointer; pvXORPlane:pointer):HCURSOR; external 'user32' name 'CreateCursor';
-function CreateConsoleScreenBuffer(dwDesiredAccess:DWORD; dwShareMode:DWORD; var lpSecurityAttributes:SECURITY_ATTRIBUTES; dwFlags:DWORD; lpScreenBufferData:LPVOID):HANDLE; external 'kernel32' name 'CreateConsoleScreenBuffer';
-function CreateDiscardableBitmap(_para1:HDC; _para2:Integer; _para3:Integer):HBITMAP; external 'gdi32' name 'CreateDiscardableBitmap';
-function CreateDIBitmap(_para1:HDC; var _para2:BITMAPINFOHEADER; _para3:DWORD; _para4:pointer; var _para5:BITMAPINFO;_para6:UINT):HBITMAP; external 'gdi32' name 'CreateDIBitmap';
-function CreateDIBPatternBrush(_para1:HGLOBAL; _para2:UINT):HBRUSH; external 'gdi32' name 'CreateDIBPatternBrush';
-function CreateEllipticRgn(_para1:Integer; _para2:Integer; _para3:Integer; _para4:Integer):HRGN; external 'gdi32' name 'CreateEllipticRgn';
-function CreateEllipticRgnIndirect(var _para1:RECT):HRGN; external 'gdi32' name 'CreateEllipticRgnIndirect';
-function CreateHalftonePalette(_para1:HDC):HPALETTE; external 'gdi32' name 'CreateHalftonePalette';
-function CreateHatchBrush(_para1:Integer; _para2:COLORREF):HBRUSH; external 'gdi32' name 'CreateHatchBrush';
-function CreateIcon(hInstance:HINST; nWidth:Integer; nHeight:Integer; cPlanes:BYTE; cBitsPixel:BYTE;var lpbANDbits:BYTE; var lpbXORbits:BYTE):HICON; external 'user32' name 'CreateIcon';
-function CreateIconFromResource(presbits:PBYTE; dwResSize:DWORD; fIcon:WINBOOL; dwVer:DWORD):HICON; external 'user32' name 'CreateIconFromResource';
-function CreateIconFromResourceEx(presbits:PBYTE; dwResSize:DWORD; fIcon:WINBOOL; dwVer:DWORD; cxDesired:Integer;cyDesired:Integer; Flags:UINT):HICON; external 'user32' name 'CreateIconFromResourceEx';
-function CreateIoCompletionPort(FileHandle:HANDLE; ExistingCompletionPort:HANDLE; CompletionKey:DWORD; NumberOfConcurrentThreads:DWORD):HANDLE; external 'kernel32' name 'CreateIoCompletionPort';
-function CreateMappedBitmap(hInstance:HINST; idBitmap:Integer; wFlags:UINT; lpColorMap:LPCOLORMAP; iNumMaps:Integer):HBITMAP; external 'comctl32' name 'CreateMappedBitmap';
-function CreatePipe(hReadPipe:PHANDLE; hWritePipe:PHANDLE; lpPipeAttributes:LPSECURITY_ATTRIBUTES; nSize:DWORD):WINBOOL; external 'kernel32' name 'CreatePipe';
-function CreatePolyPolygonRgn(var _para1:POINT; var _para2:wINT; _para3:Integer; _para4:Integer):HRGN; external 'gdi32' name 'CreatePolyPolygonRgn';
-function CreatePolygonRgn(var _para1:POINT; _para2:Integer; _para3:Integer):HRGN; external 'gdi32' name 'CreatePolygonRgn';
-function CreatePrivateObjectSecurity(ParentDescriptor:PSECURITY_DESCRIPTOR; CreatorDescriptor:PSECURITY_DESCRIPTOR; var NewDescriptor:PSECURITY_DESCRIPTOR;
- IsDirectoryObject:WINBOOL; Token:HANDLE;GenericMapping:PGENERIC_MAPPING):WINBOOL; external 'advapi32' name 'CreatePrivateObjectSecurity';
-//to move to ascfun.inc
-function CreatePropertySheetPageA(lppsp:LPCPROPSHEETPAGE):HPROPSHEETPAGE; external 'comctl32' name 'CreatePropertySheetPageA';
-function CreateRemoteThread(hProcess:HANDLE; lpThreadAttributes:LPSECURITY_ATTRIBUTES; dwStackSize:DWORD; lpStartAddress:LPTHREAD_START_ROUTINE; lpParameter:LPVOID;
- dwCreationFlags:DWORD; lpThreadId:LPDWORD):HANDLE; external 'kernel32' name 'CreateRemoteThread';
-function CreateRoundRectRgn(_para1:Integer; _para2:Integer; _para3:Integer; _para4:Integer; _para5:Integer;_para6:Integer):HRGN; external 'gdi32' name 'CreateRoundRectRgn';
-function CreateTapePartition(hDevice:HANDLE; dwPartitionMethod:DWORD; dwCount:DWORD; dwSize:DWORD):DWORD; external 'kernel32' name 'CreateTapePartition';
-function DdeAbandonTransaction(_para1:DWORD; _para2:HCONV; _para3:DWORD):BOOL;external 'user32' name 'DdeAbandonTransaction';
-function DdeAccessData(_para1:HDDEDATA; _para2:PDWORD):PBYTE;external 'user32' name 'DdeAccessData';
-function DdeAddData(_para1:HDDEDATA; _para2:PBYTE; _para3:DWORD; _para4:DWORD):HDDEDATA;external 'user32' name 'DdeAddData';
-{ This is only a prototype PM
-function DdeCallback(_para1, _para2:UINT; _para3:HCONV; _para4, _para5:HSZ;_para6: HDDEDATA; _para7, _para8:PDWORD):HDDEDATA;external 'user32' name 'DdeCallback';}
-function DdeClientTransaction(_para1:PBYTE; _para2:DWORD; _para3:HCONV; _para4:HSZ; _para5:UINT;
- _para6:UINT; _para7:DWORD; _para8:PDWORD):HDDEDATA;external 'user32' name 'DdeClientTransaction';
-function DdeCmpStringHandles(_para1:HSZ; _para2:HSZ):Integer; external 'user32' name 'DdeCmpStringHandles';
-function DdeConnect(_para1:DWORD; _para2:HSZ; _para3:HSZ; var _para4:CONVCONTEXT):HCONV; external 'user32' name 'DdeConnect';
-function DdeConnectList(_para1:DWORD; _para2:HSZ; _para3:HSZ; _para4:HCONVLIST; _para5:PCONVCONTEXT):HCONVLIST;external 'user32' name 'DdeConnectList';
-function DdeCreateDataHandle(_para1:DWORD; _para2:LPBYTE; _para3:DWORD; _para4:DWORD; _para5:HSZ;_para6:UINT; _para7:UINT):HDDEDATA; external 'user32' name 'DdeCreateDataHandle';
-function DdeDisconnect(_para1:HCONV):WINBOOL; external 'user32' name 'DdeDisconnect';
-function DdeDisconnectList(_para1:HCONVLIST):BOOL;external 'user32' name 'DdeDisconnectList';
-function DdeEnableCallback(_para1:DWORD; _para2:HCONV; _para3:UINT):BOOL;external 'user32' name 'DdeEnableCallback';
-function DdeFreeDataHandle(_para1:HDDEDATA):WINBOOL; external 'user32' name 'DdeFreeDataHandle';
-function DdeFreeStringHandle(_para1:DWORD;_para2:HSZ):WINBOOL; external 'user32' name 'DdeFreeStringHandle';
-function DdeGetData(_para1:HDDEDATA;_para2:LPBYTE; _para3:DWORD; _para4:DWORD):DWORD; external 'user32' name 'DdeGetData';
-function DdeGetLastError(_para1:DWORD):UINT; external 'user32' name 'DdeGetLastError';
-function DdeImpersonateClient(_para1:HCONV):BOOL;external 'user32' name 'DdeImpersonateClient';
-function DdeKeepStringHandle(_para1:DWORD; _para2:HSZ):BOOL;external 'user32' name 'DdeKeepStringHandle';
-function DdeNameService(_para1:DWORD; _para2:HSZ; _para3:HSZ; _para4:UINT):HDDEDATA; external 'user32' name 'DdeNameService';
-function DdePostAdvise(_para1:DWORD; _para2:HSZ; _para3:HSZ):WINBOOL; external 'user32' name 'DdePostAdvise';
-function DdeQueryConvInfo(_para1:HCONV; _para2:DWORD; _para3:PCONVINFO):UINT;external 'user32' name 'DdeQueryConvInfo';
-function DdeQueryNextServer(_para1:HCONVLIST; _para2:HCONV):HCONV;external 'user32' name 'DdeQueryNextServer';
-function DdeReconnect(_para1:HCONV):HCONV; external 'user32' name 'DdeReconnect';
-function DdeSetUserHandle(_para1:HCONV; _para2:DWORD; _para3:DWORD):BOOL;external 'user32' name 'DdeSetUserHandle';
-function DdeUnaccessData(_para1:HDDEDATA):BOOL;external 'user32' name 'DdeUnaccessData';
-function DdeUninitialize(_para1:DWORD):WINBOOL; external 'user32' name 'DdeUninitialize';
-procedure DebugBreak; external 'kernel32' name 'DebugBreak';
-function DeleteAce(pAcl:PACL; dwAceIndex:DWORD):WINBOOL; external 'advapi32' name 'DeleteAce';
-function DeleteAtom(nAtom:ATOM):ATOM; external 'kernel32' name 'DeleteAtom';
-function DeleteColorSpace(_para1:HCOLORSPACE):WINBOOL; external 'gdi32' name 'DeleteColorSpace';
-function DeleteMetaFile(_para1:HMETAFILE):WINBOOL; external 'gdi32' name 'DeleteMetaFile';
-function DeleteService(hService:SC_HANDLE):WINBOOL; external 'advapi32' name 'DeleteService';
-function DeregisterEventSource(hEventLog:HANDLE):WINBOOL; external 'advapi32' name 'DeregisterEventSource';
-function DescribePixelFormat(_para1:HDC; _para2:Integer; _para3:UINT; _para4:LPPIXELFORMATDESCRIPTOR):Integer; external 'gdi32' name 'DescribePixelFormat';
-function DestroyCursor(hCursor:HCURSOR):WINBOOL; external 'user32' name 'DestroyCursor';
-function DestroyPrivateObjectSecurity(ObjectDescriptor:PSECURITY_DESCRIPTOR):WINBOOL; external 'advapi32' name 'DestroyPrivateObjectSecurity';
-function DisconnectNamedPipe(hNamedPipe:HANDLE):WINBOOL; external 'kernel32' name 'DisconnectNamedPipe';
-function DosDateTimeToFileTime(wFatDate:WORD; wFatTime:WORD; lpFileTime:LPFILETIME):WINBOOL; external 'kernel32' name 'DosDateTimeToFileTime';
-function DPtoLP(_para1:HDC; _para2:LPPOINT; _para3:Integer):WINBOOL; external 'gdi32' name 'DPtoLP';
-procedure DragAcceptFiles(_para1:HWND; _para2:WINBOOL); external 'shell32' name 'DragAcceptFiles';
-function DragDetect(hwnd:HWND; pt:POINT):WINBOOL; {external 'user32' name 'DragDetect';bug 1807 }
-procedure DragFinish(_para1:HDROP); external 'shell32' name 'DragFinish';
-function DragObject(_para1:HWND; _para2:HWND; _para3:UINT; _para4:DWORD; _para5:HCURSOR):DWORD; external 'user32' name 'DragObject';
-function DragQueryPoint(_para1:HDROP; _para2:LPPOINT):WINBOOL; external 'shell32' name 'DragQueryPoint';
-function DrawAnimatedRects(hwnd:HWND; idAni:Integer; var lprcFrom:RECT; var lprcTo:RECT):WINBOOL; external 'user32' name 'DrawAnimatedRects';
-function DrawCaption(_para1:HWND; _para2:HDC; var _para3:RECT; _para4:UINT):WINBOOL; external 'user32' name 'DrawCaption';
-function DrawEscape(_para1:HDC; _para2:Integer; _para3:Integer; _para4:LPCSTR):Integer; external 'gdi32' name 'DrawEscape';
-function DrawIcon(hDC:HDC; X:Integer; Y:Integer; hIcon:HICON):WINBOOL; external 'user32' name 'DrawIcon';
-procedure DrawInsert(handParent:HWND; hLB:HWND; nItem:Integer); external 'comctl32' name 'DrawInsert';
-function DuplicateIcon(_para1:HINST; _para2:HICON):HICON; external 'shell32' name 'DuplicateIcon';
-function DuplicateToken(ExistingTokenHandle:HANDLE; ImpersonationLevel:SECURITY_IMPERSONATION_LEVEL; DuplicateTokenHandle:PHANDLE):WINBOOL; external 'advapi32' name 'DuplicateToken';
-function EndPath(_para1:HDC):WINBOOL; external 'gdi32' name 'EndPath';
-function EnumDesktopWindows(hDesktop:HDESK; lpfn:ENUMWINDOWSPROC; lParam:LPARAM):WINBOOL; external 'user32' name 'EnumDesktopWindows';
-function EnumObjects(_para1:HDC; _para2:Integer; _para3:ENUMOBJECTSPROC; _para4:LPARAM):Integer; external 'gdi32' name 'EnumObjects';
-function EraseTape(hDevice:HANDLE; dwEraseType:DWORD; bImmediate:WINBOOL):DWORD; external 'kernel32' name 'EraseTape';
-function Escape(_para1:HDC; _para2:Integer; _para3:Integer; _para4:LPCSTR; _para5:LPVOID):Integer; external 'gdi32' name 'Escape';
-function EqualSid(pSid1:PSID; pSid2:PSID):WINBOOL; external 'advapi32' name 'EqualSid';
-function EqualPrefixSid(pSid1:PSID; pSid2:PSID):WINBOOL; external 'advapi32' name 'EqualPrefixSid';
-function EnableScrollBar(hWnd:HWND; wSBflags:UINT; wArrows:UINT):WINBOOL; external 'user32' name 'EnableScrollBar';
-function EnumChildWindows(hWndParent:HWND; lpEnumFunc:ENUMWINDOWSPROC; lParam:LPARAM):WINBOOL; external 'user32' name 'EnumChildWindows';
-function EnumEnhMetaFile(_para1:HDC; _para2:HENHMETAFILE; _para3:ENHMETAFILEPROC; _para4:LPVOID; var _para5:RECT):WINBOOL; external 'gdi32' name 'EnumEnhMetaFile';
-function EnumMetaFile(_para1:HDC; _para2:HMETAFILE; _para3:ENUMMETAFILEPROC; _para4:LPARAM):WINBOOL; external 'gdi32' name 'EnumMetaFile';
-function EnumThreadWindows(dwThreadId:DWORD; lpfn:ENUMWINDOWSPROC; lParam:LPARAM):WINBOOL; external 'user32' name 'EnumThreadWindows';
-function EnumTaskWindows(hTask:HWND; lpfn:FARPROC; lParam: LPARAM): BOOL;external 'user32' name 'EnumThreadWindows';
-function ExcludeUpdateRgn(hDC:HDC; hWnd:HWND):Integer; external 'user32' name 'ExcludeUpdateRgn';
-procedure ExitProcess(uExitCode:UINT);external 'kernel32' name 'ExitProcess';
-function ExtCreatePen(_para1:DWORD; _para2:DWORD; var _para3:LOGBRUSH; _para4:DWORD; var _para5:DWORD):HPEN; external 'gdi32' name 'ExtCreatePen';
-function ExtFloodFill(_para1:HDC; _para2:Integer; _para3:Integer; _para4:COLORREF; _para5:UINT):WINBOOL; external 'gdi32' name 'ExtFloodFill';
-function ExtSelectClipRgn(_para1:HDC; _para2:HRGN; _para3:Integer):Integer; external 'gdi32' name 'ExtSelectClipRgn';
-procedure FatalExit(ExitCode:Integer); external 'kernel32' name 'FatalExit';
-function FileTimeToDosDateTime(lpFileTime:LPFILETIME; lpFatDate:LPWORD; lpFatTime:LPWORD):WINBOOL; external 'kernel32' name 'FileTimeToDosDateTime';
-function FillConsoleOutputAttribute(hConsoleOutput:HANDLE; wAttribute:WORD; nLength:DWORD; dwWriteCoord:COORD; lpNumberOfAttrsWritten:LPDWORD):WINBOOL; external 'kernel32' name 'FillConsoleOutputAttribute';
-function FillPath(_para1:HDC):WINBOOL; external 'gdi32' name 'FillPath';
-function FillRgn(_para1:HDC; _para2:HRGN; _para3:HBRUSH):WINBOOL; external 'gdi32' name 'FillRgn';
-function FindFirstFreeAce(pAcl:PACL; var pAce:LPVOID):WINBOOL; external 'advapi32' name 'FindFirstFreeAce';
-function FixBrushOrgEx(_para1:HDC; _para2:Integer; _para3:Integer; _para4:LPPOINT):WINBOOL; external 'gdi32' name 'FixBrushOrgEx';
-function FlashWindow(hWnd:HWND; bInvert:WINBOOL):WINBOOL; external 'user32' name 'FlashWindow';
-function FlattenPath(_para1:HDC):WINBOOL; external 'gdi32' name 'FlattenPath';
-function FloodFill(_para1:HDC; _para2:Integer; _para3:Integer; _para4:COLORREF):WINBOOL; external 'gdi32' name 'FloodFill';
-function FlushConsoleInputBuffer(hConsoleInput:HANDLE):WINBOOL; external 'kernel32' name 'FlushConsoleInputBuffer';
-function FrameRect(hDC:HDC; var lprc:RECT; hbr:HBRUSH):Integer; external 'user32' name 'FrameRect';
-function FrameRgn(_para1:HDC; _para2:HRGN; _para3:HBRUSH; _para4:Integer; _para5:Integer):WINBOOL; external 'gdi32' name 'FrameRgn';
-function FreeConsole:WINBOOL; external 'kernel32' name 'FreeConsole';
-function FreeResource(hResData:HGLOBAL):WINBOOL; external 'kernel32' name 'FreeResource';
-function FreeSid(pSid:PSID):PVOID; external 'advapi32' name 'FreeSid';
-function GdiComment(_para1:HDC; _para2:UINT; var _para3:BYTE):WINBOOL; external 'gdi32' name 'GdiComment';
-function GdiFlush:WINBOOL; external 'gdi32' name 'GdiFlush';
-function GdiGetBatchLimit:DWORD; external 'gdi32' name 'GdiGetBatchLimit';
-function GdiSetBatchLimit(_para1:DWORD):DWORD; external 'gdi32' name 'GdiSetBatchLimit';
-function GenerateConsoleCtrlEvent(dwCtrlEvent:DWORD; dwProcessGroupId:DWORD):WINBOOL; external 'kernel32' name 'GenerateConsoleCtrlEvent';
-function GetAce(pAcl:PACL; dwAceIndex:DWORD; var pAce:LPVOID):WINBOOL; external 'advapi32' name 'GetAce';
-function GetAclInformation(pAcl:PACL; pAclInformation:LPVOID; nAclInformationLength:DWORD; dwAclInformationClass:ACL_INFORMATION_CLASS):WINBOOL; external 'advapi32' name 'GetAclInformation';
-function GetAspectRatioFilterEx(_para1:HDC; _para2:LPSIZE):WINBOOL; external 'gdi32' name 'GetAspectRatioFilterEx';
-function GetArcDirection(_para1:HDC):Integer; external 'gdi32' name 'GetArcDirection';
-function GetBitmapBits(_para1:HBITMAP; _para2:LONG; _para3:LPVOID):LONG; external 'gdi32' name 'GetBitmapBits';
-function GetBitmapDimensionEx(_para1:HBITMAP; _para2:LPSIZE):WINBOOL; external 'gdi32' name 'GetBitmapDimensionEx';
-function GetBoundsRect(_para1:HDC; _para2:LPRECT; _para3:UINT):UINT; external 'gdi32' name 'GetBoundsRect';
-function GetBrushOrgEx(_para1:HDC; _para2:LPPOINT):WINBOOL; external 'gdi32' name 'GetBrushOrgEx';
-function GetClassWord(hWnd:HWND; nIndex:Integer):WORD; external 'user32' name 'GetClassWord';
-function GetClipboardViewer:HWND; external 'user32' name 'GetClipboardViewer';
-function GetColorAdjustment(_para1:HDC; _para2:LPCOLORADJUSTMENT):WINBOOL; external 'gdi32' name 'GetColorAdjustment';
-function GetColorSpace(_para1:HDC):HANDLE; external 'gdi32' name 'GetColorSpace';
-function GetCommConfig(hCommDev:HANDLE; lpCC:LPCOMMCONFIG; lpdwSize:LPDWORD):WINBOOL; external 'kernel32' name 'GetCommConfig';
-function GetConsoleCP:UINT; external 'kernel32' name 'GetConsoleCP';
-function GetConsoleCursorInfo(hConsoleOutput:HANDLE; lpConsoleCursorInfo:PCONSOLE_CURSOR_INFO):WINBOOL; external 'kernel32' name 'GetConsoleCursorInfo';
-function GetConsoleMode(hConsoleHandle:HANDLE; lpMode:LPDWORD):WINBOOL; external 'kernel32' name 'GetConsoleMode';
-function GetConsoleOutputCP:UINT; external 'kernel32' name 'GetConsoleOutputCP';
-function GetConsoleScreenBufferInfo(hConsoleOutput:HANDLE; lpConsoleScreenBufferInfo:PCONSOLE_SCREEN_BUFFER_INFO):WINBOOL; external 'kernel32' name 'GetConsoleScreenBufferInfo';
-function GetCurrentProcess:HANDLE; external 'kernel32' name 'GetCurrentProcess';
-function GetCurrentProcessId:DWORD; external 'kernel32' name 'GetCurrentProcessId';
-function GetCurrentThread:HANDLE; external 'kernel32' name 'GetCurrentThread';
-function GetCurrentThreadId:DWORD; external 'kernel32' name 'GetCurrentThreadId';
-function GetDCOrgEx(_para1:HDC; _para2:LPPOINT):WINBOOL; external 'gdi32' name 'GetDCOrgEx';
-function GetDeviceGammaRamp(_para1:HDC; _para2:LPVOID):WINBOOL; external 'gdi32' name 'GetDeviceGammaRamp';
-function GetDIBits(_para1:HDC; _para2:HBITMAP; _para3:UINT; _para4:UINT; _para5:LPVOID;_para6:LPBITMAPINFO; _para7:UINT):Integer; external 'gdi32' name 'GetDIBits';
-procedure GetEffectiveClientRect(hWnd:HWND; lprc:LPRECT; lpInfo:LPINT); external 'comctl32' name 'GetEffectiveClientRect';
-function GetEnhMetaFileHeader(_para1:HENHMETAFILE; _para2:UINT; _para3:LPENHMETAHEADER):UINT; external 'gdi32' name 'GetEnhMetaFileHeader';
-function GetEnhMetaFilePaletteEntries(_para1:HENHMETAFILE; _para2:UINT; _para3:LPPALETTEENTRY):UINT; external 'gdi32' name 'GetEnhMetaFilePaletteEntries';
-function GetFileType(hFile:HANDLE):DWORD; external 'kernel32' name 'GetFileType';
-function GetFontData(_para1:HDC; _para2:DWORD; _para3:DWORD; _para4:LPVOID; _para5:DWORD):DWORD; external 'gdi32' name 'GetFontData';
-function GetFontLanguageInfo(_para1:HDC):DWORD; external 'gdi32' name 'GetFontLanguageInfo';
-function GetGraphicsMode(_para1:HDC):Integer; external 'gdi32' name 'GetGraphicsMode';
-function GetHandleInformation(hObject:HANDLE; lpdwFlags:LPDWORD):WINBOOL; external 'kernel32' name 'GetHandleInformation';
-function GetIconInfo(hIcon:HICON; piconinfo:PICONINFO):WINBOOL; external 'user32' name 'GetIconInfo';
-function GetInputState:WINBOOL; external 'user32' name 'GetInputState';
-function GetKeyboardState(lpKeyState:PBYTE):WINBOOL; external 'user32' name 'GetKeyboardState';
-function GetKBCodePage:UINT; external 'user32' name 'GetKBCodePage';
-function GetKernelObjectSecurity(Handle:HANDLE; RequestedInformation:SECURITY_INFORMATION; pSecurityDescriptor:PSECURITY_DESCRIPTOR; nLength:DWORD; lpnLengthNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'GetKernelObjectSecurity';
-//redirected to internal_GetLargestConsoleWindowSize
-function GetLargestConsoleWindowSize(hConsoleOutput:HANDLE):COORD;
-function GetLastActivePopup(hWnd:HWND):HWND; external 'user32' name 'GetLastActivePopup';
-function GetLengthSid(pSid:PSID):DWORD; external 'advapi32' name 'GetLengthSid';
-function GetLogicalDrives:DWORD; external 'kernel32' name 'GetLogicalDrives';
-function GetMailslotInfo(hMailslot:HANDLE; lpMaxMessageSize:LPDWORD; lpNextSize:LPDWORD; lpMessageCount:LPDWORD; lpReadTimeout:LPDWORD):WINBOOL; external 'kernel32' name 'GetMailslotInfo';
-function GetMapMode(_para1:HDC):Integer; external 'gdi32' name 'GetMapMode';
-function GetMenu(hWnd:HWND):HMENU; external 'user32' name 'GetMenu';
-function GetMenuCheckMarkDimensions:LONG; external 'user32' name 'GetMenuCheckMarkDimensions';
-function GetMenuContextHelpId(_para1:HMENU):DWORD; external 'user32' name 'GetMenuContextHelpId';
-function GetMenuDefaultItem(hMenu:HMENU; fByPos:UINT; gmdiFlags:UINT):UINT; external 'user32' name 'GetMenuDefaultItem';
-function GetMenuItemID(hMenu:HMENU; nPos:Integer):UINT; external 'user32' name 'GetMenuItemID';
-function GetMenuItemCount(hMenu:HMENU):Integer; external 'user32' name 'GetMenuItemCount';
-function GetMenuItemRect(hWnd:HWND; hMenu:HMENU; uItem:UINT; lprcItem:LPRECT):WINBOOL; external 'user32' name 'GetMenuItemRect';
-function GetMenuState(hMenu:HMENU; uId:UINT; uFlags:UINT):UINT; external 'user32' name 'GetMenuState';
-function GetMetaFileBitsEx(_para1:HMETAFILE; _para2:UINT; _para3:LPVOID):UINT; external 'gdi32' name 'GetMetaFileBitsEx';
-function GetMetaRgn(_para1:HDC; _para2:HRGN):Integer; external 'gdi32' name 'GetMetaRgn';
-function GetMessageExtraInfo:LONG; external 'user32' name 'GetMessageExtraInfo';
-function GetMessageTime:LONG; external 'user32' name 'GetMessageTime';
-function GetMiterLimit(_para1:HDC; _para2:PSingle):WINBOOL; external 'gdi32' name 'GetMiterLimit';
-function GetNamedPipeInfo(hNamedPipe:HANDLE; lpFlags:LPDWORD; lpOutBufferSize:LPDWORD; lpInBufferSize:LPDWORD; lpMaxInstances:LPDWORD):WINBOOL; external 'kernel32' name 'GetNamedPipeInfo';
-function GetNextWindow(hWnd:HWND; uCmd:UINT):HWND; external 'user32' name 'GetNextWindow';
-function GetNumberOfConsoleInputEvents(hConsoleInput:HANDLE; lpNumberOfEvents:PDWORD):WINBOOL; external 'kernel32' name 'GetNumberOfConsoleInputEvents';
-function GetNumberOfConsoleMouseButtons(lpNumberOfMouseButtons:LPDWORD):WINBOOL; external 'kernel32' name 'GetNumberOfConsoleMouseButtons';
-function GetNumberOfEventLogRecords(hEventLog:HANDLE; NumberOfRecords:PDWORD):WINBOOL; external 'advapi32' name 'GetNumberOfEventLogRecords';
-function GetOldestEventLogRecord(hEventLog:HANDLE; OldestRecord:PDWORD):WINBOOL; external 'advapi32' name 'GetOldestEventLogRecord';
-function GetPath(_para1:HDC; _para2:LPPOINT; _para3:LPBYTE; _para4:Integer):Integer; external 'gdi32' name 'GetPath';
-function GetPixelFormat(_para1:HDC):Integer; external 'gdi32' name 'GetPixelFormat';
-function GetPolyFillMode(_para1:HDC):Integer; external 'gdi32' name 'GetPolyFillMode';
-function GetPriorityClass(hProcess:HANDLE):DWORD; external 'kernel32' name 'GetPriorityClass';
-function GetPrivateObjectSecurity(ObjectDescriptor:PSECURITY_DESCRIPTOR; SecurityInformation:SECURITY_INFORMATION; ResultantDescriptor:PSECURITY_DESCRIPTOR;
- DescriptorLength:DWORD; ReturnLength:PDWORD):WINBOOL;external 'advapi32' name 'GetPrivateObjectSecurity';
-function GetProcAddress(hModule:HINST; lpProcName:LPCSTR):FARPROC; external 'kernel32' name 'GetProcAddress';
-function GetProcessAffinityMask(hProcess:HANDLE; lpProcessAffinityMask:LPDWORD; lpSystemAffinityMask:LPDWORD):WINBOOL; external 'kernel32' name 'GetProcessAffinityMask';
-function GetProcessShutdownParameters(lpdwLevel:LPDWORD; lpdwFlags:LPDWORD):WINBOOL; external 'kernel32' name 'GetProcessShutdownParameters';
-function GetProcessHeaps(NumberOfHeaps:DWORD; ProcessHeaps:PHANDLE):DWORD; external 'kernel32' name 'GetProcessHeaps';
-function GetProcessTimes(hProcess:HANDLE; lpCreationTime:LPFILETIME; lpExitTime:LPFILETIME; lpKernelTime:LPFILETIME; lpUserTime:LPFILETIME):WINBOOL; external 'kernel32' name 'GetProcessTimes';
-function GetProcessWindowStation:HWINSTA; external 'user32' name 'GetProcessWindowStation';
-function GetProcessWorkingSetSize(hProcess:HANDLE; lpMinimumWorkingSetSize:LPDWORD; lpMaximumWorkingSetSize:LPDWORD):WINBOOL; external 'kernel32' name 'GetProcessWorkingSetSize';
-function GetRasterizerCaps(_para1:LPRASTERIZER_STATUS; _para2:UINT):WINBOOL; external 'gdi32' name 'GetRasterizerCaps';
-function GetROP2(_para1:HDC):Integer; external 'gdi32' name 'GetROP2';
-function GetScrollPos(hWnd:HWND; nBar:Integer):Integer; external 'user32' name 'GetScrollPos';
-function GetScrollRange(hWnd:HWND; nBar:Integer; lpMinPos:LPINT; lpMaxPos:LPINT):WINBOOL; external 'user32' name 'GetScrollRange';
-function GetSecurityDescriptorControl(pSecurityDescriptor:PSECURITY_DESCRIPTOR; pControl:PSECURITY_DESCRIPTOR_CONTROL; lpdwRevision:LPDWORD):WINBOOL; external 'advapi32' name 'GetSecurityDescriptorControl';
-function GetSecurityDescriptorDacl(pSecurityDescriptor:PSECURITY_DESCRIPTOR; lpbDaclPresent:LPBOOL; var pDacl:PACL; lpbDaclDefaulted:LPBOOL):WINBOOL; external 'advapi32' name 'GetSecurityDescriptorDacl';
-function GetSecurityDescriptorGroup(pSecurityDescriptor:PSECURITY_DESCRIPTOR; var pGroup:PSID; lpbGroupDefaulted:LPBOOL):WINBOOL; external 'advapi32' name 'GetSecurityDescriptorGroup';
-function GetSecurityDescriptorLength(pSecurityDescriptor:PSECURITY_DESCRIPTOR):DWORD; external 'advapi32' name 'GetSecurityDescriptorLength';
-function GetSecurityDescriptorOwner(pSecurityDescriptor:PSECURITY_DESCRIPTOR; var pOwner:PSID; lpbOwnerDefaulted:LPBOOL):WINBOOL; external 'advapi32' name 'GetSecurityDescriptorOwner';
-function GetSecurityDescriptorSacl(pSecurityDescriptor:PSECURITY_DESCRIPTOR; lpbSaclPresent:LPBOOL; var pSacl:PACL; lpbSaclDefaulted:LPBOOL):WINBOOL; external 'advapi32' name 'GetSecurityDescriptorSacl';
-function GetSidIdentifierAuthority(pSid:PSID):PSID_IDENTIFIER_AUTHORITY; external 'advapi32' name 'GetSidIdentifierAuthority';
-function GetSidLengthRequired(nSubAuthorityCount:UCHAR):DWORD; external 'advapi32' name 'GetSidLengthRequired';
-function GetSidSubAuthority(pSid:PSID; nSubAuthority:DWORD):PDWORD; external 'advapi32' name 'GetSidSubAuthority';
-function GetSidSubAuthorityCount(pSid:PSID):PUCHAR; external 'advapi32' name 'GetSidSubAuthorityCount';
-function GetStdHandle(nStdHandle:DWORD):HANDLE; external 'kernel32' name 'GetStdHandle';
-function GetStretchBltMode(_para1:HDC):Integer; external 'gdi32' name 'GetStretchBltMode';
-function GetSystemPaletteUse(_para1:HDC):UINT; external 'gdi32' name 'GetSystemPaletteUse';
-function GetSystemMenu(hWnd:HWND; bRevert:WINBOOL):HMENU; external 'user32' name 'GetSystemMenu';
-function GetSystemTimeAdjustment(lpTimeAdjustment:PDWORD; lpTimeIncrement:PDWORD; lpTimeAdjustmentDisabled:PWINBOOL):WINBOOL; external 'kernel32' name 'GetSystemTimeAdjustment';
-procedure GetSystemTimeAsFileTime(lpSystemTimeAsFileTime:LPFILETIME); external 'kernel32' name 'GetSystemTimeAsFileTime';
-function GetTextCharacterExtra(_para1:HDC):Integer; external 'gdi32' name 'GetTextCharacterExtra';
-function GetTextCharset(hdc:HDC):Integer; external 'gdi32' name 'GetTextCharset';
-function GetTextCharsetInfo(hdc:HDC; lpSig:LPFONTSIGNATURE; dwFlags:DWORD):Integer; external 'gdi32' name 'GetTextCharsetInfo';
-function GetThreadLocale:LCID; external 'kernel32' name 'GetThreadLocale';
-function GetTopWindow(hWnd:HWND):HWND; external 'user32' name 'GetTopWindow';
-function GetTapeParameters(hDevice:HANDLE; dwOperation:DWORD; lpdwSize:LPDWORD; lpTapeInformation:LPVOID):DWORD; external 'kernel32' name 'GetTapeParameters';
-function GetTapePosition(hDevice:HANDLE; dwPositionType:DWORD; lpdwPartition:LPDWORD; lpdwOffsetLow:LPDWORD; lpdwOffsetHigh:LPDWORD):DWORD; external 'kernel32' name 'GetTapePosition';
-function GetTapeStatus(hDevice:HANDLE):DWORD; external 'kernel32' name 'GetTapeStatus';
-function GetThreadDesktop(dwThreadId:DWORD):HDESK; external 'user32' name 'GetThreadDesktop';
-{$ifdef LPLDT_ENTRY}
-function GetThreadSelectorEntry(hThread:HANDLE; dwSelector:DWORD; lpSelectorEntry:LPLDT_ENTRY):WINBOOL; external 'kernel32' name 'GetThreadSelectorEntry';
-{$endif LPLDT_ENTRY}
-function GetTokenInformation(TokenHandle:HANDLE; TokenInformationClass:TOKEN_INFORMATION_CLASS; TokenInformation:LPVOID; TokenInformationLength:DWORD; ReturnLength:PDWORD):WINBOOL; external 'advapi32' name 'GetTokenInformation';
-function GetUserObjectSecurity(hObj:HANDLE; pSIRequested:PSECURITY_INFORMATION; pSID:PSECURITY_DESCRIPTOR; nLength:DWORD; lpnLengthNeeded:LPDWORD):WINBOOL; external 'user32' name 'GetUserObjectSecurity';
-function GetVersion:DWORD; external 'kernel32' name 'GetVersion';
-function GetViewportExtEx(_para1:HDC; _para2:LPSIZE):WINBOOL; external 'gdi32' name 'GetViewportExtEx';
-function GetViewportOrgEx(_para1:HDC; _para2:LPPOINT):WINBOOL; external 'gdi32' name 'GetViewportOrgEx';
-function GetWorldTransform(_para1:HDC; _para2:LPXFORM):WINBOOL; external 'gdi32' name 'GetWorldTransform';
-function GetWindowContextHelpId(_para1:HWND):DWORD; external 'user32' name 'GetWindowContextHelpId';
-function GetWindowExtEx(_para1:HDC; _para2:LPSIZE):WINBOOL; external 'gdi32' name 'GetWindowExtEx';
-function GetWindowOrgEx(_para1:HDC; _para2:LPPOINT):WINBOOL; external 'gdi32' name 'GetWindowOrgEx';
-function GetWindowPlacement(hWnd:HWND; var lpwndpl:WINDOWPLACEMENT):WINBOOL; external 'user32' name 'GetWindowPlacement';
-function GetWindowPlacement(hWnd:HWND; lpwndpl:PWINDOWPLACEMENT):WINBOOL; external 'user32' name 'GetWindowPlacement';
-function GetWindowWord(hWnd:HWND; nIndex:Integer):WORD; external 'user32' name 'GetWindowWord';
-function GetWinMetaFileBits(_para1:HENHMETAFILE; _para2:UINT; _para3:LPBYTE; _para4:wINT; _para5:HDC):UINT; external 'gdi32' name 'GetWinMetaFileBits';
-function GlobalAlloc(uFlags:UINT; dwBytes:DWORD):HGLOBAL; external 'kernel32' name 'GlobalAlloc';
-function GlobalCompact(dwMinFree:DWORD):UINT; external 'kernel32' name 'GlobalCompact';
-procedure GlobalFix(hMem:HGLOBAL); external 'kernel32' name 'GlobalFix';
-function GlobalFlags(hMem:HGLOBAL):UINT; external 'kernel32' name 'GlobalFlags';
-function GlobalFree(hMem:HGLOBAL):HGLOBAL; external 'kernel32' name 'GlobalFree';
-function GlobalHandle(pMem:LPCVOID):HGLOBAL; external 'kernel32' name 'GlobalHandle';
-function GlobalLock(hMem:HGLOBAL):LPVOID; external 'kernel32' name 'GlobalLock';
-function GlobalReAlloc(hMem:HGLOBAL; dwBytes:DWORD; uFlags:UINT):HGLOBAL; external 'kernel32' name 'GlobalReAlloc';
-function GlobalReAllocPtr(lp:Pointer;cbNew,flags:DWord):Pointer;
-function GlobalSize(hMem:HGLOBAL):DWORD; external 'kernel32' name 'GlobalSize';
-procedure GlobalUnfix(hMem:HGLOBAL); external 'kernel32' name 'GlobalUnfix';
-function GlobalUnlock(hMem:HGLOBAL):WINBOOL; external 'kernel32' name 'GlobalUnlock';
-function GlobalUnWire(hMem:HGLOBAL):WINBOOL; external 'kernel32' name 'GlobalUnWire';
-function GlobalWire(hMem:HGLOBAL):LPVOID; external 'kernel32' name 'GlobalWire';
-function HeapCompact(hHeap:HANDLE; dwFlags:DWORD):UINT; external 'kernel32' name 'HeapCompact';
-function HeapLock(hHeap:HANDLE):WINBOOL; external 'kernel32' name 'HeapLock';
-function HeapUnlock(hHeap:HANDLE):WINBOOL; external 'kernel32' name 'HeapUnlock';
-function HeapWalk(hHeap:HANDLE; lpEntry:LPPROCESS_HEAP_ENTRY):WINBOOL; external 'kernel32' name 'HeapWalk';
-function HiliteMenuItem(hWnd:HWND; hMenu:HMENU; uIDHiliteItem:UINT; uHilite:UINT):WINBOOL; external 'user32' name 'HiliteMenuItem';
-function ImpersonateNamedPipeClient(hNamedPipe:HANDLE):WINBOOL; external 'advapi32' name 'ImpersonateNamedPipeClient';
-function ImpersonateLoggedOnUser(hToken:HANDLE):WINBOOL; external 'advapi32' name 'ImpersonateLoggedOnUser';
-function ImpersonateSelf(ImpersonationLevel:SECURITY_IMPERSONATION_LEVEL):WINBOOL; external 'advapi32' name 'ImpersonateSelf';
-function InitAtomTable(nSize:DWORD):WINBOOL; external 'kernel32' name 'InitAtomTable';
-function InitializeAcl(pAcl:PACL; nAclLength:DWORD; dwAclRevision:DWORD):WINBOOL; external 'advapi32' name 'InitializeAcl';
-function InitializeSecurityDescriptor(pSecurityDescriptor:PSECURITY_DESCRIPTOR; dwRevision:DWORD):WINBOOL; external 'advapi32' name 'InitializeSecurityDescriptor';
-function InitializeSid(Sid:PSID; pIdentifierAuthority:PSID_IDENTIFIER_AUTHORITY; nSubAuthorityCount:BYTE):WINBOOL; external 'advapi32' name 'InitializeSid';
-function InvertRgn(_para1:HDC; _para2:HRGN):WINBOOL; external 'gdi32' name 'InvertRgn';
-function IsBadHugeReadPtr(lp:pointer; ucb:UINT):WINBOOL; external 'kernel32' name 'IsBadHugeReadPtr';
-function IsBadHugeWritePtr(lp:LPVOID; ucb:UINT):WINBOOL; external 'kernel32' name 'IsBadHugeWritePtr';
-function IsDlgButtonChecked(hDlg:HWND; nIDButton:Integer):UINT; external 'user32' name 'IsDlgButtonChecked';
-function IsIconic(hWnd:HWND):WINBOOL; external 'user32' name 'IsIconic';
-function IsMenu(hMenu:HMENU):WINBOOL; external 'user32' name 'IsMenu';
-function IsTextUnicode(lpBuffer:LPVOID; cb:Integer; lpi:LPINT):WINBOOL; external 'advapi32' name 'IsTextUnicode';
-function IsValidAcl(pAcl:PACL):WINBOOL; external 'advapi32' name 'IsValidAcl';
-function IsValidSecurityDescriptor(pSecurityDescriptor:PSECURITY_DESCRIPTOR):WINBOOL; external 'advapi32' name 'IsValidSecurityDescriptor';
-function IsValidSid(pSid:PSID):WINBOOL; external 'advapi32' name 'IsValidSid';
-function IsWindowUnicode(hWnd:HWND):WINBOOL; external 'user32' name 'IsWindowUnicode';
-function IsZoomed(hWnd:HWND):WINBOOL; external 'user32' name 'IsZoomed';
-function LBItemFromPt(hLB:HWND; pt:POINT; bAutoScroll:WINBOOL):Integer; { external 'comctl32' name 'LBItemFromPt';}
-function LineDDA(_para1:Integer; _para2:Integer; _para3:Integer; _para4:Integer; _para5:LINEDDAPROC;_para6:LPARAM):WINBOOL; external 'gdi32' name 'LineDDA';
-function LoadModule(lpModuleName:LPCSTR; lpParameterBlock:LPVOID):DWORD; external 'kernel32' name 'LoadModule';
-function LocalCompact(uMinFree:UINT):UINT; external 'kernel32' name 'LocalCompact';
-function LocalFlags(hMem:HLOCAL):UINT; external 'kernel32' name 'LocalFlags';
-function LocalHandle(pMem:LPCVOID):HLOCAL; external 'kernel32' name 'LocalHandle';
-function LocalLock(hMem:HLOCAL):LPVOID; external 'kernel32' name 'LocalLock';
-function LocalShrink(hMem:HLOCAL; cbNewSize:UINT):UINT; external 'kernel32' name 'LocalShrink';
-function LocalUnlock(hMem:HLOCAL):WINBOOL; external 'kernel32' name 'LocalUnlock';
-function LockFile(hFile:HANDLE; dwFileOffsetLow:DWORD; dwFileOffsetHigh:DWORD; nNumberOfBytesToLockLow:DWORD; nNumberOfBytesToLockHigh:DWORD):WINBOOL; external 'kernel32' name 'LockFile';
-function LockFileEx(hFile:HANDLE; dwFlags:DWORD; dwReserved:DWORD; nNumberOfBytesToLockLow:DWORD; nNumberOfBytesToLockHigh:DWORD;lpOverlapped:LPOVERLAPPED):WINBOOL; external 'kernel32' name 'LockFileEx';
-function LockResource(hResData:HGLOBAL):LPVOID; external 'kernel32' name 'LockResource';
-function LockServiceDatabase(hSCManager:SC_HANDLE):SC_LOCK; external 'advapi32' name 'LockServiceDatabase';
-function LockWindowUpdate(hWndLock:HWND):WINBOOL; external 'user32' name 'LockWindowUpdate';
-function LookupIconIdFromDirectory(presbits:PBYTE; fIcon:WINBOOL):Integer; external 'user32' name 'LookupIconIdFromDirectory';
-function LookupIconIdFromDirectoryEx(presbits:PBYTE; fIcon:WINBOOL; cxDesired:Integer; cyDesired:Integer; Flags:UINT):Integer; external 'user32' name 'LookupIconIdFromDirectoryEx';
-function LPtoDP(_para1:HDC; _para2:LPPOINT; _para3:Integer):WINBOOL; external 'gdi32' name 'LPtoDP';
-function MakeAbsoluteSD(pSelfRelativeSecurityDescriptor:PSECURITY_DESCRIPTOR; pAbsoluteSecurityDescriptor:PSECURITY_DESCRIPTOR; lpdwAbsoluteSecurityDescriptorSize:LPDWORD; pDacl:PACL; lpdwDaclSize:LPDWORD;pSacl:PACL;
- lpdwSaclSize:LPDWORD; pOwner:PSID; lpdwOwnerSize:LPDWORD; pPrimaryGroup:PSID;lpdwPrimaryGroupSize:LPDWORD):WINBOOL; external 'advapi32' name 'MakeAbsoluteSD';
-function MakeDragList(hLB:HWND):WINBOOL; external 'comctl32' name 'MakeDragList';
-function MakeSelfRelativeSD(pAbsoluteSecurityDescriptor:PSECURITY_DESCRIPTOR; pSelfRelativeSecurityDescriptor:PSECURITY_DESCRIPTOR; lpdwBufferLength:LPDWORD):WINBOOL; external 'advapi32' name 'MakeSelfRelativeSD';
-procedure MapGenericMask(AccessMask:PDWORD; GenericMapping:PGENERIC_MAPPING); external 'advapi32' name 'MapGenericMask';
-function MapViewOfFile(hFileMappingObject:HANDLE; dwDesiredAccess:DWORD; dwFileOffsetHigh:DWORD; dwFileOffsetLow:DWORD; dwNumberOfBytesToMap:DWORD):LPVOID; external 'kernel32' name 'MapViewOfFile';
-function MapViewOfFileEx(hFileMappingObject:HANDLE; dwDesiredAccess:DWORD; dwFileOffsetHigh:DWORD; dwFileOffsetLow:DWORD; dwNumberOfBytesToMap:DWORD;lpBaseAddress:LPVOID):LPVOID; external 'kernel32' name 'MapViewOfFileEx';
-procedure MenuHelp(uMsg:UINT; wParam:WPARAM; lParam:LPARAM; hMainMenu:HMENU; hInst:HINST;hwndStatus:HWND; var lpwIDs:UINT); external 'comctl32' name 'MenuHelp';
-function MenuItemFromPoint(hWnd:HWND; hMenu:HMENU; ptScreen:POINT):Integer; {external 'user32' name 'MenuItemFromPoint';bug 1807 }
-function ModifyWorldTransform(_para1:HDC; var _para2:XFORM; _para3:DWORD):WINBOOL; external 'gdi32' name 'ModifyWorldTransform';
-function MsgWaitForMultipleObjects(nCount:DWORD; pHandles:LPHANDLE; fWaitAll:WINBOOL; dwMilliseconds:DWORD; dwWakeMask:DWORD):DWORD; external 'user32' name 'MsgWaitForMultipleObjects';
-function MulDiv(nNumber:Integer; nNumerator:Integer; nDenominator:Integer):Integer; external 'kernel32' name 'MulDiv';
-function NotifyBootConfigStatus(BootAcceptable:WINBOOL):WINBOOL; external 'advapi32' name 'NotifyBootConfigStatus';
-function NotifyChangeEventLog(hEventLog:HANDLE; hEvent:HANDLE):WINBOOL; external 'advapi32' name 'NotifyChangeEventLog';
-function OemKeyScan(wOemChar:WORD):DWORD; external 'user32' name 'OemKeyScan';
-function OffsetClipRgn(_para1:HDC; _para2:Integer; _para3:Integer):Integer; external 'gdi32' name 'OffsetClipRgn';
-function OffsetViewportOrgEx(_para1:HDC; _para2:Integer; _para3:Integer; _para4:LPPOINT):WINBOOL; external 'gdi32' name 'OffsetViewportOrgEx';
-function OffsetWindowOrgEx(_para1:HDC; _para2:Integer; _para3:Integer; _para4:LPPOINT):WINBOOL; external 'gdi32' name 'OffsetWindowOrgEx';
-function OpenFile(lpFileName:LPCSTR; lpReOpenBuff:LPOFSTRUCT; uStyle:UINT):HFILE; external 'kernel32' name 'OpenFile';
-function OpenIcon(hWnd:HWND):WINBOOL; external 'user32' name 'OpenIcon';
-function OpenInputDesktop(dwFlags:DWORD; fInherit:WINBOOL; dwDesiredAccess:DWORD):HDESK; external 'user32' name 'OpenInputDesktop';
-function OpenProcessToken(ProcessHandle:HANDLE; DesiredAccess:DWORD; TokenHandle:PHANDLE):WINBOOL; external 'advapi32' name 'OpenProcessToken';
-function OpenThreadToken(ThreadHandle:HANDLE; DesiredAccess:DWORD; OpenAsSelf:WINBOOL; TokenHandle:PHANDLE):WINBOOL; external 'advapi32' name 'OpenThreadToken';
-function PaintDesktop(hdc:HDC):WINBOOL; external 'user32' name 'PaintDesktop';
-function PaintRgn(_para1:HDC; _para2:HRGN):WINBOOL; external 'gdi32' name 'PaintRgn';
-function PathToRegion(_para1:HDC):HRGN; external 'gdi32' name 'PathToRegion';
-function PeekNamedPipe(hNamedPipe:HANDLE; lpBuffer:LPVOID; nBufferSize:DWORD; lpBytesRead:LPDWORD; lpTotalBytesAvail:LPDWORD;lpBytesLeftThisMessage:LPDWORD):WINBOOL; external 'kernel32' name 'PeekNamedPipe';
-function Pie(_para1:HDC; _para2:Integer; _para3:Integer; _para4:Integer; _para5:Integer;_para6:Integer; _para7:Integer; _para8:Integer; _para9:Integer):WINBOOL; external 'gdi32' name 'Pie';
-function PlayEnhMetaFileRecord(_para1:HDC; _para2:LPHANDLETABLE; var _para3:ENHMETARECORD; _para4:UINT):WINBOOL; external 'gdi32' name 'PlayEnhMetaFileRecord';
-function PlayMetaFile(_para1:HDC; _para2:HMETAFILE):WINBOOL; external 'gdi32' name 'PlayMetaFile';
-function PlayMetaFileRecord(_para1:HDC; _para2:LPHANDLETABLE; _para3:LPMETARECORD; _para4:UINT):WINBOOL; external 'gdi32' name 'PlayMetaFileRecord';
-function PlgBlt(_para1:HDC; var _para2:POINT; _para3:HDC; _para4:Integer; _para5:Integer;_para6:Integer; _para7:Integer; _para8:HBITMAP; _para9:Integer; _para10:Integer):WINBOOL; external 'gdi32' name 'PlgBlt';
-function PolyBezier(_para1:HDC; _para2:LPPOINT; _para3:DWORD):WINBOOL; external 'gdi32' name 'PolyBezier';
-function PolyBezierTo(_para1:HDC; _para2:POINT; _para3:DWORD):WINBOOL; external 'gdi32' name 'PolyBezierTo';
-function PolyDraw(_para1:HDC; var _para2:POINT; var _para3:BYTE; _para4:Integer):WINBOOL; external 'gdi32' name 'PolyDraw';
-function PolyPolygon(_para1:HDC; var _para2:POINT; var _para3:wINT; _para4:Integer):WINBOOL; external 'gdi32' name 'PolyPolygon';
-function PolyPolyline(_para1:HDC; var _para2:POINT; var _para3:DWORD; _para4:DWORD):WINBOOL; external 'gdi32' name 'PolyPolyline';
-function PolylineTo(_para1:HDC; _para2:LPPOINT; _para3:DWORD):WINBOOL; external 'gdi32' name 'PolylineTo';
-function PrepareTape(hDevice:HANDLE; dwOperation:DWORD; bImmediate:WINBOOL):DWORD; external 'kernel32' name 'PrepareTape';
-function PrivilegeCheck(ClientToken:HANDLE; RequiredPrivileges:PPRIVILEGE_SET; pfResult:LPBOOL):WINBOOL; external 'advapi32' name 'PrivilegeCheck';
-function PtInRect(var lprc:RECT; pt:POINT):WINBOOL; {external 'user32' name 'PtInRect';bug 1807 }
-function PtInRect(lprc:LPRECT; pt:POINT):WINBOOL;
-function PtVisible(_para1:HDC; _para2:Integer; _para3:Integer):WINBOOL; external 'gdi32' name 'PtVisible';
-function QueryServiceObjectSecurity(hService:SC_HANDLE; dwSecurityInformation:SECURITY_INFORMATION; lpSecurityDescriptor:PSECURITY_DESCRIPTOR; cbBufSize:DWORD; pcbBytesNeeded:LPDWORD):WINBOOL;external 'advapi32' name 'QueryServiceObjectSecurity';
-function QueryServiceStatus(hService:SC_HANDLE; lpServiceStatus:LPSERVICE_STATUS):WINBOOL; external 'advapi32' name 'QueryServiceStatus';
-function ReadConsoleOutputAttribute(hConsoleOutput:HANDLE; lpAttribute:LPWORD; nLength:DWORD; dwReadCoord:COORD; lpNumberOfAttrsRead:LPDWORD):WINBOOL; external 'kernel32' name 'ReadConsoleOutputAttribute';
-function ReadFileEx(hFile:HANDLE; lpBuffer:LPVOID; nNumberOfBytesToRead:DWORD; lpOverlapped:LPOVERLAPPED; lpCompletionRoutine:LPOVERLAPPED_COMPLETION_ROUTINE):WINBOOL; external 'kernel32' name 'ReadFileEx';
-function RegSetKeySecurity(hKey:HKEY; SecurityInformation:SECURITY_INFORMATION; pSecurityDescriptor:PSECURITY_DESCRIPTOR):LONG; external 'advapi32' name 'RegSetKeySecurity';
-function RegGetKeySecurity(hKey:HKEY; SecurityInformation:SECURITY_INFORMATION; pSecurityDescriptor:PSECURITY_DESCRIPTOR; lpcbSecurityDescriptor:LPDWORD):LONG; external 'advapi32' name 'RegGetKeySecurity';
-function RegNotifyChangeKeyValue(hKey:HKEY; bWatchSubtree:WINBOOL; dwNotifyFilter:DWORD; hEvent:HANDLE; fAsynchronus:WINBOOL):LONG; external 'advapi32' name 'RegNotifyChangeKeyValue';
-function ReplyMessage(lResult:LRESULT):WINBOOL; external 'user32' name 'ReplyMessage';
-function ResetEvent(hEvent:HANDLE):WINBOOL; external 'kernel32' name 'ResetEvent';
-function ResizePalette(_para1:HPALETTE; _para2:UINT):WINBOOL; external 'gdi32' name 'ResizePalette';
-function RevertToSelf:WINBOOL; external 'advapi32' name 'RevertToSelf';
-function ScaleViewportExtEx(_para1:HDC; _para2:Integer; _para3:Integer; _para4:Integer; _para5:Integer;_para6:LPSIZE):WINBOOL; external 'gdi32' name 'ScaleViewportExtEx';
-function ScaleWindowExtEx(_para1:HDC; _para2:Integer; _para3:Integer; _para4:Integer; _para5:Integer;_para6:LPSIZE):WINBOOL; external 'gdi32' name 'ScaleWindowExtEx';
-function ScrollWindow(hWnd:HWND; XAmount:Integer; YAmount:Integer; var lpRect:RECT; var lpClipRect:RECT):WINBOOL; external 'user32' name 'ScrollWindow';
-function SelectClipPath(_para1:HDC; _para2:Integer):WINBOOL; external 'gdi32' name 'SelectClipPath';
-function SetAclInformation(pAcl:PACL; pAclInformation:LPVOID; nAclInformationLength:DWORD; dwAclInformationClass:ACL_INFORMATION_CLASS):WINBOOL; external 'advapi32' name 'SetAclInformation';
-function SetArcDirection(_para1:HDC; _para2:Integer):Integer; external 'gdi32' name 'SetArcDirection';
-function SetBitmapDimensionEx(_para1:HBITMAP; _para2:Integer; _para3:Integer; _para4:LPSIZE):WINBOOL; external 'gdi32' name 'SetBitmapDimensionEx';
-function SetBoundsRect(_para1:HDC; var _para2:RECT; _para3:UINT):UINT; external 'gdi32' name 'SetBoundsRect';
-function SetClassWord(hWnd:HWND; nIndex:Integer; wNewWord:WORD):WORD; external 'user32' name 'SetClassWord';
-function SetClipboardViewer(hWndNewViewer:HWND):HWND; external 'user32' name 'SetClipboardViewer';
-function SetColorAdjustment(_para1:HDC; var _para2:COLORADJUSTMENT):WINBOOL; external 'gdi32' name 'SetColorAdjustment';
-function SetColorSpace(_para1:HDC; _para2:HCOLORSPACE):WINBOOL; external 'gdi32' name 'SetColorSpace';
-function SetCommConfig(hCommDev:HANDLE; lpCC:LPCOMMCONFIG; dwSize:DWORD):WINBOOL; external 'kernel32' name 'SetCommConfig';
-function SetConsoleActiveScreenBuffer(hConsoleOutput:HANDLE):WINBOOL; external 'kernel32' name 'SetConsoleActiveScreenBuffer';
-function SetConsoleCP(wCodePageID:UINT):WINBOOL; external 'kernel32' name 'SetConsoleCP';
-function SetConsoleCtrlHandler(HandlerRoutine:PHANDLER_ROUTINE; Add:WINBOOL):WINBOOL; external 'kernel32' name 'SetConsoleCtrlHandler';
-function SetConsoleCursorInfo(hConsoleOutput:HANDLE; lpConsoleCursorInfo:PCONSOLE_CURSOR_INFO):WINBOOL; external 'kernel32' name 'SetConsoleCursorInfo';
-function SetConsoleCursorPosition(hConsoleOutput:HANDLE; dwCursorPosition:COORD):WINBOOL; external 'kernel32' name 'SetConsoleCursorPosition';
-function SetConsoleOutputCP(wCodePageID:UINT):WINBOOL; external 'kernel32' name 'SetConsoleOutputCP';
-function SetConsoleScreenBufferSize(hConsoleOutput:HANDLE; dwSize:COORD):WINBOOL; external 'kernel32' name 'SetConsoleScreenBufferSize';
-function SetConsoleTextAttribute(hConsoleOutput:HANDLE; wAttributes:WORD):WINBOOL; external 'kernel32' name 'SetConsoleTextAttribute';
-function SetConsoleMode(hConsoleHandle:HANDLE; dwMode:DWORD):WINBOOL; external 'kernel32' name 'SetConsoleMode';
-function SetConsoleWindowInfo(hConsoleOutput:HANDLE; bAbsolute:WINBOOL; var lpConsoleWindow:SMALL_RECT):WINBOOL; external 'kernel32' name 'SetConsoleWindowInfo';
-procedure SetDebugErrorLevel(dwLevel:DWORD); external 'user32' name 'SetDebugErrorLevel';
-function SetDeviceGammaRamp(_para1:HDC; _para2:LPVOID):WINBOOL; external 'gdi32' name 'SetDeviceGammaRamp';
-function SetDIBits(_para1:HDC; _para2:HBITMAP; _para3:UINT; _para4:UINT; _para5:pointer;_para6:PBITMAPINFO; _para7:UINT):Integer; external 'gdi32' name 'SetDIBits';
-function SetICMMode(_para1:HDC; _para2:Integer):Integer; external 'gdi32' name 'SetICMMode';
-function SetDoubleClickTime(_para1:UINT):WINBOOL; external 'user32' name 'SetDoubleClickTime';
-function SetEnhMetaFileBits(_para1:UINT; var _para2:BYTE):HENHMETAFILE; external 'gdi32' name 'SetEnhMetaFileBits';
-function SetErrorMode(uMode:UINT):UINT; external 'kernel32' name 'SetErrorMode';
-function SetEvent(hEvent:HANDLE):WINBOOL; external 'kernel32' name 'SetEvent';
-procedure SetFileApisToOEM; external 'kernel32' name 'SetFileApisToOEM';
-procedure SetFileApisToANSI; external 'kernel32' name 'SetFileApisToANSI';
-function SetGraphicsMode(hdc:HDC; iMode:Integer):Integer; external 'gdi32' name 'SetGraphicsMode';
-function SetHandleInformation(hObject:HANDLE; dwMask:DWORD; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'SetHandleInformation';
-function SetHandleCount(uNumber:UINT):UINT; external 'kernel32' name 'SetHandleCount';
-function SetKernelObjectSecurity(Handle:HANDLE; SecurityInformation:SECURITY_INFORMATION; SecurityDescriptor:PSECURITY_DESCRIPTOR):WINBOOL; external 'advapi32' name 'SetKernelObjectSecurity';
-function SetKeyboardState(lpKeyState:LPBYTE):WINBOOL; external 'user32' name 'SetKeyboardState';
-procedure SetLastErrorEx(dwErrCode:DWORD; dwType:DWORD); external 'user32' name 'SetLastErrorEx';
-function SetLayeredWindowAttributes(HWND:hwnd;crKey :COLORREF;bAlpha : byte;dwFlags : DWORD):WINBOOL; external 'user32' name 'SetLayeredWindowAttributes';
-function SetMailslotInfo(hMailslot:HANDLE; lReadTimeout:DWORD):WINBOOL; external 'kernel32' name 'SetMailslotInfo';
-function SetMapMode(_para1:HDC; _para2:Integer):Integer; external 'gdi32' name 'SetMapMode';
-function SetMapperFlags(_para1:HDC; _para2:DWORD):DWORD; external 'gdi32' name 'SetMapperFlags';
-function SetMenu(hWnd:HWND; hMenu:HMENU):WINBOOL; external 'user32' name 'SetMenu';
-function SetMenuContextHelpId(_para1:HMENU; _para2:DWORD):WINBOOL; external 'user32' name 'SetMenuContextHelpId';
-function SetMenuDefaultItem(hMenu:HMENU; uItem:UINT; fByPos:UINT):WINBOOL; external 'user32' name 'SetMenuDefaultItem';
-function SetMenuItemBitmaps(hMenu:HMENU; uPosition:UINT; uFlags:UINT; hBitmapUnchecked:HBITMAP; hBitmapChecked:HBITMAP):WINBOOL; external 'user32' name 'SetMenuItemBitmaps';
-function SetMessageExtraInfo(lParam:LPARAM):LPARAM; external 'user32' name 'SetMessageExtraInfo';
-function SetMessageQueue(cMessagesMax:Integer):WINBOOL; external 'user32' name 'SetMessageQueue';
-function SetMetaRgn(_para1:HDC):Integer; external 'gdi32' name 'SetMetaRgn';
-function SetMetaFileBitsEx(_para1:UINT; var _para2:BYTE):HMETAFILE; external 'gdi32' name 'SetMetaFileBitsEx';
-function SetMiterLimit(_para1:HDC; _para2:Single; _para3:PSingle):WINBOOL; external 'gdi32' name 'SetMiterLimit';
-function SetNamedPipeHandleState(hNamedPipe:HANDLE; lpMode:LPDWORD; lpMaxCollectionCount:LPDWORD; lpCollectDataTimeout:LPDWORD):WINBOOL; external 'kernel32' name 'SetNamedPipeHandleState';
-function SetPixelV(_para1:HDC; _para2:Integer; _para3:Integer; _para4:COLORREF):WINBOOL; external 'gdi32' name 'SetPixelV';
-function SetPolyFillMode(_para1:HDC; _para2:Integer):Integer; external 'gdi32' name 'SetPolyFillMode';
-function SetPriorityClass(hProcess:HANDLE; dwPriorityClass:DWORD):WINBOOL; external 'kernel32' name 'SetPriorityClass';
-function SetPrivateObjectSecurity(SecurityInformation:SECURITY_INFORMATION; ModificationDescriptor:PSECURITY_DESCRIPTOR; var ObjectsSecurityDescriptor:PSECURITY_DESCRIPTOR; GenericMapping:PGENERIC_MAPPING; Token:HANDLE):WINBOOL;
- external 'advapi32' name 'SetPrivateObjectSecurity';
-function SetProcessShutdownParameters(dwLevel:DWORD; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'SetProcessShutdownParameters';
-function SetProcessWindowStation(hWinSta:HWINSTA):WINBOOL; external 'user32' name 'SetProcessWindowStation';
-function SetProcessWorkingSetSize(hProcess:HANDLE; dwMinimumWorkingSetSize:DWORD; dwMaximumWorkingSetSize:DWORD):WINBOOL; external 'kernel32' name 'SetProcessWorkingSetSize';
-function SetSecurityDescriptorDacl(pSecurityDescriptor:PSECURITY_DESCRIPTOR; bDaclPresent:WINBOOL; pDacl:PACL; bDaclDefaulted:WINBOOL):WINBOOL; external 'advapi32' name 'SetSecurityDescriptorDacl';
-function SetSecurityDescriptorSacl(pSecurityDescriptor:PSECURITY_DESCRIPTOR; bSaclPresent:WINBOOL; pSacl:PACL; bSaclDefaulted:WINBOOL):WINBOOL; external 'advapi32' name 'SetSecurityDescriptorSacl';
-function SetSecurityDescriptorOwner(pSecurityDescriptor:PSECURITY_DESCRIPTOR; pOwner:PSID; bOwnerDefaulted:WINBOOL):WINBOOL; external 'advapi32' name 'SetSecurityDescriptorOwner';
-function SetSecurityDescriptorGroup(pSecurityDescriptor:PSECURITY_DESCRIPTOR; pGroup:PSID; bGroupDefaulted:WINBOOL):WINBOOL; external 'advapi32' name 'SetSecurityDescriptorGroup';
-function SetStdHandle(nStdHandle:DWORD; hHandle:HANDLE):WINBOOL; external 'kernel32' name 'SetStdHandle';
-function SetSystemCursor(hcur:HCURSOR; anID:DWORD):WINBOOL; external 'user32' name 'SetSystemCursor';
-function SetSystemTimeAdjustment(dwTimeAdjustment:DWORD; bTimeAdjustmentDisabled:WINBOOL):WINBOOL; external 'kernel32' name 'SetSystemTimeAdjustment';
-function SetThreadDesktop(hDesktop:HDESK):WINBOOL; external 'user32' name 'SetThreadDesktop';
-function SetTapeParameters(hDevice:HANDLE; dwOperation:DWORD; lpTapeInformation:LPVOID):DWORD; external 'kernel32' name 'SetTapeParameters';
-function SetTapePosition(hDevice:HANDLE; dwPositionMethod:DWORD; dwPartition:DWORD; dwOffsetLow:DWORD; dwOffsetHigh:DWORD;bImmediate:WINBOOL):DWORD; external 'kernel32' name 'SetTapePosition';
-function SetThreadAffinityMask(hThread:HANDLE; dwThreadAffinityMask:DWORD):DWORD; external 'kernel32' name 'SetThreadAffinityMask';
-function SetThreadToken(Thread:PHANDLE; Token:HANDLE):WINBOOL; external 'advapi32' name 'SetThreadToken';
-function SetTokenInformation(TokenHandle:HANDLE; TokenInformationClass:TOKEN_INFORMATION_CLASS; TokenInformation:LPVOID; TokenInformationLength:DWORD):WINBOOL; external 'advapi32' name 'SetTokenInformation';
-function SetPixelFormat(_para1:HDC; _para2:Integer;_para3:PPIXELFORMATDESCRIPTOR):WINBOOL; external 'gdi32' name 'SetPixelFormat';
-function SetServiceObjectSecurity(hService:SC_HANDLE; dwSecurityInformation:SECURITY_INFORMATION; lpSecurityDescriptor:PSECURITY_DESCRIPTOR):WINBOOL;external 'advapi32' name 'SetServiceObjectSecurity';
-function SetServiceStatus(hServiceStatus:SERVICE_STATUS_HANDLE; lpServiceStatus:LPSERVICE_STATUS):WINBOOL; external 'advapi32' name 'SetServiceStatus';
-function SetStretchBltMode(_para1:HDC; _para2:Integer):Integer; external 'gdi32' name 'SetStretchBltMode';
-function SetSystemPaletteUse(_para1:HDC; _para2:UINT):UINT; external 'gdi32' name 'SetSystemPaletteUse';
-function SetTextCharacterExtra(_para1:HDC; _para2:Integer):Integer; external 'gdi32' name 'SetTextCharacterExtra';
-function SetTextJustification(_para1:HDC; _para2:Integer; _para3:Integer):WINBOOL; external 'gdi32' name 'SetTextJustification';
-function SetThreadLocale(Locale:LCID):WINBOOL; external 'kernel32' name 'SetThreadLocale';
-function SetUserObjectSecurity(hObj:HANDLE; pSIRequested:PSECURITY_INFORMATION; pSID:PSECURITY_DESCRIPTOR):WINBOOL; external 'user32' name 'SetUserObjectSecurity';
-function SetViewportExtEx(_para1:HDC; _para2:Integer; _para3:Integer; _para4:LPSIZE):WINBOOL; external 'gdi32' name 'SetViewportExtEx';
-function SetWindowContextHelpId(_para1:HWND; _para2:DWORD):WINBOOL; external 'user32' name 'SetWindowContextHelpId';
-function SetWindowExtEx(_para1:HDC; _para2:Integer; _para3:Integer; _para4:LPSIZE):WINBOOL; external 'gdi32' name 'SetWindowExtEx';
-function SetWindowOrgEx(_para1:HDC; _para2:Integer; _para3:Integer; _para4:LPPOINT):WINBOOL; external 'gdi32' name 'SetWindowOrgEx';
-function SetWindowPlacement(hWnd:HWND; lpwndpl:PWINDOWPLACEMENT):WINBOOL; external 'user32' name 'SetWindowPlacement';
-function SetWindowPlacement(hWnd:HWND; var lpwndpl:WINDOWPLACEMENT):WINBOOL; external 'user32' name 'SetWindowPlacement';
-function SetWindowWord(hWnd:HWND; nIndex:Integer; wNewWord:WORD):WORD; external 'user32' name 'SetWindowWord';
-function SetWinMetaFileBits(_para1:UINT; var _para2:BYTE; _para3:HDC; var _para4:METAFILEPICT):HENHMETAFILE; external 'gdi32' name 'SetWinMetaFileBits';
-function SetWorldTransform(_para1:HDC; var _para2:XFORM):WINBOOL; external 'gdi32' name 'SetWorldTransform';
-function SHBrowseForFolder(_para1:LPBROWSEINFO):LPITEMIDLIST; external 'shell32' name 'SHBrowseForFolder';
-procedure SHChangeNotify(_para1:LONG; _para2:UINT; _para3:LPCVOID; _para4:LPCVOID); external 'shell32' name 'SHChangeNotify';
-function SHFileOperation(_para1:LPSHFILEOPSTRUCT):Integer; external 'shell32' name 'SHFileOperation';
-procedure SHFreeNameMappings(_para1:HANDLE); external 'shell32' name 'SHFreeNameMappings';
-function ShowHideMenuCtl(hWnd:HWND; uFlags:UINT; lpInfo:LPINT):WINBOOL; external 'comctl32' name 'ShowHideMenuCtl';
-function ShowWindowAsync(hWnd:HWND; nCmdShow:Integer):WINBOOL; external 'user32' name 'ShowWindowAsync';
-function ShowOwnedPopups(hWnd:HWND; fShow:WINBOOL):WINBOOL; external 'user32' name 'ShowOwnedPopups';
-function ShowScrollBar(hWnd:HWND; wBar:Integer; bShow:WINBOOL):WINBOOL; external 'user32' name 'ShowScrollBar';
-function SleepEx(dwMilliseconds:DWORD; bAlertable:WINBOOL):DWORD; external 'kernel32' name 'SleepEx';
-function StrokeAndFillPath(_para1:HDC):WINBOOL; external 'gdi32' name 'StrokeAndFillPath';
-function StrokePath(_para1:HDC):WINBOOL; external 'gdi32' name 'StrokePath';
-function SystemTimeToTzSpecificLocalTime(lpTimeZoneInformation:LPTIME_ZONE_INFORMATION; lpUniversalTime:LPSYSTEMTIME; lpLocalTime:LPSYSTEMTIME):WINBOOL; external 'kernel32' name 'SystemTimeToTzSpecificLocalTime';
-function SwapBuffers(_para1:HDC):WINBOOL; external 'gdi32' name 'SwapBuffers';
-function SwapMouseButton(fSwap:WINBOOL):WINBOOL; external 'user32' name 'SwapMouseButton';
-function SwitchDesktop(hDesktop:HDESK):WINBOOL; external 'user32' name 'SwitchDesktop';
-function TlsAlloc:DWORD; external 'kernel32' name 'TlsAlloc';
-function TlsFree(dwTlsIndex:DWORD):WINBOOL; external 'kernel32' name 'TlsFree';
-function TileWindows(hwndParent:HWND; wHow:UINT; var lpRect:RECT; cKids:UINT; var lpKids:HWND):WORD; external 'user32' name 'TileWindows';
-function ToAscii(uVirtKey:UINT; uScanCode:UINT; lpKeyState:PBYTE; lpChar:LPWORD; uFlags:UINT):Integer; external 'user32' name 'ToAscii';
-function ToAsciiEx(uVirtKey:UINT; uScanCode:UINT; lpKeyState:PBYTE; lpChar:LPWORD; uFlags:UINT;dwhkl:HKL):Integer; external 'user32' name 'ToAsciiEx';
-function ToUnicode(wVirtKey:UINT; wScanCode:UINT; lpKeyState:PBYTE; pwszBuff:LPWSTR; cchBuff:Integer;wFlags:UINT):Integer; external 'user32' name 'ToUnicode';
-function TrackPopupMenu(hMenu:HMENU; uFlags:UINT; x:Integer; y:Integer; nReserved:Integer;hWnd:HWND; var prcRect:RECT):WINBOOL; external 'user32' name 'TrackPopupMenu';
-function TransactNamedPipe(hNamedPipe:HANDLE; lpInBuffer:LPVOID; nInBufferSize:DWORD; lpOutBuffer:LPVOID; nOutBufferSize:DWORD;lpBytesRead:LPDWORD; lpOverlapped:LPOVERLAPPED):WINBOOL; external 'kernel32' name 'TransactNamedPipe';
-function TranslateMDISysAccel(hWndClient:HWND; lpMsg:LPMSG):WINBOOL; external 'user32' name 'TranslateMDISysAccel';
-function PulseEvent(hEvent:HANDLE):WINBOOL; external 'kernel32' name 'PulseEvent';
-function UnhandledExceptionFilter(ExceptionInfo:lpemptyrecord):LONG; external 'kernel32' name 'UnhandledExceptionFilter';
-function UnhookWindowsHook(nCode:Integer; pfnFilterProc:HOOKPROC):WINBOOL; external 'user32' name 'UnhookWindowsHook';
-function UnloadKeyboardLayout(hkl:HKL):WINBOOL; external 'user32' name 'UnloadKeyboardLayout';
-function UnlockFile(hFile:HANDLE; dwFileOffsetLow:DWORD; dwFileOffsetHigh:DWORD; nNumberOfBytesToUnlockLow:DWORD; nNumberOfBytesToUnlockHigh:DWORD):WINBOOL; external 'kernel32' name 'UnlockFile';
-function UnlockFileEx(hFile:HANDLE; dwReserved:DWORD; nNumberOfBytesToUnlockLow:DWORD; nNumberOfBytesToUnlockHigh:DWORD; lpOverlapped:LPOVERLAPPED):WINBOOL; external 'kernel32' name 'UnlockFileEx';
-function UnlockServiceDatabase(ScLock:SC_LOCK):WINBOOL; external 'advapi32' name 'UnlockServiceDatabase';
-function UnrealizeObject(_para1:HGDIOBJ):WINBOOL; external 'gdi32' name 'UnrealizeObject';
-function UpdateColors(_para1:HDC):WINBOOL; external 'gdi32' name 'UpdateColors';
-function VirtualLock(lpAddress:LPVOID; dwSize:DWORD):WINBOOL; external 'kernel32' name 'VirtualLock';
-function VirtualProtectEx(hProcess:HANDLE; lpAddress:LPVOID; dwSize:DWORD; flNewProtect:DWORD; lpflOldProtect:PDWORD):WINBOOL; external 'kernel32' name 'VirtualProtectEx';
-function VirtualQueryEx(hProcess:HANDLE; lpAddress:LPCVOID; lpBuffer:PMEMORY_BASIC_INFORMATION; dwLength:DWORD):DWORD; external 'kernel32' name 'VirtualQueryEx';
-function VirtualUnlock(lpAddress:LPVOID; dwSize:DWORD):WINBOOL; external 'kernel32' name 'VirtualUnlock';
-function WaitForInputIdle(hProcess:HANDLE; dwMilliseconds:DWORD):DWORD; external 'user32' name 'WaitForInputIdle';
-function WaitForMultipleObjectsEx(nCount:DWORD; lpHandles:LPHANDLE; bWaitAll:WINBOOL; dwMilliseconds:DWORD; bAlertable:WINBOOL):DWORD; external 'kernel32' name 'WaitForMultipleObjectsEx';
-function WaitForSingleObjectEx(hHandle:HANDLE; dwMilliseconds:DWORD; bAlertable:WINBOOL):DWORD; external 'kernel32' name 'WaitForSingleObjectEx';
-function WaitMessage:WINBOOL; external 'user32' name 'WaitMessage';
-{ wgl Windows OpenGL helper functions }
-function wglUseFontBitmaps(_para1:HDC; _para2:DWORD; _para3:DWORD; _para4:DWORD):WINBOOL; external 'opengl32' name 'wglUseFontBitmapsA';
-function wglCreateContext(_para1:HDC):HGLRC; external 'opengl32' name 'wglCreateContext';
-function wglCreateLayerContext(_para1:HDC; _para2:Integer):HGLRC; external 'opengl32' name 'wglCreateLayerContext';
-function wglCopyContext(_para1:HGLRC; _para2:HGLRC; _para3:UINT):WINBOOL; external 'opengl32' name 'wglCopyContext';
-function wglDeleteContext(_para1:HGLRC):WINBOOL; external 'opengl32' name 'wglDeleteContext';
-function wglGetCurrentContext:HGLRC; external 'opengl32' name 'wglGetCurrentContext';
-function wglGetCurrentDC:HDC; external 'opengl32' name 'wglGetCurrentDC';
-function wglMakeCurrent(_para1:HDC; _para2:HGLRC):WINBOOL; external 'opengl32' name 'wglMakeCurrent';
-function wglShareLists(_para1:HGLRC; _para2:HGLRC):WINBOOL; external 'opengl32' name 'wglShareLists';
-function wglUseFontBitmapsW(_para1:HDC; _para2:DWORD; _para3:DWORD; _para4:DWORD):WINBOOL; external 'opengl32' name 'wglUseFontBitmapsW';
-{ Delphi doesn't declare these, but we do: }
-function wglUseFontOutlines(_para1:HDC; _para2:DWORD; _para3:DWORD; _para4:DWORD; _para5:Single;
- _para6:Single; _para7:Integer; _para8:LPGLYPHMETRICSFLOAT):WINBOOL; external 'opengl32' name 'wglUseFontOutlinesA';
-function wglUseFontBitmapsA(_para1:HDC; _para2:DWORD; _para3:DWORD; _para4:DWORD):WINBOOL; external 'opengl32' name 'wglUseFontBitmapsA';
-function wglUseFontOutlinesA(_para1:HDC; _para2:DWORD; _para3:DWORD; _para4:DWORD; _para5:Single;
- _para6:Single; _para7:Integer; _para8:LPGLYPHMETRICSFLOAT):WINBOOL; external 'opengl32' name 'wglUseFontOutlinesA';
-function wglDescribeLayerPlane(_para1:HDC; _para2:Integer; _para3:Integer; _para4:UINT; _para5:LPLAYERPLANEDESCRIPTOR):WINBOOL; external 'opengl32' name 'wglDescribeLayerPlane';
-function wglGetLayerPaletteEntries(_para1:HDC; _para2:Integer; _para3:Integer; _para4:Integer; var _para5:COLORREF):Integer; external 'opengl32' name 'wglGetLayerPaletteEntries';
-function wglGetProcAddress(_para1:LPCSTR):PROC; external 'opengl32' name 'wglGetProcAddress';
-function wglRealizeLayerPalette(_para1:HDC; _para2:Integer; _para3:WINBOOL):WINBOOL; external 'opengl32' name 'wglRealizeLayerPalette';
-function wglSetLayerPaletteEntries(_para1:HDC; _para2:Integer; _para3:Integer; _para4:Integer; var _para5:COLORREF):Integer; external 'opengl32' name 'wglSetLayerPaletteEntries';
-function wglSwapLayerBuffers(_para1:HDC; _para2:UINT):WINBOOL; external 'opengl32' name 'wglSwapLayerBuffers';
-function wglUseFontOutlinesW(_para1:HDC; _para2:DWORD; _para3:DWORD; _para4:DWORD; _para5:Single;
- _para6:Single; _para7:Integer; _para8:LPGLYPHMETRICSFLOAT):WINBOOL; external 'opengl32' name 'wglUseFontOutlinesW';
-function WidenPath(_para1:HDC):WINBOOL; external 'gdi32' name 'WidenPath';
-function WindowFromDC(hDC:HDC):HWND; external 'user32' name 'WindowFromDC';
-function WindowFromPoint(Point:POINT):HWND; { external 'user32' name 'WindowFromPoint';bug 1807 }
-function WinExec(lpCmdLine:LPCSTR; uCmdShow:UINT):UINT; external 'kernel32' name 'WinExec';
-function WNetConnectionDialog(hwnd:HWND; dwType:DWORD):DWORD; external 'mpr' name 'WNetConnectionDialog';
-function WriteConsoleOutputAttribute(hConsoleOutput:HANDLE; var lpAttribute:WORD; nLength:DWORD; dwWriteCoord:COORD; lpNumberOfAttrsWritten:LPDWORD):WINBOOL; external 'kernel32' name 'WriteConsoleOutputAttribute';
-function WriteFileEx(hFile:HANDLE; lpBuffer:LPCVOID; nNumberOfBytesToWrite:DWORD; lpOverlapped:LPOVERLAPPED; lpCompletionRoutine:LPOVERLAPPED_COMPLETION_ROUTINE):WINBOOL; external 'kernel32' name 'WriteFileEx';
-function WriteTapemark(hDevice:HANDLE; dwTapemarkType:DWORD; dwTapemarkCount:DWORD; bImmediate:WINBOOL):DWORD; external 'kernel32' name 'WriteTapemark';
-
-function _hread(hFile:HFILE; lpBuffer:LPVOID; lBytes:Integer):Integer; external 'kernel32' name '_hread';
-function _hwrite(hFile:HFILE; lpBuffer:LPCSTR; lBytes:Integer):Integer; external 'kernel32' name '_hwrite';
-function _lclose(hFile:HFILE):HFILE; external 'kernel32' name '_lclose';
-function _lcreat(lpPathName:LPCSTR; iAttribute:Integer):HFILE; external 'kernel32' name '_lcreat';
-function _llseek(hFile:HFILE; lOffset:LONG; iOrigin:Integer):LONG; external 'kernel32' name '_llseek';
-function _lopen(lpPathName:LPCSTR; iReadWrite:Integer):HFILE; external 'kernel32' name '_lopen';
-function _lread(hFile:HFILE; lpBuffer:LPVOID; uBytes:UINT):UINT; external 'kernel32' name '_lread';
-function _lwrite(hFile:HFILE; lpBuffer:LPCSTR; uBytes:UINT):UINT; external 'kernel32' name '_lwrite';
-
-{$ifdef Unknown_functions}
-{ WARNING: functions not found !!}
-{ WARNING: function is not in my gdi32.dll !! PM}function GetEnhMetaFilePixelFormat(_para1:HENHMETAFILE; _para2:DWORD; var _para3:PIXELFORMATDESCRIPTOR):UINT; external 'gdi32' name 'GetEnhMetaFilePixelFormat';procedure OpenSound; external External_library name 'OpenSound';
-{ function GetPixelFormat(_para1:HDC):Integer; external 'gdi32' name 'GetPixelFormat'; }
-procedure CloseSound; external External_library name 'CloseSound';
-procedure StartSound; external External_library name 'StartSound';
-procedure StopSound; external External_library name 'StopSound';
-function WaitSoundState(nState:DWORD):DWORD; external External_library name 'WaitSoundState';
-function SyncAllVoices:DWORD; external External_library name 'SyncAllVoices';
-function CountVoiceNotes(nVoice:DWORD):DWORD; external External_library name 'CountVoiceNotes';
-function GetThresholdEvent:LPDWORD; external External_library name 'GetThresholdEvent';
-function GetThresholdStatus:DWORD; external External_library name 'GetThresholdStatus';
-function NetUserEnum(_para1:LPWSTR; _para2:DWORD; _para3:DWORD; var _para4:LPBYTE; _para5:DWORD;_para6:LPDWORD; _para7:LPDWORD; _para8:LPDWORD):DWORD; external 'netapi32' name 'NetUserEnum';
-function NetApiBufferFree(_para1:LPVOID):DWORD; external 'netapi32' name 'NetApiBufferFree';
-function NetUserGetInfo(_para1:LPWSTR; _para2:LPWSTR; _para3:DWORD; _para4:LPBYTE):DWORD; external 'netapi32' name 'NetUserGetInfo';
-function NetGetDCName(_para1:LPWSTR; _para2:LPWSTR; var _para3:LPBYTE):DWORD; external 'netapi32' name 'NetGetDCName';
-function NetGroupEnum(_para1:LPWSTR; _para2:DWORD; var _para3:LPBYTE; _para4:DWORD; _para5:LPDWORD;_para6:LPDWORD; _para7:LPDWORD):DWORD; external 'netapi32' name 'NetGroupEnum';
-function NetLocalGroupEnum(_para1:LPWSTR; _para2:DWORD; var _para3:LPBYTE; _para4:DWORD; _para5:LPDWORD;_para6:LPDWORD; _para7:LPDWORD):DWORD; external 'netapi32' name 'NetLocalGroupEnum';
-function SetSoundNoise(nSource:DWORD; nDuration:DWORD):DWORD; external External_library name 'SetSoundNoise';
-function SetVoiceAccent(nVoice:DWORD; nTempo:DWORD; nVolume:DWORD; nMode:DWORD; nPitch:DWORD):DWORD; external External_library name 'SetVoiceAccent';
-function SetVoiceEnvelope(nVoice:DWORD; nShape:DWORD; nRepeat:DWORD):DWORD; external External_library name 'SetVoiceEnvelope';
-function SetVoiceNote(nVoice:DWORD; nValue:DWORD; nLength:DWORD; nCdots:DWORD):DWORD; external External_library name 'SetVoiceNote';
-function SetVoiceQueueSize(nVoice:DWORD; nBytes:DWORD):DWORD; external External_library name 'SetVoiceQueueSize';
-function SetVoiceSound(nVoice:DWORD; Frequency:DWORD; nDuration:DWORD):DWORD; external External_library name 'SetVoiceSound';
-function SetVoiceThreshold(nVoice:DWORD; nNotes:DWORD):DWORD; external External_library name 'SetVoiceThreshold';
-{ WARNING: function not found !!}
-function WinMain(hInstance:HINST; hPrevInstance:HINST; lpCmdLine:LPSTR; nShowCmd:Integer):Integer; external External_library name 'WinMain';
-{$endif Unknown_functions}
-
-//end win32 only
-
-//begin win32 or wince not checked
-
-//end win32 or wince not checked
-
-{$endif WIN32}
-
-
-{$endif read_interface}
-
-
-{$ifdef read_implementation}
-
-
-{ Win32 API calling convention
- pushes POINT struct passed by value directly
- on stack instead of just pushing an address
- to overcome this we use a internal function
- that just pushes the two arguments.
- Bug report 1807. PM }
-
-//begin common win32 & wince
-function Animate_Create(hWndP:HWND; id:HMENU;dwStyle:DWORD;hInstance:HINST):HWND;
-begin
- Animate_Create:=CreateWindow(LPCTSTR(ANIMATE_CLASS),nil,dwStyle,0,0,0,0,hwndP,id,hInstance,nil);
-end;
-
-
-function Animate_Open(hwnd : HWND;szName : LPTSTR) : LRESULT;
-begin
- Animate_Open:=SendMessage(hwnd,ACM_OPEN,0,LPARAM(szName));
-end;
-
-
-function Animate_Play(hwnd : HWND;from,_to : Integer;rep : UINT) : LRESULT;
-begin
- Animate_Play:=SendMessage(hwnd,ACM_PLAY,WPARAM(rep),LPARAM(MAKELONG(from,_to)));
-end;
-
-
-function Animate_Stop(hwnd : HWND) : LRESULT;
-begin
- Animate_Stop:=SendMessage(hwnd,ACM_STOP,0,0);
-end;
-
-function Animate_Close(hwnd : HWND) : LRESULT;
-begin
- Animate_Close:=Animate_Open(hwnd,nil);
-end;
-
-
-function Animate_Seek(hwnd : HWND;frame : Integer) : LRESULT;
-begin
- Animate_Seek:=Animate_Play(hwnd,frame,frame,1);
-end;
-
-function CommDlg_OpenSave_GetSpecA(_hdlg:HWND;_psz:LPSTR;_cbmax : Integer) : LRESULT;
-begin
- CommDlg_OpenSave_GetSpecA:=SNDMSG(_hdlg,CDM_GETSPEC,WPARAM(_cbmax),LPARAM(_psz));
-end;
-
-function CommDlg_OpenSave_GetSpecW(_hdlg:HWND;_psz:LPWSTR;_cbmax : Integer) : LRESULT;
-begin
- CommDlg_OpenSave_GetSpecW:=SNDMSG(_hdlg,CDM_GETSPEC,WPARAM(_cbmax),LPARAM(_psz));
-end;
-
-
-{$ifndef Unicode}
-function CommDlg_OpenSave_GetSpec(_hdlg:HWND;_psz:LPSTR;_cbmax : Integer) : LRESULT;
-begin
- CommDlg_OpenSave_GetSpec:=SNDMSG(_hdlg,CDM_GETSPEC,WPARAM(_cbmax),LPARAM(_psz));
-end;
-{$endif Unicode}
-
-
-function CommDlg_OpenSave_GetFilePathA(_hdlg:HWND;_psz:LPSTR;_cbmax : Integer) : LRESULT;
-begin
- CommDlg_OpenSave_GetFilePathA:=SNDMSG(_hdlg,CDM_GETFILEPATH,WPARAM(_cbmax),LPARAM(_psz));
-end;
-
-
-function CommDlg_OpenSave_GetFilePathW(_hdlg:HWND;_psz:LPWSTR;_cbmax : Integer) : LRESULT;
-begin
- CommDlg_OpenSave_GetFilePathW:=SNDMSG(_hdlg,CDM_GETFILEPATH,WPARAM(_cbmax),LPARAM(LPWSTR(_psz)));
-end;
-
-{$ifndef Unicode}
-function CommDlg_OpenSave_GetFilePath(_hdlg:HWND;_psz:LPSTR;_cbmax : Integer) : LRESULT;
-begin
- CommDlg_OpenSave_GetFilePath:=SNDMSG(_hdlg,CDM_GETFILEPATH,WPARAM(_cbmax),LPARAM(_psz));
-end;
-{$endif Unicode}
-
-function CommDlg_OpenSave_GetFolderPathA(_hdlg:HWND;_psz:LPSTR;_cbmax : Integer) : LRESULT;
-begin
- CommDlg_OpenSave_GetFolderPathA:=SNDMSG(_hdlg,CDM_GETFOLDERPATH,WPARAM(_cbmax),LPARAM(LPSTR(_psz)));
-end;
-
-
-function CommDlg_OpenSave_GetFolderPathW(_hdlg:HWND;_psz:LPWSTR;_cbmax : Integer) : LRESULT;
-begin
- CommDlg_OpenSave_GetFolderPathW:=SNDMSG(_hdlg,CDM_GETFOLDERPATH,WPARAM(_cbmax),LPARAM(LPWSTR(_psz)));
-end;
-
-{$ifndef Unicode}
-function CommDlg_OpenSave_GetFolderPath(_hdlg:HWND;_psz:LPSTR;_cbmax : Integer) : LRESULT;
-begin
- CommDlg_OpenSave_GetFolderPath:=SNDMSG(_hdlg,CDM_GETFOLDERPATH,WPARAM(_cbmax),LPARAM(LPSTR(_psz)));
-end;
-{$endif Unicode}
-
-function CommDlg_OpenSave_GetFolderIDList(_hdlg:HWND;_pidl:LPVOID;_cbmax : Integer) : LRESULT;
-begin
- CommDlg_OpenSave_GetFolderIDList:=SNDMSG(_hdlg,CDM_GETFOLDERIDLIST,WPARAM(_cbmax),LPARAM(_pidl));
-end;
-
-
-function CommDlg_OpenSave_SetControlText(_hdlg:HWND;_id : Integer;_text : LPSTR) : LRESULT;
-begin
- CommDlg_OpenSave_SetControlText:=SNDMSG(_hdlg,CDM_SETCONTROLTEXT,WPARAM(_id),LPARAM(_text));
-end;
-
-
-function CommDlg_OpenSave_HideControl(_hdlg:HWND;_id : Integer) : LRESULT;
-begin
- CommDlg_OpenSave_HideControl:=SNDMSG(_hdlg,CDM_HIDECONTROL,WPARAM(_id),0);
-end;
-
-
-function CommDlg_OpenSave_SetDefExt(_hdlg:HWND;_pszext : LPSTR) : LRESULT;
-begin
- CommDlg_OpenSave_SetDefExt:=SNDMSG(_hdlg,CDM_SETDEFEXT,0,LPARAM(_pszext));
-end;
-
-procedure CopyMemory(Destination:PVOID; Source:pointer; Length:DWORD);
-begin
- Move(Source^, Destination^, Length);
-end;
-
-procedure FillMemory(Destination:PVOID; Length:DWORD; Fill:BYTE);
-begin
- FillChar(Destination^,Length,Char(Fill));
-end;
-function GlobalAllocPtr(flags,cb:DWord):Pointer;
-begin
- GlobalAllocPtr:=GlobalLock(GlobalAlloc(flags,cb));
-end;
-
-function GlobalDiscard(hglbMem:HGLOBAL):HGLOBAL;
-begin
- GlobalDiscard:=GlobalReAlloc(hglbMem,0,GMEM_MOVEABLE);
-end;
-
-function GlobalFreePtr(lp:Pointer):Pointer;
-begin
- GlobalFreePtr:=Pointer(GlobalFree(HWND(GlobalUnlockPtr(lp))));
-end;
-
-function GlobalUnlockPtr(lp:pointer):Pointer;
-begin
- GlobalUnlock(GlobalHandle(lp));
- GlobalUnlockPtr:=lp;
-end;
-
-function GlobalLockPtr(lp:pointer):Pointer;
-begin
- GlobalLockPtr:=GlobalLock(GlobalHandle(lp));
-end;
-
-
-function GlobalReAllocPtr(lp:Pointer;cbNew,flags:DWord):Pointer;
-begin
- GlobalReAllocPtr:=GlobalLock(GlobalReAlloc(HWND(GlobalUnlockPtr(lp)),cbNew,flags));
-end;
-
-
-function GlobalPtrHandle(lp:pointer):Pointer;
-begin
- GlobalPtrHandle:=Pointer(GlobalHandle(lp));
-end;
-
-function Header_DeleteItem(hwndHD:HWND;index : Integer) : WINBOOL;
-begin
- Header_DeleteItem:=WINBOOL(SendMessage(hwndHD,HDM_DELETEITEM,WPARAM(index),0));
-end;
-
-
-function Header_GetItem(hwndHD:HWND;index:Integer;var hdi : HD_ITEM) : WINBOOL;
-begin
- Header_GetItem:=WINBOOL(SendMessage(hwndHD,HDM_GETITEM,WPARAM(index),LPARAM(@hdi)));
-end;
-
-
-function Header_GetItemCount(hwndHD : HWND) : Integer;
-begin
- Header_GetItemCount:=Integer(SendMessage(hwndHD,HDM_GETITEMCOUNT,0,0));
-end;
-
-
-function Header_InsertItem(hwndHD:HWND;index : Integer;var hdi : HD_ITEM) : Integer;
-begin
- Header_InsertItem:=Integer(SendMessage(hwndHD,HDM_INSERTITEM,WPARAM(index),LPARAM(@hdi)));
-end;
-
-
-function Header_Layout(hwndHD:HWND;var layout : HD_LAYOUT) : WINBOOL;
-begin
- Header_Layout:=WINBOOL(SendMessage(hwndHD,HDM_LAYOUT,0,LPARAM(@layout)));
-end;
-
-
-function Header_SetItem(hwndHD:HWND;index : Integer;var hdi : HD_ITEM) : WINBOOL;
-begin
- Header_SetItem:=WINBOOL(SendMessage(hwndHD,HDM_SETITEM,WPARAM(index),LPARAM(@hdi)));
-end;
-
-function ImageList_AddIcon(himl:HIMAGELIST; hicon:HICON):Integer;
-begin
- ImageList_AddIcon:=ImageList_ReplaceIcon(himl,-(1),hicon);
-end;
-
-function ListView_Arrange(hwndLV:HWND;code : UINT) : LRESULT;
-begin
- ListView_Arrange:=SendMessage(hwndLV,LVM_ARRANGE,WPARAM(UINT(code)),0);
-end;
-
-
-function ListView_CreateDragImage(hwnd:HWND;i : Integer;lpptUpLeft : LPPOINT) : LRESULT;
-begin
- ListView_CreateDragImage:=SendMessage(hwnd,LVM_CREATEDRAGIMAGE,WPARAM(i),LPARAM(lpptUpLeft));
-end;
-
-
-function ListView_DeleteAllItems(hwnd : HWND) : LRESULT;
-begin
- ListView_DeleteAllItems:=SendMessage(hwnd,LVM_DELETEALLITEMS,0,0);
-end;
-
-
-function ListView_DeleteColumn(hwnd:HWND;iCol : Integer) : LRESULT;
-begin
- ListView_DeleteColumn:=SendMessage(hwnd,LVM_DELETECOLUMN,WPARAM(iCol),0);
-end;
-
-
-function ListView_DeleteItem(hwnd:HWND;iItem : Integer) : LRESULT;
-begin
- ListView_DeleteItem:=SendMessage(hwnd,LVM_DELETEITEM,WPARAM(iItem),0);
-end;
-
-
-function ListView_EditLabel(hwndLV:HWND;i : Integer) : LRESULT;
-begin
- ListView_EditLabel:=SendMessage(hwndLV,LVM_EDITLABEL,WPARAM(Integer(i)),0);
-end;
-
-
-function ListView_EnsureVisible(hwndLV:HWND;i,fPartialOK : Integer) : LRESULT;
-begin
- ListView_EnsureVisible:=SendMessage(hwndLV,LVM_ENSUREVISIBLE,WPARAM(i),MAKELPARAM(fPartialOK,0));
-end;
-
-
-function ListView_FindItem(hwnd:HWND;iStart : Integer;var lvfi : LV_FINDINFO) : Integer;
-begin
- ListView_FindItem:=SendMessage(hwnd,LVM_FINDITEM,WPARAM(iStart),LPARAM(@lvfi));
-end;
-
-
-function ListView_GetBkColor(hwnd : HWND) : LRESULT;
-begin
- ListView_GetBkColor:=SendMessage(hwnd,LVM_GETBKCOLOR,0,0);
-end;
-
-
-function ListView_GetCallbackMask(hwnd : HWND) : LRESULT;
-begin
- ListView_GetCallbackMask:=SendMessage(hwnd,LVM_GETCALLBACKMASK,0,0);
-end;
-
-
-function ListView_GetColumn(hwnd:HWND;iCol : Integer;var col : LV_COLUMN) : LRESULT;
-begin
- ListView_GetColumn:=SendMessage(hwnd,LVM_GETCOLUMN,WPARAM(iCol),LPARAM(@col));
-end;
-
-
-function ListView_GetColumnWidth(hwnd:HWND;iCol : Integer) : LRESULT;
-begin
- ListView_GetColumnWidth:=SendMessage(hwnd,LVM_GETCOLUMNWIDTH,WPARAM(iCol),0);
-end;
-
-
-function ListView_GetCountPerPage(hwndLV : HWND) : LRESULT;
-begin
- ListView_GetCountPerPage:=SendMessage(hwndLV,LVM_GETCOUNTPERPAGE,0,0);
-end;
-
-
-function ListView_GetEditControl(hwndLV : HWND) : LRESULT;
-begin
- ListView_GetEditControl:=SendMessage(hwndLV,LVM_GETEDITCONTROL,0,0);
-end;
-
-
-function ListView_GetImageList(hwnd:HWND;iImageList : wINT) : LRESULT;
-begin
- ListView_GetImageList:=SendMessage(hwnd,LVM_GETIMAGELIST,WPARAM(iImageList),0);
-end;
-
-
-function ListView_GetISearchString(hwndLV:HWND;lpsz : LPTSTR) : LRESULT;
-begin
- ListView_GetISearchString:=SendMessage(hwndLV,LVM_GETISEARCHSTRING,0,LPARAM(lpsz));
-end;
-
-
-function ListView_GetItem(hwnd:HWND;var item : LV_ITEM) : LRESULT;
-begin
- ListView_GetItem:=SendMessage(hwnd,LVM_GETITEM,0,LPARAM(@item));
-end;
-
-
-function ListView_GetItemCount(hwnd : HWND) : LRESULT;
-begin
- ListView_GetItemCount:=SendMessage(hwnd,LVM_GETITEMCOUNT,0,0);
-end;
-
-
-function ListView_GetItemPosition(hwndLV:HWND;i : Integer;var pt : POINT) : Integer;
-begin
- ListView_GetItemPosition:=SendMessage(hwndLV,LVM_GETITEMPOSITION,WPARAM(Integer(i)),LPARAM(@pt));
-end;
-
-
-function ListView_GetItemSpacing(hwndLV:HWND;fSmall : Integer) : LRESULT;
-begin
- ListView_GetItemSpacing:=SendMessage(hwndLV,LVM_GETITEMSPACING,fSmall,0);
-end;
-
-
-function ListView_GetItemState(hwndLV:HWND;i,mask : Integer) : LRESULT;
-begin
- ListView_GetItemState:=SendMessage(hwndLV,LVM_GETITEMSTATE,WPARAM(i),LPARAM(mask));
-end;
-
-
-function ListView_GetNextItem(hwnd:HWND; iStart, flags : Integer) : LRESULT;
-begin
- ListView_GetNextItem:=SendMessage(hwnd, LVM_GETNEXTITEM, WPARAM(iStart), LPARAM(flags));
-end;
-
-
-function ListView_GetOrigin(hwndLV:HWND;var pt : POINT) : LRESULT;
-begin
- ListView_GetOrigin:=SendMessage(hwndLV,LVM_GETORIGIN,WPARAM(0),LPARAM(@pt));
-end;
-
-
-function ListView_GetSelectedCount(hwndLV : HWND) : LRESULT;
-begin
- ListView_GetSelectedCount:=SendMessage(hwndLV,LVM_GETSELECTEDCOUNT,0,0);
-end;
-
-
-function ListView_GetStringWidth(hwndLV:HWND;psz : LPCTSTR) : LRESULT;
-begin
- ListView_GetStringWidth:=SendMessage(hwndLV,LVM_GETSTRINGWIDTH,0,LPARAM(psz));
-end;
-
-
-function ListView_GetTextBkColor(hwnd : HWND) : LRESULT;
-begin
- ListView_GetTextBkColor:=SendMessage(hwnd,LVM_GETTEXTBKCOLOR,0,0);
-end;
-
-
-function ListView_GetTextColor(hwnd : HWND) : LRESULT;
-begin
- ListView_GetTextColor:=SendMessage(hwnd,LVM_GETTEXTCOLOR,0,0);
-end;
-
-
-function ListView_GetTopIndex(hwndLV : HWND) : LRESULT;
-begin
- ListView_GetTopIndex:=SendMessage(hwndLV,LVM_GETTOPINDEX,0,0);
-end;
-
-
-function ListView_GetViewRect(hwnd:HWND;var rc : RECT) : LRESULT;
-begin
- ListView_GetViewRect:=SendMessage(hwnd,LVM_GETVIEWRECT,0,LPARAM(@rc));
-end;
-
-
-function ListView_HitTest(hwndLV:HWND;var info : LV_HITTESTINFO) : LRESULT;
-begin
- ListView_HitTest:=SendMessage(hwndLV,LVM_HITTEST,0,LPARAM(@info));
-end;
-
-
-function ListView_InsertColumn(hwnd:HWND;iCol : Integer;var col : LV_COLUMN) : LRESULT;
-begin
- ListView_InsertColumn:=SendMessage(hwnd,LVM_INSERTCOLUMN,WPARAM(iCol),LPARAM(@col));
-end;
-
-
-function ListView_InsertItem(hwnd:HWND;var item : LV_ITEM) : LRESULT;
-begin
- ListView_InsertItem:=SendMessage(hwnd,LVM_INSERTITEM,0,LPARAM(@item));
-end;
-
-
-function ListView_RedrawItems(hwndLV:HWND;iFirst,iLast : Integer) : LRESULT;
-begin
- ListView_RedrawItems:=SendMessage(hwndLV,LVM_REDRAWITEMS,WPARAM(iFirst),LPARAM(iLast));
-end;
-
-
-function ListView_Scroll(hwndLV:HWND;dx,dy : Integer) : LRESULT;
-begin
- ListView_Scroll:=SendMessage(hwndLV,LVM_SCROLL,WPARAM(dx),LPARAM(dy));
-end;
-
-
-function ListView_SetBkColor(hwnd:HWND;clrBk : COLORREF) : LRESULT;
-begin
- ListView_SetBkColor:=SendMessage(hwnd,LVM_SETBKCOLOR,0,LPARAM(clrBk));
-end;
-
-
-function ListView_SetCallbackMask(hwnd:HWND;mask : UINT) : LRESULT;
-begin
- ListView_SetCallbackMask:=SendMessage(hwnd,LVM_SETCALLBACKMASK,WPARAM(mask),0);
-end;
-
-
-function ListView_SetColumn(hwnd:HWND;iCol : Integer; var col : LV_COLUMN) : LRESULT;
-begin
- ListView_SetColumn:=SendMessage(hwnd,LVM_SETCOLUMN,WPARAM(iCol),LPARAM(@col));
-end;
-
-
-function ListView_SetColumnWidth(hwnd:HWND;iCol,cx : Integer) : LRESULT;
-begin
- ListView_SetColumnWidth:=SendMessage(hwnd,LVM_SETCOLUMNWIDTH,WPARAM(iCol),MAKELPARAM(cx,0));
-end;
-
-
-function ListView_SetImageList(hwnd:HWND;himl : Integer;iImageList : HIMAGELIST) : LRESULT;
-begin
- ListView_SetImageList:=SendMessage(hwnd,LVM_SETIMAGELIST,WPARAM(iImageList),LPARAM(UINT(himl)));
-end;
-
-
-function ListView_SetItem(hwnd:HWND;var item : LV_ITEM) : LRESULT;
-begin
- ListView_SetItem:=SendMessage(hwnd,LVM_SETITEM,0,LPARAM(@item));
-end;
-
-
-function ListView_SetItemCount(hwndLV:HWND;cItems : Integer) : LRESULT;
-begin
- ListView_SetItemCount:=SendMessage(hwndLV,LVM_SETITEMCOUNT,WPARAM(cItems),0);
-end;
-
-
-function ListView_SetItemPosition(hwndLV:HWND;i,x,y : Integer) : LRESULT;
-begin
- ListView_SetItemPosition:=SendMessage(hwndLV,LVM_SETITEMPOSITION,WPARAM(i),MAKELPARAM(x,y));
-end;
-
-
-function ListView_SetItemPosition32(hwndLV:HWND;i,x,y : Integer) : LRESULT;
-var
- ptNewPos : POINT;
-begin
- ptNewPos.x:=x;
- ptNewPos.y:=y;
- ListView_SetItemPosition32:=SendMessage(hwndLV, LVM_SETITEMPOSITION32, WPARAM(i),LPARAM(@ptNewPos));
-end;
-
-
-function ListView_SetItemState(hwndLV:HWND; i, data, mask:Integer) : LRESULT;
-var
- _gnu_lvi : LV_ITEM;
-begin
- _gnu_lvi.stateMask:=mask;
- _gnu_lvi.state:=data;
- ListView_SetItemState:=SendMessage(hwndLV, LVM_SETITEMSTATE, WPARAM(i),LPARAM(@_gnu_lvi));
-end;
-
-
-function ListView_SetItemText(hwndLV:HWND; i, iSubItem_:Integer;pszText_ : LPTSTR) : LRESULT;
-var
- _gnu_lvi : LV_ITEM;
-begin
- _gnu_lvi.iSubItem:=iSubItem_;
- _gnu_lvi.pszText:=pszText_;
- ListView_SetItemText:=SendMessage(hwndLV, LVM_SETITEMTEXT, WPARAM(i),LPARAM(@_gnu_lvi));
-end;
-
-
-function ListView_SetTextBkColor(hwnd:HWND;clrTextBk : COLORREF) : LRESULT;
-begin
- ListView_SetTextBkColor:=SendMessage(hwnd,LVM_SETTEXTBKCOLOR,0,LPARAM(clrTextBk));
-end;
-
-
-function ListView_SetTextColor(hwnd:HWND;clrText : COLORREF) : LRESULT;
-begin
- ListView_SetTextColor:=SendMessage(hwnd,LVM_SETTEXTCOLOR,0,LPARAM(clrText));
-end;
-
-
-function ListView_SortItems(hwndLV:HWND;_pfnCompare:PFNLVCOMPARE;_lPrm : LPARAM) : LRESULT;
-begin
- ListView_SortItems:=SendMessage(hwndLV,LVM_SORTITEMS,WPARAM(_lPrm),LPARAM(_pfnCompare));
-end;
-
-
-function ListView_Update(hwndLV:HWND;i : Integer) : LRESULT;
-begin
- ListView_Update:=SendMessage(hwndLV,LVM_UPDATE,WPARAM(i),0);
-end;
-
-function LocalDiscard(hlocMem:HLOCAL):HLOCAL;
-begin
- LocalDiscard := LocalReAlloc(hlocMem,0,LMEM_MOVEABLE);
-end;
-
-procedure MoveMemory(Destination:PVOID; Source:pointer; Length:DWORD);
-begin
- Move(Source^,Destination^,Length);
-end;
-
-function PropSheet_AddPage(hPropSheetDlg : HWND;hpage : HPROPSHEETPAGE) : LRESULT;
-begin
- PropSheet_AddPage:=SendMessage(hPropSheetDlg,PSM_ADDPAGE,0,LPARAM(hpage));
-end;
-
-
-function PropSheet_Apply(hPropSheetDlg : HWND) : LRESULT;
-begin
- PropSheet_Apply:=SendMessage(hPropSheetDlg,PSM_APPLY,0,0);
-end;
-
-
-function PropSheet_CancelToClose(hPropSheetDlg : HWND) : LRESULT;
-begin
- PropSheet_CancelToClose:=SendMessage(hPropSheetDlg,PSM_CANCELTOCLOSE,0,0);
-end;
-
-
-function PropSheet_Changed(hPropSheetDlg,hwndPage : HWND) : LRESULT;
-begin
- PropSheet_Changed:=SendMessage(hPropSheetDlg,PSM_CHANGED,WPARAM(hwndPage),0);
-end;
-
-
-function PropSheet_GetCurrentPageHwnd(hDlg : HWND) : LRESULT;
-begin
- PropSheet_GetCurrentPageHwnd:=SendMessage(hDlg,PSM_GETCURRENTPAGEHWND,0,0);
-end;
-
-
-function PropSheet_GetTabControl(hPropSheetDlg : HWND) : LRESULT;
-begin
- PropSheet_GetTabControl:=SendMessage(hPropSheetDlg,PSM_GETTABCONTROL,0,0);
-end;
-
-
-function PropSheet_IsDialogMessage(hDlg : HWND;pMsg : Integer) : LRESULT;
-begin
- PropSheet_IsDialogMessage:=SendMessage(hDlg,PSM_ISDIALOGMESSAGE,0,LPARAM(pMsg));
-end;
-
-
-function PropSheet_PressButton(hPropSheetDlg : HWND;iButton : Integer) : LRESULT;
-begin
- PropSheet_PressButton:=SendMessage(hPropSheetDlg,PSM_PRESSBUTTON,WPARAM(Integer(iButton)),0);
-end;
-
-
-function PropSheet_QuerySiblings(hPropSheetDlg : HWND;param1,param2 : Integer) : LRESULT;
-begin
- PropSheet_QuerySiblings:=SendMessage(hPropSheetDlg,PSM_QUERYSIBLINGS,WPARAM(param1),LPARAM(param2));
-end;
-
-
-function PropSheet_RebootSystem(hPropSheetDlg : HWND) : LRESULT;
-begin
- PropSheet_RebootSystem:=SendMessage(hPropSheetDlg,PSM_REBOOTSYSTEM,0,0);
-end;
-
-
-function PropSheet_RemovePage(hPropSheetDlg : HWND;hpage : HPROPSHEETPAGE; index : Integer) : LRESULT;
-begin
- PropSheet_RemovePage:=SendMessage(hPropSheetDlg,PSM_REMOVEPAGE,WPARAM(index),LPARAM(hpage));
-end;
-
-
-function PropSheet_RestartWindows(hPropSheetDlg : HWND) : LRESULT;
-begin
- PropSheet_RestartWindows:=SendMessage(hPropSheetDlg,PSM_RESTARTWINDOWS,0,0);
-end;
-
-
-function PropSheet_SetCurSel(hPropSheetDlg : HWND;hpage : HPROPSHEETPAGE; index : Integer) : LRESULT;
-begin
- PropSheet_SetCurSel:=SendMessage(hPropSheetDlg,PSM_SETCURSEL,WPARAM(index),LPARAM(hpage));
-end;
-
-
-function PropSheet_SetCurSelByID(hPropSheetDlg : HWND; id : Integer) : LRESULT;
-begin
- PropSheet_SetCurSelByID:=SendMessage(hPropSheetDlg,PSM_SETCURSELID,0,LPARAM(id));
-end;
-
-
-function PropSheet_SetFinishText(hPropSheetDlg:HWND;lpszText : LPTSTR) : LRESULT;
-begin
- PropSheet_SetFinishText:=SendMessage(hPropSheetDlg,PSM_SETFINISHTEXT,0,LPARAM(lpszText));
-end;
-
-
-function PropSheet_SetTitle(hPropSheetDlg:HWND;dwStyle:DWORD;lpszText : LPCTSTR) : LRESULT;
-begin
- PropSheet_SetTitle:=SendMessage(hPropSheetDlg,PSM_SETTITLE,WPARAM(dwStyle),LPARAM(lpszText));
-end;
-
-
-function PropSheet_SetWizButtons(hPropSheetDlg:HWND;dwFlags : DWORD) : LRESULT;
-begin
- PropSheet_SetWizButtons:=SendMessage(hPropSheetDlg,PSM_SETWIZBUTTONS,0,LPARAM(dwFlags));
-end;
-
-
-function PropSheet_UnChanged(hPropSheetDlg:HWND;hwndPage : HWND) : LRESULT;
-begin
- PropSheet_UnChanged:=SendMessage(hPropSheetDlg,PSM_UNCHANGED,WPARAM(hwndPage),0);
-end;
-
-function SNDMSG(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT;
-begin
- SNDMSG:=SendMessage(hWnd,Msg,wParam,lParam);
-end;
-
-function TreeView_InsertItem(hwnd:HWND;lpis : LPTV_INSERTSTRUCT) : LRESULT;
-begin
- TreeView_InsertItem:=SendMessage(hwnd,TVM_INSERTITEM,0,LPARAM(lpis));
-end;
-
-function TabCtrl_GetImageList(hwnd : HWND) : LRESULT;
-begin
- TabCtrl_GetImageList:=SendMessage(hwnd,TCM_GETIMAGELIST,0,0);
-end;
-
-
-function TabCtrl_SetImageList(hwnd:HWND;himl : HIMAGELIST) : LRESULT;
-begin
- TabCtrl_SetImageList:=SendMessage(hwnd,TCM_SETIMAGELIST,0,LPARAM(UINT(himl)));
-end;
-
-
-function TabCtrl_GetItemCount(hwnd : HWND) : LRESULT;
-begin
- TabCtrl_GetItemCount:=SendMessage(hwnd,TCM_GETITEMCOUNT,0,0);
-end;
-
-
-function TabCtrl_GetItem(hwnd:HWND;iItem : Integer;var item : TC_ITEM) : LRESULT;
-begin
- TabCtrl_GetItem:=SendMessage(hwnd,TCM_GETITEM,WPARAM(iItem),LPARAM(@item));
-end;
-
-
-function TabCtrl_SetItem(hwnd:HWND;iItem : Integer;var item : TC_ITEM) : LRESULT;
-begin
- TabCtrl_SetItem:=SendMessage(hwnd,TCM_SETITEM,WPARAM(iItem),LPARAM(@item));
-end;
-
-
-function TabCtrl_InsertItem(hwnd:HWND;iItem : Integer;var item : TC_ITEM) : LRESULT;
-begin
- TabCtrl_InsertItem:=SendMessage(hwnd,TCM_INSERTITEM,WPARAM(iItem),LPARAM(@item));
-end;
-
-
-function TabCtrl_DeleteItem(hwnd:HWND;i : Integer) : LRESULT;
-begin
- TabCtrl_DeleteItem:=SendMessage(hwnd,TCM_DELETEITEM,WPARAM(i),0);
-end;
-
-
-function TabCtrl_DeleteAllItems(hwnd : HWND) : LRESULT;
-begin
- TabCtrl_DeleteAllItems:=SendMessage(hwnd,TCM_DELETEALLITEMS,0,0);
-end;
-
-
-function TabCtrl_GetItemRect(hwnd:HWND;i : Integer;var rc : RECT) : LRESULT;
-begin
- TabCtrl_GetItemRect:=SendMessage(hwnd,TCM_GETITEMRECT,WPARAM(Integer(i)),LPARAM(@rc));
-end;
-
-
-function TabCtrl_GetCurSel(hwnd : HWND) : LRESULT;
-begin
- TabCtrl_GetCurSel:=SendMessage(hwnd,TCM_GETCURSEL,0,0);
-end;
-
-
-function TabCtrl_SetCurSel(hwnd:HWND;i : Integer) : LRESULT;
-begin
- TabCtrl_SetCurSel:=SendMessage(hwnd,TCM_SETCURSEL,WPARAM(i),0);
-end;
-
-
-function TabCtrl_HitTest(hwndTC:HWND;var info : TC_HITTESTINFO) : LRESULT;
-begin
- TabCtrl_HitTest:=SendMessage(hwndTC,TCM_HITTEST,0,LPARAM(@info));
-end;
-
-
-function TabCtrl_SetItemExtra(hwndTC:HWND;cb : Integer) : LRESULT;
-begin
- TabCtrl_SetItemExtra:=SendMessage(hwndTC,TCM_SETITEMEXTRA,WPARAM(cb),0);
-end;
-
-
-function TabCtrl_AdjustRect(hwnd:HWND;bLarger:WINBOOL;var rc : RECT) : LRESULT;
-begin
- TabCtrl_AdjustRect:=SendMessage(hwnd,TCM_ADJUSTRECT,WPARAM(bLarger),LPARAM(@rc));
-end;
-
-
-function TabCtrl_SetItemSize(hwnd:HWND;x,y : Integer) : LRESULT;
-begin
- TabCtrl_SetItemSize:=SendMessage(hwnd,TCM_SETITEMSIZE,0,MAKELPARAM(x,y));
-end;
-
-
-function TabCtrl_RemoveImage(hwnd:HWND;i : WPARAM) : LRESULT;
-begin
- TabCtrl_RemoveImage:=SendMessage(hwnd,TCM_REMOVEIMAGE,i,0);
-end;
-
-
-function TabCtrl_SetPadding(hwnd:HWND;cx,cy : Integer) : LRESULT;
-begin
- TabCtrl_SetPadding:=SendMessage(hwnd,TCM_SETPADDING,0,MAKELPARAM(cx,cy));
-end;
-
-
-function TabCtrl_GetRowCount(hwnd : HWND) : LRESULT;
-begin
- TabCtrl_GetRowCount:=SendMessage(hwnd,TCM_GETROWCOUNT,0,0);
-end;
-
-
-function TabCtrl_GetToolTips(hwnd : HWND) : LRESULT;
-begin
- TabCtrl_GetToolTips:=SendMessage(hwnd,TCM_GETTOOLTIPS,0,0);
-end;
-
-
-function TabCtrl_SetToolTips(hwnd:HWND;hwndTT : Integer) : LRESULT;
-begin
- TabCtrl_SetToolTips:=SendMessage(hwnd,TCM_SETTOOLTIPS,WPARAM(hwndTT),0);
-end;
-
-
-function TabCtrl_GetCurFocus(hwnd : HWND) : LRESULT;
-begin
- TabCtrl_GetCurFocus:=SendMessage(hwnd,TCM_GETCURFOCUS,0,0);
-end;
-
-
-function TabCtrl_SetCurFocus(hwnd:HWND;i : Integer) : LRESULT;
-begin
- TabCtrl_SetCurFocus:=SendMessage(hwnd,TCM_SETCURFOCUS,i,0);
-end;
-
-function TreeView_DeleteItem(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-begin
- TreeView_DeleteItem:=SendMessage(hwnd,TVM_DELETEITEM,0,LPARAM(hitem));
-end;
-
-
-function TreeView_DeleteAllItems(hwnd : HWND) : LRESULT;
-begin
- TreeView_DeleteAllItems:=SendMessage(hwnd,TVM_DELETEITEM,0,LPARAM(TVI_ROOT));
-end;
-
-
-function TreeView_Expand(hwnd:HWND;hitem:HTREEITEM;code : Integer) : LRESULT;
-begin
- TreeView_Expand:=SendMessage(hwnd,TVM_EXPAND,WPARAM(code),LPARAM(hitem));
-end;
-
-
-function TreeView_GetCount(hwnd : HWND) : LRESULT;
-begin
- TreeView_GetCount:=SendMessage(hwnd,TVM_GETCOUNT,0,0);
-end;
-
-
-function TreeView_GetIndent(hwnd : HWND) : LRESULT;
-begin
- TreeView_GetIndent:=SendMessage(hwnd,TVM_GETINDENT,0,0);
-end;
-
-
-function TreeView_SetIndent(hwnd:HWND;indent : Integer) : LRESULT;
-begin
- TreeView_SetIndent:=SendMessage(hwnd,TVM_SETINDENT,WPARAM(indent),0);
-end;
-
-
-function TreeView_GetImageList(hwnd:HWND;iImage : WPARAM) : LRESULT;
-begin
- TreeView_GetImageList:=SendMessage(hwnd,TVM_GETIMAGELIST,iImage,0);
-end;
-
-
-function TreeView_SetImageList(hwnd:HWND;himl:HIMAGELIST;iImage : WPARAM) : LRESULT;
-begin
- TreeView_SetImageList:=SendMessage(hwnd,TVM_SETIMAGELIST,iImage,LPARAM(UINT(himl)));
-end;
-
-
-function TreeView_GetNextItem(hwnd:HWND;hitem:HTREEITEM;code : Integer) : LRESULT;
-begin
- TreeView_GetNextItem:=SendMessage(hwnd,TVM_GETNEXTITEM,WPARAM(code),LPARAM(hitem));
-end;
-
-
-function TreeView_GetChild(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-begin
- TreeView_GetChild:=TreeView_GetNextItem(hwnd,hitem,TVGN_CHILD);
-end;
-
-
-function TreeView_GetNextSibling(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-begin
- TreeView_GetNextSibling:=TreeView_GetNextItem(hwnd,hitem,TVGN_NEXT);
-end;
-
-
-function TreeView_GetPrevSibling(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-begin
- TreeView_GetPrevSibling:=TreeView_GetNextItem(hwnd,hitem,TVGN_PREVIOUS);
-end;
-
-
-function TreeView_GetParent(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-begin
- TreeView_GetParent:=TreeView_GetNextItem(hwnd,hitem,TVGN_PARENT);
-end;
-
-
-function TreeView_GetFirstVisible(hwnd : HWND) : LRESULT;
-begin
- TreeView_GetFirstVisible:=TreeView_GetNextItem(hwnd,HTREEITEM(nil),TVGN_FIRSTVISIBLE);
-end;
-
-
-function TreeView_GetNextVisible(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-begin
- TreeView_GetNextVisible:=TreeView_GetNextItem(hwnd,hitem,TVGN_NEXTVISIBLE);
-end;
-
-
-function TreeView_GetPrevVisible(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-begin
- TreeView_GetPrevVisible:=TreeView_GetNextItem(hwnd,hitem,TVGN_PREVIOUSVISIBLE);
-end;
-
-
-function TreeView_GetSelection(hwnd : HWND) : LRESULT;
-begin
- TreeView_GetSelection:=TreeView_GetNextItem(hwnd,HTREEITEM(nil),TVGN_CARET);
-end;
-
-
-function TreeView_GetDropHilight(hwnd : HWND) : LRESULT;
-begin
- TreeView_GetDropHilight:=TreeView_GetNextItem(hwnd,HTREEITEM(nil),TVGN_DROPHILITE);
-end;
-
-
-function TreeView_GetRoot(hwnd : HWND) : LRESULT;
-begin
- TreeView_GetRoot:=TreeView_GetNextItem(hwnd,HTREEITEM(nil),TVGN_ROOT);
-end;
-
-
-function TreeView_Select(hwnd:HWND;hitem:HTREEITEM;code : Integer) : LRESULT;
-begin
- TreeView_Select:=SendMessage(hwnd,TVM_SELECTITEM,WPARAM(code),LPARAM(hitem));
-end;
-
-
-function TreeView_SelectItem(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-begin
- TreeView_SelectItem:=TreeView_Select(hwnd,hitem,TVGN_CARET);
-end;
-
-
-function TreeView_SelectDropTarget(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-begin
- TreeView_SelectDropTarget:=TreeView_Select(hwnd,hitem,TVGN_DROPHILITE);
-end;
-
-
-function TreeView_SelectSetFirstVisible(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-begin
- TreeView_SelectSetFirstVisible:=TreeView_Select(hwnd,hitem,TVGN_FIRSTVISIBLE);
-end;
-
-
-function TreeView_GetItem(hwnd:HWND;var item : TV_ITEM) : LRESULT;
-begin
- TreeView_GetItem:=SendMessage(hwnd,TVM_GETITEM,0,LPARAM(@item));
-end;
-
-
-function TreeView_SetItem(hwnd:HWND;var item : TV_ITEM) : LRESULT;
-begin
- TreeView_SetItem:=SendMessage(hwnd,TVM_SETITEM,0,LPARAM(@item));
-end;
-
-
-function TreeView_EditLabel(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-begin
- TreeView_EditLabel:=SendMessage(hwnd,TVM_EDITLABEL,0,LPARAM(hitem));
-end;
-
-
-function TreeView_GetEditControl(hwnd : HWND) : LRESULT;
-begin
- TreeView_GetEditControl:=SendMessage(hwnd,TVM_GETEDITCONTROL,0,0);
-end;
-
-
-function TreeView_GetVisibleCount(hwnd : HWND) : LRESULT;
-begin
- TreeView_GetVisibleCount:=SendMessage(hwnd,TVM_GETVISIBLECOUNT,0,0);
-end;
-
-
-function TreeView_HitTest(hwnd:HWND;lpht : LPTV_HITTESTINFO) : LRESULT;
-begin
- TreeView_HitTest:=SendMessage(hwnd,TVM_HITTEST,0,LPARAM(lpht));
-end;
-
-
-function TreeView_CreateDragImage(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-begin
- TreeView_CreateDragImage:=SendMessage(hwnd,TVM_CREATEDRAGIMAGE,0,LPARAM(hitem));
-end;
-
-
-function TreeView_SortChildren(hwnd:HWND;hitem:HTREEITEM;recurse : Integer) : LRESULT;
-begin
- TreeView_SortChildren:=SendMessage(hwnd,TVM_SORTCHILDREN,WPARAM(recurse),LPARAM(hitem));
-end;
-
-
-function TreeView_EnsureVisible(hwnd:HWND;hitem : HTREEITEM) : LRESULT;
-begin
- TreeView_EnsureVisible:=SendMessage(hwnd,TVM_ENSUREVISIBLE,0,LPARAM(hitem));
-end;
-
-
-function TreeView_SortChildrenCB(hwnd:HWND;psort:LPTV_SORTCB;recurse : Integer) : LRESULT;
-begin
- TreeView_SortChildrenCB:=SendMessage(hwnd,TVM_SORTCHILDRENCB,WPARAM(recurse),LPARAM(psort));
-end;
-
-
-function TreeView_EndEditLabelNow(hwnd:HWND;fCancel : Integer) : LRESULT;
-begin
- TreeView_EndEditLabelNow:=SendMessage(hwnd,TVM_ENDEDITLABELNOW,WPARAM(fCancel),0);
-end;
-
-
-function TreeView_GetISearchString(hwndTV:HWND;lpsz : LPTSTR) : LRESULT;
-begin
- TreeView_GetISearchString:=SendMessage(hwndTV,TVM_GETISEARCHSTRING,0,LPARAM(lpsz));
-end;
-
-procedure ZeroMemory(Destination:PVOID; Length:DWORD);
-begin
- FillChar(Destination^,Length,#0);
-end;
-
-//end common win32 & wince
-
-{$ifdef WINCE}
-//begin wince only
-function DrawIcon(hDC:HDC; X:Integer; Y:Integer; hIcon:HICON):WINBOOL;
-begin
- DrawIcon:=DrawIconEx(hdc,x,y,hicon,0,0,0,NULL, DI_NORMAL);
-end;
-
-procedure ExitProcess(uExitCode:UINT);
-begin
- TerminateProcess (GetCurrentProcess, uExitCode);
-end;
-
-function GetCurrentThread:HANDLE;
-begin
- GetCurrentThread:=SH_CURTHREAD+SYS_HANDLE_BASE;
-end;
-
-function GetCurrentThreadId:DWORD;
-begin
- GetCurrentThreadId:=Phandle(PUserKData+SYSHANDLE_OFFSET+SH_CURTHREAD*SizeOf(THandle))^;
-end;
-
-function GetCurrentProcess:HANDLE;
-begin
- GetCurrentProcess:=SH_CURPROC+SYS_HANDLE_BASE;
-end;
-
-function GetCurrentProcessId:DWORD;
-begin
- GetCurrentProcessId:=Phandle(PUserKData+SYSHANDLE_OFFSET+SH_CURPROC*SizeOf(THandle))^;
-end;
-
-function GlobalAlloc(uFlags:UINT; dwBytes:DWORD):HGLOBAL;
-begin
- GlobalAlloc:=LocalAlloc(uFlags,dwBytes);
-end;
-
-function GlobalFree(hMem:HGLOBAL):HGLOBAL;
-begin
- GlobalFree:=LocalFree(hMem);
-end;
-
-function GlobalReAlloc(hMem:HGLOBAL; dwBytes:DWORD; uFlags:UINT):HGLOBAL;
-begin
- GlobalReAlloc:=LocalReAlloc(hMem, dwBytes, LMEM_MOVEABLE);
-end;
-
-function GlobalSize(hMem:HGLOBAL):DWORD;
-begin
- GlobalSize:=LocalSize(hMem);
-end;
-
-function GlobalHandle(pMem:LPCVOID):HGLOBAL;
-begin
- //GlobalHandle:=LocalHandle(pMem);
- GlobalHandle:=HLOCAL(pMem); //see localhandle
-end;
-
-function GlobalLock(hMem:HGLOBAL):LPVOID;
-begin
- //GlobalLock:=LocalLock(hMem);
- GlobalLock:=LPVOID(hMem); //see locallock
-end;
-
-function GlobalUnlock(hMem:HGLOBAL):WINBOOL;
-begin
- //GlobalUnlock:=LocalUnlock(hMem);
- GlobalUnlock:=True; //see localunlock
-end;
-
-function LocalHandle(pMem:LPCVOID):HLOCAL;
-begin
- LocalHandle:=HLOCAL(pMem);
-end;
-
-function LocalLock(hMem:HLOCAL):LPVOID;
-begin
- LocalLock:=LPVOID(hMem);
-end;
-
-function LocalUnlock(hMem:HLOCAL):WINBOOL;
-begin
- LocalUnlock:=True;
-end;
-
-function MsgWaitForMultipleObjects(nCount:DWORD; pHandles:LPHANDLE; fWaitAll:WINBOOL; dwMilliseconds:DWORD; dwWakeMask:DWORD):DWORD;
-begin
- MsgWaitForMultipleObjects:=MsgWaitForMultipleObjectsEx(nCount,pHandles,dwMilliseconds,dwWakeMask,0);
-end;
-
-function TrackPopupMenu(hMenu:HMENU; uFlags:UINT; x:Integer; y:Integer; nReserved:Integer;hWnd:HWND; var prcRect:RECT):WINBOOL;
-begin
- TrackPopupMenu:=TrackPopupMenuEx(hMenu,uFlags,x,y,hWnd,nil);
-end;
-
-function PulseEvent(hEvent:HANDLE):WINBOOL;
-begin
- PulseEvent:=EventModify(hEvent,EVENT_PULSE);
-end;
-
-function ResetEvent(hEvent:HANDLE):WINBOOL;
-begin
- ResetEvent:=EventModify(hEvent,EVENT_RESET);
-end;
-
-function CheckDlgButton(hDlg:HWND; nIDButton:Integer; uCheck:UINT):WINBOOL;
-begin
- CheckDlgButton:=WINBOOL(SendDlgItemMessage(hDlg, nIDButton, BM_SETCHECK, WPARAM(uCheck), LPARAM(0)));
-end;
-
-
-function SetEvent(hEvent:HANDLE):WINBOOL;
-begin
- SetEvent:=EventModify(hEvent,EVENT_SET);
-end;
-
-function TlsAlloc:DWORD;
-begin
- TlsAlloc:=TlsCall(TLS_FUNCALLOC, 0);
-end;
-
-function TlsFree(dwTlsIndex:DWORD):WINBOOL;
-begin
- TlsFree:=WINBOOL(TlsCall(TLS_FUNCFREE, dwTlsIndex));
-end;
-
-//end wince only
-{$endif WINCE}
-
-
-{$ifdef WIN32}
-
-//begin win32 only
-function Internal_ChildWindowFromPoint(hWndParent:HWND; PointX,PointY : LONG):HWND; external 'user32' name 'ChildWindowFromPoint';
-function Internal_ChildWindowFromPointEx(_para1:HWND; _para2X,_Para2Y : LONG; _para3:UINT):HWND; external 'user32' name 'ChildWindowFromPointEx';
-function Internal_DragDetect(hwnd:HWND; ptX, ptY : LONG):WINBOOL; external 'user32' name 'DragDetect';
-function Internal_GetLargestConsoleWindowSize(hConsoleOutput:HANDLE):DWord; external 'kernel32' name 'GetLargestConsoleWindowSize';
-function Internal_LBItemFromPt(hLB:HWND; ptX, ptY : LONG; bAutoScroll:WINBOOL):Integer; external 'comctl32' name 'LBItemFromPt';
-function Internal_MenuItemFromPoint(hWnd:HWND; hMenu:HMENU; ptScreenX, ptScreenY : LONG):Integer; external 'user32' name 'MenuItemFromPoint';
-function Internal_PtInRect(var lprc:RECT; ptX,ptY : LONG):WINBOOL; external 'user32' name 'PtInRect';
-function Internal_WindowFromPoint(PointX,PointY : LONG):HWND; external 'user32' name 'WindowFromPoint';
-
-function ChildWindowFromPoint(hWndParent:HWND; Point:POINT):HWND;
-begin
- ChildWindowFromPoint:=Internal_ChildWindowFromPoint(hWndParent, Point.X, Point.Y);
-end;
-function ChildWindowFromPointEx(_para1:HWND; _para2:POINT; _para3:UINT):HWND;
-begin
- ChildWindowFromPointEx:=Internal_ChildWindowFromPointEx(_para1,_para2.X,_para2.Y,_para3);
-end;
-
-function DragDetect(hwnd:HWND; pt:POINT):WINBOOL; {external 'user32' name 'DragDetect'; bug report 1807. PM }
-begin
- DragDetect:=Internal_DragDetect(hWnd, pt.X, pt.Y);
-end;
-
-function GetLargestConsoleWindowSize(hConsoleOutput:HANDLE):COORD;
-var
- res : dword;
-begin
- res:=InternalGetLargestConsoleWindowSize(hConsoleOutput);
- GetLargestConsoleWindowSize:=COORD(res);
-end;
-
-function LBItemFromPt(hLB:HWND; pt:POINT; bAutoScroll:WINBOOL):Integer; { external 'comctl32' bug report 1807. PM }
-begin
- LBItemFromPt:=Internal_LBItemFromPt(hLB, pt.X, pt.Y, bAutoScroll);
-end;
-
-function MenuItemFromPoint(hWnd:HWND; hMenu:HMENU; ptScreen:POINT):Integer; {external 'user32' name 'MenuItemFromPoint'; bug report 1807. PM }
-begin
- MenuItemFromPoint:=Internal_MenuItemFromPoint(hWnd, hMenu, ptScreen.X, ptScreen.Y);
-end;
-function PtInRect(var lprc:RECT; pt:POINT):WINBOOL;
-begin
- PtInRect:=Internal_PtInRect(lprc,pt.X,pt.Y);
-end;
-function PtInRect(lprc:LPRECT; pt:POINT):WINBOOL;
-begin
- PtInRect:=Internal_PtInRect(lprc^,pt.X,pt.Y);
-end;
-
-function WindowFromPoint(Point:POINT):HWND;
-begin
- WindowFromPoint:=Internal_WindowFromPoint(Point.X, Point.Y);
-end;
-//end win32 only
-
-//begin win32 or wince not checked
-
-//end win32 or wince not checked
-
-{$endif WIN32}
-
-
-{$endif read_implementation}
-
diff --git a/rtl/wince/wininc/makefile.inc b/rtl/wince/wininc/makefile.inc deleted file mode 100644 index 812c10e76f..0000000000 --- a/rtl/wince/wininc/makefile.inc +++ /dev/null @@ -1 +0,0 @@ -WINDOWS_FILES=base errors defines struct redef unidef func
diff --git a/rtl/wince/wininc/messages.inc b/rtl/wince/wininc/messages.inc deleted file mode 100644 index 164b50a1c0..0000000000 --- a/rtl/wince/wininc/messages.inc +++ /dev/null @@ -1,1314 +0,0 @@ -{ - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2000 by Florian Klaempfl, - member of the Free Pascal development team. - - 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. - - **********************************************************************} - -{ - Messages.h Windows32 API message definitions - Copyright (C) 1996 Free Software Foundation, Inc. - - Author: Scott Christley <scottc@net-community.com> - - This file is part of the Windows32 API Library. - - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Library General Public - License as published by the Free Software Foundation; either - version 2 of the License, or (at your option) any later version. - - - This library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Library General Public License for more details. - - - If you are interested in a warranty or support for this source code, - contact Scott Christley <scottc@net-community.com> for more information. - - - You should have received a copy of the GNU Library General Public - License along with this library; see the file COPYING.LIB. - If not, write to the Free Software Foundation, - - 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. - - Changes : - - 08/15/2005 update for wince4.2 port,ORO06 -} - -{$ifdef read_interface} - - const - ACM_OPENW = 1127; - ACM_OPENA = 1124; - {$ifdef UNICODE} - const - ACM_OPEN = ACM_OPENW; - {$else} - const - ACM_OPEN = ACM_OPENA; - {$endif} - { UNICODE } - - const - ACM_PLAY = 1125; - ACM_STOP = 1126; - ACN_START = 1; - ACN_STOP = 2; - { Buttons } - BM_CLICK = 245; - BM_GETCHECK = 240; - BM_GETIMAGE = 246; - BM_GETSTATE = 242; - BM_SETCHECK = 241; - BM_SETIMAGE = 247; - BM_SETSTATE = 243; - BM_SETSTYLE = 244; - BN_CLICKED = 0; - BN_DBLCLK = 5; - BN_DISABLE = 4; - BN_DOUBLECLICKED = 5; - BN_HILITE = 2; - BN_KILLFOCUS = 7; - BN_PAINT = 1; - BN_PUSHED = 2; - BN_SETFOCUS = 6; - BN_UNHILITE = 3; - BN_UNPUSHED = 3; - { Combo Box } - CB_ADDSTRING = 323; - CB_DELETESTRING = 324; - CB_DIR = 325; - CB_FINDSTRING = 332; - CB_FINDSTRINGEXACT = 344; - CB_GETCOUNT = 326; - CB_GETCURSEL = 327; - CB_GETDROPPEDCONTROLRECT = 338; - CB_GETDROPPEDSTATE = 343; - CB_GETDROPPEDWIDTH = 351; - CB_GETEDITSEL = 320; - CB_GETEXTENDEDUI = 342; - CB_GETHORIZONTALEXTENT = 349; - CB_GETITEMDATA = 336; - CB_GETITEMHEIGHT = 340; - CB_GETLBTEXT = 328; - CB_GETLBTEXTLEN = 329; - CB_GETLOCALE = 346; - CB_GETTOPINDEX = 347; - CB_INITSTORAGE = 353; - CB_INSERTSTRING = 330; - CB_LIMITTEXT = 321; - CB_RESETCONTENT = 331; - CB_SELECTSTRING = 333; - CB_SETCURSEL = 334; - CB_SETDROPPEDWIDTH = 352; - CB_SETEDITSEL = 322; - CB_SETEXTENDEDUI = 341; - CB_SETHORIZONTALEXTENT = 350; - CB_SETITEMDATA = 337; - CB_SETITEMHEIGHT = 339; - CB_SETLOCALE = 345; - CB_SETTOPINDEX = 348; - CB_SHOWDROPDOWN = 335; - { Combo Box notifications } - CBN_CLOSEUP = 8; - CBN_DBLCLK = 2; - CBN_DROPDOWN = 7; - CBN_EDITCHANGE = 5; - CBN_EDITUPDATE = 6; - CBN_ERRSPACE = -(1); - CBN_KILLFOCUS = 4; - CBN_SELCHANGE = 1; - CBN_SELENDCANCEL = 10; - CBN_SELENDOK = 9; - CBN_SETFOCUS = 3; - { Control Panel } - { Device messages } - { Drag list box } - DL_BEGINDRAG = 1157; - DL_CANCELDRAG = 1160; - DL_DRAGGING = 1158; - DL_DROPPED = 1159; - { Default push button } - DM_GETDEFID = 1024; - DM_REPOSITION = 1026; - DM_SETDEFID = 1025; - { RTF control } - EM_CANPASTE = 1074; - EM_CANUNDO = 198; - EM_CHARFROMPOS = 215; - EM_DISPLAYBAND = 1075; - EM_EMPTYUNDOBUFFER = 205; - EM_EXGETSEL = 1076; - EM_EXLIMITTEXT = 1077; - EM_EXLINEFROMCHAR = 1078; - EM_EXSETSEL = 1079; - EM_FINDTEXT = 1080; - EM_FINDTEXTEX = 1103; - EM_FINDWORDBREAK = 1100; - EM_FMTLINES = 200; - EM_FORMATRANGE = 1081; - EM_GETCHARFORMAT = 1082; - EM_GETEVENTMASK = 1083; - EM_GETFIRSTVISIBLELINE = 206; - EM_GETHANDLE = 189; - EM_GETLIMITTEXT = 213; - EM_GETLINE = 196; - EM_GETLINECOUNT = 186; - EM_GETMARGINS = 212; - EM_GETMODIFY = 184; - EM_GETIMECOLOR = 1129; - EM_GETIMEOPTIONS = 1131; - EM_GETOPTIONS = 1102; - EM_GETOLEINTERFACE = 1084; - EM_GETPARAFORMAT = 1085; - EM_GETPASSWORDCHAR = 210; - EM_GETPUNCTUATION = 1125; - EM_GETRECT = 178; - EM_GETSEL = 176; - EM_GETSELTEXT = 1086; - EM_GETTEXTRANGE = 1099; - EM_GETTHUMB = 190; - EM_GETWORDBREAKPROC = 209; - EM_GETWORDBREAKPROCEX = 1104; - EM_GETWORDWRAPMODE = 1127; - EM_HIDESELECTION = 1087; - EM_LIMITTEXT = 197; - EM_LINEFROMCHAR = 201; - EM_LINEINDEX = 187; - EM_LINELENGTH = 193; - EM_LINESCROLL = 182; - EM_PASTESPECIAL = 1088; - EM_POSFROMCHAR = 214; - EM_REPLACESEL = 194; - EM_REQUESTRESIZE = 1089; - EM_SCROLL = 181; - EM_SCROLLCARET = 183; - EM_SELECTIONTYPE = 1090; - EM_SETBKGNDCOLOR = 1091; - EM_SETCHARFORMAT = 1092; - EM_SETEVENTMASK = 1093; - EM_SETHANDLE = 188; - EM_SETIMECOLOR = 1128; - EM_SETIMEOPTIONS = 1130; - EM_SETLIMITTEXT = 197; - EM_SETMARGINS = 211; - EM_SETMODIFY = 185; - EM_SETOLECALLBACK = 1094; - EM_SETOPTIONS = 1101; - EM_SETPARAFORMAT = 1095; - EM_SETPASSWORDCHAR = 204; - EM_SETPUNCTUATION = 1124; - EM_SETREADONLY = 207; - EM_SETRECT = 179; - EM_SETRECTNP = 180; - EM_SETSEL = 177; - EM_SETTABSTOPS = 203; - EM_SETTARGETDEVICE = 1096; - EM_SETWORDBREAKPROC = 208; - EM_SETWORDBREAKPROCEX = 1105; - EM_SETWORDWRAPMODE = 1126; - EM_STREAMIN = 1097; - EM_STREAMOUT = 1098; - EM_UNDO = 199; - { Edit control } - EN_CHANGE = 768; - EN_CORRECTTEXT = 1797; - EN_DROPFILES = 1795; - EN_ERRSPACE = 1280; - EN_HSCROLL = 1537; - EN_IMECHANGE = 1799; - EN_KILLFOCUS = 512; - EN_MAXTEXT = 1281; - EN_MSGFILTER = 1792; - EN_OLEOPFAILED = 1801; - EN_PROTECTED = 1796; - EN_REQUESTRESIZE = 1793; - EN_SAVECLIPBOARD = 1800; - EN_SELCHANGE = 1794; - EN_SETFOCUS = 256; - EN_STOPNOUNDO = 1798; - EN_UPDATE = 1024; - EN_VSCROLL = 1538; - { File Manager extensions } - { File Manager extensions DLL events } - { Header control } - HDM_DELETEITEM = 4610; - HDM_GETITEMW = 4619; - HDM_INSERTITEMW = 4618; - HDM_SETITEMW = 4620; - HDM_GETITEMA = 4611; - HDM_INSERTITEMA = 4609; - HDM_SETITEMA = 4612; -{$ifdef UNICODE} - - const - HDM_GETITEM = HDM_GETITEMW; - HDM_INSERTITEM = HDM_INSERTITEMW; - HDM_SETITEM = HDM_SETITEMW; -{$else} - - const - HDM_GETITEM = HDM_GETITEMA; - HDM_INSERTITEM = HDM_INSERTITEMA; - HDM_SETITEM = HDM_SETITEMA; -{$endif} - { UNICODE } - - const - HDM_GETITEMCOUNT = 4608; - HDM_HITTEST = 4614; - HDM_LAYOUT = 4613; - { Header control notifications } - HDN_BEGINTRACKW = -(326); - HDN_DIVIDERDBLCLICKW = -(325); - HDN_ENDTRACKW = -(327); - HDN_ITEMCHANGEDW = -(321); - HDN_ITEMCHANGINGW = -(320); - HDN_ITEMCLICKW = -(322); - HDN_ITEMDBLCLICKW = -(323); - HDN_TRACKW = -(328); - HDN_BEGINTRACKA = -(306); - HDN_DIVIDERDBLCLICKA = -(305); - HDN_ENDTRACKA = -(307); - HDN_ITEMCHANGEDA = -(301); - HDN_ITEMCHANGINGA = -(300); - HDN_ITEMCLICKA = -(302); - HDN_ITEMDBLCLICKA = -(303); - HDN_TRACKA = -(308); -{$ifdef UNICODE} - - const - HDN_BEGINTRACK = HDN_BEGINTRACKW; - HDN_DIVIDERDBLCLICK = HDN_DIVIDERDBLCLICKW; - HDN_ENDTRACK = HDN_ENDTRACKW; - HDN_ITEMCHANGED = HDN_ITEMCHANGEDW; - HDN_ITEMCHANGING = HDN_ITEMCHANGINGW; - HDN_ITEMCLICK = HDN_ITEMCLICKW; - HDN_ITEMDBLCLICK = HDN_ITEMDBLCLICKW; - HDN_TRACK = HDN_TRACKW; -{$else} - - const - HDN_BEGINTRACK = HDN_BEGINTRACKA; - HDN_DIVIDERDBLCLICK = HDN_DIVIDERDBLCLICKA; - HDN_ENDTRACK = HDN_ENDTRACKA; - HDN_ITEMCHANGED = HDN_ITEMCHANGEDA; - HDN_ITEMCHANGING = HDN_ITEMCHANGINGA; - HDN_ITEMCLICK = HDN_ITEMCLICKA; - HDN_ITEMDBLCLICK = HDN_ITEMDBLCLICKA; - HDN_TRACK = HDN_TRACKA; -{$endif} - { UNICODE } - { Hot key control } - - const - HKM_GETHOTKEY = 1026; - HKM_SETHOTKEY = 1025; - HKM_SETRULES = 1027; - { List box } - LB_ADDFILE = 406; - LB_ADDSTRING = 384; - LB_DELETESTRING = 386; - LB_DIR = 397; - LB_FINDSTRING = 399; - LB_FINDSTRINGEXACT = 418; - LB_GETANCHORINDEX = 413; - LB_GETCARETINDEX = 415; - LB_GETCOUNT = 395; - LB_GETCURSEL = 392; - LB_GETHORIZONTALEXTENT = 403; - LB_GETITEMDATA = 409; - LB_GETITEMHEIGHT = 417; - LB_GETITEMRECT = 408; - LB_GETLOCALE = 422; - LB_GETSEL = 391; - LB_GETSELCOUNT = 400; - LB_GETSELITEMS = 401; - LB_GETTEXT = 393; - LB_GETTEXTLEN = 394; - LB_GETTOPINDEX = 398; - LB_INITSTORAGE = 424; - LB_INSERTSTRING = 385; - LB_ITEMFROMPOINT = 425; - LB_RESETCONTENT = 388; - LB_SELECTSTRING = 396; - LB_SELITEMRANGE = 411; - LB_SELITEMRANGEEX = 387; - LB_SETANCHORINDEX = 412; - LB_SETCARETINDEX = 414; - LB_SETCOLUMNWIDTH = 405; - LB_SETCOUNT = 423; - LB_SETCURSEL = 390; - LB_SETHORIZONTALEXTENT = 404; - LB_SETITEMDATA = 410; - LB_SETITEMHEIGHT = 416; - LB_SETLOCALE = 421; - LB_SETSEL = 389; - LB_SETTABSTOPS = 402; - LB_SETTOPINDEX = 407; - { List box notifications } - LBN_DBLCLK = 2; - LBN_ERRSPACE = -(2); - LBN_KILLFOCUS = 5; - LBN_SELCANCEL = 3; - LBN_SELCHANGE = 1; - LBN_SETFOCUS = 4; - { List view control } - LVM_ARRANGE = 4118; - LVM_CREATEDRAGIMAGE = 4129; - LVM_DELETEALLITEMS = 4105; - LVM_DELETECOLUMN = 4124; - LVM_DELETEITEM = 4104; - LVM_ENSUREVISIBLE = 4115; - LVM_GETBKCOLOR = 4096; - LVM_GETCALLBACKMASK = 4106; - LVM_GETCOLUMNWIDTH = 4125; - LVM_GETCOUNTPERPAGE = 4136; - LVM_GETEDITCONTROL = 4120; - LVM_GETIMAGELIST = 4098; - LVM_EDITLABELW = 4214; - LVM_FINDITEMW = 4179; - LVM_GETCOLUMNW = 4191; - LVM_GETISEARCHSTRINGW = 4213; - LVM_GETITEMW = 4171; - LVM_GETITEMTEXTW = 4211; - LVM_GETSTRINGWIDTHW = 4183; - LVM_INSERTCOLUMNW = 4193; - LVM_INSERTITEMW = 4173; - LVM_SETCOLUMNW = 4192; - LVM_SETITEMW = 4172; - LVM_SETITEMTEXTW = 4212; - LVM_EDITLABELA = 4119; - LVM_FINDITEMA = 4109; - LVM_GETCOLUMNA = 4121; - LVM_GETISEARCHSTRINGA = 4148; - LVM_GETITEMA = 4101; - LVM_GETITEMTEXTA = 4141; - LVM_GETSTRINGWIDTHA = 4113; - LVM_INSERTCOLUMNA = 4123; - LVM_INSERTITEMA = 4103; - LVM_SETCOLUMNA = 4122; - LVM_SETITEMA = 4102; - LVM_SETITEMTEXTA = 4142; -{$ifdef UNICODE} - - const - LVM_EDITLABEL = LVM_EDITLABELW; - LVM_FINDITEM = LVM_FINDITEMW; - LVM_GETCOLUMN = LVM_GETCOLUMNW; - LVM_GETISEARCHSTRING = LVM_GETISEARCHSTRINGW; - LVM_GETITEM = LVM_GETITEMW; - LVM_GETITEMTEXT = LVM_GETITEMTEXTW; - LVM_GETSTRINGWIDTH = LVM_GETSTRINGWIDTHW; - LVM_INSERTCOLUMN = LVM_INSERTCOLUMNW; - LVM_INSERTITEM = LVM_INSERTITEMW; - LVM_SETCOLUMN = LVM_SETCOLUMNW; - LVM_SETITEM = LVM_SETITEMW; - LVM_SETITEMTEXT = LVM_SETITEMTEXTW; -{$else} - - const - LVM_EDITLABEL = LVM_EDITLABELA; - LVM_FINDITEM = LVM_FINDITEMA; - LVM_GETCOLUMN = LVM_GETCOLUMNA; - LVM_GETISEARCHSTRING = LVM_GETISEARCHSTRINGA; - LVM_GETITEM = LVM_GETITEMA; - LVM_GETITEMTEXT = LVM_GETITEMTEXTA; - LVM_GETSTRINGWIDTH = LVM_GETSTRINGWIDTHA; - LVM_INSERTCOLUMN = LVM_INSERTCOLUMNA; - LVM_INSERTITEM = LVM_INSERTITEMA; - LVM_SETCOLUMN = LVM_SETCOLUMNA; - LVM_SETITEM = LVM_SETITEMA; - LVM_SETITEMTEXT = LVM_SETITEMTEXTA; -{$endif} - { UNICODE } - - const - LVM_GETITEMCOUNT = 4100; - LVM_GETITEMPOSITION = 4112; - LVM_GETITEMRECT = 4110; - LVM_GETITEMSPACING = 4147; - LVM_GETITEMSTATE = 4140; - LVM_GETNEXTITEM = 4108; - LVM_GETORIGIN = 4137; - LVM_GETSELECTEDCOUNT = 4146; - LVM_GETTEXTBKCOLOR = 4133; - LVM_GETTEXTCOLOR = 4131; - LVM_GETTOPINDEX = 4135; - LVM_GETVIEWRECT = 4130; - LVM_HITTEST = 4114; - LVM_REDRAWITEMS = 4117; - LVM_SCROLL = 4116; - LVM_SETBKCOLOR = 4097; - LVM_SETCALLBACKMASK = 4107; - LVM_SETCOLUMNWIDTH = 4126; - LVM_SETIMAGELIST = 4099; - LVM_SETITEMCOUNT = 4143; - LVM_SETITEMPOSITION = 4111; - LVM_SETITEMPOSITION32 = 4145; - LVM_SETITEMSTATE = 4139; - LVM_SETTEXTBKCOLOR = 4134; - LVM_SETTEXTCOLOR = 4132; - LVM_SORTITEMS = 4144; - LVM_UPDATE = 4138; - { List view control notifications } - LVN_BEGINDRAG = -(109); - LVN_BEGINRDRAG = -(111); - LVN_COLUMNCLICK = -(108); - LVN_DELETEALLITEMS = -(104); - LVN_DELETEITEM = -(103); - LVN_BEGINLABELEDITW = -(175); - LVN_ENDLABELEDITW = -(176); - LVN_GETDISPINFOW = -(177); - LVN_SETDISPINFOW = -(178); - LVN_BEGINLABELEDITA = -(105); - LVN_ENDLABELEDITA = -(106); - LVN_GETDISPINFOA = -(150); - LVN_SETDISPINFOA = -(151); -{$ifdef UNICODE} - - const - LVN_BEGINLABELEDIT = LVN_BEGINLABELEDITW; - LVN_ENDLABELEDIT = LVN_ENDLABELEDITW; - LVN_GETDISPINFO = LVN_GETDISPINFOW; - LVN_SETDISPINFO = LVN_SETDISPINFOW; -{$else} - - const - LVN_BEGINLABELEDIT = LVN_BEGINLABELEDITA; - LVN_ENDLABELEDIT = LVN_ENDLABELEDITA; - LVN_GETDISPINFO = LVN_GETDISPINFOA; - LVN_SETDISPINFO = LVN_SETDISPINFOA; -{$endif} - { UNICODE } - - const - LVN_INSERTITEM = -(102); - LVN_ITEMCHANGED = -(101); - LVN_ITEMCHANGING = -(100); - LVN_KEYDOWN = -(155); - { Control notification } - NM_CLICK = -(2); - NM_DBLCLK = -(3); - NM_KILLFOCUS = -(8); - NM_OUTOFMEMORY = -(1); - NM_RCLICK = -(5); - NM_RDBLCLK = -(6); - NM_RETURN = -(4); - NM_SETFOCUS = -(7); - { Power status } - { Progress bar control } - PBM_DELTAPOS = 1027; - PBM_SETPOS = 1026; - PBM_SETRANGE = 1025; - PBM_SETSTEP = 1028; - PBM_STEPIT = 1029; - { Property sheets } - PSM_ADDPAGE = 1127; - PSM_APPLY = 1134; - PSM_CANCELTOCLOSE = 1131; - PSM_CHANGED = 1128; - PSM_GETTABCONTROL = 1140; - PSM_GETCURRENTPAGEHWND = 1142; - PSM_ISDIALOGMESSAGE = 1141; - PSM_PRESSBUTTON = 1137; - PSM_QUERYSIBLINGS = 1132; - PSM_REBOOTSYSTEM = 1130; - PSM_REMOVEPAGE = 1126; - PSM_RESTARTWINDOWS = 1129; - PSM_SETCURSEL = 1125; - PSM_SETCURSELID = 1138; - PSM_SETFINISHTEXTW = 1145; - PSM_SETTITLEW = 1144; - PSM_SETFINISHTEXTA = 1139; - PSM_SETTITLEA = 1135; -{$ifdef UNICODE} - - const - PSM_SETFINISHTEXT = PSM_SETFINISHTEXTW; - PSM_SETTITLE = PSM_SETTITLEW; -{$else} - - const - PSM_SETFINISHTEXT = PSM_SETFINISHTEXTA; - PSM_SETTITLE = PSM_SETTITLEA; -{$endif} - { UNICODE } - - const - PSM_SETWIZBUTTONS = 1136; - PSM_UNCHANGED = 1133; - { Property sheet notifications } - PSN_APPLY = -(202); - PSN_HELP = -(205); - PSN_KILLACTIVE = -(201); - PSN_QUERYCANCEL = -(209); - PSN_RESET = -(203); - PSN_SETACTIVE = -(200); - PSN_WIZBACK = -(206); - PSN_WIZFINISH = -(208); - PSN_WIZNEXT = -(207); - { Status window } - SB_GETBORDERS = 1031; - SB_GETPARTS = 1030; - SB_GETRECT = 1034; - SB_GETTEXTW = 1037; - SB_GETTEXTLENGTHW = 1036; - SB_SETTEXTW = 1035; - SB_GETTEXTA = 1026; - SB_GETTEXTLENGTHA = 1027; - SB_SETTEXTA = 1025; -{$ifdef UNICODE} - - const - SB_GETTEXT = SB_GETTEXTW; - SB_GETTEXTLENGTH = SB_GETTEXTLENGTHW; - SB_SETTEXT = SB_SETTEXTW; -{$else} - - const - SB_GETTEXT = SB_GETTEXTA; - SB_GETTEXTLENGTH = SB_GETTEXTLENGTHA; - SB_SETTEXT = SB_SETTEXTA; -{$endif} - { UNICODE } - - const - SB_SETMINHEIGHT = 1032; - SB_SETPARTS = 1028; - SB_SIMPLE = 1033; - { Scroll bar control } - SBM_ENABLE_ARROWS = 228; - SBM_GETPOS = 225; - SBM_GETRANGE = 227; - SBM_GETSCROLLINFO = 234; - SBM_SETPOS = 224; - SBM_SETRANGE = 226; - SBM_SETRANGEREDRAW = 230; - SBM_SETSCROLLINFO = 233; - { Static control } - STM_GETICON = 369; - STM_GETIMAGE = 371; - STM_SETICON = 368; - STM_SETIMAGE = 370; - { Static control notifications } - STN_CLICKED = 0; - STN_DBLCLK = 1; - STN_DISABLE = 3; - STN_ENABLE = 2; - { Toolbar control } - TB_ADDBITMAP = 1043; - TB_ADDBUTTONS = 1044; - TB_AUTOSIZE = 1057; - TB_BUTTONCOUNT = 1048; - TB_BUTTONSTRUCTSIZE = 1054; - TB_CHANGEBITMAP = 1067; - TB_CHECKBUTTON = 1026; - TB_COMMANDTOINDEX = 1049; - TB_CUSTOMIZE = 1051; - TB_DELETEBUTTON = 1046; - TB_ENABLEBUTTON = 1025; - TB_GETBITMAP = 1068; - TB_GETBITMAPFLAGS = 1065; - TB_GETBUTTON = 1047; - TB_ADDSTRINGW = 1101; - TB_GETBUTTONTEXTW = 1099; - TB_SAVERESTOREW = 1100; - TB_ADDSTRINGA = 1052; - TB_GETBUTTONTEXTA = 1069; - TB_SAVERESTOREA = 1050; -{$ifdef UNICODE} - - const - TB_ADDSTRING = TB_ADDSTRINGW; - TB_GETBUTTONTEXT = TB_GETBUTTONTEXTW; - TB_SAVERESTORE = TB_SAVERESTOREW; -{$else} - - const - TB_ADDSTRING = TB_ADDSTRINGA; - TB_GETBUTTONTEXT = TB_GETBUTTONTEXTA; - TB_SAVERESTORE = TB_SAVERESTOREA; -{$endif} - { UNICODE } - - const - TB_GETITEMRECT = 1053; - TB_GETROWS = 1064; - TB_GETSTATE = 1042; - TB_GETTOOLTIPS = 1059; - TB_HIDEBUTTON = 1028; - TB_INDETERMINATE = 1029; - TB_INSERTBUTTON = 1045; - TB_ISBUTTONCHECKED = 1034; - TB_ISBUTTONENABLED = 1033; - TB_ISBUTTONHIDDEN = 1036; - TB_ISBUTTONINDETERMINATE = 1037; - TB_ISBUTTONPRESSED = 1035; - TB_PRESSBUTTON = 1027; - TB_SETBITMAPSIZE = 1056; - TB_SETBUTTONSIZE = 1055; - TB_SETCMDID = 1066; - TB_SETPARENT = 1061; - TB_SETROWS = 1063; - TB_SETSTATE = 1041; - TB_SETTOOLTIPS = 1060; - { Track bar control } - TBM_CLEARSEL = 1043; - TBM_CLEARTICS = 1033; - TBM_GETCHANNELRECT = 1050; - TBM_GETLINESIZE = 1048; - TBM_GETNUMTICS = 1040; - TBM_GETPAGESIZE = 1046; - TBM_GETPOS = 1024; - TBM_GETPTICS = 1038; - TBM_GETRANGEMAX = 1026; - TBM_GETRANGEMIN = 1025; - TBM_GETSELEND = 1042; - TBM_GETSELSTART = 1041; - TBM_GETTHUMBLENGTH = 1052; - TBM_GETTHUMBRECT = 1049; - TBM_GETTIC = 1027; - TBM_GETTICPOS = 1039; - TBM_SETLINESIZE = 1047; - TBM_SETPAGESIZE = 1045; - TBM_SETPOS = 1029; - TBM_SETRANGE = 1030; - TBM_SETRANGEMAX = 1032; - TBM_SETRANGEMIN = 1031; - TBM_SETSEL = 1034; - TBM_SETSELEND = 1036; - TBM_SETSELSTART = 1035; - TBM_SETTHUMBLENGTH = 1051; - TBM_SETTIC = 1028; - TBM_SETTICFREQ = 1044; - { Tool bar control notifications } - TBN_BEGINADJUST = -(703); - TBN_BEGINDRAG = -(701); - TBN_CUSTHELP = -(709); - TBN_ENDADJUST = -(704); - TBN_ENDDRAG = -(702); - TBN_GETBUTTONINFOW = -(720); - TBN_GETBUTTONINFOA = -(700); - -{$ifdef UNICODE} - - const - TBN_GETBUTTONINFO = TBN_GETBUTTONINFOW; -{$else} - - const - TBN_GETBUTTONINFO = TBN_GETBUTTONINFOA; -{$endif} - { UNICODE } - - const - TBN_QUERYDELETE = -(707); - TBN_QUERYINSERT = -(706); - TBN_RESET = -(705); - TBN_TOOLBARCHANGE = -(708); - { Tab control } - TCM_ADJUSTRECT = 4904; - TCM_DELETEALLITEMS = 4873; - TCM_DELETEITEM = 4872; - TCM_GETCURFOCUS = 4911; - TCM_GETCURSEL = 4875; - TCM_GETIMAGELIST = 4866; - TCM_GETITEMW = 4924; - TCM_INSERTITEMW = 4926; - TCM_SETITEMW = 4925; - TCM_GETITEMA = 4869; - TCM_INSERTITEMA = 4871; - TCM_SETITEMA = 4870; - -{$ifdef UNICODE} - const - TCM_GETITEM = TCM_GETITEMW; //~wint, W was missing - TCM_INSERTITEM = TCM_INSERTITEMW; - TCM_SETITEM = TCM_SETITEMW; -{$else} - - const - TCM_GETITEM = TCM_GETITEMA; - TCM_INSERTITEM = TCM_INSERTITEMA; - TCM_SETITEM = TCM_SETITEMA; -{$endif} - { UNICODE } - - const - TCM_GETITEMCOUNT = 4868; - TCM_GETITEMRECT = 4874; - TCM_GETROWCOUNT = 4908; - TCM_GETTOOLTIPS = 4909; - TCM_HITTEST = 4877; - TCM_REMOVEIMAGE = 4906; - TCM_SETCURFOCUS = 4912; - TCM_SETCURSEL = 4876; - TCM_SETIMAGELIST = 4867; - TCM_SETITEMEXTRA = 4878; - TCM_SETITEMSIZE = 4905; - TCM_SETPADDING = 4907; - TCM_SETTOOLTIPS = 4910; - { Tab control notifications } - TCN_KEYDOWN = -(550); - TCN_SELCHANGE = -(551); - TCN_SELCHANGING = -(552); - { Tool tip control } - TTM_ACTIVATE = 1025; - TTM_ADDTOOLW = 1074; - TTM_DELTOOLW = 1075; - TTM_ENUMTOOLSW = 1082; - TTM_GETCURRENTTOOLW = 1083; - TTM_GETTEXTW = 1080; - TTM_GETTOOLINFOW = 1077; - TTM_HITTESTW = 1079; - TTM_NEWTOOLRECTW = 1076; - TTM_SETTOOLINFOW = 1078; - TTM_UPDATETIPTEXTW = 1081; - TTM_ADDTOOLA = 1028; - TTM_DELTOOLA = 1029; - TTM_ENUMTOOLSA = 1038; - TTM_GETCURRENTTOOLA = 1039; - TTM_GETTEXTA = 1035; - TTM_GETTOOLINFOA = 1032; - TTM_HITTESTA = 1034; - TTM_NEWTOOLRECTA = 1030; - TTM_SETTOOLINFOA = 1033; - TTM_UPDATETIPTEXTA = 1036; -{$ifdef UNICODE} - - const - TTM_ADDTOOL = TTM_ADDTOOLW; - TTM_DELTOOL = TTM_DELTOOLW; - TTM_ENUMTOOLS = TTM_ENUMTOOLSW; - TTM_GETCURRENTTOOL = TTM_GETCURRENTTOOLW; - TTM_GETTEXT = TTM_GETTEXTW; - TTM_GETTOOLINFO = TTM_GETTOOLINFOW; - TTM_HITTEST = TTM_HITTESTW; - TTM_NEWTOOLRECT = TTM_NEWTOOLRECTW; - TTM_SETTOOLINFO = TTM_SETTOOLINFOW; - TTM_UPDATETIPTEXT = TTM_UPDATETIPTEXTW; -{$else} - - const - TTM_ADDTOOL = TTM_ADDTOOLA; - TTM_DELTOOL = TTM_DELTOOLA; - TTM_ENUMTOOLS = TTM_ENUMTOOLSA; - TTM_GETCURRENTTOOL = TTM_GETCURRENTTOOLA; - TTM_GETTEXT = TTM_GETTEXTA; - TTM_GETTOOLINFO = TTM_GETTOOLINFOA; - TTM_HITTEST = TTM_HITTESTA; - TTM_NEWTOOLRECT = TTM_NEWTOOLRECTA; - TTM_SETTOOLINFO = TTM_SETTOOLINFOA; - TTM_UPDATETIPTEXT = TTM_UPDATETIPTEXTA; -{$endif} - { UNICODE } - - const - TTM_GETTOOLCOUNT = 1037; - TTM_RELAYEVENT = 1031; - TTM_SETDELAYTIME = 1027; - TTM_WINDOWFROMPOINT = 1040; - { Tool tip control notification } - TTN_NEEDTEXTW = -(530); - TTN_NEEDTEXTA = -(520); -{$ifdef UNICODE} - - const - TTN_NEEDTEXT = TTN_NEEDTEXTW; -{$else} - - const - TTN_NEEDTEXT = TTN_NEEDTEXTA; -{$endif} - { UNICODE } - - const - TTN_POP = -(522); - TTN_SHOW = -(521); - { Tree view control } - TVM_CREATEDRAGIMAGE = 4370; - TVM_DELETEITEM = 4353; - TVM_ENDEDITLABELNOW = 4374; - TVM_ENSUREVISIBLE = 4372; - TVM_EXPAND = 4354; - TVM_GETCOUNT = 4357; - TVM_GETEDITCONTROL = 4367; - TVM_GETIMAGELIST = 4360; - TVM_GETINDENT = 4358; - TVM_GETITEMRECT = 4356; - TVM_GETNEXTITEM = 4362; - TVM_GETVISIBLECOUNT = 4368; - TVM_HITTEST = 4369; - TVM_EDITLABELW = 4417; - TVM_GETISEARCHSTRINGW = 4416; - TVM_GETITEMW = 4414; - TVM_INSERTITEMW = 4402; - TVM_SETITEMW = 4415; - TVM_EDITLABELA = 4366; - TVM_GETISEARCHSTRINGA = 4375; - TVM_GETITEMA = 4364; - TVM_INSERTITEMA = 4352; - TVM_SETITEMA = 4365; -{$ifdef UNICODE} - - const - TVM_EDITLABEL = TVM_EDITLABELW; - TVM_GETISEARCHSTRING = TVM_GETISEARCHSTRINGW; - TVM_GETITEM = TVM_GETITEMW; - TVM_INSERTITEM = TVM_INSERTITEMW; - TVM_SETITEM = TVM_SETITEMW; -{$else} - - const - TVM_EDITLABEL = TVM_EDITLABELA; - TVM_GETISEARCHSTRING = TVM_GETISEARCHSTRINGA; - TVM_GETITEM = TVM_GETITEMA; - TVM_INSERTITEM = TVM_INSERTITEMA; - TVM_SETITEM = TVM_SETITEMA; -{$endif} - { UNICODE } - - const - TVM_SELECTITEM = 4363; - TVM_SETIMAGELIST = 4361; - TVM_SETINDENT = 4359; - TVM_SORTCHILDREN = 4371; - TVM_SORTCHILDRENCB = 4373; - { Tree view control notification } - TVN_KEYDOWN = -(412); - TVN_BEGINDRAGW = -(456); - TVN_BEGINLABELEDITW = -(459); - TVN_BEGINRDRAGW = -(457); - TVN_DELETEITEMW = -(458); - TVN_ENDLABELEDITW = -(460); - TVN_GETDISPINFOW = -(452); - TVN_ITEMEXPANDEDW = -(455); - TVN_ITEMEXPANDINGW = -(454); - TVN_SELCHANGEDW = -(451); - TVN_SELCHANGINGW = -(450); - TVN_SETDISPINFOW = -(453); - TVN_BEGINDRAGA = -(407); - TVN_BEGINLABELEDITA = -(410); - TVN_BEGINRDRAGA = -(408); - TVN_DELETEITEMA = -(409); - TVN_ENDLABELEDITA = -(411); - TVN_GETDISPINFOA = -(403); - TVN_ITEMEXPANDEDA = -(406); - TVN_ITEMEXPANDINGA = -(405); - TVN_SELCHANGEDA = -(402); - TVN_SELCHANGINGA = -(401); - TVN_SETDISPINFOA = -(404); -{$ifdef UNICODE} - - const - TVN_BEGINDRAG = TVN_BEGINDRAGW; - TVN_BEGINLABELEDIT = TVN_BEGINLABELEDITW; - TVN_BEGINRDRAG = TVN_BEGINRDRAGW; - TVN_DELETEITEM = TVN_DELETEITEMW; - TVN_ENDLABELEDIT = TVN_ENDLABELEDITW; - TVN_GETDISPINFO = TVN_GETDISPINFOW; - TVN_ITEMEXPANDED = TVN_ITEMEXPANDEDW; - TVN_ITEMEXPANDING = TVN_ITEMEXPANDINGW; - TVN_SELCHANGED = TVN_SELCHANGEDW; - TVN_SELCHANGING = TVN_SELCHANGINGW; - TVN_SETDISPINFO = TVN_SETDISPINFOW; -{$else} - - const - TVN_BEGINDRAG = TVN_BEGINDRAGA; - TVN_BEGINLABELEDIT = TVN_BEGINLABELEDITA; - TVN_BEGINRDRAG = TVN_BEGINRDRAGA; - TVN_DELETEITEM = TVN_DELETEITEMA; - TVN_ENDLABELEDIT = TVN_ENDLABELEDITA; - TVN_GETDISPINFO = TVN_GETDISPINFOA; - TVN_ITEMEXPANDED = TVN_ITEMEXPANDEDA; - TVN_ITEMEXPANDING = TVN_ITEMEXPANDINGA; - TVN_SELCHANGED = TVN_SELCHANGEDA; - TVN_SELCHANGING = TVN_SELCHANGINGA; - TVN_SETDISPINFO = TVN_SETDISPINFOA; -{$endif} - { UNICODE } - { Up/down control } - - const - UDM_GETACCEL = 1132; - UDM_GETBASE = 1134; - UDM_GETBUDDY = 1130; - UDM_GETPOS = 1128; - UDM_GETPOS32 = 1138; - UDM_GETRANGE = 1126; - UDM_GETRANGE32 = 1136; - UDM_SETACCEL = 1131; - UDM_SETBASE = 1133; - UDM_SETBUDDY = 1129; - UDM_SETPOS = 1127; - UDM_SETPOS32 = 1137; - UDM_SETRANGE = 1125; - UDM_SETRANGE32 = 1135; - { Up/down control notification } - UDN_DELTAPOS = -(722); - { Window messages } - WM_ACTIVATE = 6; - WM_ACTIVATEAPP = 28; - WM_ASKCBFORMATNAME = 780; - WM_CANCELJOURNAL = 75; - WM_CANCELMODE = 31; - WM_CAPTURECHANGED = 533; - WM_CHANGECBCHAIN = 781; - WM_CHAR = 258; - WM_CHARTOITEM = 47; - WM_CHILDACTIVATE = 34; - WM_CHOOSEFONT_GETLOGFONT = 1025; - WM_CHOOSEFONT_SETLOGFONT = 1125; - WM_CHOOSEFONT_SETFLAGS = 1126; - WM_CLEAR = 771; - WM_CLOSE = 16; - WM_COMMAND = 273; - WM_COMPACTING = 65; - WM_COMPAREITEM = 57; - WM_CONTEXTMENU = 123; - WM_COPY = 769; - WM_COPYDATA = 74; - WM_CREATE = 1; - WM_CTLCOLORBTN = 309; - WM_CTLCOLORDLG = 310; - WM_CTLCOLOREDIT = 307; - WM_CTLCOLORLISTBOX = 308; - WM_CTLCOLORMSGBOX = 306; - WM_CTLCOLORSCROLLBAR = 311; - WM_CTLCOLORSTATIC = 312; - WM_CUT = 768; - WM_DEADCHAR = 259; - WM_DELETEITEM = 45; - WM_DESTROY = 2; - WM_DESTROYCLIPBOARD = 775; - WM_DEVICECHANGE = 537; - WM_DEVMODECHANGE = 27; - WM_DISPLAYCHANGE = 126; - WM_DRAWCLIPBOARD = 776; - WM_DRAWITEM = 43; - WM_DROPFILES = 563; - WM_ENABLE = 10; - WM_ENDSESSION = 22; - WM_ENTERIDLE = 289; - WM_ENTERMENULOOP = 529; - WM_ENTERSIZEMOVE = 561; - WM_ERASEBKGND = 20; - WM_EXITMENULOOP = 530; - WM_EXITSIZEMOVE = 562; - WM_FONTCHANGE = 29; - WM_GETDLGCODE = 135; - WM_GETFONT = 49; - WM_GETHOTKEY = 51; - WM_GETICON = 127; - WM_GETMINMAXINFO = 36; - WM_GETTEXT = 13; - WM_GETTEXTLENGTH = 14; - WM_HELP = 83; - WM_HOTKEY = 786; - WM_HSCROLL = 276; - WM_HSCROLLCLIPBOARD = 782; - WM_ICONERASEBKGND = 39; - WM_IME_CHAR = 646; - WM_IME_COMPOSITION = 271; - WM_IME_COMPOSITIONFULL = 644; - WM_IME_CONTROL = 643; - WM_IME_ENDCOMPOSITION = 270; - WM_IME_KEYDOWN = 656; - WM_IME_KEYUP = 657; - WM_IME_NOTIFY = 642; - WM_IME_SELECT = 645; - WM_IME_SETCONTEXT = 641; - WM_IME_STARTCOMPOSITION = 269; - WM_INITDIALOG = 272; - WM_INITMENU = 278; - WM_INITMENUPOPUP = 279; - WM_INPUTLANGCHANGE = 81; - WM_INPUTLANGCHANGEREQUEST = 80; - WM_KEYDOWN = 256; - WM_KEYUP = 257; - WM_KILLFOCUS = 8; - WM_LBUTTONDBLCLK = 515; - WM_LBUTTONDOWN = 513; - WM_LBUTTONUP = 514; - WM_MBUTTONDBLCLK = 521; - WM_MBUTTONDOWN = 519; - WM_MBUTTONUP = 520; - WM_MDIACTIVATE = 546; - WM_MDICASCADE = 551; - WM_MDICREATE = 544; - WM_MDIDESTROY = 545; - WM_MDIGETACTIVE = 553; - WM_MDIICONARRANGE = 552; - WM_MDIMAXIMIZE = 549; - WM_MDINEXT = 548; - WM_MDIREFRESHMENU = 564; - WM_MDIRESTORE = 547; - WM_MDISETMENU = 560; - WM_MDITILE = 550; - WM_MEASUREITEM = 44; - WM_MENUCHAR = 288; - WM_MENUSELECT = 287; - WM_MOUSEACTIVATE = 33; - WM_MOUSEMOVE = 512; - WM_MOUSEWHEEL = 522; - WM_MOUSEHOVER = 673; - WM_MOUSELEAVE = 675; - WM_MOVE = 3; - WM_MOVING = 534; - WM_NCACTIVATE = 134; - WM_NCCALCSIZE = 131; - WM_NCCREATE = 129; - WM_NCDESTROY = 130; - WM_NCHITTEST = 132; - WM_NCLBUTTONDBLCLK = 163; - WM_NCLBUTTONDOWN = 161; - WM_NCLBUTTONUP = 162; - WM_NCMBUTTONDBLCLK = 169; - WM_NCMBUTTONDOWN = 167; - WM_NCMBUTTONUP = 168; - WM_NCMOUSEMOVE = 160; - WM_NCPAINT = 133; - WM_NCRBUTTONDBLCLK = 166; - WM_NCRBUTTONDOWN = 164; - WM_NCRBUTTONUP = 165; - WM_NEXTDLGCTL = 40; - WM_NOTIFY = 78; - WM_NOTIFYFORMAT = 85; - WM_NULL = 0; - WM_PAINT = 15; - WM_PAINTCLIPBOARD = 777; - WM_PAINTICON = 38; - WM_PALETTECHANGED = 785; - WM_PALETTEISCHANGING = 784; - WM_PARENTNOTIFY = 528; - WM_PASTE = 770; - WM_PENWINFIRST = 896; - WM_PENWINLAST = 911; - WM_POWER = 72; - WM_POWERBROADCAST = 536; - WM_PRINT = 791; - WM_PRINTCLIENT = 792; - WM_PSD_ENVSTAMPRECT = 1029; - WM_PSD_FULLPAGERECT = 1025; - WM_PSD_GREEKTEXTRECT = 1028; - WM_PSD_MARGINRECT = 1027; - WM_PSD_MINMARGINRECT = 1026; - WM_PSD_PAGESETUPDLG = 1024; - WM_PSD_YAFULLPAGERECT = 1030; - WM_QUERYDRAGICON = 55; - WM_QUERYENDSESSION = 17; - WM_QUERYNEWPALETTE = 783; - WM_QUERYOPEN = 19; - WM_QUEUESYNC = 35; - WM_QUIT = 18; - WM_RBUTTONDBLCLK = 518; - WM_RBUTTONDOWN = 516; - WM_RBUTTONUP = 517; - WM_RENDERALLFORMATS = 774; - WM_RENDERFORMAT = 773; - WM_SETCURSOR = 32; - WM_SETFOCUS = 7; - WM_SETFONT = 48; - WM_SETHOTKEY = 50; - WM_SETICON = 128; - WM_SETREDRAW = 11; - WM_SETTEXT = 12; - WM_SETTINGCHANGE = 26; - WM_SHOWWINDOW = 24; - WM_SIZE = 5; - WM_SIZECLIPBOARD = 779; - WM_SIZING = 532; - WM_SPOOLERSTATUS = 42; - WM_STYLECHANGED = 125; - WM_STYLECHANGING = 124; - WM_SYSCHAR = 262; - WM_SYSCOLORCHANGE = 21; - WM_SYSCOMMAND = 274; - WM_SYSDEADCHAR = 263; - WM_SYSKEYDOWN = 260; - WM_SYSKEYUP = 261; - WM_TCARD = 82; - WM_TIMECHANGE = 30; - WM_TIMER = 275; - WM_UNDO = 772; - WM_USER = 1024; - WM_USERCHANGED = 84; - WM_VKEYTOITEM = 46; - WM_VSCROLL = 277; - WM_VSCROLLCLIPBOARD = 778; - WM_WINDOWPOSCHANGED = 71; - WM_WINDOWPOSCHANGING = 70; - WM_WININICHANGE = 26; - { Window message ranges } - WM_KEYFIRST = 256; - WM_KEYLAST = 264; - WM_MOUSEFIRST = 512; - WM_MOUSELAST = 525; - WM_XBUTTONDOWN = 523; - WM_XBUTTONUP = 524; - WM_XBUTTONDBLCLK = 525; - -Type -{$ifdef MESSAGESUNIT} - - MSG = Windows.MSG; - TMessage = Windows.TMessage; - TWMSize = Windows.TWMSize; - TWMNoParams = Windows.TWMNoParams; - TWMScroll = Windows.TWMScroll; - TWMGetText = Windows.TWMGetText; - TWMKillFocus = Windows.TWMKillFocus; - TWMSetCursor = Windows.TWMSetCursor; - TWMSetFocus = Windows.TWMSetFocus; - TWMSetFont = Windows.TWMSetFont; - TWMShowWindow = Windows.TWMShowWindow; - TWMEraseBkgnd = Windows.TWMEraseBkgnd; - LPMSG = Windows.MSG; - tagMSG = Windows.tagMSG; - TMSG = Windows.TMSG; - PMSG = Windows.PMSG; - PMessage = Windows.PMessage; - TWMGetDlgCode = TWMNoParams; - TWMFontChange = TWMNoParams; - TWMGetFont = TWMNoParams; - TWMHScroll = TWMScroll; - TWMVScroll = TWMScroll; - TWMGetTextLength = TWMNoParams; - -{$else} - - MSG = record - hwnd : HWND; - message : UINT; - wParam : WPARAM; - lParam : LPARAM; - time : DWORD; - pt : POINT; - end; - - LPMSG = ^MSG; - tagMSG = MSG; - TMSG = MSG; - PMSG = ^MSG; - - - PMessage = ^TMessage; - TMessage = packed record {fields according to ICS} - msg : UINT; - case longint of - 0: ( - wParam : WPARAM; - lParam : LPARAM; - Result : LRESULT; - ); - 1: ( - wParamlo, - wParamhi : WORD; // Is there Windows type for half an wparam? - lParamlo, - lParamhi : WORD; - Resultlo, - Resulthi : WORD; - ); - end; - - TWMSize = packed record - Msg: Cardinal; - SizeType : LongInt; - Width : Word; - Height : Word; - Result : LongInt; - End; - - TWMNoParams = packed record - Msg : Cardinal; - Unused : array[0..3] of Word; - Result : Longint; - end; - - TWMGetDlgCode = TWMNoParams; - TWMFontChange = TWMNoParams; - TWMGetFont = TWMNoParams; - - TWMScroll = record - Msg : Cardinal; - ScrollCode : SmallInt; - Pos : SmallInt; - ScrollBar : HWND; - Result : LongInt; - end; - - TWMHScroll = TWMScroll; - TWMVScroll = TWMScroll; - - TWMGetText = packed record - Msg : Cardinal; - TextMax : LongInt; - Text : PChar; - Result : LongInt; - end; - - TWMGetTextLength = TWMNoParams; - - TWMKillFocus = packed record - Msg : Cardinal; - FocusedWnd : HWND; - UnUsed : LongInt; - Result : LongInt; - End; - - TWMSetCursor = packed record - Msg : Cardinal; - CursorWnd : HWND; - HitTest : Word; - MouseMsg : Word; - Result : LongInt; - end; - - TWMSetFocus = packed record - Msg : Cardinal; - FocusedWnd : HWND; - Unused : LongInt; - Result : LongInt; - end; - - TWMSetFont = packed record - Msg : Cardinal; - Font : HFONT; - Redraw : WordBool; - Unused : Word; - Result : LongInt; - end; - - TWMShowWindow = packed record - Msg : Cardinal; - Show : BOOL; - Status : LongInt; - Result : LongInt; - end; - - TWMEraseBkgnd = packed record - Msg: Cardinal; - DC: HDC; - Unused: Longint; - Result: Longint; - end; - -{$endif messagesunit} - -{$endif read_interface} - diff --git a/rtl/wince/wininc/redef.inc b/rtl/wince/wininc/redef.inc deleted file mode 100644 index 4229cc7a2e..0000000000 --- a/rtl/wince/wininc/redef.inc +++ /dev/null @@ -1,1116 +0,0 @@ -{
- This file is part of the Free Pascal run time library.
- Copyright (c) 1999-2001 by the Free Pascal development team
-
- This file defines type names as they are used by Delphi
-
- 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.
-
- **********************************************************************
-
- Changes :
-
- 22/15/2005 update for wince4.2 port, orinaudo@gmail.com
-
-}
-
-{$ifdef read_interface}
-
-//begin common win32 & wince
-
-//
-// A language ID is a 16 bit value which is the combination of a
-// primary language ID and a secondary language ID. The bits are
-// allocated as follows:
-//
-// +-----------------------+-------------------------+
-// | Sublanguage ID | Primary Language ID |
-// +-----------------------+-------------------------+
-// 15 10 9 0 bit
-//
-//
-// Language ID creation/extraction macros:
-//
-// MAKELANGID - construct language id from a primary language id and
-// a sublanguage id.
-// PRIMARYLANGID - extract primary language id from a language id.
-// SUBLANGID - extract sublanguage id from a language id.
-//
-
-function MAKELANGID(PrimaryLang, SubLang: USHORT): WORD;
-function PRIMARYLANGID(LangId: WORD): WORD;
-function SUBLANGID(LangId: WORD): WORD;
-
-//
-// A locale ID is a 32 bit value which is the combination of a
-// language ID, a sort ID, and a reserved area. The bits are
-// allocated as follows:
-//
-// +-------------+---------+-------------------------+
-// | Reserved | Sort ID | Language ID |
-// +-------------+---------+-------------------------+
-// 31 20 19 16 15 0 bit
-//
-//
-// Locale ID creation/extraction macros:
-//
-// MAKELCID - construct the locale id from a language id and a sort id.
-// MAKESORTLCID - construct the locale id from a language id, sort id, and sort version.
-// LANGIDFROMLCID - extract the language id from a locale id.
-// SORTIDFROMLCID - extract the sort id from a locale id.
-// SORTVERSIONFROMLCID - extract the sort version from a locale id.
-//
-
-const
- NLS_VALID_LOCALE_MASK = $000fffff; //winnt
-
-function MAKELCID(LangId, SortId: WORD): DWORD; //winnt
-function MAKESORTLCID(LangId, SortId, SortVersion: WORD): DWORD; //winnt
-function LANGIDFROMLCID(LocaleId: LCID): WORD; //winnt
-function SORTIDFROMLCID(LocaleId: LCID): WORD; //winnt
-function SORTVERSIONFROMLCID(LocaleId: LCID): WORD; //winnt
-
-//
-// Default System and User IDs for language and locale.
-//
-
-function LANG_SYSTEM_DEFAULT: WORD; //winnt
-function LANG_USER_DEFAULT: WORD; //winnt
-function LOCALE_SYSTEM_DEFAULT: DWORD; //+winnt
-function LOCALE_USER_DEFAULT: DWORD; //+winnt
-function LOCALE_NEUTRAL: DWORD; //winnt
-function LOCALE_INVARIANT: DWORD; //winnt
-
-
-function GetVersionExW(var lpVersionInformation: TOSVersionInfoW): BOOL; external KernelDLL name 'GetVersionExW';
-procedure GetLocalTime(var SystemTime: SYSTEMTIME); external KernelDLL name 'GetLocalTime';
-function SetLocalTime(var lpSystemTime:SYSTEMTIME):WINBOOL; external KernelDLL name 'SetLocalTime';
-function CreateProcessW(lpApplicationName: LPWSTR; lpCommandLine: LPWSTR; lpProcessAttributes, lpThreadAttributes: PSecurityAttributes; bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer; lpCurrentDirectory: LPWSTR;
- const lpStartupInfo: TStartupInfo; var lpProcessInformation: TProcessInformation): BOOL; external KernelDLL name 'CreateProcessW';
-function GetExitCodeProcess(hProcess: THandle; var lpExitCode: DWORD): BOOL; external KernelDLL name 'GetExitCodeProcess';
-function ReadFile(hFile: THandle; var Buffer; nNumberOfBytesToRead: DWORD; var lpNumberOfBytesRead: DWORD; lpOverlapped: POverlapped): BOOL; external KernelDLL name 'ReadFile';
-function WriteFile(hFile: THandle; const Buffer; nNumberOfBytesToWrite: DWORD; var lpNumberOfBytesWritten: DWORD; lpOverlapped: POverlapped): BOOL; external KernelDLL name 'WriteFile';
-function SetFileTime(hFile:HANDLE; var lpCreationTime:FILETIME; var lpLastAccessTime:FILETIME; var lpLastWriteTime:FILETIME):WINBOOL; external KernelDLL name 'SetFileTime';
-procedure EnterCriticalSection(var CriticalSection : TRTLCriticalSection); external KernelDLL name 'EnterCriticalSection';
-procedure LeaveCriticalSection(var CriticalSection : TRTLCriticalSection); external KernelDLL name 'LeaveCriticalSection';
-function RegisterClassW(const lpWndClass: TWndClassW): ATOM; external UserDLLCore name 'RegisterClassW';
-//redirected to MsgWaitForMultipleObjectsEx
-function MsgWaitForMultipleObjects(nCount: DWORD; var pHandles; fWaitAll: BOOL; dwMilliseconds, dwWakeMask: DWORD): DWORD;
-function PeekMessageW(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external UserDLLCore name 'PeekMessageW';
-function GetExitCodeThread(hThread: THandle; var lpExitCode: DWORD): BOOL; external KernelDLL name 'GetExitCodeThread';
-//end common win32 & wince
-
-{$ifdef WINCE}
-//begin wince only
-function GetVersionEx(var lpVersionInformation: TOSVersionInfo): BOOL;external KernelDLL name 'GetVersionExW';
-function CreateProcess(lpApplicationName: LPTSTR; lpCommandLine: LPTSTR; lpProcessAttributes, lpThreadAttributes: PSecurityAttributes; bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer; lpCurrentDirectory: LPTSTR;
- const lpStartupInfo: LPStartupInfo; var lpProcessInformation: TProcessInformation): BOOL;external KernelDLL name 'CreateProcessW';
-function FindFirstFile(lpFileName: LPTSTR; var lpFindFileData: TWIN32FindData): THandle; external KernelDLL name 'FindFirstFileW';
-function FindNextFile(hFindFile: THandle; var lpFindFileData: TWIN32FindData): BOOL; external KernelDLL name 'FindNextFileW';
-function RegisterClass(const lpWndClass: TWndClass): ATOM;external UserDLLCore name 'RegisterClassW';
-function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL;external UserDLLCore name 'PeekMessageW';
-//end wince only
-{$endif WINCE}
-
-{$ifdef WIN32}
-//begin win32 only ie not exist in wince4.2 second release lib imported functions from dlls
-function GetVersionExA(var lpVersionInformation: TOSVersionInfo): BOOL; external 'kernel32' name 'GetVersionExA';
-function CreateProcessA(lpApplicationName: LPCSTR; lpCommandLine: LPCSTR; lpProcessAttributes, lpThreadAttributes: PSecurityAttributes; bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer; lpCurrentDirectory: LPCSTR;
- const lpStartupInfo: TStartupInfo; var lpProcessInformation: TProcessInformation): BOOL; external 'kernel32' name 'CreateProcessA';
-//end win32 only
-{$endif WIN32}
-
-{$ifdef WIN32}
-//begin win32 or wince not checked
-type
- PIID = PGUID;
- TIID = TGUID;
- THANDLE = HANDLE;
-
- PSmallRect = ^TSmallRect;
- TSmallRect = SMALL_RECT;
-
- PCharInfo = ^TCharInfo;
- TCharInfo = _CHAR_INFO;
-
- TFarProc = FARPROC;
- TFNDlgProc = FARPROC;
- TFNThreadStartRoutine = FARPROC;
- TFNTimerAPCRoutine = FARPROC;
- TFNFiberStartRoutine = FARPROC;
-
- PObjectTypeList = ^TObjectTypeList;
- _OBJECT_TYPE_LIST = record
- Level: WORD;
- Sbz: WORD;
- ObjectType: PGUID;
- end;
- TObjectTypeList = _OBJECT_TYPE_LIST;
- OBJECT_TYPE_LIST = _OBJECT_TYPE_LIST;
-
- AUDIT_EVENT_TYPE = DWORD;
-
- PBlendFunction = ^TBlendFunction;
- _BLENDFUNCTION = packed record
- BlendOp: BYTE;
- BlendFlags: BYTE;
- SourceConstantAlpha: BYTE;
- AlphaFormat: BYTE;
- end;
- TBlendFunction = _BLENDFUNCTION;
- BLENDFUNCTION = _BLENDFUNCTION;
-
- _WIN_CERTIFICATE = Packed Record
- dwLength : DWord;
- wRevision : Word;
- wCertificateType : Word;
- bCertificate : Array[0..0] of Byte;
- End;
- TWinCertificate = _WIN_CERTIFICATE;
- PWinCertificate = ^TWinCertificate;
-
- TMaxLogPalette = Packed Record
- palVersion : Word;
- palNumEntries : Word;
- palPalEntry : array[Byte] of TPaletteEntry;
- end;
- PMaxLogPalette = ^TMaxLogPalette;
-
-
-const
- { dll names }
- advapi32 = 'advapi32.dll';
- kernel32 = 'kernel32.dll';
- mpr = 'mpr.dll';
- version = 'version.dll';
- comctl32 = 'comctl32.dll';
- gdi32 = 'gdi32.dll';
- opengl32 = 'opengl32.dll';
- user32 = 'user32.dll';
- wintrust = 'wintrust.dll';
-
- { Openfile Share modes normally declared in sysutils }
- fmShareCompat = $00000000;
- fmShareExclusive = $10;
- fmShareDenyWrite = $20;
- fmShareDenyRead = $30;
- fmShareDenyNone = $40;
-
- { HRESULT codes, delphilike }
- NOERROR = 0;
-
-const
- { Severity values }
- FACILITY_NT_BIT = $10000000;
- HFILE_ERROR = HFILE(-1);
-
-function Succeeded(Status : HRESULT) : BOOL;
-function Failed(Status : HRESULT) : BOOL;
-function IsError(Status : HRESULT) : BOOL;
-function HResultCode(hr : HRESULT) : Longint;
-function HResultFacility(hr : HRESULT) : Longint;
-function HResultSeverity(hr : HRESULT) : Longint;
-function MakeResult(p1,p2,mask : Longint) : HRESULT;
-function HResultFromWin32(x : Longint) : HRESULT;
-function HResultFromNT(x : Longint) : HRESULT;
-
-procedure InitializeCriticalSection(var CriticalSection : TRTLCriticalSection); external 'kernel32' name 'InitializeCriticalSection';
-procedure DeleteCriticalSection(var CriticalSection : TRTLCriticalSection); external 'kernel32' name 'DeleteCriticalSection';
-function InitializeCriticalSectionAndSpinCount(var CriticalSection : TRTLCriticalSection;dwSpinCount : DWORD) : BOOL; external 'kernel32' name 'InitializeCriticalSectionAndSpinCount';
-function SetCriticalSectionSpinCount(var CriticalSection : TRTLCriticalSection;dwSpinCount : DWORD ): DWORD; external 'kernel32' name 'SetCriticalSectionSpinCount';
-function TryEnterCriticalSection(var CriticalSection : TRTLCriticalSection) : BOOL; external 'kernel32' name 'TryEnterCriticalSection';
-
-//function _lwrite(hFile: HFILE; const lpBuffer: LPCSTR; uBytes: UINT): UINT; external 'kernel32' name '_lwrite';
-//function AccessCheck(pSecurityDescriptor: PSecurityDescriptor; ClientToken: THandle; DesiredAccess: DWORD; const GenericMapping: TGenericMapping; var PrivilegeSet: TPrivilegeSet; var PrivilegeSetLength: DWORD; var GrantedAccess: DWORD;
-// var AccessStatus: BOOL): BOOL; external 'advapi32' name 'AccessCheck';
-//function AccessCheckAndAuditAlarm(SubsystemName: PChar; HandleId: Pointer; ObjectTypeName, ObjectName: PChar; SecurityDescriptor: PSecurityDescriptor; DesiredAccess: DWORD; const GenericMapping: TGenericMapping; ObjectCreation: BOOL;
-// var GrantedAccess: DWORD; var AccessStatus, pfGenerateOnClose: BOOL): BOOL; external 'advapi32' name 'AccessCheckAndAuditAlarmA';
-//function AccessCheckAndAuditAlarmA(SubsystemName: LPCSTR; HandleId: Pointer; ObjectTypeName, ObjectName: LPCSTR; SecurityDescriptor: PSecurityDescriptor; DesiredAccess: DWORD; const GenericMapping: TGenericMapping; ObjectCreation: BOOL;
-// var GrantedAccess: DWORD; var AccessStatus, pfGenerateOnClose: BOOL): BOOL; external 'advapi32' name 'AccessCheckAndAuditAlarmA';
-//function AccessCheckAndAuditAlarmW(SubsystemName: LPWSTR; HandleId: Pointer; ObjectTypeName, ObjectName: LPWSTR; SecurityDescriptor: PSecurityDescriptor; DesiredAccess: DWORD; const GenericMapping: TGenericMapping; ObjectCreation: BOOL;
-// var GrantedAccess: DWORD; var AccessStatus, pfGenerateOnClose: BOOL): BOOL; external 'advapi32' name 'AccessCheckAndAuditAlarmW';
-//function AccessCheckByType(pSecurityDescriptor: PSecurityDescriptor; PrincipalSelfSid: PSID; ClientToken: THandle; DesiredAccess: DWORD; ObjectTypeList: PObjectTypeList; const GenericMapping: TGenericMapping; ObjectTypeListLength: DWORD;
-// var PrivilegeSet: TPrivilegeSet; var PrivilegeSetLength: DWORD; var GrantedAccess: DWORD; var AccessStatus: BOOL): BOOL;external 'advapi32' name 'AccessCheckByType';
-//function AccessCheckByTypeAndAuditAlarm(SubsystemName: PChar; HandleId: Pointer; ObjectTypeName, ObjectName: PChar; SecurityDescriptor: PSecurityDescriptor; PrincipalSelfSid: PSID; DesiredAccess: DWORD; AuditType: AUDIT_EVENT_TYPE; Flags: DWORD;
-// ObjectTypeList: PObjectTypeList; ObjectTypeListLength: DWORD; const GenericMapping: TGenericMapping; ObjectCreation: BOOL; var GrantedAccess: DWORD; var AccessStatus, pfGenerateOnClose: BOOL): BOOL;
-// external 'advapi32' name 'AccessCheckByTypeAndAuditAlarm';
-//function AccessCheckByTypeAndAuditAlarmA(SubsystemName: LPCSTR; HandleId: Pointer; ObjectTypeName, ObjectName: LPCSTR; SecurityDescriptor: PSecurityDescriptor; PrincipalSelfSid: PSID; DesiredAccess: DWORD; AuditType: AUDIT_EVENT_TYPE; Flags: DWORD;
-// ObjectTypeList: PObjectTypeList; ObjectTypeListLength: DWORD; const GenericMapping: TGenericMapping; ObjectCreation: BOOL; var GrantedAccess: DWORD; var AccessStatus, pfGenerateOnClose: BOOL): BOOL;
-// external 'advapi32' name 'AccessCheckByTypeAndAuditAlarmA';
-//function AccessCheckByTypeAndAuditAlarmW(SubsystemName: LPWSTR; HandleId: Pointer; ObjectTypeName, ObjectName: LPWSTR; SecurityDescriptor: PSecurityDescriptor; PrincipalSelfSid: PSID; DesiredAccess: DWORD; AuditType: AUDIT_EVENT_TYPE; Flags: DWORD;
-// ObjectTypeList: PObjectTypeList; ObjectTypeListLength: DWORD; const GenericMapping: TGenericMapping; ObjectCreation: BOOL; var GrantedAccess: DWORD; var AccessStatus, pfGenerateOnClose: BOOL): BOOL;
-// external 'advapi32' name 'AccessCheckByTypeAndAuditAlarmW';
-//function AccessCheckByTypeResultList(pSecurityDescriptor: PSecurityDescriptor; PrincipalSelfSid: PSID; ClientToken: THandle; DesiredAccess: DWORD; ObjectTypeList: PObjectTypeList; const GenericMapping: TGenericMapping; ObjectTypeListLength: DWORD;
-// var PrivilegeSet: TPrivilegeSet; var PrivilegeSetLength: DWORD; var GrantedAccess: DWORD; var AccessStatusList: DWORD): BOOL;external 'advapi32' name 'AccessCheckByTypeResultList';
-//function AccessCheckByTypeResultListAndAuditAlarm(SubsystemName: PChar; HandleId: Pointer; ObjectTypeName, ObjectName: PChar; SecurityDescriptor: PSecurityDescriptor; PrincipalSelfSid: PSID; DesiredAccess: DWORD; AuditType: AUDIT_EVENT_TYPE;
-// Flags: DWORD; ObjectTypeList: PObjectTypeList; ObjectTypeListLength: DWORD; const GenericMapping: TGenericMapping; ObjectCreation: BOOL; var GrantedAccess: DWORD; var AccessStatusList: DWORD; var pfGenerateOnClose: BOOL): BOOL;
-// external 'advapi32' name 'AccessCheckByTypeResultListAndAuditAlarmA';
-//function AccessCheckByTypeResultListAndAuditAlarmA(SubsystemName: LPCSTR; HandleId: Pointer; ObjectTypeName, ObjectName: LPCSTR; SecurityDescriptor: PSecurityDescriptor; PrincipalSelfSid: PSID; DesiredAccess: DWORD; AuditType: AUDIT_EVENT_TYPE;
-// Flags: DWORD; ObjectTypeList: PObjectTypeList; ObjectTypeListLength: DWORD; const GenericMapping: TGenericMapping; ObjectCreation: BOOL; var GrantedAccess: DWORD; var AccessStatusList: DWORD; var pfGenerateOnClose: BOOL): BOOL;
-// external 'advapi32' name 'AccessCheckByTypeResultListAndAuditAlarmA';
-//function AccessCheckByTypeResultListAndAuditAlarmW(SubsystemName: LPWSTR; HandleId: Pointer; ObjectTypeName, ObjectName: LPWSTR; SecurityDescriptor: PSecurityDescriptor; PrincipalSelfSid: PSID; DesiredAccess: DWORD; AuditType: AUDIT_EVENT_TYPE;
-// Flags: DWORD; ObjectTypeList: PObjectTypeList; ObjectTypeListLength: DWORD; const GenericMapping: TGenericMapping; ObjectCreation: BOOL; var GrantedAccess: DWORD; var AccessStatusList: DWORD; var pfGenerateOnClose: BOOL): BOOL;
-// external 'advapi32' name 'AccessCheckByTypeResultListAndAuditAlarmW';
-//function AddAccessAllowedAce(var pAcl: TACL; dwAceRevision: DWORD; AccessMask: DWORD; pSid: PSID): BOOL; external 'advapi32' name 'AddAccessAllowedAce';
-//function AddAccessAllowedAceEx(var pAcl: TACL; dwAceRevision: DWORD; AceFlags: DWORD; AccessMask: DWORD; pSid: PSID): BOOL;external 'advapi32' name 'AddAccessAllowedAceEx';
-//function AddAccessAllowedObjectAce(var pAcl: TACL; dwAceRevision: DWORD; AceFlags: DWORD; AccessMask: DWORD; ObjectTypeGuid, InheritedObjectTypeGuid: PGuid; pSid: Pointer): BOOL;external 'advapi32' name 'AddAccessAllowedObjectAce';
-//function AddAccessDeniedAce(var pAcl: TACL; dwAceRevision: DWORD; AccessMask: DWORD; pSid: PSID): BOOL; external 'advapi32' name 'AddAccessDeniedAce';
-//function AddAccessDeniedAceEx(var pAcl: TACL; dwAceRevision: DWORD; ACEFlags: DWORD; AccessMask: DWORD; pSid: PSID): BOOL;external 'advapi32' name 'AddAccessDeniedAceEx';
-//function AddAccessDeniedObjectAce(var pAcl: TACL; dwAceRevision: DWORD; AceFlags: DWORD; AccessMask: DWORD; ObjectTypeGuid, InheritedObjectTypeGuid: PGuid; pSid: Pointer): BOOL;external 'advapi32' name 'AddAccessDeniedObjectAce';
-//function AddAce(var pAcl: TACL; dwAceRevision, dwStartingAceIndex: DWORD; pAceList: Pointer; nAceListLength: DWORD): BOOL; external 'advapi32' name 'AddAce';
-//function AddAuditAccessAce(var pAcl: TACL; dwAceRevision: DWORD; dwAccessMask: DWORD; pSid: Pointer; bAuditSuccess, bAuditFailure: BOOL): BOOL; external 'advapi32' name 'AddAuditAccessAce';
-//function AddAuditAccessAceEx(var pAcl: TACL; dwAceRevision: DWORD; AceFlags: DWORD; dwAccessMask: DWORD; pSid: Pointer; bAuditSuccess, bAuditFailure: BOOL): BOOL;external 'advapi32' name 'AddAuditAccessAceEx';
-//function AddAuditAccessObjectAce(var pAcl: TACL; dwAceRevision: DWORD; AceFlags: DWORD; AccessMask: DWORD; ObjectTypeGuid, InheritedObjectTypeGuid: PGuid; pSid: Pointer; bAuditSuccess, bAuditFailure: BOOL): BOOL;
-// external 'advapi32' name 'AddAuditAccessObjectAce';
-//function AdjustTokenGroups(TokenHandle: THandle; ResetToDefault: BOOL; const NewState: TTokenGroups; BufferLength: DWORD; var PreviousState: TTokenGroups; var ReturnLength: DWORD): BOOL; external 'advapi32' name 'AdjustTokenGroups';
-function AdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BOOL; const NewState: TTokenPrivileges; BufferLength: DWORD;
- var PreviousState: TTokenPrivileges; var ReturnLength: DWORD): BOOL; external 'advapi32' name 'AdjustTokenPrivileges';
-function AdjustWindowRect(var lpRect: TRect; dwStyle: DWORD; bMenu: BOOL): BOOL; external 'user32' name 'AdjustWindowRect';
-function AdjustWindowRectEx(var lpRect: TRect; dwStyle: DWORD; bMenu: BOOL; dwExStyle: DWORD): BOOL; external 'user32' name 'AdjustWindowRectEx';
-function AllocateAndInitializeSid(const pIdentifierAuthority: TSIDIdentifierAuthority; nSubAuthorityCount: Byte; nSubAuthority0, nSubAuthority1: DWORD; nSubAuthority2, nSubAuthority3, nSubAuthority4: DWORD;
- nSubAuthority5, nSubAuthority6, nSubAuthority7:DWORD; var pSid: Pointer): BOOL; external 'advapi32' name 'AllocateAndInitializeSid';
-function AllocateLocallyUniqueId(var Luid: TLargeInteger): BOOL; external 'advapi32' name 'AllocateLocallyUniqueId';
-//function AlphaDIBBlend(DC: HDC; p2, p3, p4, p5: Integer; const p6: Pointer; const p7: PBitmapInfo; p8: UINT; p9, p10, p11, p12: Integer; p13: TBlendFunction): BOOL;external 'gdi32' name 'AlphaDIBBlend';
-function BackupRead(hFile: THandle; lpBuffer: PByte; nNumberOfBytesToRead: DWORD; var lpNumberOfBytesRead: DWORD; bAbort: BOOL; bProcessSecurity: BOOL; var lpContext: Pointer): BOOL; external 'kernel32' name 'BackupRead';
-function BackupSeek(hFile: THandle; dwLowBytesToSeek, dwHighBytesToSeek: DWORD; var lpdwLowByteSeeked, lpdwHighByteSeeked: DWORD; lpContext: Pointer): BOOL; external 'kernel32' name 'BackupSeek';
-function BackupWrite(hFile: THandle; lpBuffer: PByte; nNumberOfBytesToWrite: DWORD; var lpNumberOfBytesWritten: DWORD; bAbort, bProcessSecurity: BOOL; var lpContext: Pointer): BOOL; external 'kernel32' name 'BackupWrite';
-function BeginPaint(hWnd: HWND; var lpPaint: TPaintStruct): HDC; external 'user32' name 'BeginPaint';
-function BuildCommDCB(lpDef: PChar; var lpDCB: TDCB): BOOL;external 'kernel32' name 'BuildCommDCBA';
-function BuildCommDCBA(lpDef: LPCSTR; var lpDCB: TDCB): BOOL; external 'kernel32' name 'BuildCommDCBA';
-function BuildCommDCBAndTimeouts(lpDef: PChar; var lpDCB: TDCB; var lpCommTimeouts: TCommTimeouts): BOOL;external 'kernel32' name 'BuildCommDCBAndTimeoutsA';
-function BuildCommDCBAndTimeoutsA(lpDef: LPCSTR; var lpDCB: TDCB; var lpCommTimeouts: TCommTimeouts): BOOL; external 'kernel32' name 'BuildCommDCBAndTimeoutsA';
-function BuildCommDCBAndTimeoutsW(lpDef: LPWSTR; var lpDCB: TDCB; var lpCommTimeouts: TCommTimeouts): BOOL; external 'kernel32' name 'BuildCommDCBAndTimeoutsW';
-function BuildCommDCBW(lpDef: LPWSTR; var lpDCB: TDCB): BOOL; external 'kernel32' name 'BuildCommDCBW';
-function CallMsgFilter(var lpMsg: TMsg; nCode: Integer): BOOL;external 'user32' name 'CallMsgFilterA';
-function CallMsgFilterA(var lpMsg: TMsg; nCode: Integer): BOOL; external 'user32' name 'CallMsgFilterA';
-function CallMsgFilterW(var lpMsg: TMsg; nCode: Integer): BOOL; external 'user32' name 'CallMsgFilterW';
-function CallNamedPipe(lpNamedPipeName: PChar; lpInBuffer: Pointer; nInBufferSize: DWORD; lpOutBuffer: Pointer; nOutBufferSize: DWORD; var lpBytesRead: DWORD; nTimeOut: DWORD): BOOL;external 'kernel32' name 'CallNamedPipeA';
-function CallNamedPipeA(lpNamedPipeName: LPCSTR; lpInBuffer: Pointer; nInBufferSize: DWORD; lpOutBuffer: Pointer; nOutBufferSize: DWORD; var lpBytesRead: DWORD; nTimeOut: DWORD): BOOL; external 'kernel32' name 'CallNamedPipeA';
-function CallNamedPipeW(lpNamedPipeName: LPWSTR; lpInBuffer: Pointer; nInBufferSize: DWORD; lpOutBuffer: Pointer; nOutBufferSize: DWORD; var lpBytesRead: DWORD; nTimeOut: DWORD): BOOL; external 'kernel32' name 'CallNamedPipeW';
-function CoRegisterClassObject(const _para1:TCLSID; _para2:IUnknown; _para3:DWORD; _para4:DWORD; out_para5:DWORD):HRESULT;external 'ole32.dll' name 'CoRegisterClassObject';
-function ChangeDisplaySettings(var lpDevMode: TDeviceMode; dwFlags: DWORD): Longint;external 'user32' name 'ChangeDisplaySettingsA';
-function ChangeDisplaySettingsA(var lpDevMode: TDeviceModeA; dwFlags: DWORD): Longint; external 'user32' name 'ChangeDisplaySettingsA';
-{$ifdef support_smartlink}
-function ChangeDisplaySettingsEx(lpszDeviceName: PChar; var lpDevMode: TDeviceMode; wnd: HWND; dwFlags: DWORD; lParam: Pointer): Longint;external 'user32' name 'ChangeDisplaySettingsExA';
-function ChangeDisplaySettingsExA(lpszDeviceName: LPCSTR; var lpDevMode: TDeviceModeA; wnd: HWND; dwFlags: DWORD; lParam: Pointer): Longint;external 'user32' name 'ChangeDisplaySettingsExA';
-function ChangeDisplaySettingsExW(lpszDeviceName: LPWSTR; var lpDevMode: TDeviceModeW; wnd: HWND; dwFlags: DWORD; lParam: Pointer): Longint;external 'user32' name 'ChangeDisplaySettingsExW';
-{$endif support_smartlink}
-function ChangeDisplaySettingsW(var lpDevMode: TDeviceModeW; dwFlags: DWORD): Longint; external 'user32' name 'ChangeDisplaySettingsW';
-//function CheckColorsInGamut(DC: HDC; var RGBQuads, Results; Count: DWORD): BOOL; external 'gdi32' name 'CheckColorsInGamut';
-function ChoosePixelFormat(_para1:HDC; var _para2:PIXELFORMATDESCRIPTOR):longint; external 'gdi32' name 'ChoosePixelFormat';
-function ClearCommError(hFile: THandle; var lpErrors: DWORD; lpStat: PComStat): BOOL; external 'kernel32' name 'ClearCommError';
-function ClientToScreen(hWnd: HWND; var lpPoint: TPoint): BOOL; external 'user32' name 'ClientToScreen';
-function ClipCursor(var lpRect:RECT):WINBOOL; external 'user32' name 'ClipCursor';
-//function CombineTransform(var p1: TXForm; const p2, p3: TXForm): BOOL; external 'gdi32' name 'CombineTransform';
-function CommConfigDialog(lpszName: PChar; hWnd: HWND; var lpCC: TCommConfig): BOOL;external 'kernel32' name 'CommConfigDialogA';
-function CommConfigDialogA(lpszName: LPCSTR; hWnd: HWND; var lpCC: TCommConfig): BOOL; external 'kernel32' name 'CommConfigDialogA';
-function CommConfigDialogW(lpszName: LPWSTR; hWnd: HWND; var lpCC: TCommConfig): BOOL; external 'kernel32' name 'CommConfigDialogW';
-//function CompareFileTime(const lpFileTime1, lpFileTime2: TFileTime): Longint; external 'kernel32' name 'CompareFileTime';
-//function ConvertToAutoInheritPrivateObjectSecurity(ParentDescriptor, CurrentSecurityDescriptor: PSecurityDescriptor; var NewDescriptor: PSecurityDescriptor; ObjectType: PGUID; IsDirectoryObject: BOOL; const GenericMapping: TGenericMapping): BOOL;
-// external 'advapi32' name 'ConvertToAutoInheritPrivateObjectSecurity';
-function CopyAcceleratorTable(hAccelSrc: HACCEL; var lpAccelDst; cAccelEntries: Integer): Integer;external 'user32' name 'CopyAcceleratorTableA';
-function CopyAcceleratorTableA(hAccelSrc: HACCEL; var lpAccelDst; cAccelEntries: Integer): Integer; external 'user32' name 'CopyAcceleratorTableA';
-function CopyAcceleratorTableW(hAccelSrc: HACCEL; var lpAccelDst; cAccelEntries: Integer): Integer; external 'user32' name 'CopyAcceleratorTableW';
-function CopyRect(var lprcDst: TRect; const lprcSrc: TRect): BOOL; external 'user32' name 'CopyRect';
-function CreateAcceleratorTable(var Accel; Count: Integer): HACCEL;external 'user32' name 'CreateAcceleratorTableA';
-function CreateAcceleratorTableA(var Accel; Count: Integer): HACCEL; external 'user32' name 'CreateAcceleratorTableA';
-function CreateAcceleratorTableW(var Accel; Count: Integer): HACCEL; external 'user32' name 'CreateAcceleratorTableW';
-//function CreateBitmapIndirect(const p1: TBitmap): HBITMAP; external 'gdi32' name 'CreateBitmapIndirect';
-//function CreateBrushIndirect(const p1: TLogBrush): HBRUSH; external 'gdi32' name 'CreateBrushIndirect';
-function CreateColorSpace(var ColorSpace: TLogColorSpace): HCOLORSPACE;external 'gdi32' name 'CreateColorSpaceA';
-function CreateColorSpaceA(var ColorSpace: TLogColorSpaceA): HCOLORSPACE; external 'gdi32' name 'CreateColorSpaceA';
-//function CreateColorSpaceW(var ColorSpace: TLogColorSpaceW): HCOLORSPACE; external 'gdi32' name 'CreateColorSpaceW';
-function CreateDialogIndirectParam(hInstance: HINST; const lpTemplate: TDlgTemplate; hWndParent: HWND; lpDialogFunc: TFNDlgProc; dwInitParam: LPARAM): HWND;external 'user32' name 'CreateDialogIndirectParamA';
-//function CreateDialogIndirectParamA(hInstance: HINST; const lpTemplate: TDlgTemplate; hWndParent: HWND; lpDialogFunc: TFNDlgProc; dwInitParam: LPARAM): HWND; external 'user32' name 'CreateDialogIndirectParamA';
-//function CreateDialogIndirectParamW(hInstance: HINST; const lpTemplate: TDlgTemplate; hWndParent: HWND; lpDialogFunc: TFNDlgProc; dwInitParam: LPARAM): HWND; external 'user32' name 'CreateDialogIndirectParamW';
-//function CreateDIBitmap(DC: HDC; var InfoHeader: TBitmapInfoHeader; dwUsage: DWORD; InitBits: PChar; var InitInfo: TBitmapInfo; wUsage: UINT): HBITMAP; external 'gdi32' name 'CreateDIBitmap';
-//function CreateDIBPatternBrushPt(const p1: Pointer; p2: UINT): HBRUSH; external 'gdi32' name 'CreateDIBPatternBrushPt';
-//function CreateDIBSection(DC: HDC; const p2: TBitmapInfo; p3: UINT; var p4: Pointer; p5: THandle; p6: DWORD): HBITMAP; external 'gdi32' name 'CreateDIBSection';
-//function CreateEllipticRgnIndirect(const p1: TRect): HRGN; external 'gdi32' name 'CreateEllipticRgnIndirect';
-//function CreateFontIndirect(const p1: TLogFont): HFONT;external 'gdi32' name 'CreateFontIndirectA';
-//function CreateFontIndirectA(const p1: TLogFontA): HFONT; external 'gdi32' name 'CreateFontIndirectA';
-//function CreateFontIndirectEx(const p1: PEnumLogFontExDV): HFONT;external 'gdi32' name 'CreateFontIndirectExA';
-//function CreateFontIndirectExA(const p1: PEnumLogFontExDVA): HFONT;external 'gdi32' name 'CreateFontIndirectExA';
-//function CreateFontIndirectExW(const p1: PEnumLogFontExDVW): HFONT;external 'gdi32' name 'CreateFontIndirectExW';
-//function CreateFontIndirectW(const p1: TLogFontW): HFONT; external 'gdi32' name 'CreateFontIndirectW';
-function CreateIconIndirect(var piconinfo: TIconInfo): HICON; external 'user32' name 'CreateIconIndirect';
-//function CreatePalette(const LogPalette: TLogPalette): HPalette; external 'gdi32' name 'CreatePalette';
-//function CreatePenIndirect(const LogPen: TLogPen): HPEN; external 'gdi32' name 'CreatePenIndirect';
-function CreatePipe(var hReadPipe, hWritePipe: THandle; lpPipeAttributes: PSecurityAttributes; nSize: DWORD): BOOL; external 'kernel32' name 'CreatePipe';
-function CreatePolygonRgn(const Points; Count, FillMode: Integer): HRGN; external 'gdi32' name 'CreatePolygonRgn';
-function CreatePolyPolygonRgn(const pPtStructs; const pIntArray; p3, p4: Integer): HRGN; external 'gdi32' name 'CreatePolyPolygonRgn';
-//function CreatePrivateObjectSecurity(ParentDescriptor, CreatorDescriptor: PSecurityDescriptor; var NewDescriptor: PSecurityDescriptor; IsDirectoryObject: BOOL; Token: THandle; const GenericMapping: TGenericMapping): BOOL;
-// external 'advapi32' name 'CreatePrivateObjectSecurity';
-//function CreatePrivateObjectSecurityEx(ParentDescriptor, CreatorDescriptor: PSecurityDescriptor; var NewDescriptor: PSecurityDescriptor; ObjectType: PGUID; IsContainerObject: BOOL; AutoInheritFlags: ULONG; Token: THandle;
-// const GenericMapping: TGenericMapping): BOOL;external 'advapi32' name 'CreatePrivateObjectSecurityEx';
-//function CreateProcessAsUser(hToken: THandle; lpApplicationName: PChar; lpCommandLine: PChar; lpProcessAttributes: PSecurityAttributes; lpThreadAttributes: PSecurityAttributes; bInheritHandles: BOOL; dwCreationFlags: DWORD;
-// lpEnvironment: Pointer; lpCurrentDirectory: PChar; const lpStartupInfo: TStartupInfo; var lpProcessInformation: TProcessInformation): BOOL;external 'advapi32' name 'CreateProcessAsUserA';
-//function CreateProcessAsUserA(hToken: THandle; lpApplicationName: LPCSTR; lpCommandLine: LPCSTR; lpProcessAttributes: PSecurityAttributes; lpThreadAttributes: PSecurityAttributes; bInheritHandles: BOOL; dwCreationFlags: DWORD;
-// lpEnvironment: Pointer; lpCurrentDirectory: LPCSTR; const lpStartupInfo: TStartupInfo; var lpProcessInformation: TProcessInformation): BOOL; external 'advapi32' name 'CreateProcessAsUserA';
-//function CreateProcessAsUserW(hToken: THandle; lpApplicationName: LPWSTR; lpCommandLine: LPWSTR; lpProcessAttributes: PSecurityAttributes; lpThreadAttributes: PSecurityAttributes; bInheritHandles: BOOL; dwCreationFlags: DWORD;
-// lpEnvironment: Pointer; lpCurrentDirectory: LPWSTR; const lpStartupInfo: TStartupInfo; var lpProcessInformation: TProcessInformation): BOOL; external 'advapi32' name 'CreateProcessAsUserW';
-//function CreateRectRgnIndirect(const p1: TRect): HRGN; external 'gdi32' name 'CreateRectRgnIndirect';
-function CreateRemoteThread(hProcess: THandle; lpThreadAttributes: Pointer; dwStackSize: DWORD; lpStartAddress: TFNThreadStartRoutine; lpParameter: Pointer; dwCreationFlags: DWORD; var lpThreadId: DWORD): THandle;
- external 'kernel32' name 'CreateRemoteThread';
-function CreateThread(lpThreadAttributes: Pointer; dwStackSize: DWORD; lpStartAddress: TFNThreadStartRoutine; lpParameter: Pointer; dwCreationFlags: DWORD; var lpThreadId: DWORD): THandle; external 'kernel32' name 'CreateThread';
-function DdeSetQualityOfService(hWndClient: HWnd; const pqosNew: TSecurityQualityOfService; pqosPrev: PSecurityQualityOfService): BOOL;external 'user32' name 'DdeSetQualityOfService';
-//function DeleteAce(var pAcl: TACL; dwAceIndex: DWORD): BOOL; external 'advapi32' name 'DeleteAce';
-function DescribePixelFormat(DC: HDC; p2: Integer; p3: UINT; var p4: TPixelFormatDescriptor): BOOL; external 'gdi32' name 'DescribePixelFormat';
-//function DestroyPrivateObjectSecurity(var ObjectDescriptor: PSecurityDescriptor): BOOL; external 'advapi32' name 'DestroyPrivateObjectSecurity';
-function DeviceIoControl(hDevice: THandle; dwIoControlCode: DWORD; lpInBuffer: Pointer; nInBufferSize: DWORD; lpOutBuffer: Pointer; nOutBufferSize: DWORD; var lpBytesReturned: DWORD; lpOverlapped: POverlapped): BOOL;
- external 'kernel32' name 'DeviceIoControl';
-function DialogBoxIndirectParam(hInstance: HINST; const lpDialogTemplate: TDlgTemplate; hWndParent: HWND; lpDialogFunc: TFNDlgProc; dwInitParam: LPARAM): Integer;external 'user32' name 'DialogBoxIndirectParamA';
-function DialogBoxIndirectParamA(hInstance: HINST; const lpDialogTemplate: TDlgTemplate; hWndParent: HWND; lpDialogFunc: TFNDlgProc; dwInitParam: LPARAM): Integer; external 'user32' name 'DialogBoxIndirectParamA';
-function DialogBoxIndirectParamW(hInstance: HINST; const lpDialogTemplate: TDlgTemplate; hWndParent: HWND; lpDialogFunc: TFNDlgProc; dwInitParam: LPARAM): Integer; external 'user32' name 'DialogBoxIndirectParamW';
-function DispatchMessage(const lpMsg: TMsg): Longint;external 'user32' name 'DispatchMessageA';
-function DispatchMessageA(const lpMsg: TMsg): Longint; external 'user32' name 'DispatchMessageA';
-function DispatchMessageW(const lpMsg: TMsg): Longint; external 'user32' name 'DispatchMessageW';
-function DosDateTimeToFileTime(wFatDate, wFatTime: Word; var lpFileTime: TFileTime): BOOL; external 'kernel32' name 'DosDateTimeToFileTime';
-function DPtoLP(DC: HDC; var Points; Count: Integer): BOOL; external 'gdi32' name 'DPtoLP';
-// function DrawAnimatedRects(hwnd: HWND; idAni: Integer; const lprcFrom, lprcTo: TRect): BOOL; external 'user32' name 'DrawAnimatedRects';
-//function DrawCaption(p1: HWND; p2: HDC; const p3: TRect; p4: UINT): BOOL; external 'user32' name 'DrawCaption';
-function DrawEdge(hdc: HDC; var qrc: TRect; edge: UINT; grfFlags: UINT): BOOL; external 'user32' name 'DrawEdge';
-//function DrawFocusRect(hDC: HDC; const lprc: TRect): BOOL; external 'user32' name 'DrawFocusRect';
-function DrawFrameControl(DC: HDC; const Rect: TRect; uType, uState: UINT): BOOL; external 'user32' name 'DrawFrameControl';
-function DrawText(hDC: HDC; lpString: PChar; nCount: Integer; var lpRect: TRect; uFormat: UINT): Integer;external 'user32' name 'DrawTextA';
-function DrawTextA(hDC: HDC; lpString: LPCSTR; nCount: Integer; var lpRect: TRect; uFormat: UINT): Integer; external 'user32' name 'DrawTextA';
-function DrawTextEx(DC: HDC; lpchText: PChar; cchText: Integer; var p4: TRect; dwDTFormat: UINT; DTParams: PDrawTextParams): Integer;external 'user32' name 'DrawTextExA';
-function DrawTextExA(DC: HDC; lpchText: LPCSTR; cchText: Integer; var p4: TRect; dwDTFormat: UINT; DTParams: PDrawTextParams): Integer; external 'user32' name 'DrawTextExA';
-function DrawTextExW(DC: HDC; lpchText: LPWSTR; cchText: Integer; var p4: TRect; dwDTFormat: UINT; DTParams: PDrawTextParams): Integer; external 'user32' name 'DrawTextExW';
-function DrawTextW(hDC: HDC; lpString: LPWSTR; nCount: Integer; var lpRect: TRect; uFormat: UINT): Integer; external 'user32' name 'DrawTextW';
-//function DuplicateTokenEx(hExistingToken: THandle; dwDesiredAccess: DWORD; lpTokenAttributes: PSecurityAttributes; ImpersonationLevel: TSecurityImpersonationLevel; TokenType: TTokenType; var phNewToken: THandle): BOOL;
-// external 'advapi32' name 'DuplicateTokenEx';
-function EndPaint(hWnd: HWND; const lpPaint: TPaintStruct): BOOL; external 'user32' name 'EndPaint';
-//function EnumDisplayDevices(Unused: Pointer; iDevNum: DWORD; var lpDisplayDevice: TDisplayDevice; dwFlags: DWORD): BOOL;external 'user32' name 'EnumDisplayDevicesA';
-//function EnumDisplayDevicesA(Unused: Pointer; iDevNum: DWORD; var lpDisplayDevice: TDisplayDeviceA; dwFlags: DWORD): BOOL;external 'user32' name 'EnumDisplayDevicesA';
-//function EnumDisplayDevicesW(Unused: Pointer; iDevNum: DWORD; var lpDisplayDevice: TDisplayDeviceW; dwFlags: DWORD): BOOL;external 'user32' name 'EnumDisplayDevicesW';
-function EnumDisplaySettings(lpszDeviceName: PChar; iModeNum: DWORD; var lpDevMode: TDeviceMode): BOOL;external 'user32' name 'EnumDisplaySettingsA';
-function EnumDisplaySettingsA(lpszDeviceName: LPCSTR; iModeNum: DWORD; var lpDevMode: TDeviceModeA): BOOL; external 'user32' name 'EnumDisplaySettingsA';
-function EnumDisplaySettingsW(lpszDeviceName: LPWSTR; iModeNum: DWORD; var lpDevMode: TDeviceModeW): BOOL; external 'user32' name 'EnumDisplaySettingsW';
-//function EnumEnhMetaFile(DC: HDC; p2: HENHMETAFILE; p3: TFNEnhMFEnumProc; p4: Pointer; const p5: TRect): BOOL; external 'gdi32' name 'EnumEnhMetaFile';
-//function EnumFontFamiliesEx(DC: HDC; var p2: TLogFont; p3: TFNFontEnumProc; p4: LPARAM; p5: DWORD): BOOL;external 'gdi32' name 'EnumFontFamiliesExA';
-//function EnumFontFamiliesExA(DC: HDC; var p2: TLogFontA; p3: TFNFontEnumProcA; p4: LPARAM; p5: DWORD): BOOL; external 'gdi32' name 'EnumFontFamiliesExA';
-//function EnumFontFamiliesExW(DC: HDC; var p2: TLogFontW; p3: TFNFontEnumProcW; p4: LPARAM; p5: DWORD): BOOL; external 'gdi32' name 'EnumFontFamiliesExW';
-//function EqualRect(const lprc1, lprc2: TRect): BOOL; external 'user32' name 'EqualRect';
-function ExtCreatePen(PenStyle, Width: DWORD; const Brush: TLogBrush; StyleCount: DWORD; Style: Pointer): HPEN; external 'gdi32' name 'ExtCreatePen';
-function ExtCreateRegion(p1: PXForm; p2: DWORD; const p3: TRgnData): HRGN; external 'gdi32' name 'ExtCreateRegion';
-// function ExtEscape(DC: HDC; p2, p3: Integer; const p4: LPCSTR; p5: Integer; p6: LPSTR): Integer; external 'gdi32' name 'ExtEscape';
-function FileTimeToDosDateTime(const lpFileTime: TFileTime; var lpFatDate, lpFatTime: Word): BOOL; external 'kernel32' name 'FileTimeToDosDateTime';
-function FileTimeToLocalFileTime(const lpFileTime: TFileTime; var lpLocalFileTime: TFileTime): BOOL; external 'kernel32' name 'FileTimeToLocalFileTime';
-function FileTimeToSystemTime(const lpFileTime: TFileTime; var lpSystemTime: TSystemTime): BOOL; external 'kernel32' name 'FileTimeToSystemTime';
-function FillConsoleOutputAttribute(hConsoleOutput: THandle; wAttribute: Word; nLength: DWORD; dwWriteCoord: TCoord; var lpNumberOfAttrsWritten: DWORD): BOOL; external 'kernel32' name 'FillConsoleOutputAttribute';
-function FillConsoleOutputCharacter(hConsoleOutput: THandle; cCharacter: Char; nLength: DWORD; dwWriteCoord: TCoord; var lpNumberOfCharsWritten: DWORD): BOOL;external 'kernel32' name 'FillConsoleOutputCharacterA';
-function FillConsoleOutputCharacterA(hConsoleOutput: THandle; cCharacter: AnsiChar; nLength: DWORD; dwWriteCoord: TCoord; var lpNumberOfCharsWritten: DWORD): BOOL; external 'kernel32' name 'FillConsoleOutputCharacterA';
-function FillConsoleOutputCharacterW(hConsoleOutput: THandle; cCharacter: WideChar; nLength: DWORD; dwWriteCoord: TCoord; var lpNumberOfCharsWritten: DWORD): BOOL; external 'kernel32' name 'FillConsoleOutputCharacterW';
-//function FillRect(hDC: HDC; const lprc: TRect; hbr: HBRUSH): Integer; external 'user32' name 'FillRect';
-function FindFirstFileA(lpFileName: LPCSTR; var lpFindFileData: TWIN32FindDataA): THandle; external 'kernel32' name 'FindFirstFileA';
-//function FindFirstFileW(lpFileName: LPWSTR; var lpFindFileData: TWIN32FindDataW): THandle; external 'kernel32' name 'FindFirstFileW';
-//function FindFirstFreeAce(var pAcl: TACL; var pAce: Pointer): BOOL; external 'advapi32' name 'FindFirstFreeAce';
-function FindNextFileA(hFindFile: THandle; var lpFindFileData: TWIN32FindDataA): BOOL; external 'kernel32' name 'FindNextFileA';
-//function FindNextFileW(hFindFile: THandle; var lpFindFileData: TWIN32FindDataW): BOOL; external 'kernel32' name 'FindNextFileW';
-//function FlushInstructionCache(hProcess: THandle; const lpBaseAddress: Pointer; dwSize: DWORD): BOOL; external 'kernel32' name 'FlushInstructionCache';
-//function FlushViewOfFile(const lpBaseAddress: Pointer; dwNumberOfBytesToFlush: DWORD): BOOL; external 'kernel32' name 'FlushViewOfFile';
-//function FrameRect(hDC: HDC; const lprc: TRect; hbr: HBRUSH): Integer; external 'user32' name 'FrameRect';
-//function GetAce(const pAcl: TACL; dwAceIndex: DWORD; var pAce: Pointer): BOOL; external 'advapi32' name 'GetAce';
-//function GetAclInformation(const pAcl: TACL; pAclInformation: Pointer; nAclInformationLength: DWORD; dwAclInformationClass: TAclInformationClass): BOOL; external 'advapi32' name 'GetAclInformation';
-//function GetAltTabInfo(hwnd: HWND; iItem: Integer; var pati: TAltTabInfo; pszItemText: PChar; cchItemText: UINT): BOOL;external 'user32' name 'GetAltTabInfoA';
-//function GetAltTabInfoA(hwnd: HWND; iItem: Integer; var pati: TAltTabInfo; pszItemText: LPCSTR; cchItemText: UINT): BOOL;external 'user32' name 'GetAltTabInfoA';
-//function GetAltTabInfoW(hwnd: HWND; iItem: Integer; var pati: TAltTabInfo; pszItemText: LPWSTR; cchItemText: UINT): BOOL;external 'user32' name 'GetAltTabInfoW';
-function GetAspectRatioFilterEx(DC: HDC; var p2: TSize): BOOL; external 'gdi32' name 'GetAspectRatioFilterEx';
-function GetBinaryType(lpApplicationName: PChar; var lpBinaryType: DWORD): BOOL;external 'kernel32' name 'GetBinaryTypeA';
-function GetBinaryTypeA(lpApplicationName: LPCSTR; var lpBinaryType: DWORD): BOOL; external 'kernel32' name 'GetBinaryTypeA';
-function GetBinaryTypeW(lpApplicationName: LPWSTR; var lpBinaryType: DWORD): BOOL; external 'kernel32' name 'GetBinaryTypeW';
-function GetBitmapDimensionEx(p1: HBITMAP; var p2: TSize): BOOL; external 'gdi32' name 'GetBitmapDimensionEx';
-function GetBoundsRect(DC: HDC; var p2: TRect; p3: UINT): UINT; external 'gdi32' name 'GetBoundsRect';
-function GetBrushOrgEx(DC: HDC; var p2: TPoint): BOOL; external 'gdi32' name 'GetBrushOrgEx';
-function GetCaretPos(var lpPoint: TPoint): BOOL; external 'user32' name 'GetCaretPos';
-function GetCharABCWidths(DC: HDC; p2, p3: UINT; const ABCStructs): BOOL;external 'gdi32' name 'GetCharABCWidthsA';
-function GetCharABCWidthsA(DC: HDC; p2, p3: UINT; const ABCStructs): BOOL; external 'gdi32' name 'GetCharABCWidthsA';
-function GetCharABCWidthsFloat(DC: HDC; p2, p3: UINT; const ABCFloatSturcts): BOOL;external 'gdi32' name 'GetCharABCWidthsFloatA';
-function GetCharABCWidthsFloatA(DC: HDC; p2, p3: UINT; const ABCFloatSturcts): BOOL; external 'gdi32' name 'GetCharABCWidthsFloatA';
-function GetCharABCWidthsFloatW(DC: HDC; p2, p3: UINT; const ABCFloatSturcts): BOOL; external 'gdi32' name 'GetCharABCWidthsFloatW';
-//function GetCharABCWidthsI(DC: HDC; p2, p3: UINT; p4: PWORD; const Widths): BOOL;external 'gdi32' name 'GetCharABCWidthsI';
-function GetCharABCWidthsW(DC: HDC; p2, p3: UINT; const ABCStructs): BOOL; external 'gdi32' name 'GetCharABCWidthsW';
-function GetCharacterPlacement(DC: HDC; p2: PChar; p3, p4: BOOL; var p5: TGCPResults; p6: DWORD): DWORD;external 'gdi32' name 'GetCharacterPlacementA';
-function GetCharacterPlacementA(DC: HDC; p2: LPCSTR; p3, p4: BOOL; var p5: TGCPResults; p6: DWORD): DWORD; external 'gdi32' name 'GetCharacterPlacementA';
-function GetCharacterPlacementW(DC: HDC; p2: LPWSTR; p3, p4: BOOL; var p5: TGCPResults; p6: DWORD): DWORD; external 'gdi32' name 'GetCharacterPlacementW';
-function GetCharWidth(DC: HDC; p2, p3: UINT; const Widths): BOOL;external 'gdi32' name 'GetCharWidthA';
-function GetCharWidth32(DC: HDC; p2, p3: UINT; const Widths): BOOL;external 'gdi32' name 'GetCharWidth32A';
-function GetCharWidth32A(DC: HDC; p2, p3: UINT; const Widths): BOOL; external 'gdi32' name 'GetCharWidth32A';
-function GetCharWidth32W(DC: HDC; p2, p3: UINT; const Widths): BOOL; external 'gdi32' name 'GetCharWidth32W';
-function GetCharWidthA(DC: HDC; p2, p3: UINT; const Widths): BOOL; external 'gdi32' name 'GetCharWidthA';
-function GetCharWidthFloat(DC: HDC; p2, p3: UINT; const Widths): BOOL;external 'gdi32' name 'GetCharWidthFloatA';
-function GetCharWidthFloatA(DC: HDC; p2, p3: UINT; const Widths): BOOL; external 'gdi32' name 'GetCharWidthFloatA';
-function GetCharWidthFloatW(DC: HDC; p2, p3: UINT; const Widths): BOOL; external 'gdi32' name 'GetCharWidthFloatW';
-//function GetCharWidthI(DC: HDC; p2, p3: UINT; p4: PWORD; const Widths): BOOL;external 'gdi32' name 'GetCharWidthI';
-function GetCharWidthW(DC: HDC; p2, p3: UINT; const Widths): BOOL; external 'gdi32' name 'GetCharWidthW';
-function GetClassInfo(hInstance: HINST; lpClassName: PChar; var lpWndClass: TWndClass): BOOL;external 'user32' name 'GetClassInfoA';
-function GetClassInfoA(hInstance: HINST; lpClassName: LPCSTR; var lpWndClass: TWndClassA): BOOL; external 'user32' name 'GetClassInfoA';
-function GetClassInfoEx(Instance: HINST; Classname: PChar; var WndClass: TWndClassEx): BOOL;external 'user32' name 'GetClassInfoExA';
-//function GetClassInfoExA(Instance: HINST; Classname: LPCSTR; var WndClass: TWndClassExA): BOOL; external 'user32' name 'GetClassInfoExA';
-//function GetClassInfoExW(Instance: HINST; Classname: LPWSTR; var WndClass: TWndClassExW): BOOL; external 'user32' name 'GetClassInfoExW';
-//function GetClassInfoW(hInstance: HINST; lpClassName: LPWSTR; var lpWndClass: TWndClassW): BOOL; external 'user32' name 'GetClassInfoW';
-function GetClientRect(hWnd: HWND; var lpRect: TRect): BOOL; external 'user32' name 'GetClientRect';
-function GetClipBox(DC: HDC; var Rect: TRect): Integer; external 'gdi32' name 'GetClipBox';
-function GetClipCursor(var lpRect: TRect): BOOL; external 'user32' name 'GetClipCursor';
-function GetColorAdjustment(DC: HDC; var p2: TColorAdjustment): BOOL; external 'gdi32' name 'GetColorAdjustment';
-function GetCommConfig(hCommDev: THandle; var lpCC: TCommConfig; var lpdwSize: DWORD): BOOL; external 'kernel32' name 'GetCommConfig';
-function GetCommMask(hFile: THandle; var lpEvtMask: DWORD): BOOL; external 'kernel32' name 'GetCommMask';
-function GetCommModemStatus(hFile: THandle; var lpModemStat: DWORD): BOOL; external 'kernel32' name 'GetCommModemStatus';
-function GetCommProperties(hFile: THandle; var lpCommProp: TCommProp): BOOL; external 'kernel32' name 'GetCommProperties';
-function GetCommState(hFile: THandle; var lpDCB: TDCB): BOOL; external 'kernel32' name 'GetCommState';
-function GetCommTimeouts(hFile: THandle; var lpCommTimeouts: TCommTimeouts): BOOL; external 'kernel32' name 'GetCommTimeouts';
-function GetComputerName(lpBuffer: PChar; var nSize: DWORD): BOOL;external 'kernel32' name 'GetComputerNameA';
-function GetComputerNameA(lpBuffer: LPCSTR; var nSize: DWORD): BOOL; external 'kernel32' name 'GetComputerNameA';
-function GetComputerNameW(lpBuffer: LPWSTR; var nSize: DWORD): BOOL; external 'kernel32' name 'GetComputerNameW';
-function GetConsoleCursorInfo(hConsoleOutput: THandle; var lpConsoleCursorInfo: TConsoleCursorInfo): BOOL; external 'kernel32' name 'GetConsoleCursorInfo';
-function GetConsoleMode(hConsoleHandle: THandle; var lpMode: DWORD): BOOL; external 'kernel32' name 'GetConsoleMode';
-function GetConsoleScreenBufferInfo(hConsoleOutput: THandle; var lpConsoleScreenBufferInfo: TConsoleScreenBufferInfo): BOOL; external 'kernel32' name 'GetConsoleScreenBufferInfo';
-function GetCPInfo(CodePage: UINT; var lpCPInfo: TCPInfo): BOOL;external 'kernel32' name 'GetCPInfo';
-//function GetCurrentHwProfile(var lpHwProfileInfo: THWProfileInfo): BOOL;external 'advapi32' name 'GetCurrentHwProfileA';
-//function GetCurrentHwProfileA(var lpHwProfileInfo: THWProfileInfoA): BOOL;external 'advapi32' name 'GetCurrentHwProfileA';
-//function GetCurrentHwProfileW(var lpHwProfileInfo: THWProfileInfoW): BOOL;external 'advapi32' name 'GetCurrentHwProfileW';
-{$ifdef support_smartlink}
-function GetCursorInfo(var pci: TCursorInfo): BOOL;external 'user32' name 'GetCursorInfo';
-{$endif support_smartlink}
-function GetCursorPos(var lpPoint: TPoint): BOOL; external 'user32' name 'GetCursorPos';
-function GetDCOrgEx(DC: HDC; var Origin: TPoint): BOOL; external 'gdi32' name 'GetDCOrgEx';
-function GetDefaultCommConfig(lpszName: PChar; var lpCC: TCommConfig; var lpdwSize: DWORD): BOOL;external 'kernel32' name 'GetDefaultCommConfigA';
-function GetDefaultCommConfigA(lpszName: LPCSTR; var lpCC: TCommConfig; var lpdwSize: DWORD): BOOL; external 'kernel32' name 'GetDefaultCommConfigA';
-function GetDefaultCommConfigW(lpszName: LPWSTR; var lpCC: TCommConfig; var lpdwSize: DWORD): BOOL; external 'kernel32' name 'GetDefaultCommConfigW';
-function GetDeviceGammaRamp(DC: HDC; var Ramp): BOOL; external 'gdi32' name 'GetDeviceGammaRamp';
-function GetDIBColorTable(DC: HDC; p2, p3: UINT; var RGBQuadStructs): UINT; external 'gdi32' name 'GetDIBColorTable';
-function GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT; Bits: Pointer; var BitInfo: TBitmapInfo; Usage: UINT): Integer; external 'gdi32' name 'GetDIBits';
-function GetDiskFreeSpace(lpRootPathName: PChar; var lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters: DWORD): BOOL;external 'kernel32' name 'GetDiskFreeSpaceA';
-function GetDiskFreeSpaceA(lpRootPathName: LPCSTR; var lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters: DWORD): BOOL; external 'kernel32' name 'GetDiskFreeSpaceA';
-function GetDiskFreeSpaceEx(lpDirectoryName: PChar; var lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes: TLargeInteger; lpTotalNumberOfFreeBytes: PLargeInteger): BOOL;external 'kernel32' name 'GetDiskFreeSpaceExA';
-function GetDiskFreeSpaceExA(lpDirectoryName: LPCSTR; var lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes: TLargeInteger; lpTotalNumberOfFreeBytes: PLargeInteger): BOOL;external 'kernel32' name 'GetDiskFreeSpaceExA';
-function GetDiskFreeSpaceExW(lpDirectoryName: LPWSTR; var lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes: TLargeInteger; lpTotalNumberOfFreeBytes: PLargeInteger): BOOL;external 'kernel32' name 'GetDiskFreeSpaceExW';
-function GetDiskFreeSpaceW(lpRootPathName: LPWSTR; var lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters: DWORD): BOOL; external 'kernel32' name 'GetDiskFreeSpaceW';
-function GetDiskFreeSpaceEx(lpDirectoryName: PChar; lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes:pLargeInteger; lpTotalNumberOfFreeBytes: PLargeInteger): BOOL;external 'kernel32' name 'GetDiskFreeSpaceExA';
-function GetDiskFreeSpaceExA(lpDirectoryName: LPCSTR; lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes: pLargeInteger; lpTotalNumberOfFreeBytes: PLargeInteger): BOOL;external 'kernel32' name 'GetDiskFreeSpaceExA';
-function GetDiskFreeSpaceExW(lpDirectoryName: LPWSTR; lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes: pLargeInteger; lpTotalNumberOfFreeBytes: PLargeInteger): BOOL;external 'kernel32' name 'GetDiskFreeSpaceExW';
-//function GetEnhMetaFilePixelFormat(p1: HENHMETAFILE; p2: Cardinal; var p3: TPixelFormatDescriptor): UINT;external 'gdi32' name 'GetEnhMetaFilePixelFormat';
-function GetFileInformationByHandle(hFile: THandle; var lpFileInformation: TByHandleFileInformation): BOOL; external 'kernel32' name 'GetFileInformationByHandle';
-//function GetFileSecurity(lpFileName: PChar; RequestedInformation: SECURITY_INFORMATION; pSecurityDescriptor: PSecurityDescriptor; nLength: DWORD; var lpnLengthNeeded: DWORD): BOOL;external 'advapi32' name 'GetFileSecurityA';
-//function GetFileSecurityA(lpFileName: LPCSTR; RequestedInformation: SECURITY_INFORMATION; pSecurityDescriptor: PSecurityDescriptor; nLength: DWORD; var lpnLengthNeeded: DWORD): BOOL; external 'advapi32' name 'GetFileSecurityA';
-//function GetFileSecurityW(lpFileName: LPWSTR; RequestedInformation: SECURITY_INFORMATION; pSecurityDescriptor: PSecurityDescriptor; nLength: DWORD; var lpnLengthNeeded: DWORD): BOOL; external 'advapi32' name 'GetFileSecurityW';
-function GetFileVersionInfoSize(lptstrFilename: PChar; var lpdwHandle: DWORD): DWORD;external 'version' name 'GetFileVersionInfoSizeA';
-function GetFileVersionInfoSizeA(lptstrFilename: LPCSTR; var lpdwHandle: DWORD): DWORD; external 'version' name 'GetFileVersionInfoSizeA';
-function GetFileVersionInfoSizeW(lptstrFilename: LPWSTR; var lpdwHandle: DWORD): DWORD; external 'version' name 'GetFileVersionInfoSizeW';
-// removed because old definition was wrong !
-// function GetFullPathName(lpFileName: PChar; nBufferLength: DWORD; lpBuffer: PChar; var lpFilePart: PChar): DWORD;external 'kernel32' name 'GetFullPathNameA';
-// function GetFullPathNameA(lpFileName: LPCSTR; nBufferLength: DWORD; lpBuffer: LPCSTR; var lpFilePart: LPCSTR): DWORD; external 'kernel32' name 'GetFullPathNameA';
-// function GetFullPathNameW(lpFileName: LPWSTR; nBufferLength: DWORD; lpBuffer: LPWSTR; var lpFilePart: LPWSTR): DWORD; external 'kernel32' name 'GetFullPathNameW';
-function GetGlyphOutline(DC: HDC; p2, p3: UINT; const p4: TGlyphMetrics; p5: DWORD; p6: Pointer; const p7: TMat2): DWORD;external 'gdi32' name 'GetGlyphOutlineA';
-function GetGlyphOutlineA(DC: HDC; p2, p3: UINT; const p4: TGlyphMetrics; p5: DWORD; p6: Pointer; const p7: TMat2): DWORD; external 'gdi32' name 'GetGlyphOutlineA';
-function GetGlyphOutlineW(DC: HDC; p2, p3: UINT; const p4: TGlyphMetrics; p5: DWORD; p6: Pointer; const p7: TMat2): DWORD; external 'gdi32' name 'GetGlyphOutlineW';
-//function GetGUIThreadInfo(idThread: DWORD; var pgui: TGUIThreadinfo): BOOL;external 'user32' name 'GetGUIThreadInfo';
-function GetHandleInformation(hObject: THandle; var lpdwFlags: DWORD): BOOL; external 'kernel32' name 'GetHandleInformation';
-//function GetICMProfile(DC: HDC; var Size: DWORD; Name: PChar): BOOL;external 'gdi32' name 'GetICMProfileA';
-//function GetICMProfileA(DC: HDC; var Size: DWORD; Name: LPCSTR): BOOL; external 'gdi32' name 'GetICMProfileA';
-//function GetICMProfileW(DC: HDC; var Size: DWORD; Name: LPWSTR): BOOL; external 'gdi32' name 'GetICMProfileW';
-function GetIconInfo(hIcon: HICON; var piconinfo: TIconInfo): BOOL; external 'user32' name 'GetIconInfo';
-//function GetKernelObjectSecurity(Handle: THandle; RequestedInformation: SECURITY_INFORMATION; pSecurityDescriptor: PSecurityDescriptor; nLength: DWORD; var lpnLengthNeeded: DWORD): BOOL; external 'advapi32' name 'GetKernelObjectSecurity';
-function GetKerningPairs(DC: HDC; Count: DWORD; var KerningPairs): DWORD;external 'gdi32' name 'GetKerningPairs';
-function GetKeyboardLayoutList(nBuff: Integer; var List): UINT; external 'user32' name 'GetKeyboardLayoutList';
-//function GetKeyboardState(var KeyState: TKeyboardState): BOOL; external 'user32' name 'GetKeyboardState';
-//function GetLastInputInfo(var plii: TLastInputInfo): BOOL;external 'user32' name 'GetLastInputInfo';
-procedure GetSystemTime(var lpSystemTime:SYSTEMTIME); external 'kernel32' name 'GetSystemTime';
-procedure GetSystemInfo(var SystemInfo:SYSTEM_INFO); external 'kernel32' name 'GetSystemInfo';
-function SetSystemTime(var lpSystemTime:SYSTEMTIME):WINBOOL; external 'kernel32' name 'SetSystemTime';
-function GetLogColorSpace(p1: HCOLORSPACE; var ColorSpace: TLogColorSpace; Size: DWORD): BOOL;external 'gdi32' name 'GetLogColorSpaceA';
-function GetLogColorSpaceA(p1: HCOLORSPACE; var ColorSpace: TLogColorSpaceA; Size: DWORD): BOOL; external 'gdi32' name 'GetLogColorSpaceA';
-//function GetLogColorSpaceW(p1: HCOLORSPACE; var ColorSpace: TLogColorSpaceW; Size: DWORD): BOOL; external 'gdi32' name 'GetLogColorSpaceW';
-function GetMailslotInfo(hMailslot: THandle; lpMaxMessageSize: Pointer; var lpNextSize: DWORD; lpMessageCount, lpReadTimeout: Pointer): BOOL; external 'kernel32' name 'GetMailslotInfo';
-//function GetMenuBarInfo(hend: HWND; idObject, idItem: Longint; var pmbi: TMenuBarInfo): BOOL;external 'user32' name 'GetMenuBarInfo';
-//function GetMenuInfo(hMenu: HMENU; var lpmi: TMenuInfo): BOOL;external 'user32' name 'GetMenuInfo';
-function GetMenuItemInfo(p1: HMENU; p2: UINT; p3: BOOL; var p4: TMenuItemInfo): BOOL;external 'user32' name 'GetMenuItemInfoA';
-function GetMenuItemInfoA(p1: HMENU; p2: UINT; p3: BOOL; var p4: TMenuItemInfoA): BOOL; external 'user32' name 'GetMenuItemInfoA';
-//function GetMenuItemInfoW(p1: HMENU; p2: UINT; p3: BOOL; var p4: TMenuItemInfoW): BOOL; external 'user32' name 'GetMenuItemInfoW';
-function GetMenuItemRect(hWnd: HWND; hMenu: HMENU; uItem: UINT; var lprcItem: TRect): BOOL; external 'user32' name 'GetMenuItemRect';
-function GetMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax: UINT): BOOL;external 'user32' name 'GetMessageA';
-function GetMessageA(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax: UINT): BOOL; external 'user32' name 'GetMessageA';
-function GetMessageW(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax: UINT): BOOL; external 'user32' name 'GetMessageW';
-function GetMiterLimit(DC: HDC; var Limit: Single): BOOL; external 'gdi32' name 'GetMiterLimit';
-//function GetMouseMovePoints(cbSize: UINT; var lppt, lpptBuf: TMouseMovePoint; nBufPoints: Integer; resolution: DWORD): Integer;external 'user32' name 'GetMouseMovePoints';
-function GetNamedPipeInfo(hNamedPipe: THandle; var lpFlags: DWORD; lpOutBufferSize, lpInBufferSize, lpMaxInstances: Pointer): BOOL; external 'kernel32' name 'GetNamedPipeInfo';
-function GetNumberOfConsoleInputEvents(hConsoleInput: THandle; var lpNumberOfEvents: DWORD): BOOL; external 'kernel32' name 'GetNumberOfConsoleInputEvents';
-function GetNumberOfConsoleMouseButtons(var lpNumberOfMouseButtons: DWORD): BOOL; external 'kernel32' name 'GetNumberOfConsoleMouseButtons';
-//function GetNumberOfEventLogRecords(hEventLog: THandle; var NumberOfRecords: DWORD): BOOL; external 'advapi32' name 'GetNumberOfEventLogRecords';
-//function GetOldestEventLogRecord(hEventLog: THandle; var OldestRecord: DWORD): BOOL; external 'advapi32' name 'GetOldestEventLogRecord';
-function GetOverlappedResult(hFile: THandle; const lpOverlapped: TOverlapped; var lpNumberOfBytesTransferred: DWORD; bWait: BOOL): BOOL; external 'kernel32' name 'GetOverlappedResult';
-function GetPaletteEntries(Palette: HPALETTE; StartIndex, NumEntries: UINT; var PaletteEntries): UINT; external 'gdi32' name 'GetPaletteEntries';
-function GetPath(DC: HDC; var Points, Types; nSize: Integer): Integer; external 'gdi32' name 'GetPath';
-function GetPriorityClipboardFormat(var paFormatPriorityList; cFormats: Integer): Integer; external 'user32' name 'GetPriorityClipboardFormat';
-//function GetPrivateObjectSecurity(ObjectDescriptor: PSecurityDescriptor; SecurityInformation: SECURITY_INFORMATION; ResultantDescriptor: PSecurityDescriptor; DescriptorLength: DWORD; var ReturnLength: DWORD): BOOL;
-// external 'advapi32' name 'GetPrivateObjectSecurity';
-function GetProcessAffinityMask(hProcess: THandle; var lpProcessAffinityMask, lpSystemAffinityMask: DWORD): BOOL; external 'kernel32' name 'GetProcessAffinityMask';
-function GetProcessHeaps(NumberOfHeaps: DWORD; var ProcessHeaps: THandle): DWORD;external 'kernel32' name 'GetProcessHeaps';
-{$ifdef support_smartlink}
-function GetProcessPriorityBoost(hThread: THandle; var DisablePriorityBoost: Bool): BOOL;external 'kernel32' name 'GetProcessPriorityBoost';
-{$endif support_smartlink}
-function GetProcessShutdownParameters(var lpdwLevel, lpdwFlags: DWORD): BOOL; external 'kernel32' name 'GetProcessShutdownParameters';
-function GetProcessTimes(hProcess: THandle; var lpCreationTime, lpExitTime, lpKernelTime, lpUserTime: TFileTime): BOOL; external 'kernel32' name 'GetProcessTimes';
-function GetProcessWorkingSetSize(hProcess: THandle; var lpMinimumWorkingSetSize, lpMaximumWorkingSetSize: DWORD): BOOL; external 'kernel32' name 'GetProcessWorkingSetSize';
-function GetQueuedCompletionStatus(CompletionPort: THandle; var lpNumberOfBytesTransferred, lpCompletionKey: DWORD; var lpOverlapped: POverlapped; dwMilliseconds: DWORD): BOOL; external 'kernel32' name 'GetQueuedCompletionStatus';
-function GetRasterizerCaps(var p1: TRasterizerStatus; p2: UINT): BOOL; external 'gdi32' name 'GetRasterizerCaps';
-function GetRgnBox(RGN: HRGN; var p2: TRect): Integer; external 'gdi32' name 'GetRgnBox';
-function GetScrollInfo(hWnd: HWND; BarFlag: Integer; var ScrollInfo: TScrollInfo): BOOL; external 'user32' name 'GetScrollInfo';
-function GetScrollRange(hWnd: HWND; nBar: Integer; var lpMinPos, lpMaxPos: Integer): BOOL; external 'user32' name 'GetScrollRange';
-//function GetSecurityDescriptorControl(pSecurityDescriptor: PSecurityDescriptor; var pControl: SECURITY_DESCRIPTOR_CONTROL; var lpdwRevision: DWORD): BOOL; external 'advapi32' name 'GetSecurityDescriptorControl';
-//function GetSecurityDescriptorDacl(pSecurityDescriptor: PSecurityDescriptor; var lpbDaclPresent: BOOL; var pDacl: PACL; var lpbDaclDefaulted: BOOL): BOOL; external 'advapi32' name 'GetSecurityDescriptorDacl';
-//function GetSecurityDescriptorGroup(pSecurityDescriptor: PSecurityDescriptor; var pGroup: PSID; var lpbGroupDefaulted: BOOL): BOOL; external 'advapi32' name 'GetSecurityDescriptorGroup';
-//function GetSecurityDescriptorOwner(pSecurityDescriptor: PSecurityDescriptor; var pOwner: PSID; var lpbOwnerDefaulted: BOOL): BOOL; external 'advapi32' name 'GetSecurityDescriptorOwner';
-//function GetSecurityDescriptorSacl(pSecurityDescriptor: PSecurityDescriptor; var lpbSaclPresent: BOOL; var pSacl: PACL; var lpbSaclDefaulted: BOOL): BOOL; external 'advapi32' name 'GetSecurityDescriptorSacl';
-function GetStringTypeA(Locale: LCID; dwInfoType: DWORD; const lpSrcStr: LPCSTR; cchSrc: BOOL; var lpCharType: Word): BOOL;external 'kernel32' name 'GetStringTypeA';
-function GetStringTypeEx(Locale: LCID; dwInfoType: DWORD; lpSrcStr: PChar; cchSrc: Integer; var lpCharType): BOOL;external 'kernel32' name 'GetStringTypeExA';
-function GetStringTypeExA(Locale: LCID; dwInfoType: DWORD; lpSrcStr: LPCSTR; cchSrc: Integer; var lpCharType): BOOL; external 'kernel32' name 'GetStringTypeExA';
-function GetStringTypeExW(Locale: LCID; dwInfoType: DWORD; lpSrcStr: LPWSTR; cchSrc: Integer; var lpCharType): BOOL; external 'kernel32' name 'GetStringTypeExW';
-function GetStringTypeW(dwInfoType: DWORD; const lpSrcStr: WCHAR; cchSrc: BOOL; var lpCharType: Word): BOOL;external 'kernel32' name 'GetStringTypeW';
-function GetSystemPaletteEntries(DC: HDC; StartIndex, NumEntries: UINT; var PaletteEntries): UINT; external 'gdi32' name 'GetSystemPaletteEntries';
-function GetSystemPowerStatus(var lpSystemPowerStatus: TSystemPowerStatus): BOOL;external 'kernel32' name 'GetSystemPowerStatus';
-function GetSystemTimeAdjustment(var lpTimeAdjustment, lpTimeIncrement: DWORD; var lpTimeAdjustmentDisabled: BOOL): BOOL; external 'kernel32' name 'GetSystemTimeAdjustment';
-procedure GetSystemTimeAsFileTime(var lpSystemTimeAsFileTime:TFILETIME); external 'kernel32' name 'GetSystemTimeAsFileTime';
-function GetTabbedTextExtent(hDC: HDC; lpString: PChar; nCount, nTabPositions: Integer; var lpnTabStopPositions): DWORD;external 'user32' name 'GetTabbedTextExtentA';
-function GetTabbedTextExtentA(hDC: HDC; lpString: LPCSTR; nCount, nTabPositions: Integer; var lpnTabStopPositions): DWORD; external 'user32' name 'GetTabbedTextExtentA';
-function GetTabbedTextExtentW(hDC: HDC; lpString: LPWSTR; nCount, nTabPositions: Integer; var lpnTabStopPositions): DWORD; external 'user32' name 'GetTabbedTextExtentW';
-function GetTapeParameters(hDevice: THandle; dwOperation: DWORD; var lpdwSize: DWORD; lpTapeInformation: Pointer): DWORD; external 'kernel32' name 'GetTapeParameters';
-function GetTapePosition(hDevice: THandle; dwPositionType: DWORD; var lpdwPartition, lpdwOffsetLow: DWORD; lpdwOffsetHigh: Pointer): DWORD; external 'kernel32' name 'GetTapePosition';
-function GetTextExtentExPoint(DC: HDC; p2: PChar; p3, p4: Integer; p5, p6: PInteger; var p7: TSize): BOOL;external 'gdi32' name 'GetTextExtentExPointA';
-function GetTextExtentExPointA(DC: HDC; p2: LPCSTR; p3, p4: Integer; p5, p6: PInteger; var p7: TSize): BOOL; external 'gdi32' name 'GetTextExtentExPointA';
-//function GetTextExtentExPointI(DC: HDC; p2: PWORD; p3, p4: Integer; p5, p6: PINT; var p7: TSize): BOOL;external 'gdi32' name 'GetTextExtentExPointI';
-function GetTextExtentExPointW(DC: HDC; p2: LPWSTR; p3, p4: Integer; p5, p6: PInteger; var p7: TSize): BOOL; external 'gdi32' name 'GetTextExtentExPointW';
-function GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): BOOL;external 'gdi32' name 'GetTextExtentPointA';
-function GetTextExtentPoint32(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): BOOL;external 'gdi32' name 'GetTextExtentPoint32A';
-function GetTextExtentPoint32A(DC: HDC; Str: LPCSTR; Count: Integer; var Size: TSize): BOOL; external 'gdi32' name 'GetTextExtentPoint32A';
-function GetTextExtentPoint32W(DC: HDC; Str: LPWSTR; Count: Integer; var Size: TSize): BOOL; external 'gdi32' name 'GetTextExtentPoint32W';
-function GetTextExtentPointA(DC: HDC; Str: LPCSTR; Count: Integer; var Size: TSize): BOOL; external 'gdi32' name 'GetTextExtentPointA';
-//function GetTextExtentPointI(DC: HDC; p2: PWORD; p3: Integer; var p4: TSize): BOOL;external 'gdi32' name 'GetTextExtentPointI';
-function GetTextExtentPointW(DC: HDC; Str: LPWSTR; Count: Integer; var Size: TSize): BOOL; external 'gdi32' name 'GetTextExtentPointW';
-function GetTextMetrics(DC: HDC; var TM: TTextMetric): BOOL;external 'gdi32' name 'GetTextMetricsA';
-//function GetTextMetricsA(DC: HDC; var TM: TTextMetricA): BOOL; external 'gdi32' name 'GetTextMetricsA';
-//function GetTextMetricsW(DC: HDC; var TM: TTextMetricW): BOOL; external 'gdi32' name 'GetTextMetricsW';
-function GetThreadContext(hThread: THandle; var lpContext: TContext): BOOL; external 'kernel32' name 'GetThreadContext';
-{$ifdef support_smartlink}
-function GetThreadPriorityBoost(hThread: THandle; var DisablePriorityBoost: Bool): BOOL;external 'kernel32' name 'GetThreadPriorityBoost';
-{$endif support_smartlink}
-{$ifdef TLDTEntry}
-function GetThreadSelectorEntry(hThread: THandle; dwSelector: DWORD; var lpSelectorEntry: TLDTEntry): BOOL; external 'kernel32' name 'GetThreadSelectorEntry';
-{$endif TLDTEntry}
-function GetThreadTimes(hThread: THandle; var lpCreationTime, lpExitTime, lpKernelTime, lpUserTime: TFileTime): BOOL; external 'kernel32' name 'GetThreadTimes';
-function GetTimeZoneInformation(var lpTimeZoneInformation: TTimeZoneInformation): DWORD; external 'kernel32' name 'GetTimeZoneInformation';
-//function GetTitleBarInfo(hwnd: HWND; var pti: TTitleBarInfo): BOOL;external 'user32' name 'GetTitleBarInfo';
-//function GetTokenInformation(TokenHandle: THandle; TokenInformationClass: TTokenInformationClass; TokenInformation: Pointer; TokenInformationLength: DWORD; var ReturnLength: DWORD): BOOL; external 'advapi32' name 'GetTokenInformation';
-function GetUpdateRect(hWnd: HWND; var lpRect: TRect; bErase: BOOL): BOOL; external 'user32' name 'GetUpdateRect';
-function GetUserName(lpBuffer: PChar; var nSize: DWORD): BOOL;external 'advapi32' name 'GetUserNameA';
-function GetUserNameA(lpBuffer: LPCSTR; var nSize: DWORD): BOOL; external 'advapi32' name 'GetUserNameA';
-function GetUserNameW(lpBuffer: LPWSTR; var nSize: DWORD): BOOL; external 'advapi32' name 'GetUserNameW';
-function GetUserObjectInformation(hObj: THandle; nIndex: Integer; pvInfo: Pointer; nLength: DWORD; var lpnLengthNeeded: DWORD): BOOL;external 'user32' name 'GetUserObjectInformationA';
-function GetUserObjectInformationA(hObj: THandle; nIndex: Integer; pvInfo: Pointer; nLength: DWORD; var lpnLengthNeeded: DWORD): BOOL; external 'user32' name 'GetUserObjectInformationA';
-function GetUserObjectInformationW(hObj: THandle; nIndex: Integer; pvInfo: Pointer; nLength: DWORD; var lpnLengthNeeded: DWORD): BOOL; external 'user32' name 'GetUserObjectInformationW';
-function GetUserObjectSecurity(hObj: THandle; var pSIRequested: DWORD; pSID: PSecurityDescriptor; nLength: DWORD; var lpnLengthNeeded: DWORD): BOOL; external 'user32' name 'GetUserObjectSecurity';
-function GetViewportExtEx(DC: HDC; var Size: TSize): BOOL; external 'gdi32' name 'GetViewportExtEx';
-function GetViewportOrgEx(DC: HDC; var Point: TPoint): BOOL; external 'gdi32' name 'GetViewportOrgEx';
-function GetVolumeInformation(lpRootPathName: PChar; lpVolumeNameBuffer: PChar; nVolumeNameSize: DWORD; lpVolumeSerialNumber: PDWORD; var lpMaximumComponentLength, lpFileSystemFlags: DWORD;
- lpFileSystemNameBuffer: PChar; nFileSystemNameSize: DWORD): BOOL; external 'kernel32' name 'GetVolumeInformationA';
-function GetVolumeInformationA(lpRootPathName: LPCSTR; lpVolumeNameBuffer: LPCSTR; nVolumeNameSize: DWORD; lpVolumeSerialNumber: PDWORD; var lpMaximumComponentLength, lpFileSystemFlags: DWORD;
- lpFileSystemNameBuffer: LPCSTR; nFileSystemNameSize: DWORD): BOOL; external 'kernel32' name 'GetVolumeInformationA';
-function GetVolumeInformationW(lpRootPathName: LPWSTR; lpVolumeNameBuffer: LPWSTR; nVolumeNameSize: DWORD; lpVolumeSerialNumber: PDWORD; var lpMaximumComponentLength, lpFileSystemFlags: DWORD;
- lpFileSystemNameBuffer: LPWSTR; nFileSystemNameSize: DWORD): BOOL; external 'kernel32' name 'GetVolumeInformationW';
-function GetWindowExtEx(DC: HDC; var Size: TSize): BOOL; external 'gdi32' name 'GetWindowExtEx';
-//function GetWindowInfo(hwnd: HWND; var pwi: TWindowInfo): BOOL;external 'user32' name 'GetWindowInfo';
-function GetWindowOrgEx(DC: HDC; var Point: TPoint): BOOL; external 'gdi32' name 'GetWindowOrgEx';
-function GetWindowRect(hWnd: HWND; var lpRect: TRect): BOOL; external 'user32' name 'GetWindowRect';
-function GetWorldTransform(DC: HDC; var p2: TXForm): BOOL; external 'gdi32' name 'GetWorldTransform';
-//function GradientFill(DC: HDC; var p2: TTriVertex; p3: ULONG; p4: Pointer; p5, p6: ULONG): BOOL;external 'gdi32' name 'GradientFill';
-procedure GlobalMemoryStatus(var Buffer: MEMORYSTATUS); external 'kernel32' name 'GlobalMemoryStatus';
-function HeapWalk(hHeap: THandle; var lpEntry: TProcessHeapEntry): BOOL; external 'kernel32' name 'HeapWalk';
-function ImageList_GetDragImage(var ppt:POINT; var pptHotspot:POINT):HIMAGELIST; external 'comctl32' name 'ImageList_GetDragImage';
-function InflateRect(var lprc: TRect; dx, dy: Integer): BOOL; external 'user32' name 'InflateRect';
-function InitializeAcl(var pAcl: TACL; nAclLength, dwAclRevision: DWORD): BOOL; external 'advapi32' name 'InitializeAcl';
-{$ifdef support_smartlink}
-function InitializeCriticalSectionAndSpinCount(var lpCriticalSection: TRTLCriticalSection; dwSpinCount: DWORD): BOOL;external 'kernel32' name 'InitializeCriticalSectionAndSpinCount';
-{$endif support_smartlink}
-function InitializeSid(Sid: Pointer; const pIdentifierAuthority: TSIDIdentifierAuthority; nSubAuthorityCount: Byte): BOOL; external 'advapi32' name 'InitializeSid';
-function InsertMenuItem(p1: HMENU; p2: UINT; p3: BOOL; const p4: TMenuItemInfo): BOOL;external 'user32' name 'InsertMenuItemA';
-function InsertMenuItemA(p1: HMENU; p2: UINT; p3: BOOL; const p4: TMenuItemInfoA): BOOL; external 'user32' name 'InsertMenuItemA';
-//function InsertMenuItemW(p1: HMENU; p2: UINT; p3: BOOL; const p4: TMenuItemInfoW): BOOL; external 'user32' name 'InsertMenuItemW';
-{$ifdef support_smartlink}
-function InterlockedCompareExchange(var Destination: Pointer; Exchange: Pointer; Comperand: Pointer): Pointer;external 'kernel32' name 'InterlockedCompareExchange';
-{$endif support_smartlink}
-function InterlockedDecrement(var Addend: longint): longint; external 'kernel32' name 'InterlockedDecrement';
-function InterlockedExchange(var Target: longint; Value: longint): longint; external 'kernel32' name 'InterlockedExchange';
-function InterlockedIncrement(var Addend: longint): longint; external 'kernel32' name 'InterlockedIncrement';
-function IntersectRect(var lprcDst: TRect; const lprcSrc1, lprcSrc2: TRect): BOOL; external 'user32' name 'IntersectRect';
-//function InvertRect(hDC: HDC; const lprc: TRect): BOOL; external 'user32' name 'InvertRect';
-function IsDialogMessage(hDlg: HWND; var lpMsg: TMsg): BOOL;external 'user32' name 'IsDialogMessageA';
-function IsDialogMessageA(hDlg: HWND; var lpMsg: TMsg): BOOL; external 'user32' name 'IsDialogMessageA';
-function IsDialogMessageW(hDlg: HWND; var lpMsg: TMsg): BOOL; external 'user32' name 'IsDialogMessageW';
-//function IsRectEmpty(const lprc: TRect): BOOL; external 'user32' name 'IsRectEmpty';
-function IsValidAcl(const pAcl: TACL): BOOL; external 'advapi32' name 'IsValidAcl';
-function LocalFileTimeToFileTime(const lpLocalFileTime: TFileTime; var lpFileTime: TFileTime): BOOL; external 'kernel32' name 'LocalFileTimeToFileTime';
-function LockFileEx(hFile: THandle; dwFlags, dwReserved: DWORD; nNumberOfBytesToLockLow, nNumberOfBytesToLockHigh: DWORD; const lpOverlapped: TOverlapped): BOOL; external 'kernel32' name 'LockFileEx';
-function LogonUser(lpszUsername, lpszDomain, lpszPassword: PChar; dwLogonType, dwLogonProvider: DWORD; var phToken: THandle): BOOL;external 'advapi32' name 'LogonUserA';
-function LogonUserA(lpszUsername, lpszDomain, lpszPassword: LPCSTR; dwLogonType, dwLogonProvider: DWORD; var phToken: THandle): BOOL; external 'advapi32' name 'LogonUserA';
-function LogonUserW(lpszUsername, lpszDomain, lpszPassword: LPWSTR; dwLogonType, dwLogonProvider: DWORD; var phToken: THandle): BOOL; external 'advapi32' name 'LogonUserW';
-function LookupAccountName(lpSystemName, lpAccountName: PChar; Sid: PSID; var cbSid: DWORD; ReferencedDomainName: PChar; var cbReferencedDomainName: DWORD; var peUse: SID_NAME_USE): BOOL;external 'advapi32' name 'LookupAccountNameA';
-function LookupAccountNameA(lpSystemName, lpAccountName: LPCSTR; Sid: PSID; var cbSid: DWORD; ReferencedDomainName: LPCSTR; var cbReferencedDomainName: DWORD; var peUse: SID_NAME_USE): BOOL; external 'advapi32' name 'LookupAccountNameA';
-function LookupAccountNameW(lpSystemName, lpAccountName: LPWSTR; Sid: PSID; var cbSid: DWORD; ReferencedDomainName: LPWSTR; var cbReferencedDomainName: DWORD; var peUse: SID_NAME_USE): BOOL; external 'advapi32' name 'LookupAccountNameW';
-function LookupAccountSid(lpSystemName: PChar; Sid: PSID; Name: PChar; var cbName: DWORD; ReferencedDomainName: PChar; var cbReferencedDomainName: DWORD; var peUse: SID_NAME_USE): BOOL;external 'advapi32' name 'LookupAccountSidA';
-function LookupAccountSidA(lpSystemName: LPCSTR; Sid: PSID; Name: LPCSTR; var cbName: DWORD; ReferencedDomainName: LPCSTR; var cbReferencedDomainName: DWORD; var peUse: SID_NAME_USE): BOOL; external 'advapi32' name 'LookupAccountSidA';
-function LookupAccountSidW(lpSystemName: LPWSTR; Sid: PSID; Name: LPWSTR; var cbName: DWORD; ReferencedDomainName: LPWSTR; var cbReferencedDomainName: DWORD; var peUse: SID_NAME_USE): BOOL; external 'advapi32' name 'LookupAccountSidW';
-function LookupPrivilegeDisplayName(lpSystemName, lpName: LPCSTR; lpDisplayName: PChar; var cbDisplayName, lpLanguageId: DWORD): BOOL;external 'advapi32' name 'LookupPrivilegeDisplayNameA';
-function LookupPrivilegeDisplayNameA(lpSystemName, lpName: LPCSTR; lpDisplayName: LPCSTR; var cbDisplayName, lpLanguageId: DWORD): BOOL; external 'advapi32' name 'LookupPrivilegeDisplayNameA';
-function LookupPrivilegeDisplayNameW(lpSystemName, lpName: LPCSTR; lpDisplayName: LPWSTR; var cbDisplayName, lpLanguageId: DWORD): BOOL; external 'advapi32' name 'LookupPrivilegeDisplayNameW';
-function LookupPrivilegeName(lpSystemName: PChar; var lpLuid: TLargeInteger; lpName: PChar; var cbName: DWORD): BOOL;external 'advapi32' name 'LookupPrivilegeNameA';
-function LookupPrivilegeNameA(lpSystemName: LPCSTR; var lpLuid: TLargeInteger; lpName: LPCSTR; var cbName: DWORD): BOOL; external 'advapi32' name 'LookupPrivilegeNameA';
-function LookupPrivilegeNameW(lpSystemName: LPWSTR; var lpLuid: TLargeInteger; lpName: LPWSTR; var cbName: DWORD): BOOL; external 'advapi32' name 'LookupPrivilegeNameW';
-function LookupPrivilegeValue(lpSystemName, lpName: PChar; var lpLuid: TLargeInteger): BOOL;external 'advapi32' name 'LookupPrivilegeValueA';
-function LookupPrivilegeValueA(lpSystemName, lpName: LPCSTR; var lpLuid: TLargeInteger): BOOL; external 'advapi32' name 'LookupPrivilegeValueA';
-function LookupPrivilegeValueW(lpSystemName, lpName: LPWSTR; var lpLuid: TLargeInteger): BOOL; external 'advapi32' name 'LookupPrivilegeValueW';
-function LPtoDP(DC: HDC; var Points; Count: Integer): BOOL; external 'gdi32' name 'LPtoDP';
-function MakeAbsoluteSD(pSelfRelativeSecurityDescriptor: PSecurityDescriptor; pAbsoluteSecurityDescriptor: PSecurityDescriptor; var lpdwAbsoluteSecurityDescriptorSi: DWORD; var pDacl: TACL; var lpdwDaclSize: DWORD; var pSacl: TACL;
- var lpdwSaclSize: DWORD; pOwner: PSID; var lpdwOwnerSize: DWORD; pPrimaryGroup: Pointer; var lpdwPrimaryGroupSize: DWORD): BOOL; external 'advapi32' name 'MakeAbsoluteSD';
-function MakeSelfRelativeSD(pAbsoluteSecurityDescriptor: PSecurityDescriptor; pSelfRelativeSecurityDescriptor: PSecurityDescriptor; var lpdwBufferLength: DWORD): BOOL; external 'advapi32' name 'MakeSelfRelativeSD';
-function MapDialogRect(hDlg: HWND; var lpRect: TRect): BOOL; external 'user32' name 'MapDialogRect';
-function MapWindowPoints(hWndFrom, hWndTo: HWND; var lpPoints; cPoints: UINT): Integer; external 'user32' name 'MapWindowPoints';
-function MessageBoxIndirect(const MsgBoxParams: TMsgBoxParams): BOOL;external 'user32' name 'MessageBoxIndirectA';
-function MessageBoxIndirectA(const MsgBoxParams: TMsgBoxParamsA): BOOL; external 'user32' name 'MessageBoxIndirectA';
-//function MessageBoxIndirectW(const MsgBoxParams: TMsgBoxParamsW): BOOL; external 'user32' name 'MessageBoxIndirectW';
-//function ModifyWorldTransform(DC: HDC; const p2: TXForm; p3: DWORD): BOOL; external 'gdi32' name 'ModifyWorldTransform';
-{$ifdef support_smartlink}
-function MsgWaitForMultipleObjectsEx(nCount: DWORD; var pHandles; dwMilliseconds, dwWakeMask, dwFlags: DWORD): DWORD;external 'user32' name 'MsgWaitForMultipleObjectsEx';
-{$endif support_smartlink}
-// function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; const lpMultiByteStr: LPCSTR; cchMultiByte: Integer; lLPWSTRStr: LPWSTR; cchWideChar: Integer): Integer; external 'kernel32' name 'MultiByteToWideChar';
-function ObjectOpenAuditAlarm(SubsystemName: PChar; HandleId: Pointer; ObjectTypeName: PChar; ObjectName: PChar; pSecurityDescriptor: PSecurityDescriptor; ClientToken: THandle; DesiredAccess, GrantedAccess: DWORD; var Privileges: TPrivilegeSet;
- ObjectCreation, AccessGranted: BOOL; var GenerateOnClose: BOOL): BOOL;external 'advapi32' name 'ObjectOpenAuditAlarmA';
-function ObjectOpenAuditAlarmA(SubsystemName: LPCSTR; HandleId: Pointer; ObjectTypeName: LPCSTR; ObjectName: LPCSTR; pSecurityDescriptor: PSecurityDescriptor; ClientToken: THandle; DesiredAccess, GrantedAccess: DWORD; var Privileges: TPrivilegeSet;
- ObjectCreation, AccessGranted: BOOL; var GenerateOnClose: BOOL): BOOL; external 'advapi32' name 'ObjectOpenAuditAlarmA';
-function ObjectOpenAuditAlarmW(SubsystemName: LPWSTR; HandleId: Pointer; ObjectTypeName: LPWSTR; ObjectName: LPWSTR; pSecurityDescriptor: PSecurityDescriptor; ClientToken: THandle; DesiredAccess, GrantedAccess: DWORD; var Privileges: TPrivilegeSet;
- ObjectCreation, AccessGranted: BOOL; var GenerateOnClose: BOOL): BOOL; external 'advapi32' name 'ObjectOpenAuditAlarmW';
-function ObjectPrivilegeAuditAlarm(SubsystemName: PChar; HandleId: Pointer; ClientToken: THandle; DesiredAccess: DWORD; var Privileges: TPrivilegeSet; AccessGranted: BOOL): BOOL;external 'advapi32' name 'ObjectPrivilegeAuditAlarmA';
-function ObjectPrivilegeAuditAlarmA(SubsystemName: LPCSTR; HandleId: Pointer; ClientToken: THandle; DesiredAccess: DWORD; var Privileges: TPrivilegeSet; AccessGranted: BOOL): BOOL; external 'advapi32' name 'ObjectPrivilegeAuditAlarmA';
-function ObjectPrivilegeAuditAlarmW(SubsystemName: LPWSTR; HandleId: Pointer; ClientToken: THandle; DesiredAccess: DWORD; var Privileges: TPrivilegeSet; AccessGranted: BOOL): BOOL; external 'advapi32' name 'ObjectPrivilegeAuditAlarmW';
-
-function OffsetRect(var lprc: TRect; dx, dy: Integer): BOOL; external 'user32' name 'OffsetRect';
-function OffsetViewportOrgEx(DC: HDC; X, Y: Integer; var Points): BOOL; external 'gdi32' name 'OffsetViewportOrgEx';
-function OffsetWindowOrgEx(DC: HDC; X, Y: Integer; var Points): BOOL; external 'gdi32' name 'OffsetWindowOrgEx';
-function OpenFile(const lpFileName: LPCSTR; var lpReOpenBuff: TOFStruct; uStyle: UINT): HFILE; external 'kernel32' name 'OpenFile';
-function OpenProcessToken(ProcessHandle: THandle; DesiredAccess: DWORD; var TokenHandle: THandle): BOOL; external 'advapi32' name 'OpenProcessToken';
-function OpenThreadToken(ThreadHandle: THandle; DesiredAccess: DWORD; OpenAsSelf: BOOL; var TokenHandle: THandle): BOOL; external 'advapi32' name 'OpenThreadToken';
-function PeekConsoleInput(hConsoleInput: THandle; var lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsRead: DWORD): BOOL;external 'kernel32' name 'PeekConsoleInputA';
-function PeekConsoleInputA(hConsoleInput: THandle; var lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsRead: DWORD): BOOL; external 'kernel32' name 'PeekConsoleInputA';
-function PeekConsoleInputW(hConsoleInput: THandle; var lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsRead: DWORD): BOOL; external 'kernel32' name 'PeekConsoleInputW';
-function PeekMessageA(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'user32' name 'PeekMessageA';
-//function PlayEnhMetaFile(DC: HDC; p2: HENHMETAFILE; const p3: TRect): BOOL; external 'gdi32' name 'PlayEnhMetaFile';
-function PlayEnhMetaFileRecord(DC: HDC; var p2: THandleTable; const p3: TEnhMetaRecord; p4: UINT): BOOL; external 'gdi32' name 'PlayEnhMetaFileRecord';
-function PlayMetaFileRecord(DC: HDC; const p2: THandleTable; const p3: TMetaRecord; p4: UINT): BOOL; external 'gdi32' name 'PlayMetaFileRecord';
-function PlgBlt(DC: HDC; const PointsArray; p3: HDC; p4, p5, p6, p7: Integer; p8: HBITMAP; p9, p10: Integer): BOOL; external 'gdi32' name 'PlgBlt';
-function PolyBezier(DC: HDC; const Points; Count: DWORD): BOOL; external 'gdi32' name 'PolyBezier';
-function PolyBezierTo(DC: HDC; const Points; Count: DWORD): BOOL; external 'gdi32' name 'PolyBezierTo';
-function PolyDraw(DC: HDC; const Points, Types; cCount: Integer): BOOL; external 'gdi32' name 'PolyDraw';
-function Polygon(DC: HDC; var Points; Count: Integer): BOOL; external 'gdi32' name 'Polygon';
-function Polyline(DC: HDC; var Points; Count: Integer): BOOL; external 'gdi32' name 'Polyline';
-function PolyLineTo(DC: HDC; const Points; Count: DWORD): BOOL; external 'gdi32' name 'PolylineTo';
-function PolyPolygon(DC: HDC; var Points; var nPoints; p4: Integer): BOOL; external 'gdi32' name 'PolyPolygon';
-function PolyPolyline(DC: HDC; const PointStructs; const Points; p4: DWORD): BOOL; external 'gdi32' name 'PolyPolyline';
-function PolyTextOut(DC: HDC; const PolyTextArray; Strings: Integer): BOOL;external 'gdi32' name 'PolyTextOutA';
-function PolyTextOutA(DC: HDC; const PolyTextArray; Strings: Integer): BOOL; external 'gdi32' name 'PolyTextOutA';
-function PolyTextOutW(DC: HDC; const PolyTextArray; Strings: Integer): BOOL; external 'gdi32' name 'PolyTextOutW';
-function PrivilegeCheck(ClientToken: THandle; const RequiredPrivileges: TPrivilegeSet; var pfResult: BOOL): BOOL; external 'advapi32' name 'PrivilegeCheck';
-function PrivilegedServiceAuditAlarm(SubsystemName, ServiceName: PChar; ClientToken: THandle; var Privileges: TPrivilegeSet; AccessGranted: BOOL): BOOL;external 'advapi32' name 'PrivilegedServiceAuditAlarmA';
-function PrivilegedServiceAuditAlarmA(SubsystemName, ServiceName: LPCSTR; ClientToken: THandle; var Privileges: TPrivilegeSet; AccessGranted: BOOL): BOOL; external 'advapi32' name 'PrivilegedServiceAuditAlarmA';
-function PrivilegedServiceAuditAlarmW(SubsystemName, ServiceName: LPWSTR; ClientToken: THandle; var Privileges: TPrivilegeSet; AccessGranted: BOOL): BOOL; external 'advapi32' name 'PrivilegedServiceAuditAlarmW';
-//function PtInRect(const lprc: TRect; pt: TPoint): BOOL; external 'user32' name 'PtInRect';
-function QueryPerformanceCounter(var lpPerformanceCount: TLargeInteger): BOOL; external 'kernel32' name 'QueryPerformanceCounter';
-function QueryPerformanceFrequency(var lpFrequency: TLargeInteger): BOOL; external 'kernel32' name 'QueryPerformanceFrequency';
-//function QueryRecoveryAgents(p1: PChar; var p2: Pointer; var p3: TRecoveryAgentInformation): DWORD;external 'kernel32' name 'QueryRecoveryAgentsA';
-//function QueryRecoveryAgentsA(p1: LPCSTR; var p2: Pointer; var p3: TRecoveryAgentInformationA): DWORD;external 'kernel32' name 'QueryRecoveryAgentsA';
-//function QueryRecoveryAgentsW(p1: LPWSTR; var p2: Pointer; var p3: TRecoveryAgentInformationW): DWORD;external 'kernel32' name 'QueryRecoveryAgentsW';
-procedure RaiseException(dwExceptionCode:DWORD; dwExceptionFlags:DWORD; nNumberOfArguments:DWORD; var lpArguments:DWORD); external 'kernel32' name 'RaiseException';
-function UnhandledExceptionFilter(var ExceptionInfo:emptyrecord):LONG; external 'kernel32' name 'UnhandledExceptionFilter';
-function ReadConsole(hConsoleInput: THandle; lpBuffer: Pointer; nNumberOfCharsToRead: DWORD; var lpNumberOfCharsRead: DWORD; lpReserved: Pointer): BOOL;external 'kernel32' name 'ReadConsoleA';
-function ReadConsoleA(hConsoleInput: THandle; lpBuffer: Pointer; nNumberOfCharsToRead: DWORD; var lpNumberOfCharsRead: DWORD; lpReserved: Pointer): BOOL; external 'kernel32' name 'ReadConsoleA';
-function ReadConsoleInput(hConsoleInput: THandle; var lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsRead: DWORD): BOOL;external 'kernel32' name 'ReadConsoleInputA';
-function ReadConsoleInputA(hConsoleInput: THandle; var lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsRead: DWORD): BOOL; external 'kernel32' name 'ReadConsoleInputA';
-function ReadConsoleInputW(hConsoleInput: THandle; var lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsRead: DWORD): BOOL; external 'kernel32' name 'ReadConsoleInputW';
-function ReadConsoleOutput(hConsoleOutput: THandle; lpBuffer: Pointer; dwBufferSize, dwBufferCoord: TCoord; var lpReadRegion: TSmallRect): BOOL;external 'kernel32' name 'ReadConsoleOutputA';
-function ReadConsoleOutputA(hConsoleOutput: THandle; lpBuffer: Pointer; dwBufferSize, dwBufferCoord: TCoord; var lpReadRegion: TSmallRect): BOOL; external 'kernel32' name 'ReadConsoleOutputA';
-function ReadConsoleOutputAttribute(hConsoleOutput: THandle; lpAttribute: Pointer; nLength: DWORD; dwReadCoord: TCoord; var lpNumberOfAttrsRead: DWORD): BOOL;external 'kernel32' name 'ReadConsoleOutputAttribute';
-function ReadConsoleOutputCharacter(hConsoleOutput: THandle; lpCharacter: LPCSTR; nLength: DWORD; dwReadCoord: TCoord; var lpNumberOfCharsRead: DWORD): BOOL;external 'kernel32' name 'ReadConsoleOutputCharacterA';
-function ReadConsoleOutputCharacterA(hConsoleOutput: THandle; lpCharacter: LPCSTR; nLength: DWORD; dwReadCoord: TCoord; var lpNumberOfCharsRead: DWORD): BOOL; external 'kernel32' name 'ReadConsoleOutputCharacterA';
-function ReadConsoleOutputCharacterW(hConsoleOutput: THandle; lpCharacter: LPCSTR; nLength: DWORD; dwReadCoord: TCoord; var lpNumberOfCharsRead: DWORD): BOOL; external 'kernel32' name 'ReadConsoleOutputCharacterW';
-function ReadConsoleOutputW(hConsoleOutput: THandle; lpBuffer: Pointer; dwBufferSize, dwBufferCoord: TCoord; var lpReadRegion: TSmallRect): BOOL; external 'kernel32' name 'ReadConsoleOutputW';
-function ReadConsoleW(hConsoleInput: THandle; lpBuffer: Pointer; nNumberOfCharsToRead: DWORD; var lpNumberOfCharsRead: DWORD; lpReserved: Pointer): BOOL; external 'kernel32' name 'ReadConsoleW';
-function ReadEventLog(hEventLog: THandle; dwReadFlags, dwRecordOffset: DWORD; lpBuffer: Pointer; nNumberOfBytesToRead: DWORD; var pnBytesRead, pnMinNumberOfBytesNeeded: DWORD): BOOL;external 'advapi32' name 'ReadEventLogA';
-function ReadEventLogA(hEventLog: THandle; dwReadFlags, dwRecordOffset: DWORD; lpBuffer: Pointer; nNumberOfBytesToRead: DWORD; var pnBytesRead, pnMinNumberOfBytesNeeded: DWORD): BOOL; external 'advapi32' name 'ReadEventLogA';
-function ReadEventLogW(hEventLog: THandle; dwReadFlags, dwRecordOffset: DWORD; lpBuffer: Pointer; nNumberOfBytesToRead: DWORD; var pnBytesRead, pnMinNumberOfBytesNeeded: DWORD): BOOL; external 'advapi32' name 'ReadEventLogW';
-function ReadProcessMemory(hProcess: THandle; const lpBaseAddress: Pointer; lpBuffer: Pointer; nSize: DWORD; var lpNumberOfBytesRead: DWORD): BOOL; external 'kernel32' name 'ReadProcessMemory';
-//function RectInRegion(RGN: HRGN; const p2: TRect): BOOL; external 'gdi32' name 'RectInRegion';
-//function RectVisible(DC: HDC; const Rect: TRect): BOOL; external 'gdi32' name 'RectVisible';
-function RegConnectRegistry(lpMachineName: PChar; hKey: HKEY; var phkResult: HKEY): Longint;external 'advapi32' name 'RegConnectRegistryA';
-function RegConnectRegistryA(lpMachineName: LPCSTR; hKey: HKEY; var phkResult: HKEY): Longint; external 'advapi32' name 'RegConnectRegistryA';
-function RegConnectRegistryW(lpMachineName: LPWSTR; hKey: HKEY; var phkResult: HKEY): Longint; external 'advapi32' name 'RegConnectRegistryW';
-function RegCreateKey(hKey: HKEY; lpSubKey: PChar; var phkResult: HKEY): Longint;external 'advapi32' name 'RegCreateKeyA';
-function RegCreateKeyA(hKey: HKEY; lpSubKey: LPCSTR; var phkResult: HKEY): Longint; external 'advapi32' name 'RegCreateKeyA';
-function RegCreateKeyEx(hKey: HKEY; lpSubKey: PChar; Reserved: DWORD; lpClass: PChar; dwOptions: DWORD; samDesired: REGSAM; lpSecurityAttributes: PSecurityAttributes; var phkResult: HKEY; lpdwDisposition: PDWORD): Longint;
- external 'advapi32' name 'RegCreateKeyExA';
-function RegCreateKeyExA(hKey: HKEY; lpSubKey: LPCSTR; Reserved: DWORD; lpClass: LPCSTR; dwOptions: DWORD; samDesired: REGSAM; lpSecurityAttributes: PSecurityAttributes; var phkResult: HKEY; lpdwDisposition: PDWORD): Longint;
- external 'advapi32' name 'RegCreateKeyExA';
-function RegCreateKeyExW(hKey: HKEY; lpSubKey: LPWSTR; Reserved: DWORD; lpClass: LPWSTR; dwOptions: DWORD; samDesired: REGSAM; lpSecurityAttributes: PSecurityAttributes; var phkResult: HKEY; lpdwDisposition: PDWORD): Longint;
- external 'advapi32' name 'RegCreateKeyExW';
-function RegCreateKeyW(hKey: HKEY; lpSubKey: LPWSTR; var phkResult: HKEY): Longint; external 'advapi32' name 'RegCreateKeyW';
-function RegEnumKeyEx(hKey: HKEY; dwIndex: DWORD; lpName: PChar; var lpcbName: DWORD; lpReserved: Pointer; lpClass: PChar; lpcbClass: PDWORD; lpftLastWriteTime: PFileTime): Longint;external 'advapi32' name 'RegEnumKeyExA';
-function RegEnumKeyExA(hKey: HKEY; dwIndex: DWORD; lpName: LPCSTR; var lpcbName: DWORD; lpReserved: Pointer; lpClass: LPCSTR; lpcbClass: PDWORD; lpftLastWriteTime: PFileTime): Longint; external 'advapi32' name 'RegEnumKeyExA';
-function RegEnumKeyExW(hKey: HKEY; dwIndex: DWORD; lpName: LPWSTR; var lpcbName: DWORD; lpReserved: Pointer; lpClass: LPWSTR; lpcbClass: PDWORD; lpftLastWriteTime: PFileTime): Longint; external 'advapi32' name 'RegEnumKeyExW';
-function RegEnumValue(hKey: HKEY; dwIndex: DWORD; lpValueName: PChar; var lpcbValueName: DWORD; lpReserved: Pointer; lpType: PDWORD; lpData: PByte; lpcbData: PDWORD): Longint;external 'advapi32' name 'RegEnumValueA';
-function RegEnumValueA(hKey: HKEY; dwIndex: DWORD; lpValueName: PChar; var lpcbValueName: DWORD; lpReserved: Pointer; lpType: PDWORD; lpData: PByte; lpcbData: PDWORD): Longint; external 'advapi32' name 'RegEnumValueA';
-function RegEnumValueW(hKey: HKEY; dwIndex: DWORD; lpValueName: PChar; var lpcbValueName: DWORD; lpReserved: Pointer; lpType: PDWORD; lpData: PByte; lpcbData: PDWORD): Longint; external 'advapi32' name 'RegEnumValueW';
-function RegGetKeySecurity(hKey: HKEY; SecurityInformation: SECURITY_INFORMATION; pSecurityDescriptor: PSecurityDescriptor; var lpcbSecurityDescriptor: DWORD): Longint; external 'advapi32' name 'RegGetKeySecurity';
-function RegisterClassA(const lpWndClass: TWndClassA): ATOM; external 'user32' name 'RegisterClassA';
-function RegisterClassEx(const WndClass: TWndClassEx): ATOM;external 'user32' name 'RegisterClassExA';
-function RegisterClassExA(const WndClass: TWndClassExA): ATOM; external 'user32' name 'RegisterClassExA';
-function RegisterClassExW(const WndClass: TWndClassExW): ATOM; external 'user32' name 'RegisterClassExW';
-function RegOpenKey(hKey: HKEY; lpSubKey: PChar; var phkResult: HKEY): Longint;external 'advapi32' name 'RegOpenKeyA';
-function RegOpenKeyA(hKey: HKEY; lpSubKey: LPCSTR; var phkResult: HKEY): Longint; external 'advapi32' name 'RegOpenKeyA';
-function RegOpenKeyEx(hKey: HKEY; lpSubKey: PChar; ulOptions: DWORD; samDesired: REGSAM; var phkResult: HKEY): Longint;external 'advapi32' name 'RegOpenKeyExA';
-function RegOpenKeyExA(hKey: HKEY; lpSubKey: LPCSTR; ulOptions: DWORD; samDesired: REGSAM; var phkResult: HKEY): Longint; external 'advapi32' name 'RegOpenKeyExA';
-function RegOpenKeyExW(hKey: HKEY; lpSubKey: LPWSTR; ulOptions: DWORD; samDesired: REGSAM; var phkResult: HKEY): Longint; external 'advapi32' name 'RegOpenKeyExW';
-function RegOpenKeyW(hKey: HKEY; lpSubKey: LPWSTR; var phkResult: HKEY): Longint; external 'advapi32' name 'RegOpenKeyW';
-function RegQueryMultipleValues(hKey: HKEY; var ValList; NumVals: DWORD; lpValueBuf: PChar; var ldwTotsize: DWORD): Longint;external 'advapi32' name 'RegQueryMultipleValuesA';
-function RegQueryMultipleValuesA(hKey: HKEY; var ValList; NumVals: DWORD; lpValueBuf: LPCSTR; var ldwTotsize: DWORD): Longint; external 'advapi32' name 'RegQueryMultipleValuesA';
-function RegQueryMultipleValuesW(hKey: HKEY; var ValList; NumVals: DWORD; lpValueBuf: LPWSTR; var ldwTotsize: DWORD): Longint; external 'advapi32' name 'RegQueryMultipleValuesW';
-function RegQueryValue(hKey: HKEY; lpSubKey: PChar; lpValue: PChar; var lpcbValue: Longint): Longint;external 'advapi32' name 'RegQueryValueA';
-function RegQueryValueA(hKey: HKEY; lpSubKey: LPCSTR; lpValue: LPCSTR; var lpcbValue: Longint): Longint; external 'advapi32' name 'RegQueryValueA';
-function RegQueryValueW(hKey: HKEY; lpSubKey: LPWSTR; lpValue: LPWSTR; var lpcbValue: Longint): Longint; external 'advapi32' name 'RegQueryValueW';
-function ResetDC(DC: HDC; const p2: TDeviceMode): HDC;external 'gdi32' name 'ResetDCA';
-function ResetDCA(DC: HDC; const p2: TDeviceModeA): HDC; external 'gdi32' name 'ResetDCA';
-//function ResetDCW(DC: HDC; const p2: TDeviceModeW): HDC; external 'gdi32' name 'ResetDCW';
-function ScreenToClient(hWnd: HWND; var lpPoint: TPoint): BOOL; external 'user32' name 'ScreenToClient';
-function ScrollConsoleScreenBuffer(hConsoleOutput: THandle; const lpScrollRectangle: TSmallRect; const lpClipRectangle: TSmallRect; dwDestinationOrigin: TCoord; var lpFill: TCharInfo): BOOL;external 'kernel32' name 'ScrollConsoleScreenBufferA';
-function ScrollConsoleScreenBufferA(hConsoleOutput: THandle; const lpScrollRectangle: TSmallRect; const lpClipRectangle: TSmallRect; dwDestinationOrigin: TCoord; var lpFill: TCharInfo): BOOL; external 'kernel32' name 'ScrollConsoleScreenBufferA';
-function ScrollConsoleScreenBufferW(hConsoleOutput: THandle; const lpScrollRectangle: TSmallRect; const lpClipRectangle: TSmallRect; dwDestinationOrigin: TCoord; var lpFill: TCharInfo): BOOL; external 'kernel32' name 'ScrollConsoleScreenBufferW';
-function ScrollWindow(hWnd:HWND; XAmount:longint; YAmount:longint;lpRect:lpRECT; lpClipRect:lpRECT):WINBOOL; external 'user32' name 'ScrollWindow';
-function ScrollWindowEx(hWnd:HWND; dx:longint; dy:longint; prcScroll:lpRECT; prcClip:lpRECT;hrgnUpdate:HRGN; prcUpdate:LPRECT; flags:UINT):longint; external 'user32' name 'ScrollWindowEx';
-//function ScrollDC(DC: HDC; DX, DY: Integer; var Scroll, Clip: TRect; Rgn: HRGN; Update: PRect): BOOL; external 'user32' name 'ScrollDC';
-//function SearchPath(lpPath, lpFileName, lpExtension: PChar; nBufferLength: DWORD; lpBuffer: PChar; var lpFilePart: PChar): DWORD;external 'kernel32' name 'SearchPathA';
-//function SearchPathA(lpPath, lpFileName, lpExtension: LPCSTR; nBufferLength: DWORD; lpBuffer: LPCSTR; var lpFilePart: LPCSTR): DWORD; external 'kernel32' name 'SearchPathA';
-//function SearchPathW(lpPath, lpFileName, lpExtension: LPWSTR; nBufferLength: DWORD; lpBuffer: LPWSTR; var lpFilePart: LPWSTR): DWORD; external 'kernel32' name 'SearchPathW';
-//function SendInput(cInputs: UINT; var pInputs: TInput; cbSize: Integer): UINT;external 'user32' name 'SendInput';
-function SendMessageTimeout(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM; fuFlags, uTimeout: UINT; var lpdwResult: DWORD): LRESULT;external 'user32' name 'SendMessageTimeoutA';
-function SendMessageTimeoutA(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM; fuFlags, uTimeout: UINT; var lpdwResult: DWORD): LRESULT; external 'user32' name 'SendMessageTimeoutA';
-function SendMessageTimeoutW(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM; fuFlags, uTimeout: UINT; var lpdwResult: DWORD): LRESULT; external 'user32' name 'SendMessageTimeoutW';
-//function SetAclInformation(var pAcl: TACL; pAclInformation: Pointer; nAclInformationLength: DWORD; dwAclInformationClass: TAclInformationClass): BOOL; external 'advapi32' name 'SetAclInformation';
-//function SetColorAdjustment(DC: HDC; const p2: TColorAdjustment): BOOL; external 'gdi32' name 'SetColorAdjustment';
-function SetCommConfig(hCommDev: THandle; const lpCC: TCommConfig; dwSize: DWORD): BOOL; external 'kernel32' name 'SetCommConfig';
-function SetCommState(hFile: THandle; const lpDCB: TDCB): BOOL; external 'kernel32' name 'SetCommState';
-function SetCommTimeouts(hFile: THandle; const lpCommTimeouts: TCommTimeouts): BOOL; external 'kernel32' name 'SetCommTimeouts';
-function SetConsoleCursorInfo(hConsoleOutput: THandle; const lpConsoleCursorInfo: TConsoleCursorInfo): BOOL; external 'kernel32' name 'SetConsoleCursorInfo';
-//function SetConsoleWindowInfo(hConsoleOutput: THandle; bAbsolute: BOOL; const lpConsoleWindow: TSmallRect): BOOL; external 'kernel32' name 'SetConsoleWindowInfo';
-{$ifdef support_smartlink}
-function SetCriticalSectionSpinCount(var lpCriticalSection: TRTLCriticalSection; dwSpinCount: DWORD): DWORD;external 'kernel32' name 'SetCriticalSectionSpinCount';
-{$endif support_smartlink}
-function SetDeviceGammaRamp(DC: HDC; var Ramp): BOOL; external 'gdi32' name 'SetDeviceGammaRamp';
-function SetDIBColorTable(DC: HDC; p2, p3: UINT; var RGBQuadSTructs): UINT; external 'gdi32' name 'SetDIBColorTable';
-function SetDIBits(DC: HDC; Bitmap: HBITMAP; StartScan, NumScans: UINT; Bits: Pointer; var BitsInfo: TBitmapInfo; Usage: UINT): Integer; external 'gdi32' name 'SetDIBits';
-//function SetDIBitsToDevice(DC: HDC; DestX, DestY: Integer; Width, Height: DWORD; SrcX, SrcY: Integer; nStartScan, NumScans: UINT; Bits: Pointer; var BitsInfo: TBitmapInfo; Usage: UINT): Integer; external 'gdi32' name 'SetDIBitsToDevice';
-//function SetKeyboardState(var KeyState: TKeyboardState): BOOL; external 'user32' name 'SetKeyboardState';
-//function SetLocalTime(const lpSystemTime: TSystemTime): BOOL; external 'kernel32' name 'SetLocalTime';
-//function SetMenuInfo(hMenu: HMENU; const lpcmi: TMenuInfo): BOOL;external 'user32' name 'SetMenuInfo';
-function SetMenuItemInfo(p1: HMENU; p2: UINT; p3: BOOL; const p4: TMenuItemInfo): BOOL;external 'user32' name 'SetMenuItemInfoA';
-function SetMenuItemInfoA(p1: HMENU; p2: UINT; p3: BOOL; const p4: TMenuItemInfoA): BOOL; external 'user32' name 'SetMenuItemInfoA';
-//function SetMenuItemInfoW(p1: HMENU; p2: UINT; p3: BOOL; const p4: TMenuItemInfoW): BOOL; external 'user32' name 'SetMenuItemInfoW';
-function SetMetaFileBitsEx(p1: UINT; const p2: PChar): HMETAFILE; external 'gdi32' name 'SetMetaFileBitsEx';
-function SetNamedPipeHandleState(hNamedPipe: THandle; var lpMode: DWORD; lpMaxCollectionCount, lpCollectDataTimeout: Pointer): BOOL; external 'kernel32' name 'SetNamedPipeHandleState';
-function SetPaletteEntries(Palette: HPALETTE; StartIndex, NumEntries: UINT; var PaletteEntries): UINT; external 'gdi32' name 'SetPaletteEntries';
-//function SetPrivateObjectSecurity(SecurityInformation: SECURITY_INFORMATION; ModificationDescriptor: PSecurityDescriptor; var ObjectsSecurityDescriptor: PSecurityDescriptor; const GenericMapping: TGenericMapping; Token: THandle): BOOL;
-// external 'advapi32' name 'SetPrivateObjectSecurity';
-//function SetPrivateObjectSecurityEx(SecurityInformation: SECURITY_INFORMATION; ModificationDescriptor: PSecurityDescriptor; var ObjectsSecurityDescriptor: PSecurityDescriptor; AutoInheritFlags: ULONG;
-// const GenericMapping: TGenericMapping; Token: THandle): BOOL;external 'advapi32' name 'SetPrivateObjectSecurityEx';
-function SetRect(var lprc: TRect; xLeft, yTop, xRight, yBottom: Integer): BOOL; external 'user32' name 'SetRect';
-function SetRectEmpty(var lprc: TRect): BOOL; external 'user32' name 'SetRectEmpty';
-function SetScrollInfo(hWnd: HWND; BarFlag: Integer; const ScrollInfo: TScrollInfo; Redraw: BOOL): Integer; external 'user32' name 'SetScrollInfo';
-function SetSysColors(cElements: Integer; const lpaElements; const lpaRgbValues): BOOL; external 'user32' name 'SetSysColors';
-//function SetSystemTime(const lpSystemTime: TSystemTime): BOOL; external 'kernel32' name 'SetSystemTime';
-function SetThreadContext(hThread: THandle; const lpContext: TContext): BOOL; external 'kernel32' name 'SetThreadContext';
-//function SetTimeZoneInformation(const lpTimeZoneInformation: TTimeZoneInformation): BOOL; external 'kernel32' name 'SetTimeZoneInformation';
-function SetUserObjectSecurity(hObj: THandle; var pSIRequested: DWORD; pSID: PSecurityDescriptor): BOOL;external 'user32' name 'SetUserObjectSecurity';
-function SetWaitableTimer(hTimer: THandle; const lpDueTime: TLargeInteger; lPeriod: Longint; pfnCompletionRoutine: TFNTimerAPCRoutine; lpArgToCompletionRoutine: Pointer; fResume: BOOL): BOOL;external 'kernel32' name 'SetWaitableTimer';
-function SetWinMetaFileBits(p1: UINT; p2: PChar; p3: HDC; const p4: TMetaFilePict): HENHMETAFILE; external 'gdi32' name 'SetWinMetaFileBits';
-//function SetWorldTransform(DC: HDC; const p2: TXForm): BOOL; external 'gdi32' name 'SetWorldTransform';
-function StartDoc(DC: HDC; const p2: TDocInfo): Integer;external 'gdi32' name 'StartDocA';
-function StartDocA(DC: HDC; const p2: TDocInfoA): Integer; external 'gdi32' name 'StartDocA';
-//function StartDocW(DC: HDC; const p2: TDocInfoW): Integer; external 'gdi32' name 'StartDocW';
-//function StretchDIBits(DC: HDC; DestX, DestY, DestWidth, DestHegiht, SrcX, SrcY, SrcWidth, SrcHeight: Integer; Bits: Pointer; var BitsInfo: TBitmapInfo; Usage: UINT; Rop: DWORD): Integer; external 'gdi32' name 'StretchDIBits';
-function SubtractRect(var lprcDst: TRect; const lprcSrc1, lprcSrc2: TRect): BOOL; external 'user32' name 'SubtractRect';
-function SystemTimeToFileTime(const lpSystemTime: TSystemTime; var lpFileTime: TFileTime): BOOL; external 'kernel32' name 'SystemTimeToFileTime';
-function SystemTimeToTzSpecificLocalTime(lpTimeZoneInformation: PTimeZoneInformation; var lpUniversalTime, lpLocalTime: TSystemTime): BOOL; external 'kernel32' name 'SystemTimeToTzSpecificLocalTime';
-function TabbedTextOut(hDC: HDC; X, Y: Integer; lpString: PChar; nCount, nTabPositions: Integer; var lpnTabStopPositions; nTabOrigin: Integer): Longint;external 'user32' name 'TabbedTextOutA';
-function TabbedTextOutA(hDC: HDC; X, Y: Integer; lpString: LPCSTR; nCount, nTabPositions: Integer; var lpnTabStopPositions; nTabOrigin: Integer): Longint; external 'user32' name 'TabbedTextOutA';
-function TabbedTextOutW(hDC: HDC; X, Y: Integer; lpString: LPWSTR; nCount, nTabPositions: Integer; var lpnTabStopPositions; nTabOrigin: Integer): Longint; external 'user32' name 'TabbedTextOutW';
-//function ToAscii(uVirtKey, uScanCode: UINT; const KeyState: TKeyboardState; lpChar: PChar; uFlags: UINT): Integer; external 'user32' name 'ToAscii';
-//function ToAsciiEx(uVirtKey: UINT; uScanCode: UINT; const KeyState: TKeyboardState; lpChar: PChar; uFlags: UINT; dwhkl: HKL): Integer; external 'user32' name 'ToAsciiEx';
-//function ToUnicode(wVirtKey, wScanCode: UINT; const KeyState: TKeyboardState; var pwszBuff; cchBuff: Integer; wFlags: UINT): Integer; external 'user32' name 'ToUnicode';
-// Careful, NT and higher only.
-function TrackMouseEvent(var EventTrack: TTrackMouseEvent): BOOL;external 'user32' name 'TrackMouseEvent';
-function TrackMouseEvent(lpEventTrack: PTrackMouseEvent): BOOL;external 'user32' name 'TrackMouseEvent';
-function TransactNamedPipe(hNamedPipe: THandle; lpInBuffer: Pointer; nInBufferSize: DWORD; lpOutBuffer: Pointer; nOutBufferSize: DWORD; var lpBytesRead: DWORD; lpOverlapped: POverlapped): BOOL; external 'kernel32' name 'TransactNamedPipe';
-function TranslateAccelerator(hWnd: HWND; hAccTable: HACCEL; var lpMsg: TMsg): Integer;external 'user32' name 'TranslateAcceleratorA';
-function TranslateAcceleratorA(hWnd: HWND; hAccTable: HACCEL; var lpMsg: TMsg): Integer; external 'user32' name 'TranslateAcceleratorA';
-function TranslateAcceleratorW(hWnd: HWND; hAccTable: HACCEL; var lpMsg: TMsg): Integer; external 'user32' name 'TranslateAcceleratorW';
-function TranslateCharsetInfo(var lpSrc: DWORD; var lpCs: TCharsetInfo; dwFlags: DWORD): BOOL; external 'gdi32' name 'TranslateCharsetInfo';
-function TranslateMDISysAccel(hWndClient: HWND; const lpMsg: TMsg): BOOL; external 'user32' name 'TranslateMDISysAccel';
-function TranslateMessage(const lpMsg: TMsg): BOOL; external 'user32' name 'TranslateMessage';
-//function TransparentDIBits(DC: HDC; p2, p3, p4, p5: Integer; const p6: Pointer; const p7: PBitmapInfo; p8: UINT; p9, p10, p11, p12: Integer; p13: UINT): BOOL;external 'gdi32' name 'TransparentDIBits';
-{$ifdef support_smartlink}
-function TryEnterCriticalSection(var lpCriticalSection: TRTLCriticalSection): BOOL;external 'kernel32' name 'TryEnterCriticalSection';
-{$endif support_smartlink}
-function UnhandledExceptionFilter(const ExceptionInfo: TExceptionPointers): Longint; external 'kernel32' name 'UnhandledExceptionFilter';
-function UnionRect(var lprcDst: TRect; const lprcSrc1, lprcSrc2: TRect): BOOL; external 'user32' name 'UnionRect';
-function UnlockFileEx(hFile: THandle; dwReserved, nNumberOfBytesToUnlockLow: DWORD; nNumberOfBytesToUnlockHigh: DWORD; const lpOverlapped: TOverlapped): BOOL; external 'kernel32' name 'UnlockFileEx';
-function VerFindFile(uFlags: DWORD; szFileName, szWinDir, szAppDir, szCurDir: PChar; var lpuCurDirLen: UINT; szDestDir: PChar; var lpuDestDirLen: UINT): DWORD;external 'version' name 'VerFindFileA';
-function VerFindFileA(uFlags: DWORD; szFileName, szWinDir, szAppDir, szCurDir: LPCSTR; var lpuCurDirLen: UINT; szDestDir: LPCSTR; var lpuDestDirLen: UINT): DWORD; external 'version' name 'VerFindFileA';
-function VerFindFileW(uFlags: DWORD; szFileName, szWinDir, szAppDir, szCurDir: LPWSTR; var lpuCurDirLen: UINT; szDestDir: LPWSTR; var lpuDestDirLen: UINT): DWORD; external 'version' name 'VerFindFileW';
-function VerInstallFile(uFlags: DWORD; szSrcFileName, szDestFileName, szSrcDir, szDestDir, szCurDir, szTmpFile: PChar; var lpuTmpFileLen: UINT): DWORD;external 'version' name 'VerInstallFileA';
-function VerInstallFileA(uFlags: DWORD; szSrcFileName, szDestFileName, szSrcDir, szDestDir, szCurDir, szTmpFile: LPCSTR; var lpuTmpFileLen: UINT): DWORD; external 'version' name 'VerInstallFileA';
-function VerInstallFileW(uFlags: DWORD; szSrcFileName, szDestFileName, szSrcDir, szDestDir, szCurDir, szTmpFile: LPWSTR; var lpuTmpFileLen: UINT): DWORD; external 'version' name 'VerInstallFileW';
-function VerQueryValue(pBlock: Pointer; lpSubBlock: PChar; var lplpBuffer: Pointer; var puLen: UINT): BOOL;external 'version' name 'VerQueryValueA';
-function VerQueryValueA(pBlock: Pointer; lpSubBlock: LPCSTR; var lplpBuffer: Pointer; var puLen: UINT): BOOL; external 'version' name 'VerQueryValueA';
-function VerQueryValueW(pBlock: Pointer; lpSubBlock: LPWSTR; var lplpBuffer: Pointer; var puLen: UINT): BOOL; external 'version' name 'VerQueryValueW';
-function VirtualQuery(lpAddress: Pointer; var lpBuffer: TMemoryBasicInformation; dwLength: DWORD): DWORD; external 'kernel32' name 'VirtualQuery';
-function VirtualQueryEx(hProcess: THandle; lpAddress: Pointer; var lpBuffer: TMemoryBasicInformation; dwLength: DWORD): DWORD; external 'kernel32' name 'VirtualQueryEx';
-function WaitCommEvent(hFile: THandle; var lpEvtMask: DWORD; lpOverlapped: POverlapped): BOOL; external 'kernel32' name 'WaitCommEvent';
-function WaitForDebugEvent(var lpDebugEvent: TDebugEvent; dwMilliseconds: DWORD): BOOL; external 'kernel32' name 'WaitForDebugEvent';
-function wglDescribeLayerPlane(p1: HDC; p2, p3: Integer; p4: Cardinal; var p5: TLayerPlaneDescriptor): BOOL;external 'opengl32' name 'wglDescribeLayerPlane';
-function wglGetLayerPaletteEntries(p1: HDC; p2, p3, p4: Integer; var pcr): Integer;external 'opengl32' name 'wglGetLayerPaletteEntries';
-function wglSetLayerPaletteEntries(p1: HDC; p2, p3, p4: Integer; var pcr): Integer;external 'opengl32' name 'wglSetLayerPaletteEntries';
-//function wglSwapMultipleBuffers(p1: UINT; const p2: PWGLSwap): DWORD;external 'opengl32' name 'wglSwapMultipleBuffers';
-//function WinSubmitCertificate(var lpCertificate: TWinCertificate): BOOL;external 'imaghlp' name 'WinSubmitCertificate';
-//function WinVerifyTrust(hwnd: HWND; const ActionID: TGUID; ActionData: Pointer): Longint;external 'imaghlp' name 'WinVerifyTrust';
-function WNetAddConnection2(var lpNetResource: TNetResource; lpPassword, lpUserName: PChar; dwFlags: DWORD): DWORD;external 'mpr' name 'WNetAddConnection2A';
-function WNetAddConnection2A(var lpNetResource: TNetResourceA; lpPassword, lpUserName: LPCSTR; dwFlags: DWORD): DWORD; external 'mpr' name 'WNetAddConnection2A';
-//function WNetAddConnection2W(var lpNetResource: TNetResourceW; lpPassword, lpUserName: LPWSTR; dwFlags: DWORD): DWORD; external 'mpr' name 'WNetAddConnection2W';
-function WNetAddConnection3(hwndOwner: HWND; var lpNetResource: TNetResource; lpPassword, lpUserName: PChar; dwFlags: DWORD): DWORD;external 'mpr' name 'WNetAddConnection3A';
-function WNetAddConnection3A(hwndOwner: HWND; var lpNetResource: TNetResourceA; lpPassword, lpUserName: LPCSTR; dwFlags: DWORD): DWORD; external 'mpr' name 'WNetAddConnection3A';
-//function WNetAddConnection3W(hwndOwner: HWND; var lpNetResource: TNetResourceW; lpPassword, lpUserName: LPWSTR; dwFlags: DWORD): DWORD; external 'mpr' name 'WNetAddConnection3W';
-function WNetConnectionDialog1(var lpConnDlgStruct: TConnectDlgStruct): DWORD;external 'mpr' name 'WNetConnectionDialog1A';
-function WNetConnectionDialog1A(var lpConnDlgStruct: TConnectDlgStruct): DWORD; external 'mpr' name 'WNetConnectionDialog1A';
-//function WNetConnectionDialog1W(var lpConnDlgStruct: TConnectDlgStruct): DWORD; external 'mpr' name 'WNetConnectionDialog1W';
-function WNetDisconnectDialog1(var lpConnDlgStruct: TDiscDlgStruct): DWORD;external 'mpr' name 'WNetDisconnectDialog1A';
-function WNetDisconnectDialog1A(var lpConnDlgStruct: TDiscDlgStructA): DWORD; external 'mpr' name 'WNetDisconnectDialog1A';
-//function WNetDisconnectDialog1W(var lpConnDlgStruct: TDiscDlgStructW): DWORD; external 'mpr' name 'WNetDisconnectDialog1W';
-function WNetEnumResource(hEnum: THandle; var lpcCount: DWORD; lpBuffer: Pointer; var lpBufferSize: DWORD): DWORD;external 'mpr' name 'WNetEnumResourceA';
-function WNetEnumResourceA(hEnum: THandle; var lpcCount: DWORD; lpBuffer: Pointer; var lpBufferSize: DWORD): DWORD; external 'mpr' name 'WNetEnumResourceA';
-function WNetEnumResourceW(hEnum: THandle; var lpcCount: DWORD; lpBuffer: Pointer; var lpBufferSize: DWORD): DWORD; external 'mpr' name 'WNetEnumResourceW';
-function WNetGetConnection(lpLocalName: PChar; lpRemoteName: PChar; var lpnLength: DWORD): DWORD;external 'mpr' name 'WNetGetConnectionA';
-function WNetGetConnectionA(lpLocalName: LPCSTR; lpRemoteName: LPCSTR; var lpnLength: DWORD): DWORD; external 'mpr' name 'WNetGetConnectionA';
-function WNetGetConnectionW(lpLocalName: LPWSTR; lpRemoteName: LPWSTR; var lpnLength: DWORD): DWORD; external 'mpr' name 'WNetGetConnectionW';
-function WNetGetLastError(var lpError: DWORD; lpErrorBuf: PChar; nErrorBufSize: DWORD; lpNameBuf: PChar; nNameBufSize: DWORD): DWORD;external 'mpr' name 'WNetGetLastErrorA';
-function WNetGetLastErrorA(var lpError: DWORD; lpErrorBuf: LPCSTR; nErrorBufSize: DWORD; lpNameBuf: LPCSTR; nNameBufSize: DWORD): DWORD; external 'mpr' name 'WNetGetLastErrorA';
-function WNetGetLastErrorW(var lpError: DWORD; lpErrorBuf: LPWSTR; nErrorBufSize: DWORD; lpNameBuf: LPWSTR; nNameBufSize: DWORD): DWORD; external 'mpr' name 'WNetGetLastErrorW';
-function WNetGetNetworkInformation(lpProvider: PChar; var lpNetInfoStruct: TNetInfoStruct): DWORD;external 'mpr' name 'WNetGetNetworkInformationA';
-function WNetGetNetworkInformationA(lpProvider: LPCSTR; var lpNetInfoStruct: TNetInfoStruct): DWORD; external 'mpr' name 'WNetGetNetworkInformationA';
-function WNetGetNetworkInformationW(lpProvider: LPWSTR; var lpNetInfoStruct: TNetInfoStruct): DWORD; external 'mpr' name 'WNetGetNetworkInformationW';
-function WNetGetProviderName(dwNetType: DWORD; lpProviderName: PChar; var lpBufferSize: DWORD): DWORD;external 'mpr' name 'WNetGetProviderNameA';
-function WNetGetProviderNameA(dwNetType: DWORD; lpProviderName: LPCSTR; var lpBufferSize: DWORD): DWORD; external 'mpr' name 'WNetGetProviderNameA';
-function WNetGetProviderNameW(dwNetType: DWORD; lpProviderName: LPWSTR; var lpBufferSize: DWORD): DWORD; external 'mpr' name 'WNetGetProviderNameW';
-function WNetGetResourceParent(lpNetResource: PNetResource; lpBuffer: Pointer; var cbBuffer: DWORD): DWORD;external 'mpr' name 'WNetGetResourceParentA';
-function WNetGetResourceParentA(lpNetResource: PNetResourceA; lpBuffer: Pointer; var cbBuffer: DWORD): DWORD;external 'mpr' name 'WNetGetResourceParentA';
-//function WNetGetResourceParentW(lpNetResource: PNetResourceW; lpBuffer: Pointer; var cbBuffer: DWORD): DWORD;external 'mpr' name 'WNetGetResourceParentW';
-function WNetGetUniversalName(lpLocalPath: PChar; dwInfoLevel: DWORD; lpBuffer: Pointer; var lpBufferSize: DWORD): DWORD;external 'mpr' name 'WNetGetUniversalNameA';
-function WNetGetUniversalNameA(lpLocalPath: LPCSTR; dwInfoLevel: DWORD; lpBuffer: Pointer; var lpBufferSize: DWORD): DWORD; external 'mpr' name 'WNetGetUniversalNameA';
-function WNetGetUniversalNameW(lpLocalPath: LPWSTR; dwInfoLevel: DWORD; lpBuffer: Pointer; var lpBufferSize: DWORD): DWORD; external 'mpr' name 'WNetGetUniversalNameW';
-function WNetGetUser(lpName: PChar; lpUserName: PChar; var lpnLength: DWORD): DWORD;external 'mpr' name 'WNetGetUserA';
-function WNetGetUserA(lpName: LPCSTR; lpUserName: LPCSTR; var lpnLength: DWORD): DWORD; external 'mpr' name 'WNetGetUserA';
-function WNetGetUserW(lpName: LPWSTR; lpUserName: LPWSTR; var lpnLength: DWORD): DWORD; external 'mpr' name 'WNetGetUserW';
-function WNetOpenEnum(dwScope, dwType, dwUsage: DWORD; lpNetResource: PNetResource; var lphEnum: THandle): DWORD;external 'mpr' name 'WNetOpenEnumA';
-function WNetOpenEnumA(dwScope, dwType, dwUsage: DWORD; lpNetResource: PNetResourceA; var lphEnum: THandle): DWORD; external 'mpr' name 'WNetOpenEnumA';
-//function WNetOpenEnumW(dwScope, dwType, dwUsage: DWORD; lpNetResource: PNetResourceW; var lphEnum: THandle): DWORD; external 'mpr' name 'WNetOpenEnumW';
-function WNetUseConnection(hwndOwner: HWND; var lpNetResource: TNetResource; lpUserID: PChar; lpPassword: PChar; dwFlags: DWORD; lpAccessName: PChar; var lpBufferSize: DWORD; var lpResult: DWORD): DWORD;external 'mpr' name 'WNetUseConnectionA';
-function WNetUseConnectionA(hwndOwner: HWND; var lpNetResource: TNetResourceA; lpUserID: LPCSTR; lpPassword: LPCSTR; dwFlags: DWORD; lpAccessName: LPCSTR; var lpBufferSize: DWORD; var lpResult: DWORD): DWORD; external 'mpr' name 'WNetUseConnectionA';
-//function WNetUseConnectionW(hwndOwner: HWND; var lpNetResource: TNetResourceW; lpUserID: LPWSTR; lpPassword: LPWSTR; dwFlags: DWORD; lpAccessName: LPWSTR; var lpBufferSize: DWORD; var lpResult: DWORD): DWORD; external 'mpr' name 'WNetUseConnectionW';
-function WriteConsole(hConsoleOutput: THandle; const lpBuffer: Pointer; nNumberOfCharsToWrite: DWORD; var lpNumberOfCharsWritten: DWORD; lpReserved: Pointer): BOOL;external 'kernel32' name 'WriteConsoleA';
-function WriteConsoleA(hConsoleOutput: THandle; const lpBuffer: Pointer; nNumberOfCharsToWrite: DWORD; var lpNumberOfCharsWritten: DWORD; lpReserved: Pointer): BOOL; external 'kernel32' name 'WriteConsoleA';
-function WriteConsoleInput(hConsoleInput: THandle; const lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsWritten: DWORD): BOOL;external 'kernel32' name 'WriteConsoleInputA';
-function WriteConsoleInputA(hConsoleInput: THandle; const lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsWritten: DWORD): BOOL; external 'kernel32' name 'WriteConsoleInputA';
-function WriteConsoleInputW(hConsoleInput: THandle; const lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsWritten: DWORD): BOOL; external 'kernel32' name 'WriteConsoleInputW';
-function WriteConsoleOutput(hConsoleOutput: THandle; lpBuffer: Pointer; dwBufferSize, dwBufferCoord: TCoord; var lpWriteRegion: TSmallRect): BOOL;external 'kernel32' name 'WriteConsoleOutputA';
-function WriteConsoleOutputA(hConsoleOutput: THandle; lpBuffer: Pointer; dwBufferSize, dwBufferCoord: TCoord; var lpWriteRegion: TSmallRect): BOOL; external 'kernel32' name 'WriteConsoleOutputA';
-function WriteConsoleOutputAttribute(hConsoleOutput: THandle; lpAttribute: Pointer; nLength: DWORD; dwWriteCoord: TCoord; var lpNumberOfAttrsWritten: DWORD): BOOL; external 'kernel32' name 'WriteConsoleOutputAttribute';
-function WriteConsoleOutputCharacter(hConsoleOutput: THandle;lpCharacter: PChar; nLength: DWORD; dwWriteCoord: TCoord; var lpNumberOfCharsWritten: DWORD): BOOL;external 'kernel32' name 'WriteConsoleOutputCharacterA';
-function WriteConsoleOutputCharacterA(hConsoleOutput: THandle;lpCharacter: LPCSTR; nLength: DWORD; dwWriteCoord: TCoord; var lpNumberOfCharsWritten: DWORD): BOOL; external 'kernel32' name 'WriteConsoleOutputCharacterA';
-function WriteConsoleOutputCharacterW(hConsoleOutput: THandle;lpCharacter: LPWSTR; nLength: DWORD; dwWriteCoord: TCoord; var lpNumberOfCharsWritten: DWORD): BOOL; external 'kernel32' name 'WriteConsoleOutputCharacterW';
-function WriteConsoleOutputW(hConsoleOutput: THandle; lpBuffer: Pointer; dwBufferSize, dwBufferCoord: TCoord; var lpWriteRegion: TSmallRect): BOOL; external 'kernel32' name 'WriteConsoleOutputW';
-function WriteConsoleW(hConsoleOutput: THandle; const lpBuffer: Pointer; nNumberOfCharsToWrite: DWORD; var lpNumberOfCharsWritten: DWORD; lpReserved: Pointer): BOOL; external 'kernel32' name 'WriteConsoleW';
-function WriteFileEx(hFile: THandle; lpBuffer: Pointer; nNumberOfBytesToWrite: DWORD; const lpOverlapped: TOverlapped; lpCompletionRoutine: FARPROC): BOOL; external 'kernel32' name 'WriteFileEx';
-function WriteProcessMemory(hProcess: THandle; const lpBaseAddress: Pointer; lpBuffer: Pointer; nSize: DWORD; var lpNumberOfBytesWritten: DWORD): BOOL; external 'kernel32' name 'WriteProcessMemory';
-
-// these are old Win16 funcs that under win32 are aliases for several char* funcs.
-// exist under Win32 (even in SDK's from 2002), but are officially "depreciated"
-function AnsiNext(const lpsz: LPCSTR): LPSTR;external 'user32' name 'CharNextA';
-function AnsiPrev(const lpszStart: LPCSTR; const lpszCurrent: LPCSTR): LPSTR;external 'user32' name 'CharPrevA';
-function AnsiToOem(const lpszSrc: LPCSTR; lpszDst: LPSTR): BOOL;external 'user32' name 'CharToOemA';
-function OemToAnsi(const lpszSrc: LPCSTR; lpszDst: LPSTR): BOOL;external 'user32' name 'OemToCharA';
-function AnsiToOemBuff(lpszSrc:LPCSTR; lpszDst:LPSTR; cchDstLength:DWORD):WINBOOL; external 'user32' name 'CharToOemBuffA';
-function OemToAnsiBuff(lpszSrc:LPCSTR; lpszDst:LPSTR; cchDstLength:DWORD):WINBOOL; external 'user32' name 'OemToCharBuffA';
-function AnsiUpper(lpsz:LPSTR):LPSTR; external 'user32' name 'CharUpperA';
-function AnsiUpperBuff(lpsz:LPSTR; cchLength:DWORD):DWORD; external 'user32' name 'CharUpperBuffA';
-function AnsiLower(lpsz:LPSTR):LPSTR; external 'user32' name 'CharLowerA';
-function AnsiLowerBuff(lpsz:LPSTR; cchLength:DWORD):DWORD; external 'user32' name 'CharLowerBuffA';
-//end win32 or wince not checked
-
-{$endif WIN32}
-
-
-{$endif read_interface}
-
-
-{$ifdef read_implementation}
-
-//begin common win32 & wince
-function MAKELANGID(PrimaryLang, SubLang: USHORT): WORD;
-begin
- MAKELANGID := (SubLang shl 10) or PrimaryLang;
-end;
-
-function PRIMARYLANGID(LangId: WORD): WORD;
-begin
- PRIMARYLANGID := LangId and $3FF;
-end;
-
-function SUBLANGID(LangId: WORD): WORD;
-begin
- SUBLANGID := LangId shr 10;
-end;
-
-function MAKELCID(LangId, SortId: WORD): DWORD;
-begin
- MAKELCID := (DWORD(SortId) shl 16) or DWORD(LangId);
-end;
-
-function MAKESORTLCID(LangId, SortId, SortVersion: WORD): DWORD;
-begin
- MAKESORTLCID := MAKELCID(LangId, SortId) or (SortVersion shl 20);
-end;
-
-function LANGIDFROMLCID(LocaleId: LCID): WORD;
-begin
- LANGIDFROMLCID := WORD(LocaleId);
-end;
-
-function SORTIDFROMLCID(LocaleId: LCID): WORD;
-begin
- SORTIDFROMLCID := WORD((DWORD(LocaleId) shr 16) and $F);
-end;
-
-function SORTVERSIONFROMLCID(LocaleId: LCID): WORD;
-begin
- SORTVERSIONFROMLCID := WORD((DWORD(LocaleId) shr 20) and $F);
-end;
-
-function LANG_SYSTEM_DEFAULT: WORD;
-begin
- LANG_SYSTEM_DEFAULT := MAKELANGID(LANG_NEUTRAL, SUBLANG_SYS_DEFAULT);
-end;
-
-function LANG_USER_DEFAULT: WORD;
-begin
- LANG_USER_DEFAULT := MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT);
-end;
-
-function LOCALE_USER_DEFAULT: DWORD;
-begin
- LOCALE_USER_DEFAULT:= MAKELCID(LANG_USER_DEFAULT, SORT_DEFAULT);
-end;
-
-function LOCALE_SYSTEM_DEFAULT: DWORD;
-begin
- LOCALE_SYSTEM_DEFAULT:= MAKELCID(LANG_SYSTEM_DEFAULT, SORT_DEFAULT);
-end;
-
-function LOCALE_NEUTRAL: DWORD;
-begin
- LOCALE_NEUTRAL := MAKELCID(MAKELANGID(LANG_NEUTRAL, SUBLANG_NEUTRAL), SORT_DEFAULT);
-end;
-
-function LOCALE_INVARIANT: DWORD;
-begin
- LOCALE_INVARIANT := MAKELCID(MAKELANGID(LANG_INVARIANT, SUBLANG_NEUTRAL), SORT_DEFAULT);
-end;
-
-//end common win32 & wince
-
-{$ifdef WINCE}
-//begin wince only
-
-function MsgWaitForMultipleObjects(nCount: DWORD; var pHandles; fWaitAll: BOOL; dwMilliseconds, dwWakeMask: DWORD): DWORD;
-begin
- MsgWaitForMultipleObjects:=MsgWaitForMultipleObjectsEx(nCount,@pHandles,dwMilliseconds,dwWakeMask,0);
-end;
-
-//end wince only
-{$endif WINCE}
-
-{$ifdef WIN32}
-//begin win32 or wince not checked
-function Succeeded(Status : HRESULT) : BOOL;
- begin
- Succeeded:=Status and HRESULT($80000000)=0;
- end;
-
-function Failed(Status : HRESULT) : BOOL;
- begin
- Failed:=Status and HRESULT($80000000)<>0;
- end;
-
-function IsError(Status : HRESULT) : BOOL;
- begin
- IsError:=(Status shr 31)=SEVERITY_ERROR;
- end;
-
-function HResultCode(hr : HRESULT) : Longint;
- begin
- HResultCode:=hr and $0000ffff;
- end;
-
-function HResultFacility(hr : HRESULT) : Longint;
- begin
- HResultFacility:=(hr shr 16) and $00001fff;
- end;
-
-function HResultSeverity(hr : HRESULT) : Longint;
- begin
- HResultSeverity:=(hr shr 31) and $00000001;
- end;
-
-function MakeResult(p1,p2,mask : Longint): HRESULT;
- begin
- MakeResult:=(p1 shl 31) or (p2 shl 16) or mask;
- end;
-
-function HResultFromWin32(x : Longint) : HRESULT;
- begin
- HResultFromWin32:=x;
- if HResultFromWin32<>0 then
- HResultFromWin32:=((HResultFromWin32 and $0000ffff) or
- (FACILITY_WIN32 shl 16) or HRESULT($80000000));
- end;
-
-function HResultFromNT(x : Longint) : HRESULT;
- begin
- HResultFromNT:=x or FACILITY_NT_BIT;
- end;
-
-//end win32 or wince not checked
-
-{$endif WIN32}
-
-
-{$endif read_implementation}
-
diff --git a/rtl/wince/wininc/struct.inc b/rtl/wince/wininc/struct.inc deleted file mode 100644 index b93d34ad16..0000000000 --- a/rtl/wince/wininc/struct.inc +++ /dev/null @@ -1,8091 +0,0 @@ -{
- This file is part of the Free Pascal run time library.
- This unit contains the record definition for the Win32 API
- Copyright (c) 1999-2000 by Florian KLaempfl,
- member of the Free Pascal development team.
-
- 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.
-
- **********************************************************************}
-
-{
- Structures.h
-
- Declarations for all the Windows32 API Structures
-
- Copyright (C) 1996 Free Software Foundation, Inc.
-
- Author: Scott Christley <scottc@net-community.com>
- Date: 1996
-
- This file is part of the Windows32 API Library.
-
- This library is free software; you can redistribute it and/or
- modify it under the terms of the GNU Library General Public
- License as published by the Free Software Foundation; either
- version 2 of the License, or (at your option) any later version.
-
- This library is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
-
- If you are interested in a warranty or support for this source code,
- contact Scott Christley <scottc@net-community.com> for more information.
-
- You should have received a copy of the GNU Library General Public
- License along with this library; see the file COPYING.LIB.
- If not, write to the Free Software Foundation,
- 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-
- Changes :
-
- 22/15/2005 update for wince4.2 port, orinaudo@gmail.com
-
-}
-
-{$ifdef read_interface}
-
- type
-
- { WARNING
- the variable argument list
- is not implemented for FPC
- va_list is just a dummy record
- MvdV: Nevertheless it should be a pointer type, not a record}
-
- va_list = pchar;
-
- ABC = record
- abcA : longint;
- abcB : UINT;
- abcC : longint;
- end;
- LPABC = ^ABC;
- _ABC = ABC;
- TABC = ABC;
- PABC = ^ABC;
-
- ABCFLOAT = record
- abcfA : Single;
- abcfB : Single;
- abcfC : Single;
- end;
- LPABCFLOAT = ^ABCFLOAT;
- _ABCFLOAT = ABCFLOAT;
- TABCFLOAT = ABCFLOAT;
- PABCFLOAT = ^ABCFLOAT;
-
- ACCEL = record
- fVirt : BYTE;
- key : WORD;
- cmd : WORD;
- end;
- LPACCEL = ^ACCEL;
- _ACCEL = ACCEL;
- TACCEL = ACCEL;
- PACCEL = ^ACCEL;
-
- //
- // The structure of an ACE is a common ace header followed by ace type
- // specific data. Pictorally the structure of the common ace header is
- // as follows:
- //
- // 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1
- // 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
- // +---------------+-------+-------+---------------+---------------+
- // | AceSize | AceFlags | AceType |
- // +---------------+-------+-------+---------------+---------------+
- //
- // AceType denotes the type of the ace, there are some predefined ace
- // types
- //
- // AceSize is the size, in bytes, of ace.
- //
- // AceFlags are the Ace flags for audit and inheritance, defined shortly.
-
- ACE_HEADER = record //winnt
- AceType : BYTE;
- AceFlags : BYTE;
- AceSize : WORD;
- end;
- _ACE_HEADER = ACE_HEADER;
- TACE_HEADER = ACE_HEADER;
- PACE_HEADER = ^ACE_HEADER;
-
- ACCESS_MASK = DWORD; //winnt
- PACCESS_MASK = ^ACCESS_MASK; //+winnt
-
- REGSAM = ACCESS_MASK;
-
- ACCESS_ALLOWED_ACE = record
- Header : ACE_HEADER;
- Mask : ACCESS_MASK;
- SidStart : DWORD;
- end;
- _ACCESS_ALLOWED_ACE = ACCESS_ALLOWED_ACE;
- TACCESS_ALLOWED_ACE = ACCESS_ALLOWED_ACE;
- PACCESS_ALLOWED_ACE = ^ACCESS_ALLOWED_ACE;
-
- ACCESS_DENIED_ACE = record
- Header : ACE_HEADER;
- Mask : ACCESS_MASK;
- SidStart : DWORD;
- end;
- _ACCESS_DENIED_ACE = ACCESS_DENIED_ACE;
- TACCESS_DENIED_ACE = ACCESS_DENIED_ACE;
-
- ACCESSTIMEOUT = record
- cbSize : UINT;
- dwFlags : DWORD;
- iTimeOutMSec : DWORD;
- end;
- _ACCESSTIMEOUT = ACCESSTIMEOUT;
- TACCESSTIMEOUT = ACCESSTIMEOUT;
- PACCESSTIMEOUT = ^ACCESSTIMEOUT;
-
- PACCESS_TOKEN = PVOID; //+winnt
-
- ////////////////////////////////////////////////////////////////////////
- // //
- // ACL and ACE //
- // //
- ////////////////////////////////////////////////////////////////////////
-
- //
- // Define an ACL and the ACE format. The structure of an ACL header
- // followed by one or more ACEs. Pictorally the structure of an ACL header
- // is as follows:
- //
- // 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1
- // 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
- // +-------------------------------+---------------+---------------+
- // | AclSize | Sbz1 | AclRevision |
- // +-------------------------------+---------------+---------------+
- // | Sbz2 | AceCount |
- // +-------------------------------+-------------------------------+
- //
- // The current AclRevision is defined to be ACL_REVISION.
- //
- // AclSize is the size, in bytes, allocated for the ACL. This includes
- // the ACL header, ACES, and remaining free space in the buffer.
- //
- // AceCount is the number of ACES in the ACL.
- //
-
- ACL = record //winnt
- AclRevision : BYTE;
- Sbz1 : BYTE;
- AclSize : WORD;
- AceCount : WORD;
- Sbz2 : WORD;
- end;
- PACL = ^ACL;
- _ACL = ACL;
- TACL = ACL;
-
- ACL_REVISION_INFORMATION = record
- AclRevision : DWORD;
- end;
- _ACL_REVISION_INFORMATION = ACL_REVISION_INFORMATION;
- TACLREVISIONINFORMATION = ACL_REVISION_INFORMATION;
- PACLREVISIONINFORMATION = ^ACL_REVISION_INFORMATION;
-
- ACL_SIZE_INFORMATION = record
- AceCount : DWORD;
- AclBytesInUse : DWORD;
- AclBytesFree : DWORD;
- end;
- _ACL_SIZE_INFORMATION = ACL_SIZE_INFORMATION;
- TACLSIZEINFORMATION = ACL_SIZE_INFORMATION;
- PACLSIZEINFORMATION = ^ACL_SIZE_INFORMATION;
-
- ACTION_HEADER = record
- transport_id : ULONG;
- action_code : USHORT;
- reserved : USHORT;
- end;
- _ACTION_HEADER = ACTION_HEADER;
- TACTIONHEADER = ACTION_HEADER;
- PACTIONHEADER = ^ACTION_HEADER;
-
- ADAPTER_STATUS = record
- adapter_address : array[0..5] of UCHAR;
- rev_major : UCHAR;
- reserved0 : UCHAR;
- adapter_type : UCHAR;
- rev_minor : UCHAR;
- duration : WORD;
- frmr_recv : WORD;
- frmr_xmit : WORD;
- iframe_recv_err : WORD;
- xmit_aborts : WORD;
- xmit_success : DWORD;
- recv_success : DWORD;
- iframe_xmit_err : WORD;
- recv_buff_unavail : WORD;
- t1_timeouts : WORD;
- ti_timeouts : WORD;
- reserved1 : DWORD;
- free_ncbs : WORD;
- max_cfg_ncbs : WORD;
- max_ncbs : WORD;
- xmit_buf_unavail : WORD;
- max_dgram_size : WORD;
- pending_sess : WORD;
- max_cfg_sess : WORD;
- max_sess : WORD;
- max_sess_pkt_size : WORD;
- name_count : WORD;
- end;
- _ADAPTER_STATUS = ADAPTER_STATUS;
- TADAPTERSTATUS = ADAPTER_STATUS;
- PADAPTERSTATUS = ^ADAPTER_STATUS;
-
- ADDJOB_INFO_1 = record
- Path : LPTSTR;
- JobId : DWORD;
- end;
- _ADDJOB_INFO_1 = ADDJOB_INFO_1;
- TADDJOB_INFO_1 = ADDJOB_INFO_1;
- PADDJOB_INFO_1 = ^ADDJOB_INFO_1;
-
- ANIMATIONINFO = record
- cbSize : UINT;
- iMinAnimate : longint;
- end;
- LPANIMATIONINFO = ^ANIMATIONINFO;
- _ANIMATIONINFO = ANIMATIONINFO;
- TANIMATIONINFO = ANIMATIONINFO;
- PANIMATIONINFO = ^ANIMATIONINFO;
-
- POINT = record
- x : LONG;
- y : LONG;
- end;
- LPPOINT = ^POINT;
- tagPOINT = POINT;
- TPOINT = POINT;
- PPOINT = ^POINT;
-
- RECT = record
- case Integer of
- 0: (Left,Top,Right,Bottom : Longint);
- 1: (TopLeft,BottomRight : TPoint);
- end;
- LPRECT = ^RECT;
- _RECT = RECT;
- TRECT = RECT;
- PRECT = ^RECT;
- tagRECT = RECT; //+windef
-
- RECTL = record
- left : LONG;
- top : LONG;
- right : LONG;
- bottom : LONG;
- end;
- _RECTL = RECTL;
- TRECTL = RECTL;
- PRECTL = ^RECTL;
-
- APPBARDATA = record
- cbSize : DWORD;
- hWnd : HWND;
- uCallbackMessage : UINT;
- uEdge : UINT;
- rc : RECT;
- lParam : LPARAM;
- end;
- _AppBarData = APPBARDATA;
- TAppBarData = APPBARDATA;
- PAppBarData = ^APPBARDATA;
-
- BITMAP = record
- bmType : LONG;
- bmWidth : LONG;
- bmHeight : LONG;
- bmWidthBytes : LONG;
- bmPlanes : WORD;
- bmBitsPixel : WORD;
- bmBits : LPVOID;
- end;
- PBITMAP = ^BITMAP;
- NPBITMAP = ^BITMAP;
- LPBITMAP = ^BITMAP;
- tagBITMAP = BITMAP;
- TBITMAP = BITMAP;
-
- BITMAPCOREHEADER = record
- bcSize : DWORD;
- bcWidth : WORD;
- bcHeight : WORD;
- bcPlanes : WORD;
- bcBitCount : WORD;
- end;
- tagBITMAPCOREHEADER = BITMAPCOREHEADER;
- TBITMAPCOREHEADER = BITMAPCOREHEADER;
- PBITMAPCOREHEADER = ^BITMAPCOREHEADER;
-
- RGBTRIPLE = record
- rgbtBlue : BYTE;
- rgbtGreen : BYTE;
- rgbtRed : BYTE;
- end;
- tagRGBTRIPLE = RGBTRIPLE;
- TRGBTRIPLE = RGBTRIPLE;
- PRGBTRIPLE = ^RGBTRIPLE;
-
- BITMAPCOREINFO = record
- bmciHeader : BITMAPCOREHEADER;
- bmciColors : array[0..0] of RGBTRIPLE;
- end;
- PBITMAPCOREINFO = ^BITMAPCOREINFO;
- LPBITMAPCOREINFO = ^BITMAPCOREINFO;
- _BITMAPCOREINFO = BITMAPCOREINFO;
- TBITMAPCOREINFO = BITMAPCOREINFO;
-
-(* error
- WORD bfReserved1;
- WORD bfReserved2;
- in declarator_list *)
-
- BITMAPINFOHEADER = record
- biSize : DWORD;
- biWidth : LONG;
- biHeight : LONG;
- biPlanes : WORD;
- biBitCount : WORD;
- biCompression : DWORD;
- biSizeImage : DWORD;
- biXPelsPerMeter : LONG;
- biYPelsPerMeter : LONG;
- biClrUsed : DWORD;
- biClrImportant : DWORD;
- end;
- LPBITMAPINFOHEADER = ^BITMAPINFOHEADER;
- TBITMAPINFOHEADER = BITMAPINFOHEADER;
- PBITMAPINFOHEADER = ^BITMAPINFOHEADER;
-
- RGBQUAD = record
- rgbBlue : BYTE;
- rgbGreen : BYTE;
- rgbRed : BYTE;
- rgbReserved : BYTE;
- end;
- tagRGBQUAD = RGBQUAD;
- TRGBQUAD = RGBQUAD;
- PRGBQUAD = ^RGBQUAD;
-
- BITMAPINFO = record
- bmiHeader : BITMAPINFOHEADER;
- bmiColors : array[0..0] of RGBQUAD;
- end;
- LPBITMAPINFO = ^BITMAPINFO;
- PBITMAPINFO = ^BITMAPINFO;
- TBITMAPINFO = BITMAPINFO;
-
- FXPT2DOT30 = longint;
- LPFXPT2DOT30 = ^FXPT2DOT30;
- TPFXPT2DOT30 = FXPT2DOT30;
- PPFXPT2DOT30 = ^FXPT2DOT30;
-
- CIEXYZ = record
- ciexyzX : FXPT2DOT30;
- ciexyzY : FXPT2DOT30;
- ciexyzZ : FXPT2DOT30;
- end;
- tagCIEXYZ = CIEXYZ;
- LPCIEXYZ = ^CIEXYZ;
- TPCIEXYZ = CIEXYZ;
- PCIEXYZ = ^CIEXYZ;
-
- CIEXYZTRIPLE = record
- ciexyzRed : CIEXYZ;
- ciexyzGreen : CIEXYZ;
- ciexyzBlue : CIEXYZ;
- end;
- tagCIEXYZTRIPLE = CIEXYZTRIPLE;
- LPCIEXYZTRIPLE = ^CIEXYZTRIPLE;
- TCIEXYZTRIPLE = CIEXYZTRIPLE;
- PCIEXYZTRIPLE = ^CIEXYZTRIPLE;
-
- BITMAPV4HEADER = record
- bV4Size : DWORD;
- bV4Width : LONG;
- bV4Height : LONG;
- bV4Planes : WORD;
- bV4BitCount : WORD;
- bV4V4Compression : DWORD;
- bV4SizeImage : DWORD;
- bV4XPelsPerMeter : LONG;
- bV4YPelsPerMeter : LONG;
- bV4ClrUsed : DWORD;
- bV4ClrImportant : DWORD;
- bV4RedMask : DWORD;
- bV4GreenMask : DWORD;
- bV4BlueMask : DWORD;
- bV4AlphaMask : DWORD;
- bV4CSType : DWORD;
- bV4Endpoints : CIEXYZTRIPLE;
- bV4GammaRed : DWORD;
- bV4GammaGreen : DWORD;
- bV4GammaBlue : DWORD;
- end;
- LPBITMAPV4HEADER = ^BITMAPV4HEADER;
- TBITMAPV4HEADER = BITMAPV4HEADER;
- PBITMAPV4HEADER = ^BITMAPV4HEADER;
-
- BITMAPFILEHEADER = packed record
- bfType : Word;
- bfSize : DWord;
- bfReserved1 : Word;
- bfReserved2 : Word;
- bfOffBits : DWord;
- end;
-
- BLOB = record
- cbSize : ULONG;
- pBlobData : ^BYTE;
- end;
- _BLOB = BLOB;
- TBLOB = BLOB;
- PBLOB = ^BLOB;
-
- SHITEMID = record
- cb : USHORT;
- abID : array[0..0] of BYTE;
- end;
- LPSHITEMID = ^SHITEMID;
- LPCSHITEMID = ^SHITEMID;
- _SHITEMID = SHITEMID;
- TSHITEMID = SHITEMID;
- PSHITEMID = ^SHITEMID;
-
- ITEMIDLIST = record
- mkid : SHITEMID;
- end;
- LPITEMIDLIST = ^ITEMIDLIST;
- LPCITEMIDLIST = ^ITEMIDLIST;
- _ITEMIDLIST = ITEMIDLIST;
- TITEMIDLIST = ITEMIDLIST;
- PITEMIDLIST = ^ITEMIDLIST;
-
- BROWSEINFO = record
- hwndOwner : HWND;
- pidlRoot : LPCITEMIDLIST;
- pszDisplayName : LPSTR;
- lpszTitle : LPCSTR;
- ulFlags : UINT;
- lpfn : BFFCALLBACK;
- lParam : LPARAM;
- iImage : longint;
- end;
- LPBROWSEINFO = ^BROWSEINFO;
- _browseinfo = BROWSEINFO;
- Tbrowseinfo = BROWSEINFO;
- PBROWSEINFO = ^BROWSEINFO;
-
- FILETIME = record
- dwLowDateTime : DWORD;
- dwHighDateTime : DWORD;
- end;
- LPFILETIME = ^FILETIME;
- _FILETIME = FILETIME;
- TFILETIME = FILETIME;
- PFILETIME = ^FILETIME;
-
- _GET_FILEEX_INFO_LEVELS=(GetFileExInfoStandard,GetFileExMaxInfoLevel); //+winbase
- GET_FILEEX_INFO_LEVELS=_GET_FILEEX_INFO_LEVELS; //+winbase
-
- _FINDEX_INFO_LEVELS = (FindExInfoStandard,FindExInfoMaxInfoLevel); //+winbase
- FINDEX_INFO_LEVELS = _FINDEX_INFO_LEVELS; //+winbase
-
- _FINDEX_SEARCH_OPS = ( FindExSearchNameMatch, FindExSearchLimitToDirectories,
- FindExSearchLimitToDevices, FindExSearchMaxSearchOp);
- FINDEX_SEARCH_OPS=_FINDEX_SEARCH_OPS;
-
- BY_HANDLE_FILE_INFORMATION = record
- dwFileAttributes : DWORD;
- ftCreationTime : FILETIME;
- ftLastAccessTime : FILETIME;
- ftLastWriteTime : FILETIME;
- dwVolumeSerialNumber : DWORD;
- nFileSizeHigh : DWORD;
- nFileSizeLow : DWORD;
- nNumberOfLinks : DWORD;
- nFileIndexHigh : DWORD;
- nFileIndexLow : DWORD;
- end;
- LPBY_HANDLE_FILE_INFORMATION = ^BY_HANDLE_FILE_INFORMATION;
- _BY_HANDLE_FILE_INFORMATION = BY_HANDLE_FILE_INFORMATION;
- TBYHANDLEFILEINFORMATION = BY_HANDLE_FILE_INFORMATION;
- PBYHANDLEFILEINFORMATION = ^BY_HANDLE_FILE_INFORMATION;
-
- FIXED = record
- fract : WORD;
- value : integer;
- end;
- _FIXED = FIXED;
- TFIXED = FIXED;
- PFIXED = ^FIXED;
-
- POINTFX = record
- x : FIXED;
- y : FIXED;
- end;
- tagPOINTFX = POINTFX;
- TPOINTFX = POINTFX;
- PPOINTFX = ^POINTFX;
-
- POINTL = record
- x : LONG;
- y : LONG;
- end;
- _POINTL = POINTL;
- TPOINTL = POINTL;
- PPOINTL = ^POINTL;
-
- TSmallPoint = record
- X,
- Y : SmallInt;
- end;
-
-
- POINTS = record
- x : SHORT;
- y : SHORT;
- end;
- tagPOINTS = POINTS; //windef
- TPOINTS = POINTS;
- PPOINTS = ^POINTS;
-
- CANDIDATEFORM = record
- dwIndex : DWORD;
- dwStyle : DWORD;
- ptCurrentPos : POINT;
- rcArea : RECT;
- end;
- LPCANDIDATEFORM = ^CANDIDATEFORM;
- _tagCANDIDATEFORM = CANDIDATEFORM;
- TCANDIDATEFORM = CANDIDATEFORM;
- PCANDIDATEFORM = ^CANDIDATEFORM;
-
- CANDIDATELIST = record
- dwSize : DWORD;
- dwStyle : DWORD;
- dwCount : DWORD;
- dwSelection : DWORD;
- dwPageStart : DWORD;
- dwPageSize : DWORD;
- dwOffset : array[0..0] of DWORD;
- end;
- LPCANDIDATELIST = ^CANDIDATELIST;
- _tagCANDIDATELIST = CANDIDATELIST;
- TCANDIDATELIST = CANDIDATELIST;
- PCANDIDATELIST = ^CANDIDATELIST;
-
- CREATESTRUCT = record
- lpCreateParams : LPVOID;
- hInstance : HINST;
- hMenu : HMENU;
- hwndParent : HWND;
- cy : longint;
- cx : longint;
- y : longint;
- x : longint;
- style : LONG;
- lpszName : LPCTSTR;
- lpszClass : LPCTSTR;
- dwExStyle : DWORD;
- end;
- LPCREATESTRUCT = ^CREATESTRUCT;
- tagCREATESTRUCT = CREATESTRUCT;
- TCREATESTRUCT = CREATESTRUCT;
- PCREATESTRUCT = ^CREATESTRUCT;
-
- CBT_CREATEWND = record
- lpcs : LPCREATESTRUCT;
- hwndInsertAfter : HWND;
- end;
- tagCBT_CREATEWND = CBT_CREATEWND;
- TCBT_CREATEWND = CBT_CREATEWND;
- PCBT_CREATEWND = ^CBT_CREATEWND;
-
- CBTACTIVATESTRUCT = record
- fMouse : WINBOOL;
- hWndActive : HWND;
- end;
- tagCBTACTIVATESTRUCT = CBTACTIVATESTRUCT;
- TCBTACTIVATESTRUCT = CBTACTIVATESTRUCT;
- PCBTACTIVATESTRUCT = ^CBTACTIVATESTRUCT;
-
-
- CHAR_INFO = record
- case longint of
- 0 : ( UnicodeChar : WCHAR;
- Attributes : Word);
- 1 : ( AsciiChar : CHAR );
- end;
- _CHAR_INFO = CHAR_INFO;
- TCHAR_INFO = CHAR_INFO;
- PCHAR_INFO = ^CHAR_INFO;
-
- CHARFORMAT = record
- cbSize : UINT;
- dwMask : DWORD;
- dwEffects : DWORD;
- yHeight : LONG;
- yOffset : LONG;
- crTextColor : COLORREF;
- bCharSet : BYTE;
- bPitchAndFamily : BYTE;
- szFaceName : array[0..(LF_FACESIZE)-1] of TCHAR;
- end;
- _charformat = CHARFORMAT;
- Tcharformat = CHARFORMAT;
- Pcharformat = ^CHARFORMAT;
-
- CHARRANGE = record
- cpMin : LONG;
- cpMax : LONG;
- end;
- _charrange = CHARRANGE;
- Tcharrange = CHARRANGE;
- Pcharrange = ^CHARRANGE;
-
- CHARSET = record
- aflBlock : array[0..2] of DWORD;
- flLang : DWORD;
- end;
- tagCHARSET = CHARSET;
- TCHARSET = CHARSET;
- PCHARSET = ^CHARSET;
-
- FONTSIGNATURE = record
- fsUsb : array[0..3] of DWORD;
- fsCsb : array[0..1] of DWORD;
- end;
- LPFONTSIGNATURE = ^FONTSIGNATURE;
- tagFONTSIGNATURE = FONTSIGNATURE;
- TFONTSIGNATURE = FONTSIGNATURE;
- PFONTSIGNATURE = ^FONTSIGNATURE;
-
- FLOAT128 = record //+winnt
- LowPart : int64;
- HighPart : int64;
- end;
- PFLOAT128 = ^FLOAT128;
-
- CHARSETINFO = record
- ciCharset : UINT;
- ciACP : UINT;
- fs : FONTSIGNATURE;
- end;
- LPCHARSETINFO = ^CHARSETINFO;
- TCHARSETINFO = CHARSETINFO;
- PCHARSETINFO = ^CHARSETINFO;
-
- {CHOOSECOLOR = record confilcts with function ChooseColor }
- TCHOOSECOLOR = record
- lStructSize : DWORD;
- hwndOwner : HWND;
- hInstance : HWND;
- rgbResult : COLORREF;
- lpCustColors : ^COLORREF;
- Flags : DWORD;
- lCustData : LPARAM;
- lpfnHook : LPCCHOOKPROC;
- lpTemplateName : LPCTSTR;
- end;
- LPCHOOSECOLOR = ^TCHOOSECOLOR;
- PCHOOSECOLOR = ^TCHOOSECOLOR;
-
- LOGFONT = record
- lfHeight : LONG;
- lfWidth : LONG;
- lfEscapement : LONG;
- lfOrientation : LONG;
- lfWeight : LONG;
- lfItalic : BYTE;
- lfUnderline : BYTE;
- lfStrikeOut : BYTE;
- lfCharSet : BYTE;
- lfOutPrecision : BYTE;
- lfClipPrecision : BYTE;
- lfQuality : BYTE;
- lfPitchAndFamily : BYTE;
- lfFaceName : array[0..(LF_FACESIZE)-1] of TCHAR;
- end;
- LPLOGFONT = ^LOGFONT;
- TLOGFONT = LOGFONT;
- TLOGFONTA = LOGFONT;
- PLOGFONT = ^LOGFONT;
- PLOGFONTA = PLOGFONT;
-
- LOGFONTW = record
- lfHeight: LONG;
- lfWidth: LONG;
- lfEscapement: LONG;
- lfOrientation: LONG;
- lfWeight: LONG;
- lfItalic: BYTE;
- lfUnderline: BYTE;
- lfStrikeOut: BYTE;
- lfCharSet: BYTE;
- lfOutPrecision: BYTE;
- lfClipPrecision: BYTE;
- lfQuality: BYTE;
- lfPitchAndFamily: BYTE;
- lfFaceName: array [0..LF_FACESIZE - 1] of WCHAR;
- end;
- LPLOGFONTW = ^LOGFONTW;
- NPLOGFONTW = ^LOGFONTW;
- tagLOGFONTW = LOGFONTW;
- TLogFontW = LOGFONTW;
- PLogFontW = ^TLogFontW;
-
- TCHOOSEFONTW = record //+commdlg
- lStructSize : DWORD;
- hwndOwner : HWND;
- hDC : HDC;
- lpLogFont : LPLOGFONTW;
- iPointSize : Integer;
- Flags : DWORD;
- rgbColors : DWORD;
- lCustData : LPARAM;
- lpfnHook : LPCFHOOKPROC;
- lpTemplateName : LPCWSTR;
- hInstance : HINST;
- lpszStyle : LPTSTR;
- nFontType : WORD;
- ___MISSING_ALIGNMENT__ : WORD;
- nSizeMin : Integer;
- nSizeMax : Integer;
- end;
- tagCHOOSEFONTW = TCHOOSEFONTW; //+commdlg
- LPCHOOSEFONTW = ^TCHOOSEFONTW; //+commdlg
- PCHOOSEFONTW = ^TCHOOSEFONTW; //+commdlg
-
- {CHOOSEFONT = record conflicts with ChooseFont function }
- TCHOOSEFONT = record
- lStructSize : DWORD;
- hwndOwner : HWND;
- hDC : HDC;
- lpLogFont : LPLOGFONT;
- iPointSize : WINT;
- Flags : DWORD;
- rgbColors : DWORD;
- lCustData : LPARAM;
- lpfnHook : LPCFHOOKPROC;
- lpTemplateName : LPCTSTR;
- hInstance : HINST;
- lpszStyle : LPTSTR;
- nFontType : WORD;
- ___MISSING_ALIGNMENT__ : WORD;
- nSizeMin : WINT;
- nSizeMax : WINT;
- end;
- LPCHOOSEFONT = ^TCHOOSEFONT;
- PCHOOSEFONT = ^TCHOOSEFONT;
-
- CIDA = record
- cidl : UINT;
- aoffset : array[0..0] of UINT;
- end;
- LPIDA = ^CIDA;
- _IDA = CIDA;
- TIDA = CIDA;
- PIDA = ^CIDA;
-
- CLIENTCREATESTRUCT = record
- hWindowMenu : HANDLE;
- idFirstChild : UINT;
- end;
- LPCLIENTCREATESTRUCT = ^CLIENTCREATESTRUCT;
- tagCLIENTCREATESTRUCT = CLIENTCREATESTRUCT;
- TCLIENTCREATESTRUCT = CLIENTCREATESTRUCT;
- PCLIENTCREATESTRUCT = ^CLIENTCREATESTRUCT;
-
- CMINVOKECOMMANDINFO = record
- cbSize : DWORD;
- fMask : DWORD;
- hwnd : HWND;
- lpVerb : LPCSTR;
- lpParameters : LPCSTR;
- lpDirectory : LPCSTR;
- nShow : longint;
- dwHotKey : DWORD;
- hIcon : HANDLE;
- end;
- LPCMINVOKECOMMANDINFO = ^CMINVOKECOMMANDINFO;
- _CMInvokeCommandInfo = CMINVOKECOMMANDINFO;
- TCMInvokeCommandInfo = CMINVOKECOMMANDINFO;
- PCMInvokeCommandInfo = ^CMINVOKECOMMANDINFO;
-
- COLORADJUSTMENT = record
- caSize : WORD;
- caFlags : WORD;
- caIlluminantIndex : WORD;
- caRedGamma : WORD;
- caGreenGamma : WORD;
- caBlueGamma : WORD;
- caReferenceBlack : WORD;
- caReferenceWhite : WORD;
- caContrast : SHORT;
- caBrightness : SHORT;
- caColorfulness : SHORT;
- caRedGreenTint : SHORT;
- end;
- LPCOLORADJUSTMENT = ^COLORADJUSTMENT;
- tagCOLORADJUSTMENT = COLORADJUSTMENT;
- TCOLORADJUSTMENT = COLORADJUSTMENT;
- PCOLORADJUSTMENT = ^COLORADJUSTMENT;
-
- COLORMAP = record
- from : COLORREF;
- _to : COLORREF;
- end;
- LPCOLORMAP = ^COLORMAP;
- _COLORMAP = COLORMAP;
- TCOLORMAP = COLORMAP;
- PCOLORMAP = ^COLORMAP;
-
- DCB = record
- DCBlength : DWORD;
- BaudRate : DWORD;
- flags : DWORD;
- wReserved : WORD;
- XonLim : WORD;
- XoffLim : WORD;
- ByteSize : BYTE;
- Parity : BYTE;
- StopBits : BYTE;
- XonChar : char;
- XoffChar : char;
- ErrorChar : char;
- EofChar : char;
- EvtChar : char;
- wReserved1 : WORD;
- end;
- LPDCB = ^DCB;
- _DCB = DCB;
- TDCB = DCB;
- PDCB = ^DCB;
-
- const
- bm_DCB_fBinary = $1;
- bp_DCB_fBinary = 0;
- bm_DCB_fParity = $2;
- bp_DCB_fParity = 1;
- bm_DCB_fOutxCtsFlow = $4;
- bp_DCB_fOutxCtsFlow = 2;
- bm_DCB_fOutxDsrFlow = $8;
- bp_DCB_fOutxDsrFlow = 3;
- bm_DCB_fDtrControl = $30;
- bp_DCB_fDtrControl = 4;
- bm_DCB_fDsrSensitivity = $40;
- bp_DCB_fDsrSensitivity = 6;
- bm_DCB_fTXContinueOnXoff = $80;
- bp_DCB_fTXContinueOnXoff = 7;
- bm_DCB_fOutX = $100;
- bp_DCB_fOutX = 8;
- bm_DCB_fInX = $200;
- bp_DCB_fInX = 9;
- bm_DCB_fErrorChar = $400;
- bp_DCB_fErrorChar = 10;
- bm_DCB_fNull = $800;
- bp_DCB_fNull = 11;
- bm_DCB_fRtsControl = $3000;
- bp_DCB_fRtsControl = 12;
- bm_DCB_fAbortOnError = $4000;
- bp_DCB_fAbortOnError = 14;
- bm_DCB_fDummy2 = $FFFF8000;
- bp_DCB_fDummy2 = 15;
- function fBinary(var a : DCB) : DWORD;
- procedure set_fBinary(var a : DCB; __fBinary : DWORD);
- function fParity(var a : DCB) : DWORD;
- procedure set_fParity(var a : DCB; __fParity : DWORD);
- function fOutxCtsFlow(var a : DCB) : DWORD;
- procedure set_fOutxCtsFlow(var a : DCB; __fOutxCtsFlow : DWORD);
- function fOutxDsrFlow(var a : DCB) : DWORD;
- procedure set_fOutxDsrFlow(var a : DCB; __fOutxDsrFlow : DWORD);
- function fDtrControl(var a : DCB) : DWORD;
- procedure set_fDtrControl(var a : DCB; __fDtrControl : DWORD);
- function fDsrSensitivity(var a : DCB) : DWORD;
- procedure set_fDsrSensitivity(var a : DCB; __fDsrSensitivity : DWORD);
- function fTXContinueOnXoff(var a : DCB) : DWORD;
- procedure set_fTXContinueOnXoff(var a : DCB; __fTXContinueOnXoff : DWORD);
- function fOutX(var a : DCB) : DWORD;
- procedure set_fOutX(var a : DCB; __fOutX : DWORD);
- function fInX(var a : DCB) : DWORD;
- procedure set_fInX(var a : DCB; __fInX : DWORD);
- function fErrorChar(var a : DCB) : DWORD;
- procedure set_fErrorChar(var a : DCB; __fErrorChar : DWORD);
- function fNull(var a : DCB) : DWORD;
- procedure set_fNull(var a : DCB; __fNull : DWORD);
- function fRtsControl(var a : DCB) : DWORD;
- procedure set_fRtsControl(var a : DCB; __fRtsControl : DWORD);
- function fAbortOnError(var a : DCB) : DWORD;
- procedure set_fAbortOnError(var a : DCB; __fAbortOnError : DWORD);
- function fDummy2(var a : DCB) : DWORD;
- procedure set_fDummy2(var a : DCB; __fDummy2 : DWORD);
-
- type
-
- tagINITCOMMONCONTROLSEX = record
- dwSize:DWORD; // size of this structure
- dwICC:DWORD; // flags indicating which classes to be initialized
- end;
- INITCOMMONCONTROLSEX=tagINITCOMMONCONTROLSEX;
- LPINITCOMMONCONTROLSEX=^tagINITCOMMONCONTROLSEX;
-
- COMMCONFIG = record
- dwSize : DWORD;
- wVersion : WORD;
- wReserved : WORD;
- dcb : DCB;
- dwProviderSubType : DWORD;
- dwProviderOffset : DWORD;
- dwProviderSize : DWORD;
- wcProviderData : array[0..0] of WCHAR;
- end;
- LPCOMMCONFIG = ^COMMCONFIG;
- _COMM_CONFIG = COMMCONFIG;
- TCOMMCONFIG = COMMCONFIG;
- PCOMMCONFIG = ^COMMCONFIG;
-
- COMMPROP = record
- wPacketLength : WORD;
- wPacketVersion : WORD;
- dwServiceMask : DWORD;
- dwReserved1 : DWORD;
- dwMaxTxQueue : DWORD;
- dwMaxRxQueue : DWORD;
- dwMaxBaud : DWORD;
- dwProvSubType : DWORD;
- dwProvCapabilities : DWORD;
- dwSettableParams : DWORD;
- dwSettableBaud : DWORD;
- wSettableData : WORD;
- wSettableStopParity : WORD;
- dwCurrentTxQueue : DWORD;
- dwCurrentRxQueue : DWORD;
- dwProvSpec1 : DWORD;
- dwProvSpec2 : DWORD;
- wcProvChar : array[0..0] of WCHAR;
- end;
- LPCOMMPROP = ^COMMPROP;
- _COMMPROP = COMMPROP;
- TCOMMPROP = COMMPROP;
- PCOMMPROP = ^COMMPROP;
-
- COMMTIMEOUTS = record
- ReadIntervalTimeout : DWORD;
- ReadTotalTimeoutMultiplier : DWORD;
- ReadTotalTimeoutConstant : DWORD;
- WriteTotalTimeoutMultiplier : DWORD;
- WriteTotalTimeoutConstant : DWORD;
- end;
- LPCOMMTIMEOUTS = ^COMMTIMEOUTS;
- _COMMTIMEOUTS = COMMTIMEOUTS;
- TCOMMTIMEOUTS = COMMTIMEOUTS;
- PCOMMTIMEOUTS = ^COMMTIMEOUTS;
-
- COMPAREITEMSTRUCT = record
- CtlType : UINT;
- CtlID : UINT;
- hwndItem : HWND;
- itemID1 : UINT;
- itemData1 : DWORD;
- itemID2 : UINT;
- itemData2 : DWORD;
- end;
- tagCOMPAREITEMSTRUCT = COMPAREITEMSTRUCT;
- TCOMPAREITEMSTRUCT = COMPAREITEMSTRUCT;
- PCOMPAREITEMSTRUCT = ^COMPAREITEMSTRUCT;
-
- COMPCOLOR = record
- crText : COLORREF;
- crBackground : COLORREF;
- dwEffects : DWORD;
- end;
- TCOMPCOLOR = COMPCOLOR;
- PCOMPCOLOR = ^COMPCOLOR;
-
- COMPOSITIONFORM = record
- dwStyle : DWORD;
- ptCurrentPos : POINT;
- rcArea : RECT;
- end;
- LPCOMPOSITIONFORM = ^COMPOSITIONFORM;
- _tagCOMPOSITIONFORM = COMPOSITIONFORM;
- TCOMPOSITIONFORM = COMPOSITIONFORM;
- PCOMPOSITIONFORM = ^COMPOSITIONFORM;
-
-// TComStatFlags = set of (fCtsHold, fDsrHold, fRlsdHold , fXoffHold ,
-// fXoffSent , fEof , fTxim , fReserved);
-
- COMSTAT = record
- flag0 : DWORD; // can't use tcomstatflags, set packing issues
- // and conflicts with macro's
- cbInQue : DWORD;
- cbOutQue : DWORD;
- end;
- LPCOMSTAT = ^COMSTAT;
- _COMSTAT = COMSTAT;
- TCOMSTAT = COMSTAT;
- PCOMSTAT = ^COMSTAT;
- const
- bm_COMSTAT_fCtsHold = $1;
- bp_COMSTAT_fCtsHold = 0;
- bm_COMSTAT_fDsrHold = $2;
- bp_COMSTAT_fDsrHold = 1;
- bm_COMSTAT_fRlsdHold = $4;
- bp_COMSTAT_fRlsdHold = 2;
- bm_COMSTAT_fXoffHold = $8;
- bp_COMSTAT_fXoffHold = 3;
- bm_COMSTAT_fXoffSent = $10;
- bp_COMSTAT_fXoffSent = 4;
- bm_COMSTAT_fEof = $20;
- bp_COMSTAT_fEof = 5;
- bm_COMSTAT_fTxim = $40;
- bp_COMSTAT_fTxim = 6;
- bm_COMSTAT_fReserved = $FFFFFF80;
- bp_COMSTAT_fReserved = 7;
- function fCtsHold(var a : COMSTAT) : DWORD; // should be renamed to get_<x>?
- procedure set_fCtsHold(var a : COMSTAT; __fCtsHold : DWORD);
- function fDsrHold(var a : COMSTAT) : DWORD;
- procedure set_fDsrHold(var a : COMSTAT; __fDsrHold : DWORD);
- function fRlsdHold(var a : COMSTAT) : DWORD;
- procedure set_fRlsdHold(var a : COMSTAT; __fRlsdHold : DWORD);
- function fXoffHold(var a : COMSTAT) : DWORD;
- procedure set_fXoffHold(var a : COMSTAT; __fXoffHold : DWORD);
- function fXoffSent(var a : COMSTAT) : DWORD;
- procedure set_fXoffSent(var a : COMSTAT; __fXoffSent : DWORD);
- function fEof(var a : COMSTAT) : DWORD;
- procedure set_fEof(var a : COMSTAT; __fEof : DWORD);
- function fTxim(var a : COMSTAT) : DWORD;
- procedure set_fTxim(var a : COMSTAT; __fTxim : DWORD);
- function fReserved(var a : COMSTAT) : DWORD;
- procedure set_fReserved(var a : COMSTAT; __fReserved : DWORD);
-
- type
-
- CONSOLE_CURSOR_INFO = record
- dwSize : DWORD;
- bVisible : WINBOOL;
- end;
- PCONSOLE_CURSOR_INFO = ^CONSOLE_CURSOR_INFO;
- _CONSOLE_CURSOR_INFO = CONSOLE_CURSOR_INFO;
- TCONSOLECURSORINFO = CONSOLE_CURSOR_INFO;
- PCONSOLECURSORINFO = ^CONSOLE_CURSOR_INFO;
- TCURSORINFO = CONSOLE_CURSOR_INFO;
-
- COORD = record
- X : SHORT;
- Y : SHORT;
- end;
- _COORD = COORD;
- TCOORD = COORD;
- PCOORD = ^COORD;
-
- SMALL_RECT = record
- Left : SHORT;
- Top : SHORT;
- Right : SHORT;
- Bottom : SHORT;
- end;
- _SMALL_RECT = SMALL_RECT;
- TSMALL_RECT = SMALL_RECT;
- PSMALL_RECT = ^SMALL_RECT;
-
- CONSOLE_SCREEN_BUFFER_INFO = packed record
- dwSize : COORD;
- dwCursorPosition : COORD;
- wAttributes : WORD;
- srWindow : SMALL_RECT;
- dwMaximumWindowSize : COORD;
- end;
- PCONSOLE_SCREEN_BUFFER_INFO = ^CONSOLE_SCREEN_BUFFER_INFO;
- _CONSOLE_SCREEN_BUFFER_INFO = CONSOLE_SCREEN_BUFFER_INFO;
- TCONSOLESCREENBUFFERINFO = CONSOLE_SCREEN_BUFFER_INFO;
- PCONSOLESCREENBUFFERINFO = ^CONSOLE_SCREEN_BUFFER_INFO;
-
-{$ifdef i386} //+winnt
- type
- FLOATING_SAVE_AREA = record //~winnt
- ControlWord : DWORD;
- StatusWord : DWORD;
- TagWord : DWORD;
- ErrorOffset : DWORD;
- ErrorSelector : DWORD;
- DataOffset : DWORD;
- DataSelector : DWORD;
- RegisterArea : array[0..SIZE_OF_80387_REGISTERS-1] of BYTE; //~winnt
- Cr0NpxState : DWORD;
- end;
- _FLOATING_SAVE_AREA = FLOATING_SAVE_AREA; //winnt
- TFLOATINGSAVEAREA = FLOATING_SAVE_AREA; //winnt
- PFLOATING_SAVE_AREA = ^FLOATING_SAVE_AREA; //~winnt
-
-//
-// Context Frame
-//
-// This frame has a several purposes: 1) it is used as an argument to
-// NtContinue, 2) is is used to constuct a call frame for APC delivery,
-// and 3) it is used in the user level thread creation routines.
-//
-// The layout of the record conforms to a standard call frame.
-//
-
- CONTEXT = record //winnt
- ContextFlags : DWORD;
- Dr0 : DWORD;
- Dr1 : DWORD;
- Dr2 : DWORD;
- Dr3 : DWORD;
- Dr6 : DWORD;
- Dr7 : DWORD;
- FloatSave : FLOATING_SAVE_AREA;
- SegGs : DWORD;
- SegFs : DWORD;
- SegEs : DWORD;
- SegDs : DWORD;
- Edi : DWORD;
- Esi : DWORD;
- Ebx : DWORD;
- Edx : DWORD;
- Ecx : DWORD;
- Eax : DWORD;
- Ebp : DWORD;
- Eip : DWORD;
- SegCs : DWORD;
- EFlags : DWORD;
- Esp : DWORD;
- SegSs : DWORD;
- end;
-
- LDT_ENTRY = record //~winnt, moved into _X86_
- LimitLow : WORD;
- BaseLow : WORD;
- HighWord : record
- case longint of
- 0 : ( Bytes : record
- BaseMid : BYTE;
- Flags1 : BYTE;
- Flags2 : BYTE;
- BaseHi : BYTE;
- end );
- 1 : ( Bits : record
- flag0 : longint;
- end );
- end;
- end;
- LPLDT_ENTRY = ^LDT_ENTRY;
- PLDT_ENTRY = ^LDT_ENTRY;
- _LDT_ENTRY = LDT_ENTRY;
- TLDTENTRY = LDT_ENTRY;
- PLDTENTRY = ^LDT_ENTRY;
-
-{$endif i386} //+winnt
-
-{$ifdef _MIPS_} //+winnt all block added
-//
-// Context Frame
-//
-// N.B. This frame must be exactly a multiple of 16 bytes in length.
-//
-// This frame has a several purposes: 1) it is used as an argument to
-// NtContinue, 2) it is used to constuct a call frame for APC delivery,
-// 3) it is used to construct a call frame for exception dispatching
-// in user mode, and 4) it is used in the user level thread creation
-// routines.
-//
-// The layout of the record conforms to a standard call frame.
-//
- type
- {$ifdef _MIPS64} //+winnt
- FREG_TYPE = ULONGLONG;
- REG_TYPE = ULONGLONG;
- {$else}
- FREG_TYPE = DWORD;
- REG_TYPE = ULONG;
- {$endif _MIPS64}
- CONTEXT = record //+winnt
- Argument : Array[0..3] of REG_TYPE;
- FltF0 : FREG_TYPE;
- FltF1 : FREG_TYPE;
- FltF2 : FREG_TYPE;
- FltF3 : FREG_TYPE;
- FltF4 : FREG_TYPE;
- FltF5 : FREG_TYPE;
- FltF6 : FREG_TYPE;
- FltF7 : FREG_TYPE;
- FltF8 : FREG_TYPE;
- FltF9 : FREG_TYPE;
- FltF10 : FREG_TYPE;
- FltF11 : FREG_TYPE;
- FltF12 : FREG_TYPE;
- FltF13 : FREG_TYPE;
- FltF14 : FREG_TYPE;
- FltF15 : FREG_TYPE;
- FltF16 : FREG_TYPE;
- FltF17 : FREG_TYPE;
- FltF18 : FREG_TYPE;
- FltF19 : FREG_TYPE;
- FltF20 : FREG_TYPE;
- FltF21 : FREG_TYPE;
- FltF22 : FREG_TYPE;
- FltF23 : FREG_TYPE;
- FltF24 : FREG_TYPE;
- FltF25 : FREG_TYPE;
- FltF26 : FREG_TYPE;
- FltF27 : FREG_TYPE;
- FltF28 : FREG_TYPE;
- FltF29 : FREG_TYPE;
- FltF30 : FREG_TYPE;
- FltF31 : FREG_TYPE;
-
- IntZero : REG_TYPE;
- IntAt : REG_TYPE;
- IntV0 : REG_TYPE;
- IntV1 : REG_TYPE;
- IntA0 : REG_TYPE;
- IntA1 : REG_TYPE;
- IntA2 : REG_TYPE;
- IntA3 : REG_TYPE;
- IntT0 : REG_TYPE;
- IntT1 : REG_TYPE;
- IntT2 : REG_TYPE;
- IntT3 : REG_TYPE;
- IntT4 : REG_TYPE;
- IntT5 : REG_TYPE;
- IntT6 : REG_TYPE;
- IntT7 : REG_TYPE;
- IntS0 : REG_TYPE;
- IntS1 : REG_TYPE;
- IntS2 : REG_TYPE;
- IntS3 : REG_TYPE;
- IntS4 : REG_TYPE;
- IntS5 : REG_TYPE;
- IntS6 : REG_TYPE;
- IntS7 : REG_TYPE;
- IntT8 : REG_TYPE;
- IntT9 : REG_TYPE;
- IntK0 : REG_TYPE;
- IntK1 : REG_TYPE;
- IntGp : REG_TYPE;
- IntSp : REG_TYPE;
- IntS8 : REG_TYPE;
- IntRa : REG_TYPE;
- IntLo : REG_TYPE;
- IntHi : REG_TYPE;
-
- Fsr : DWORD;
- Fir : DWORD;
- Psr : DWORD;
- ContextFlags : DWORD;
- Fill : Array[0..1] of DWORD;
- end;
-
-{$endif _MIPS_} //+winnt
-
-{$ifdef _PPC_} //+winnt
- { Floating point registers returned when CONTEXT_FLOATING_POINT is set }
- { Integer registers returned when CONTEXT_INTEGER is set. }
- { Condition register }
- { Fixed point exception register }
- { The following are set when CONTEXT_CONTROL is set. }
- { Machine status register }
- { Instruction address register }
- { Link register }
- { Control register }
- { Control which context values are returned }
- { Registers returned if CONTEXT_DEBUG_REGISTERS is set. }
- { Breakpoint Register 1 }
- { Breakpoint Register 2 }
- { Breakpoint Register 3 }
- { Breakpoint Register 4 }
- { Breakpoint Register 5 }
- { Breakpoint Register 6 }
- { Debug Status Register }
- { Debug Control Register }
-
- type
-
- CONTEXT = record
- Fpr0 : double;
- Fpr1 : double;
- Fpr2 : double;
- Fpr3 : double;
- Fpr4 : double;
- Fpr5 : double;
- Fpr6 : double;
- Fpr7 : double;
- Fpr8 : double;
- Fpr9 : double;
- Fpr10 : double;
- Fpr11 : double;
- Fpr12 : double;
- Fpr13 : double;
- Fpr14 : double;
- Fpr15 : double;
- Fpr16 : double;
- Fpr17 : double;
- Fpr18 : double;
- Fpr19 : double;
- Fpr20 : double;
- Fpr21 : double;
- Fpr22 : double;
- Fpr23 : double;
- Fpr24 : double;
- Fpr25 : double;
- Fpr26 : double;
- Fpr27 : double;
- Fpr28 : double;
- Fpr29 : double;
- Fpr30 : double;
- Fpr31 : double;
- Fpscr : double;
- Gpr0 : DWORD;
- Gpr1 : DWORD;
- Gpr2 : DWORD;
- Gpr3 : DWORD;
- Gpr4 : DWORD;
- Gpr5 : DWORD;
- Gpr6 : DWORD;
- Gpr7 : DWORD;
- Gpr8 : DWORD;
- Gpr9 : DWORD;
- Gpr10 : DWORD;
- Gpr11 : DWORD;
- Gpr12 : DWORD;
- Gpr13 : DWORD;
- Gpr14 : DWORD;
- Gpr15 : DWORD;
- Gpr16 : DWORD;
- Gpr17 : DWORD;
- Gpr18 : DWORD;
- Gpr19 : DWORD;
- Gpr20 : DWORD;
- Gpr21 : DWORD;
- Gpr22 : DWORD;
- Gpr23 : DWORD;
- Gpr24 : DWORD;
- Gpr25 : DWORD;
- Gpr26 : DWORD;
- Gpr27 : DWORD;
- Gpr28 : DWORD;
- Gpr29 : DWORD;
- Gpr30 : DWORD;
- Gpr31 : DWORD;
- Cr : DWORD;
- Xer : DWORD;
- Msr : DWORD;
- Iar : DWORD;
- Lr : DWORD;
- Ctr : DWORD;
- ContextFlags : DWORD;
- Fill : array[0..2] of DWORD;
- Dr0 : DWORD;
- Dr1 : DWORD;
- Dr2 : DWORD;
- Dr3 : DWORD;
- Dr4 : DWORD;
- Dr5 : DWORD;
- Dr6 : DWORD;
- Dr7 : DWORD;
- end;
- _STACK_FRAME_HEADER = record // GPR 1 points here
- BackChain : DWORD; // Addr of previous frame
- Reserved1 : DWORD; // Reserved
-
- Parameter0 : DWORD; // First 8 parameter words are
- Parameter1 : DWORD; // always present
- Parameter2 : DWORD;
- Parameter3 : DWORD;
- Parameter4 : DWORD;
- Parameter5 : DWORD;
- Parameter6 : DWORD;
- Parameter7 : DWORD;
- end;
-
- PSTACK_FRAME_HEADER=^STACK_FRAME_HEADER;
- {$endif _PPC_} //~winnt
-
- {$ifdef _MPPC_} //+winnt all block
- type
- CONTEXT = record
- Fpr0 : double;
- Fpr1 : double;
- Fpr2 : double;
- Fpr3 : double;
- Fpr4 : double;
- Fpr5 : double;
- Fpr6 : double;
- Fpr7 : double;
- Fpr8 : double;
- Fpr9 : double;
- Fpr10 : double;
- Fpr11 : double;
- Fpr12 : double;
- Fpr13 : double;
- Fpr14 : double;
- Fpr15 : double;
- Fpr16 : double;
- Fpr17 : double;
- Fpr18 : double;
- Fpr19 : double;
- Fpr20 : double;
- Fpr21 : double;
- Fpr22 : double;
- Fpr23 : double;
- Fpr24 : double;
- Fpr25 : double;
- Fpr26 : double;
- Fpr27 : double;
- Fpr28 : double;
- Fpr29 : double;
- Fpr30 : double;
- Fpr31 : double;
- Fpscr : double;
- Gpr0 : DWORD;
- Gpr1 : DWORD;
- Gpr2 : DWORD;
- Gpr3 : DWORD;
- Gpr4 : DWORD;
- Gpr5 : DWORD;
- Gpr6 : DWORD;
- Gpr7 : DWORD;
- Gpr8 : DWORD;
- Gpr9 : DWORD;
- Gpr10 : DWORD;
- Gpr11 : DWORD;
- Gpr12 : DWORD;
- Gpr13 : DWORD;
- Gpr14 : DWORD;
- Gpr15 : DWORD;
- Gpr16 : DWORD;
- Gpr17 : DWORD;
- Gpr18 : DWORD;
- Gpr19 : DWORD;
- Gpr20 : DWORD;
- Gpr21 : DWORD;
- Gpr22 : DWORD;
- Gpr23 : DWORD;
- Gpr24 : DWORD;
- Gpr25 : DWORD;
- Gpr26 : DWORD;
- Gpr27 : DWORD;
- Gpr28 : DWORD;
- Gpr29 : DWORD;
- Gpr30 : DWORD;
- Gpr31 : DWORD;
- Cr : DWORD;
- Xer : DWORD;
- Msr : DWORD;
- Iar : DWORD;
- Lr : DWORD;
- Ctr : DWORD;
- ContextFlags : DWORD;
- Fill : array[0..2] of DWORD;
- Dr0 : DWORD;
- Dr1 : DWORD;
- Dr2 : DWORD;
- Dr3 : DWORD;
- Dr4 : DWORD;
- Dr5 : DWORD;
- Dr6 : DWORD;
- Dr7 : DWORD;
- end;
- _STACK_FRAME_HEADER = record // GPR 1 points here
- BackChain : DWORD; // Addr of previous frame
- GlueSaved1 : DWORD; // Used by glue code
- GlueSaved2 : DWORD;
- Reserved1 : DWORD;
- Spare1 : DWORD;
- Spare2 : DWORD;
-
- Parameter0 : DWORD; // First 8 parameter words are
- Parameter1 : DWORD; // always present
- Parameter2 : DWORD;
- Parameter3 : DWORD;
- Parameter4 : DWORD;
- Parameter5 : DWORD;
- Parameter6 : DWORD;
- Parameter7 : DWORD;
- end;
-
- PSTACK_FRAME_HEADER=^STACK_FRAME_HEADER;
-
- {$endif _MPPC_} //+winnt
-
- {$ifdef _IA64_} //+winnt all block
- type
- CONTEXT = record
-
- ContextFlags : DWORD;
- Fill1 : array[0..2] of DWORD;
- DbI0 : ULONGLONG; // Instruction debug registers
- DbI1 : ULONGLONG;
- DbI2 : ULONGLONG;
- DbI3 : ULONGLONG;
- DbI4 : ULONGLONG;
- DbI5 : ULONGLONG;
- DbI6 : ULONGLONG;
- DbI7 : ULONGLONG;
-
- DbD0 : ULONGLONG; // Data debug registers
- DbD1 : ULONGLONG;
- DbD2 : ULONGLONG;
- DbD3 : ULONGLONG;
- DbD4 : ULONGLONG;
- DbD5 : ULONGLONG;
- DbD6 : ULONGLONG;
- DbD7 : ULONGLONG;
-
- FltS0 : FLOAT128; // Lower floating point (f2-f5) - saved (preserved)
- FltS1 : FLOAT128;
- FltS2 : FLOAT128;
- FltS3 : FLOAT128;
- FltT0 : FLOAT128; // Lower floating point (f6-f15) - temporary (volatile)
- FltT1 : FLOAT128;
- FltT2 : FLOAT128;
- FltT3 : FLOAT128;
- FltT4 : FLOAT128;
- FltT5 : FLOAT128;
- FltT6 : FLOAT128;
- FltT7 : FLOAT128;
- FltT8 : FLOAT128;
- FltT9 : FLOAT128;
- FltS4 : FLOAT128; // Higher floating point (f16-f31) - saved (preserved)
- FltS5 : FLOAT128;
- FltS6 : FLOAT128;
- FltS7 : FLOAT128;
- FltS8 : FLOAT128;
- FltS9 : FLOAT128;
- FltS10 : FLOAT128;
- FltS11 : FLOAT128;
- FltS12 : FLOAT128;
- FltS13 : FLOAT128;
- FltS14 : FLOAT128;
- FltS15 : FLOAT128;
- FltS16 : FLOAT128;
- FltS17 : FLOAT128;
- FltS18 : FLOAT128;
- FltS19 : FLOAT128;
-
- FltF32 : FLOAT128; // Higher floating point (f32-f127) - temporary (volatile)
- FltF33 : FLOAT128;
- FltF34 : FLOAT128;
- FltF35 : FLOAT128;
- FltF36 : FLOAT128;
- FltF37 : FLOAT128;
- FltF38 : FLOAT128;
- FltF39 : FLOAT128;
-
- FltF40 : FLOAT128;
- FltF41 : FLOAT128;
- FltF42 : FLOAT128;
- FltF43 : FLOAT128;
- FltF44 : FLOAT128;
- FltF45 : FLOAT128;
- FltF46 : FLOAT128;
- FltF47 : FLOAT128;
- FltF48 : FLOAT128;
- FltF49 : FLOAT128;
-
- FltF50 : FLOAT128;
- FltF51 : FLOAT128;
- FltF52 : FLOAT128;
- FltF53 : FLOAT128;
- FltF54 : FLOAT128;
- FltF55 : FLOAT128;
- FltF56 : FLOAT128;
- FltF57 : FLOAT128;
- FltF58 : FLOAT128;
- FltF59 : FLOAT128;
-
- FltF60 : FLOAT128;
- FltF61 : FLOAT128;
- FltF62 : FLOAT128;
- FltF63 : FLOAT128;
- FltF64 : FLOAT128;
- FltF65 : FLOAT128;
- FltF66 : FLOAT128;
- FltF67 : FLOAT128;
- FltF68 : FLOAT128;
- FltF69 : FLOAT128;
-
- FltF70 : FLOAT128;
- FltF71 : FLOAT128;
- FltF72 : FLOAT128;
- FltF73 : FLOAT128;
- FltF74 : FLOAT128;
- FltF75 : FLOAT128;
- FltF76 : FLOAT128;
- FltF77 : FLOAT128;
- FltF78 : FLOAT128;
- FltF79 : FLOAT128;
-
- FltF80 : FLOAT128;
- FltF81 : FLOAT128;
- FltF82 : FLOAT128;
- FltF83 : FLOAT128;
- FltF84 : FLOAT128;
- FltF85 : FLOAT128;
- FltF86 : FLOAT128;
- FltF87 : FLOAT128;
- FltF88 : FLOAT128;
- FltF89 : FLOAT128;
-
- FltF90 : FLOAT128;
- FltF91 : FLOAT128;
- FltF92 : FLOAT128;
- FltF93 : FLOAT128;
- FltF94 : FLOAT128;
- FltF95 : FLOAT128;
- FltF96 : FLOAT128;
- FltF97 : FLOAT128;
- FltF98 : FLOAT128;
- FltF99 : FLOAT128;
-
- FltF100 : FLOAT128;
- FltF101 : FLOAT128;
- FltF102 : FLOAT128;
- FltF103 : FLOAT128;
- FltF104 : FLOAT128;
- FltF105 : FLOAT128;
- FltF106 : FLOAT128;
- FltF107 : FLOAT128;
- FltF108 : FLOAT128;
- FltF109 : FLOAT128;
-
- FltF110 : FLOAT128;
- FltF111 : FLOAT128;
- FltF112 : FLOAT128;
- FltF113 : FLOAT128;
- FltF114 : FLOAT128;
- FltF115 : FLOAT128;
- FltF116 : FLOAT128;
- FltF117 : FLOAT128;
- FltF118 : FLOAT128;
- FltF119 : FLOAT128;
-
- FltF120 : FLOAT128;
- FltF121 : FLOAT128;
- FltF122 : FLOAT128;
- FltF123 : FLOAT128;
- FltF124 : FLOAT128;
- FltF125 : FLOAT128;
- FltF126 : FLOAT128;
- FltF127 : FLOAT128;
-
- StFPSR : ULONGLONG; // FP status
- StFSR : ULONGLONG; // x86 FP status (a copy of AR28)
- StFIR : ULONGLONG; // x86 FP status (a copy of AR29)
- StFDR : ULONGLONG; // x86 FP status (a copy of AR30)
-
- IntGp : ULONGLONG; // global pointer (r1) - temporary (volatile)
- IntT0 : ULONGLONG; // integer registers (r2-r3) - temporary (volatile)
- IntT1 : ULONGLONG;
- IntS0 : ULONGLONG; // integer registers (r4-r7) - saved (preserved)
- IntS1 : ULONGLONG;
- IntS2 : ULONGLONG;
- IntS3 : ULONGLONG;
- IntV0 : ULONGLONG; // return value (r8) - temporary (volatile)
- IntT2 : ULONGLONG; // integer registers (r9-r11) - temporary (volatile)
- IntT3 : ULONGLONG;
- IntT4 : ULONGLONG;
- IntSP : ULONGLONG; // stack pointer (r12) - special
- IntTeb : ULONGLONG; // teb (r13) - special
- IntT5 : ULONGLONG; // integer registers (r14-r31) - temporary (volatile)
- IntT6 : ULONGLONG;
- IntT7 : ULONGLONG;
- IntT8 : ULONGLONG;
- IntT9 : ULONGLONG;
- IntT10 : ULONGLONG;
- IntT11 : ULONGLONG;
- IntT12 : ULONGLONG;
- IntT13 : ULONGLONG;
- IntT14 : ULONGLONG;
- IntT15 : ULONGLONG;
- IntT16 : ULONGLONG;
- IntT17 : ULONGLONG;
- IntT18 : ULONGLONG;
- IntT19 : ULONGLONG;
- IntT20 : ULONGLONG;
- IntT21 : ULONGLONG;
- IntT22 : ULONGLONG;
-
- IntNats : ULONGLONG; // Nat bits for general registers
- // r1-r31 in bit positions 1 to 31.
- Preds : ULONGLONG; // predicates - saved (preserved)
- BrRp : ULONGLONG; // return pointer (b0) - saved (preserved)
- BrS0 : ULONGLONG; // branch registers (b1-b5) - saved (preserved)
- BrS1 : ULONGLONG;
- BrS2 : ULONGLONG;
- BrS3 : ULONGLONG;
- BrS4 : ULONGLONG;
-
- BrT0 : ULONGLONG; // branch registers (b6-b7) - temporary (volatile)
- BrT1 : ULONGLONG;
- // iA32 related Interger registers
- SegCSD : ULONGLONG; // iA32 CSDescriptor (Ar25)
- SegSSD : ULONGLONG; // iA32 SSDescriptor (Ar26)
-
- // Other application registers
- ApUNAT : ULONGLONG; // User Nat collection register - saved (preserved)
- ApLC : ULONGLONG; // Loop counter register - saved (preserved)
- ApEC : ULONGLONG; // Epilog counter register - saved (preserved)
- ApCCV : ULONGLONG; // CMPXCHG value register - temporary (volatile)
- ApDCR : ULONGLONG; // Default control register (TBD)
-
- // Register stack info
- RsPFS : ULONGLONG; // Previous function state - saved (preserved)
- RsBSP : ULONGLONG; // Backing store pointer - saved (preserved)
- RsBSPSTORE : ULONGLONG; // BSP Store - saved (preserved)
- RsRSC : ULONGLONG; // RSE configuration - temporary (volatile)
- RsRNAT : ULONGLONG; // RSE Nat collection register - saved (preserved)
- // iA32 related control registers
- Eflag : ULONGLONG; // Eflag copy of Ar24
- Cflag : ULONGLONG; // Cr0+Cr4 copy of Ar27
-
- // Trap Status Information
- StIPSR : ULONGLONG; // Interruption Processor Status
- StIIP : ULONGLONG; // Interruption IP
- StIFS : ULONGLONG; // Interruption Function State
-
- end;
-
- FLOATING_SAVE_AREA = record
- ControlWord : DWORD;
- StatusWord : DWORD;
- TagWord : DWORD;
- ErrorOffset : DWORD;
- ErrorSelector : DWORD;
- DataOffset : DWORD;
- DataSelector : DWORD;
- RegisterArea : array[0..SIZE_OF_80387_REGISTERS-1] of BYTE;
- Cr0NpxState : DWORD;
- end;
- _FLOATING_SAVE_AREA = FLOATING_SAVE_AREA;
- TFLOATINGSAVEAREA = FLOATING_SAVE_AREA;
- PFLOATING_SAVE_AREA = ^FLOATING_SAVE_AREA;
-
- CONTEXT86 = record
- ContextFlags : DWORD;
- Dr0 : DWORD;
- Dr1 : DWORD;
- Dr2 : DWORD;
- Dr3 : DWORD;
- Dr6 : DWORD;
- Dr7 : DWORD;
- FloatSave : FLOATING_SAVE_AREA;
- SegGs : DWORD;
- SegFs : DWORD;
- SegEs : DWORD;
- SegDs : DWORD;
- Edi : DWORD;
- Esi : DWORD;
- Ebx : DWORD;
- Edx : DWORD;
- Ecx : DWORD;
- Eax : DWORD;
- Ebp : DWORD;
- Eip : DWORD;
- SegCs : DWORD;
- EFlags : DWORD;
- Esp : DWORD;
- SegSs : DWORD;
- end;
-
- LDT_ENTRY = record
- LimitLow : WORD;
- BaseLow : WORD;
- HighWord : record
- case longint of
- 0 : ( Bytes : record
- BaseMid : BYTE;
- Flags1 : BYTE;
- Flags2 : BYTE;
- BaseHi : BYTE;
- end );
- 1 : ( Bits : record
- flag0 : longint;
- end );
- end;
- end;
- LPLDT_ENTRY = ^LDT_ENTRY;
- PLDT_ENTRY = ^LDT_ENTRY;
- _LDT_ENTRY = LDT_ENTRY;
- TLDTENTRY = LDT_ENTRY;
- PLDTENTRY = ^LDT_ENTRY;
-
- PLABEL_DESCRIPTOR = record
- EntryPoint : ULONGLONG;
- GlobalPointer : ULONGLONG;
- end;
- _PLABEL_DESCRIPTOR = PLABEL_DESCRIPTOR;
- PPLABEL_DESCRIPTOR = ^PLABEL_DESCRIPTOR;
-
-
- {$endif _IA64_} //+winnt
-
- {$ifdef SHx} //+winnt all block added
- //These are the debug or break registers on the SH3
- DEBUG_REGISTERS = RECORD
- BarA : ULONG;
- BasrA : UCHAR;
- BamrA : UCHAR;
- BbrA : USHORT;
- BarB : ULONG;
- BasrB : UCHAR;
- BamrB : UCHAR;
- BbrB : USHORT;
- BdrB : ULONG;
- BdmrB : ULONG;
- Brcr : USHORT;
- Align : USHORT;
- end;
- _DEBUG_REGISTERS=DEBUG_REZGISTERS;
- PDEBUG_REGISTERS=^DEBUG_REZGISTERS;
-
- CONTEXT = record
- ContextFlags : ULONG;
- PR : ULONG;
- MACH : ULONG;
- MACL : ULONG;
- GBR : ULONG;
- R0 : ULONG;
- R1 : ULONG;
- R2 : ULONG;
- R3 : ULONG;
- R4 : ULONG;
- R5 : ULONG;
- R6 : ULONG;
- R7 : ULONG;
- R8 : ULONG;
- R9 : ULONG;
- R10 : ULONG;
- R11 : ULONG;
- R12 : ULONG;
- R13 : ULONG;
- R14 : ULONG;
- R15 : ULONG;
-
- // N.B. The registers r15 and ra are defined in the integer section,
- // but are considered part of the control context rather than part of
- // the integer context.
- //
-
- Fir : ULONG;
- Psr : ULONG;
-
- {$ifndef SH3e}
- {$ifndef SH4}
- OldStuff : Array[0..1] of ULONG;
- DebugRegisters : DEBUG_REGISTERS;
- DSR : ULONG;
- MOD_ : ULONG; // MOD replaced by MOD_
- RS : ULONG;
- RE : ULONG;
- A0 : ULONG;
- A1 : ULONG;
- M0 : ULONG;
- M1 : ULONG;
- X0 : ULONG;
- X1 : ULONG;
- Y0 : ULONG;
- Y1 : ULONG;
- // The guard bit registers are 8 bits long, but can only be saved and
- // restored using 16 or 32 bit moves. Note, the contents of the guard
- // bit register are in the upper 8 bits.
- A0G : USHORT;
- A1G : USHORT;
- {$else}
- Fpscr : ULONG;
- Fpul : ULONG;
- FRegs : Array[0..15] of ULONG;
- xFRegs : Array[0..15] of ULONG;
- {$endif SH4}
- {$else}
- Fpscr : ULONG;
- Fpul : ULONG;
- FRegs : Array[0..15] of ULONG;
- {$endif SH3e}
- end;
-
- {$endif SHx} //+winnt
-
- {$ifdef CPUARM} //+winnt all block added
- CONTEXT = record
- ContextFlags : ULONG;
- R0 : ULONG;
- R1 : ULONG;
- R2 : ULONG;
- R3 : ULONG;
- R4 : ULONG;
- R5 : ULONG;
- R6 : ULONG;
- R7 : ULONG;
- R8 : ULONG;
- R9 : ULONG;
- R10 : ULONG;
- R11 : ULONG;
- R12 : ULONG;
-
- SP : ULONG;
- Lr : ULONG;
- Pc : ULONG;
- Psr : ULONG;
- Fpscr : ULONG;
- FpExc : ULONG;
- S : Array [0..NUM_VFP_REGS] of ULONG;
- FpExtra : Array [0..NUM_EXTRA_CONTROL_REGS-1] of ULONG;
- end;
- {$endif CPUARM} //+winnt
-
- LPCONTEXT = ^CONTEXT;
- _CONTEXT = CONTEXT;
- TCONTEXT = CONTEXT;
- PCONTEXT = ^CONTEXT; //winnt
-
- type
-
- LIST_ENTRY = record //winnt
- Flink : ^_LIST_ENTRY;
- Blink : ^_LIST_ENTRY;
- end;
- _LIST_ENTRY = LIST_ENTRY;
- TLISTENTRY = LIST_ENTRY;
- PLISTENTRY = ^LIST_ENTRY;
-
- CRITICAL_SECTION_DEBUG = record
- _Type : WORD;
- CreatorBackTraceIndex : WORD;
- CriticalSection : ^_CRITICAL_SECTION;
- ProcessLocksList : LIST_ENTRY;
- EntryCount : DWORD;
- ContentionCount : DWORD;
- Depth : DWORD;
- OwnerBackTrace : array[0..4] of PVOID;
- end;
- LPCRITICAL_SECTION_DEBUG = ^CRITICAL_SECTION_DEBUG;
- PCRITICAL_SECTION_DEBUG = ^CRITICAL_SECTION_DEBUG;
- _CRITICAL_SECTION_DEBUG = CRITICAL_SECTION_DEBUG;
- TCRITICALSECTIONDEBUG = CRITICAL_SECTION_DEBUG;
- PCRITICALSECTIONDEBUG = ^CRITICAL_SECTION_DEBUG;
-
- CRITICAL_SECTION = TRTLCriticalSection;
- _CRITICAL_SECTION = TRTLCriticalSection;
- TCRITICAL_SECTION = TRTLCriticalSection;
- PCRITICAL_SECTION = PRTLCriticalSection;
- LPCRITICAL_SECTION = PRTLCriticalSection;
- TCRITICALSECTION = TRTLCriticalSection;
- PCRITICALSECTION = PRTLCriticalSection;
-
- { SECURITY_CONTEXT_TRACKING_MODE ContextTrackingMode; }
-
- SECURITY_QUALITY_OF_SERVICE = record
- Length : DWORD;
- ImpersonationLevel : SECURITY_IMPERSONATION_LEVEL;
- ContextTrackingMode : WINBOOL;
- EffectiveOnly : BOOLEAN;
- end;
- PSECURITY_QUALITY_OF_SERVICE = ^SECURITY_QUALITY_OF_SERVICE;
- _SECURITY_QUALITY_OF_SERVICE = SECURITY_QUALITY_OF_SERVICE;
- TSECURITYQUALITYOFSERVICE = SECURITY_QUALITY_OF_SERVICE;
- PSECURITYQUALITYOFSERVICE = ^SECURITY_QUALITY_OF_SERVICE;
-
- CONVCONTEXT = record
- cb : UINT;
- wFlags : UINT;
- wCountryID : UINT;
- iCodePage : longint;
- dwLangID : DWORD;
- dwSecurity : DWORD;
- qos : SECURITY_QUALITY_OF_SERVICE;
- end;
- tagCONVCONTEXT = CONVCONTEXT;
- TCONVCONTEXT = CONVCONTEXT;
- PCONVCONTEXT = ^CONVCONTEXT;
-
- CONVINFO = record
- cb : DWORD;
- hUser : DWORD;
- hConvPartner : HCONV;
- hszSvcPartner : HSZ;
- hszServiceReq : HSZ;
- hszTopic : HSZ;
- hszItem : HSZ;
- wFmt : UINT;
- wType : UINT;
- wStatus : UINT;
- wConvst : UINT;
- wLastError : UINT;
- hConvList : HCONVLIST;
- ConvCtxt : CONVCONTEXT;
- _hwnd : HWND;
- hwndPartner : HWND;
- end;
- tagCONVINFO = CONVINFO;
- TCONVINFO = CONVINFO;
- PCONVINFO = ^CONVINFO;
-
- COPYDATASTRUCT = record
- dwData : DWORD;
- cbData : DWORD;
- lpData : PVOID;
- end;
- tagCOPYDATASTRUCT = COPYDATASTRUCT;
- TCOPYDATASTRUCT = COPYDATASTRUCT;
- PCOPYDATASTRUCT = ^COPYDATASTRUCT;
-
- CPINFO = record
- MaxCharSize : UINT;
- DefaultChar : array[0..(MAX_DEFAULTCHAR)-1] of BYTE;
- LeadByte : array[0..(MAX_LEADBYTES)-1] of BYTE;
- end;
- LPCPINFO = ^CPINFO;
- _cpinfo = CPINFO;
- Tcpinfo = CPINFO;
- Pcpinfo = ^CPINFO;
-
- CPLINFO = record
- idIcon : longint;
- idName : longint;
- idInfo : longint;
- lData : LONG;
- end;
- tagCPLINFO = CPLINFO;
- TCPLINFO = CPLINFO;
- PCPLINFO = ^CPLINFO;
-
- CREATE_PROCESS_DEBUG_INFO = record
- hFile : HANDLE;
- hProcess : HANDLE;
- hThread : HANDLE;
- lpBaseOfImage : LPVOID;
- dwDebugInfoFileOffset : DWORD;
- nDebugInfoSize : DWORD;
- lpThreadLocalBase : LPVOID;
- lpStartAddress : LPTHREAD_START_ROUTINE;
- lpImageName : LPVOID;
- fUnicode : WORD;
- end;
- _CREATE_PROCESS_DEBUG_INFO = CREATE_PROCESS_DEBUG_INFO;
- TCREATEPROCESSDEBUGINFO = CREATE_PROCESS_DEBUG_INFO;
- PCREATEPROCESSDEBUGINFO = ^CREATE_PROCESS_DEBUG_INFO;
-
- CREATE_THREAD_DEBUG_INFO = record
- hThread : HANDLE;
- lpThreadLocalBase : LPVOID;
- lpStartAddress : LPTHREAD_START_ROUTINE;
- end;
- _CREATE_THREAD_DEBUG_INFO = CREATE_THREAD_DEBUG_INFO;
- TCREATETHREADDEBUGINFO = CREATE_THREAD_DEBUG_INFO;
- PCREATETHREADDEBUGINFO = ^CREATE_THREAD_DEBUG_INFO;
- (*
- TODO: sockets
- typedef struct _SOCKET_ADDRESS {
- LPSOCKADDR lpSockaddr ;
- INT iSockaddrLength ;
- } SOCKET_ADDRESS, PSOCKET_ADDRESS, LPSOCKET_ADDRESS;
- }
- {
- typedef struct _CSADDR_INFO {
- SOCKET_ADDRESS LocalAddr;
- SOCKET_ADDRESS RemoteAddr;
- INT iSocketType;
- INT iProtocol;
- } CSADDR_INFO;
- *)
-
- CURRENCYFMT = record
- NumDigits : UINT;
- LeadingZero : UINT;
- Grouping : UINT;
- lpDecimalSep : LPTSTR;
- lpThousandSep : LPTSTR;
- NegativeOrder : UINT;
- PositiveOrder : UINT;
- lpCurrencySymbol : LPTSTR;
- end;
- _currencyfmt = CURRENCYFMT;
- Tcurrencyfmt = CURRENCYFMT;
- Pcurrencyfmt = ^CURRENCYFMT;
-
- CURSORSHAPE = record
- xHotSpot : longint;
- yHotSpot : longint;
- cx : longint;
- cy : longint;
- cbWidth : longint;
- Planes : BYTE;
- BitsPixel : BYTE;
- end;
- LPCURSORSHAPE = ^CURSORSHAPE;
- tagCURSORSHAPE = CURSORSHAPE;
- TCURSORSHAPE = CURSORSHAPE;
- PCURSORSHAPE = ^CURSORSHAPE;
-
- CWPRETSTRUCT = record
- lResult : LRESULT;
- lParam : LPARAM;
- wParam : WPARAM;
- message : DWORD;
- hwnd : HWND;
- end;
- tagCWPRETSTRUCT = CWPRETSTRUCT;
- TCWPRETSTRUCT = CWPRETSTRUCT;
- PCWPRETSTRUCT = ^CWPRETSTRUCT;
-
- CWPSTRUCT = record
- lParam : LPARAM;
- wParam : WPARAM;
- message : UINT;
- hwnd : HWND;
- end;
- tagCWPSTRUCT = CWPSTRUCT;
- TCWPSTRUCT = CWPSTRUCT;
- PCWPSTRUCT = ^CWPSTRUCT;
-
- DATATYPES_INFO_1 = record
- pName : LPTSTR;
- end;
- _DATATYPES_INFO_1 = DATATYPES_INFO_1;
- TDATATYPESINFO1 = DATATYPES_INFO_1;
- PDATATYPESINFO1 = ^DATATYPES_INFO_1;
-
- DDEACK = record
- flag0 : word;
- end;
- TDDEACK = DDEACK;
- PDDEACK = ^DDEACK;
- const
- bm_DDEACK_bAppReturnCode = $FF;
- bp_DDEACK_bAppReturnCode = 0;
- bm_DDEACK_reserved = $3F00;
- bp_DDEACK_reserved = 8;
- bm_DDEACK_fBusy = $4000;
- bp_DDEACK_fBusy = 14;
- bm_DDEACK_fAck = $8000;
- bp_DDEACK_fAck = 15;
- function bAppReturnCode(var a : DDEACK) : word;
- procedure set_bAppReturnCode(var a : DDEACK; __bAppReturnCode : word);
- function reserved(var a : DDEACK) : word;
- procedure set_reserved(var a : DDEACK; __reserved : word);
- function fBusy(var a : DDEACK) : word;
- procedure set_fBusy(var a : DDEACK; __fBusy : word);
- function fAck(var a : DDEACK) : word;
- procedure set_fAck(var a : DDEACK; __fAck : word);
-
- type
-
- DDEADVISE = record
- flag0 : word;
- cfFormat : integer;
- end;
- TDDEADVISE = DDEADVISE;
- PDDEADVISE = ^DDEADVISE;
- const
- bm_DDEADVISE_reserved = $3FFF;
- bp_DDEADVISE_reserved = 0;
- bm_DDEADVISE_fDeferUpd = $4000;
- bp_DDEADVISE_fDeferUpd = 14;
- bm_DDEADVISE_fAckReq = $8000;
- bp_DDEADVISE_fAckReq = 15;
- function reserved(var a : DDEADVISE) : word;
- procedure set_reserved(var a : DDEADVISE; __reserved : word);
- function fDeferUpd(var a : DDEADVISE) : word;
- procedure set_fDeferUpd(var a : DDEADVISE; __fDeferUpd : word);
- function fAckReq(var a : DDEADVISE) : word;
- procedure set_fAckReq(var a : DDEADVISE; __fAckReq : word);
-
- type
-
- DDEDATA = record
- flag0 : word;
- cfFormat : integer;
- Value : array[0..0] of BYTE;
- end;
- PDDEDATA = ^DDEDATA;
- const
- bm_DDEDATA_unused = $FFF;
- bp_DDEDATA_unused = 0;
- bm_DDEDATA_fResponse = $1000;
- bp_DDEDATA_fResponse = 12;
- bm_DDEDATA_fRelease = $2000;
- bp_DDEDATA_fRelease = 13;
- bm_DDEDATA_reserved = $4000;
- bp_DDEDATA_reserved = 14;
- bm_DDEDATA_fAckReq = $8000;
- bp_DDEDATA_fAckReq = 15;
- function unused(var a : DDEDATA) : word;
- procedure set_unused(var a : DDEDATA; __unused : word);
- function fResponse(var a : DDEDATA) : word;
- procedure set_fResponse(var a : DDEDATA; __fResponse : word);
- function fRelease(var a : DDEDATA) : word;
- procedure set_fRelease(var a : DDEDATA; __fRelease : word);
- function reserved(var a : DDEDATA) : word;
- procedure set_reserved(var a : DDEDATA; __reserved : word);
- function fAckReq(var a : DDEDATA) : word;
- procedure set_fAckReq(var a : DDEDATA; __fAckReq : word);
-
- type
-
- DDELN = record
- flag0 : word;
- cfFormat : integer;
- end;
- TDDELN = DDELN;
- PDDELN = ^DDELN;
- const
- bm_DDELN_unused = $1FFF;
- bp_DDELN_unused = 0;
- bm_DDELN_fRelease = $2000;
- bp_DDELN_fRelease = 13;
- bm_DDELN_fDeferUpd = $4000;
- bp_DDELN_fDeferUpd = 14;
- bm_DDELN_fAckReq = $8000;
- bp_DDELN_fAckReq = 15;
- function unused(var a : DDELN) : word;
- procedure set_unused(var a : DDELN; __unused : word);
- function fRelease(var a : DDELN) : word;
- procedure set_fRelease(var a : DDELN; __fRelease : word);
- function fDeferUpd(var a : DDELN) : word;
- procedure set_fDeferUpd(var a : DDELN; __fDeferUpd : word);
- function fAckReq(var a : DDELN) : word;
- procedure set_fAckReq(var a : DDELN; __fAckReq : word);
-
- type
-
- DDEML_MSG_HOOK_DATA = record
- uiLo : UINT;
- uiHi : UINT;
- cbData : DWORD;
- Data : array[0..7] of DWORD;
- end;
- tagDDEML_MSG_HOOK_DATA = DDEML_MSG_HOOK_DATA;
- TDDEMLMSGHOOKDATA = DDEML_MSG_HOOK_DATA;
- PDDEMLMSGHOOKDATA = ^DDEML_MSG_HOOK_DATA;
-
- DDEPOKE = record
- flag0 : word;
- cfFormat : integer;
- Value : array[0..0] of BYTE;
- end;
- TDDEPOKE = DDEPOKE;
- PDDEPOKE = ^DDEPOKE;
- const
- bm_DDEPOKE_unused = $1FFF;
- bp_DDEPOKE_unused = 0;
- bm_DDEPOKE_fRelease = $2000;
- bp_DDEPOKE_fRelease = 13;
- bm_DDEPOKE_fReserved = $C000;
- bp_DDEPOKE_fReserved = 14;
- function unused(var a : DDEPOKE) : word;
- procedure set_unused(var a : DDEPOKE; __unused : word);
- function fRelease(var a : DDEPOKE) : word;
- procedure set_fRelease(var a : DDEPOKE; __fRelease : word);
- function fReserved(var a : DDEPOKE) : word;
- procedure set_fReserved(var a : DDEPOKE; __fReserved : word);
-
- type
-
- DDEUP = record
- flag0 : word;
- cfFormat : integer;
- rgb : array[0..0] of BYTE;
- end;
- TDDEUP = DDEUP;
- PDDEUP = ^DDEUP;
- const
- bm_DDEUP_unused = $FFF;
- bp_DDEUP_unused = 0;
- bm_DDEUP_fAck = $1000;
- bp_DDEUP_fAck = 12;
- bm_DDEUP_fRelease = $2000;
- bp_DDEUP_fRelease = 13;
- bm_DDEUP_fReserved = $4000;
- bp_DDEUP_fReserved = 14;
- bm_DDEUP_fAckReq = $8000;
- bp_DDEUP_fAckReq = 15;
- function unused(var a : DDEUP) : word;
- procedure set_unused(var a : DDEUP; __unused : word);
- function fAck(var a : DDEUP) : word;
- procedure set_fAck(var a : DDEUP; __fAck : word);
- function fRelease(var a : DDEUP) : word;
- procedure set_fRelease(var a : DDEUP; __fRelease : word);
- function fReserved(var a : DDEUP) : word;
- procedure set_fReserved(var a : DDEUP; __fReserved : word);
- function fAckReq(var a : DDEUP) : word;
- procedure set_fAckReq(var a : DDEUP; __fAckReq : word);
-
- type
-
- // definition of _exception struct - this struct is passed to the matherr
- // routine when a floating point exception is detected
- _EXCEPTION = record //+stdlib
- type_ : Integer; //identifier type replaced by Type_ for compilation
- Name : PChar; // name of function where error occured
- arg1 : double; // first argument to function
- arg2 : double; // second argument (if any) to function
- retval : double; // value to be returned by function
- end;
-
- EXCEPTION_RECORD = record //winnt
- ExceptionCode : DWORD;
- ExceptionFlags : DWORD;
- ExceptionRecord : ^_EXCEPTION_RECORD;
- ExceptionAddress : PVOID;
- NumberParameters : DWORD;
- ExceptionInformation : array[0..(EXCEPTION_MAXIMUM_PARAMETERS)-1] of Pointer; //~winnt, was DWORD, SDK:ULONG_PTR
- end;
- PEXCEPTION_RECORD = ^EXCEPTION_RECORD;
- _EXCEPTION_RECORD = EXCEPTION_RECORD;
- TEXCEPTIONRECORD = EXCEPTION_RECORD;
- PEXCEPTIONRECORD = ^EXCEPTION_RECORD;
-
- EXCEPTION_DEBUG_INFO = record
- ExceptionRecord : EXCEPTION_RECORD;
- dwFirstChance : DWORD;
- end;
- PEXCEPTION_DEBUG_INFO = ^EXCEPTION_DEBUG_INFO;
- _EXCEPTION_DEBUG_INFO = EXCEPTION_DEBUG_INFO;
- TEXCEPTIONDEBUGINFO = EXCEPTION_DEBUG_INFO;
- PEXCEPTIONDEBUGINFO = ^EXCEPTION_DEBUG_INFO;
-
- EXIT_PROCESS_DEBUG_INFO = record
- dwExitCode : DWORD;
- end;
- _EXIT_PROCESS_DEBUG_INFO = EXIT_PROCESS_DEBUG_INFO;
- TEXITPROCESSDEBUGINFO = EXIT_PROCESS_DEBUG_INFO;
- PEXITPROCESSDEBUGINFO = ^EXIT_PROCESS_DEBUG_INFO;
-
-
- EXIT_THREAD_DEBUG_INFO = record
- dwExitCode : DWORD;
- end;
- _EXIT_THREAD_DEBUG_INFO = EXIT_THREAD_DEBUG_INFO;
- TEXITTHREADDEBUGINFO = EXIT_THREAD_DEBUG_INFO;
- PEXITTHREADDEBUGINFO = ^EXIT_THREAD_DEBUG_INFO;
-
- LOAD_DLL_DEBUG_INFO = record
- hFile : HANDLE;
- lpBaseOfDll : LPVOID;
- dwDebugInfoFileOffset : DWORD;
- nDebugInfoSize : DWORD;
- lpImageName : LPVOID;
- fUnicode : WORD;
- end;
- _LOAD_DLL_DEBUG_INFO = LOAD_DLL_DEBUG_INFO;
- TLOADDLLDEBUGINFO = LOAD_DLL_DEBUG_INFO;
- PLOADDLLDEBUGINFO = ^LOAD_DLL_DEBUG_INFO;
-
- UNLOAD_DLL_DEBUG_INFO = record
- lpBaseOfDll : LPVOID;
- end;
- _UNLOAD_DLL_DEBUG_INFO = UNLOAD_DLL_DEBUG_INFO;
- TUNLOADDLLDEBUGINFO = UNLOAD_DLL_DEBUG_INFO;
- PUNLOADDLLDEBUGINFO = ^UNLOAD_DLL_DEBUG_INFO;
-
- OUTPUT_DEBUG_STRING_INFO = record
- lpDebugStringData : LPSTR;
- fUnicode : WORD;
- nDebugStringLength : WORD;
- end;
- _OUTPUT_DEBUG_STRING_INFO = OUTPUT_DEBUG_STRING_INFO;
- TOUTPUTDEBUGSTRINGINFO = OUTPUT_DEBUG_STRING_INFO;
- POUTPUTDEBUGSTRINGINFO = ^OUTPUT_DEBUG_STRING_INFO;
-
- RIP_INFO = record
- dwError : DWORD;
- dwType : DWORD;
- end;
- _RIP_INFO = RIP_INFO;
- TRIPINFO = RIP_INFO;
- PRIPINFO = ^RIP_INFO;
-
- DEBUG_EVENT = record
- dwDebugEventCode : DWORD;
- dwProcessId : DWORD;
- dwThreadId : DWORD;
- u : record
- case longint of
- 0 : ( Exception : EXCEPTION_DEBUG_INFO );
- 1 : ( CreateThread : CREATE_THREAD_DEBUG_INFO );
- 2 : ( CreateProcessInfo : CREATE_PROCESS_DEBUG_INFO );
- 3 : ( ExitThread : EXIT_THREAD_DEBUG_INFO );
- 4 : ( ExitProcess : EXIT_PROCESS_DEBUG_INFO );
- 5 : ( LoadDll : LOAD_DLL_DEBUG_INFO );
- 6 : ( UnloadDll : UNLOAD_DLL_DEBUG_INFO );
- 7 : ( DebugString : OUTPUT_DEBUG_STRING_INFO );
- 8 : ( RipInfo : RIP_INFO );
- end;
- end;
- LPDEBUG_EVENT = ^DEBUG_EVENT;
- _DEBUG_EVENT = DEBUG_EVENT;
- TDEBUGEVENT = DEBUG_EVENT;
- PDEBUGEVENT = ^DEBUG_EVENT;
-
- DEBUGHOOKINFO = record
- idThread : DWORD;
- idThreadInstaller : DWORD;
- lParam : LPARAM;
- wParam : WPARAM;
- code : longint;
- end;
- tagDEBUGHOOKINFO = DEBUGHOOKINFO;
- TDEBUGHOOKINFO = DEBUGHOOKINFO;
- PDEBUGHOOKINFO = ^DEBUGHOOKINFO;
-
- DELETEITEMSTRUCT = record
- CtlType : UINT;
- CtlID : UINT;
- itemID : UINT;
- hwndItem : HWND;
- itemData : UINT;
- end;
- tagDELETEITEMSTRUCT = DELETEITEMSTRUCT;
- TDELETEITEMSTRUCT = DELETEITEMSTRUCT;
- PDELETEITEMSTRUCT = ^DELETEITEMSTRUCT;
-
- DEV_BROADCAST_HDR = record
- dbch_size : ULONG;
- dbch_devicetype : ULONG;
- dbch_reserved : ULONG;
- end;
- PDEV_BROADCAST_HDR = ^DEV_BROADCAST_HDR;
- _DEV_BROADCAST_HDR = DEV_BROADCAST_HDR;
- TDEVBROADCASTHDR = DEV_BROADCAST_HDR;
- PDEVBROADCASTHDR = ^DEV_BROADCAST_HDR;
-
- DEV_BROADCAST_OEM = record
- dbco_size : ULONG;
- dbco_devicetype : ULONG;
- dbco_reserved : ULONG;
- dbco_identifier : ULONG;
- dbco_suppfunc : ULONG;
- end;
- PDEV_BROADCAST_OEM = ^DEV_BROADCAST_OEM;
- _DEV_BROADCAST_OEM = DEV_BROADCAST_OEM;
- TDEVBROADCASTOEM = DEV_BROADCAST_OEM;
- PDEVBROADCASTOEM = ^DEV_BROADCAST_OEM;
-
- DEV_BROADCAST_PORT = record
- dbcp_size : ULONG;
- dbcp_devicetype : ULONG;
- dbcp_reserved : ULONG;
- dbcp_name : array[0..0] of char;
- end;
- PDEV_BROADCAST_PORT = ^DEV_BROADCAST_PORT;
- _DEV_BROADCAST_PORT = DEV_BROADCAST_PORT;
- TDEVBROADCASTPORT = DEV_BROADCAST_PORT;
- PDEVBROADCASTPORT = ^DEV_BROADCAST_PORT;
-
- _DEV_BROADCAST_USERDEFINED = record
- dbud_dbh : _DEV_BROADCAST_HDR;
- dbud_szName : array[0..0] of char;
- dbud_rgbUserDefined : array[0..0] of BYTE;
- end;
- TDEVBROADCASTUSERDEFINED = _DEV_BROADCAST_USERDEFINED;
- PDEVBROADCASTUSERDEFINED = ^_DEV_BROADCAST_USERDEFINED;
-
- DEV_BROADCAST_VOLUME = record
- dbcv_size : ULONG;
- dbcv_devicetype : ULONG;
- dbcv_reserved : ULONG;
- dbcv_unitmask : ULONG;
- dbcv_flags : USHORT;
- end;
- PDEV_BROADCAST_VOLUME = ^DEV_BROADCAST_VOLUME;
- _DEV_BROADCAST_VOLUME = DEV_BROADCAST_VOLUME;
- TDEVBROADCASTVOLUME = DEV_BROADCAST_VOLUME;
- PDEVBROADCASTVOLUME = ^DEV_BROADCAST_VOLUME;
-
- DEVMODE = record
- dmDeviceName : array[0..(CCHDEVICENAME)-1] of BCHAR;
- dmSpecVersion : WORD;
- dmDriverVersion : WORD;
- dmSize : WORD;
- dmDriverExtra : WORD;
- dmFields : DWORD;
- case byte of
- 1: (dmOrientation : SmallInt;
- dmPaperSize : SmallInt;
- dmPaperLength : SmallInt;
- dmPaperWidth : SmallInt;
- dmScale : SmallInt;
- dmCopies : SmallInt;
- dmDefaultSource : SmallInt;
- dmPrintQuality : SmallInt;
- dmColor : SmallInt;
- dmDuplex : SmallInt;
- dmYResolution : SmallInt;
- dmTTOption : SmallInt;
- dmCollate : SmallInt;
- dmFormName : array[0..(CCHFORMNAME)-1] of BCHAR;
- dmLogPixels : WORD;
- dmBitsPerPel : DWORD;
- dmPelsWidth : DWORD;
- dmPelsHeight : DWORD;
- dmDisplayFlags : DWORD;
- dmDisplayFrequency : DWORD;
- dmICMMethod : DWORD;
- dmICMIntent : DWORD;
- dmMediaType : DWORD;
- dmDitherType : DWORD;
- dmICCManufacturer : DWORD;
- dmICCModel : DWORD
- );
- 2: (dmPosition: POINTL;
- dmDisplayOrientation: DWORD;
- dmDisplayFixedOutput: DWORD;
- );
- end;
-
- LPDEVMODE = ^DEVMODE;
- _devicemode = DEVMODE;
- devicemode = DEVMODE;
- tdevicemode = DEVMODE;
- tdevicemodeA = DEVMODE;
- PDeviceModeA = LPDEVMODE;
- PDeviceMode = LPDEVMODE;
- TDEVMODE = DEVMODE;
- PDEVMODE = LPDEVMODE;
-
-
- devmodeW = record
- dmDeviceName : array[0.. CCHDEVICENAME-1] of WCHAR;
- dmSpecVersion : WORD;
- dmDriverVersion: WORD;
- dmSize : WORD;
- dmDriverExtra : WORD;
- dmFields : DWORD;
- dmOrientation : short;
- dmPaperSize : short;
- dmPaperLength : short;
- dmPaperWidth : short;
- dmScale : short;
- dmCopies : short;
- dmDefaultSource: short;
- dmPrintQuality : short;
- dmColor : short;
- dmDuplex : short;
- dmYResolution : short;
- dmTTOption : short;
- dmCollate : short;
- dmFormName : array [0..CCHFORMNAME-1] of wchar;
- dmLogPixels : WORD;
- dmBitsPerPel : DWORD;
- dmPelsWidth : DWORD;
- dmPelsHeight : DWORD;
- dmDisplayFlags : DWORD;
- dmDisplayFrequency : DWORD;
- dmICMMethod : DWORD;
- dmICMIntent : DWORD;
- dmMediaType : DWORD;
- dmDitherType : DWORD;
- dmReserved1 : DWORD;
- dmReserved2 : DWORD;
- dmPanningWidth : DWORD;
- dmPanningHeight: DWORD;
- end;
-
- LPDEVMODEW = ^DEVMODEW;
- _devicemodeW = DEVMODEW;
- devicemodeW = DEVMODEW;
- TDeviceModeW = DEVMODEW;
- PDeviceModeW = LPDEVMODEW;
- TDEVMODEW = DEVMODEW;
-
- PDEVMODEW = LPDEVMODEW;
-
- DEVNAMES = record
- wDriverOffset : WORD;
- wDeviceOffset : WORD;
- wOutputOffset : WORD;
- wDefault : WORD;
- end;
- LPDEVNAMES = ^DEVNAMES;
- tagDEVNAMES = DEVNAMES;
- TDEVNAMES = DEVNAMES;
- PDEVNAMES = ^DEVNAMES;
-
- DIBSECTION = record
- dsBm : BITMAP;
- dsBmih : BITMAPINFOHEADER;
- dsBitfields : array[0..2] of DWORD;
- dshSection : HANDLE;
- dsOffset : DWORD;
- end;
- tagDIBSECTION = DIBSECTION;
- TDIBSECTION = DIBSECTION;
- PDIBSECTION = ^DIBSECTION;
-
- LARGE_INTEGER = record //winnt
- case byte of
- 0: (LowPart : DWORD;
- HighPart : LONG);
- 1: (QuadPart : LONGLONG);
- end;
- PLARGE_INTEGER = ^LARGE_INTEGER; //winnt
- _LARGE_INTEGER = LARGE_INTEGER; //winnt
-
- TLargeInteger = Int64;
- PLargeInteger = ^TLargeInteger;
-
- ULARGE_INTEGER = record
- case byte of
- 0: (LowPart : DWORD;
- HighPart : DWORD);
- 1: (QuadPart : LONGLONG);
- end;
- PULARGE_INTEGER = ^ULARGE_INTEGER;
- _ULARGE_INTEGER = ULARGE_INTEGER;
-
- TULargeInteger = QWord;
- PULargeInteger = ^TULargeInteger;
-
- DISK_GEOMETRY = record
- Cylinders : LARGE_INTEGER;
- MediaType : MEDIA_TYPE;
- TracksPerCylinder : DWORD;
- SectorsPerTrack : DWORD;
- BytesPerSector : DWORD;
- end;
- _DISK_GEOMETRY = DISK_GEOMETRY;
- TDISKGEOMETRY = DISK_GEOMETRY;
- PDISKGEOMETRY = ^DISK_GEOMETRY;
-
- DISK_PERFORMANCE = record
- BytesRead : LARGE_INTEGER;
- BytesWritten : LARGE_INTEGER;
- ReadTime : LARGE_INTEGER;
- WriteTime : LARGE_INTEGER;
- ReadCount : DWORD;
- WriteCount : DWORD;
- QueueDepth : DWORD;
- end;
- _DISK_PERFORMANCE = DISK_PERFORMANCE;
- TDISKPERFORMANCE = DISK_PERFORMANCE;
- PDISKPERFORMANCE = ^DISK_PERFORMANCE;
-
- DLGITEMTEMPLATE = packed record
- style : DWORD;
- dwExtendedStyle : DWORD;
- x : integer;
- y : integer;
- cx : integer;
- cy : integer;
- id : WORD;
- end;
- LPDLGITEMTEMPLATE = ^DLGITEMTEMPLATE;
- TDLGITEMTEMPLATE = DLGITEMTEMPLATE;
- PDLGITEMTEMPLATE = ^DLGITEMTEMPLATE;
-
- DLGTEMPLATE = packed record
- style : DWORD;
- dwExtendedStyle : DWORD;
- cdit : WORD;
- x : integer;
- y : integer;
- cx : integer;
- cy : integer;
- end;
- LPDLGTEMPLATE = ^DLGTEMPLATE;
- LPCDLGTEMPLATE = ^DLGTEMPLATE;
- LPCDLGTEMPLATEW = ^DLGTEMPLATE; //+winuser
- TDLGTEMPLATE = DLGTEMPLATE;
- PDLGTEMPLATE = ^DLGTEMPLATE;
-
- DOC_INFO_1 = record
- pDocName : LPTSTR;
- pOutputFile : LPTSTR;
- pDatatype : LPTSTR;
- end;
- _DOC_INFO_1 = DOC_INFO_1;
- TDOCINFO1 = DOC_INFO_1;
- PDOCINFO1 = ^DOC_INFO_1;
-
- DOC_INFO_2 = record
- pDocName : LPTSTR;
- pOutputFile : LPTSTR;
- pDatatype : LPTSTR;
- dwMode : DWORD;
- JobId : DWORD;
- end;
- _DOC_INFO_2 = DOC_INFO_2;
- TDOCINFO2 = DOC_INFO_2;
- PDOCINFO2 = ^DOC_INFO_2;
-
- DOCINFO = record
- cbSize : longint;
- lpszDocName : LPCTSTR;
- lpszOutput : LPCTSTR;
- lpszDatatype : LPCTSTR;
- fwType : DWORD;
- end;
- TDOCINFO = DOCINFO;
- TDOCINFOA = DOCINFO;
- PDOCINFO = ^DOCINFO;
-
- DOCINFOW = record //+wingdi
- cbSize : Integer;
- lpszDocName : LPCWSTR;
- lpszOutput : LPCWSTR;
- lpszDatatype : LPCWSTR;
- fwType : DWORD;
- end;
- _DOCINFOW=DOCINFOW; //+wingdi
- LPDOCINFOW=^PDOCINFO; //+wingdi
- PDOCINFOW=^PDOCINFO; //+wingdi
-
- DRAGLISTINFO = record
- uNotification : UINT;
- hWnd : HWND;
- ptCursor : POINT;
- end;
- LPDRAGLISTINFO = ^DRAGLISTINFO;
- TDRAGLISTINFO = DRAGLISTINFO;
- PDRAGLISTINFO = ^DRAGLISTINFO;
-
- DRAWITEMSTRUCT = record
- CtlType : UINT;
- CtlID : UINT;
- itemID : UINT;
- itemAction : UINT;
- itemState : UINT;
- hwndItem : HWND;
- hDC : HDC;
- rcItem : RECT;
- itemData : DWORD;
- end;
- LPDRAWITEMSTRUCT = ^DRAWITEMSTRUCT;
- tagDRAWITEMSTRUCT = DRAWITEMSTRUCT;
- TDRAWITEMSTRUCT = DRAWITEMSTRUCT;
- PDRAWITEMSTRUCT = ^DRAWITEMSTRUCT;
-
- DRAWTEXTPARAMS = record
- cbSize : UINT;
- iTabLength : longint;
- iLeftMargin : longint;
- iRightMargin : longint;
- uiLengthDrawn : UINT;
- end;
- LPDRAWTEXTPARAMS = ^DRAWTEXTPARAMS;
- TDRAWTEXTPARAMS = DRAWTEXTPARAMS;
- PDRAWTEXTPARAMS = ^DRAWTEXTPARAMS;
-
- PARTITION_INFORMATION = record
- PartitionType : BYTE;
- BootIndicator : BOOLEAN;
- RecognizedPartition : BOOLEAN;
- RewritePartition : BOOLEAN;
- StartingOffset : LARGE_INTEGER;
- PartitionLength : LARGE_INTEGER;
- HiddenSectors : LARGE_INTEGER;
- end;
- _PARTITION_INFORMATION = PARTITION_INFORMATION;
- TPARTITIONINFORMATION = PARTITION_INFORMATION;
- PPARTITIONINFORMATION = ^PARTITION_INFORMATION;
-
- DRIVE_LAYOUT_INFORMATION = record
- PartitionCount : DWORD;
- Signature : DWORD;
- PartitionEntry : array[0..0] of PARTITION_INFORMATION;
- end;
- _DRIVE_LAYOUT_INFORMATION = DRIVE_LAYOUT_INFORMATION;
- TDRIVELAYOUTINFORMATION = DRIVE_LAYOUT_INFORMATION;
- PDRIVELAYOUTINFORMATION = ^DRIVE_LAYOUT_INFORMATION;
-
- DRIVER_INFO_1 = record
- pName : LPTSTR;
- end;
- _DRIVER_INFO_1 = DRIVER_INFO_1;
- TDRIVERINFO1 = DRIVER_INFO_1;
- PDRIVERINFO1 = ^DRIVER_INFO_1;
-
- DRIVER_INFO_2 = record
- cVersion : DWORD;
- pName : LPTSTR;
- pEnvironment : LPTSTR;
- pDriverPath : LPTSTR;
- pDataFile : LPTSTR;
- pConfigFile : LPTSTR;
- end;
- _DRIVER_INFO_2 = DRIVER_INFO_2;
- TDRIVERINFO2 = DRIVER_INFO_2;
- PDRIVERINFO2 = ^DRIVER_INFO_2;
-
- DRIVER_INFO_3 = record
- cVersion : DWORD;
- pName : LPTSTR;
- pEnvironment : LPTSTR;
- pDriverPath : LPTSTR;
- pDataFile : LPTSTR;
- pConfigFile : LPTSTR;
- pHelpFile : LPTSTR;
- pDependentFiles : LPTSTR;
- pMonitorName : LPTSTR;
- pDefaultDataType : LPTSTR;
- end;
- _DRIVER_INFO_3 = DRIVER_INFO_3;
- TDRIVERINFO3 = DRIVER_INFO_3;
- PDRIVERINFO3 = ^DRIVER_INFO_3;
-
- EDITSTREAM = record
- dwCookie : DWORD;
- dwError : DWORD;
- pfnCallback : EDITSTREAMCALLBACK;
- end;
- _editstream = EDITSTREAM;
- Teditstream = EDITSTREAM;
- Peditstream = ^EDITSTREAM;
-
- EMR = record
- iType : DWORD;
- nSize : DWORD;
- end;
- tagEMR = EMR;
- TEMR = EMR;
- PEMR = ^EMR;
-
- EMRANGLEARC = record
- emr : EMR;
- ptlCenter : POINTL;
- nRadius : DWORD;
- eStartAngle : Single;
- eSweepAngle : Single;
- end;
- tagEMRANGLEARC = EMRANGLEARC;
- TEMRANGLEARC = EMRANGLEARC;
- PEMRANGLEARC = ^EMRANGLEARC;
-
- EMRARC = record
- emr : EMR;
- rclBox : RECTL;
- ptlStart : POINTL;
- ptlEnd : POINTL;
- end;
- tagEMRARC = EMRARC;
- TEMRARC = EMRARC;
- PEMRARC = ^EMRARC;
-
- EMRARCTO = EMRARC;
- TEMRARCTO = EMRARC;
- PEMRARCTO = ^EMRARC;
-
- EMRCHORD = EMRARC;
- TEMRCHORD = EMRARC;
- PEMRCHORD = ^EMRARC;
-
- EMRPIE = EMRARC;
- TEMRPIE = EMRARC;
- PEMRPIE = ^EMRARC;
-
- XFORM = record
- eM11 : Single;
- eM12 : Single;
- eM21 : Single;
- eM22 : Single;
- eDx : Single;
- eDy : Single;
- end;
- LPXFORM = ^XFORM;
- _XFORM = XFORM;
- TXFORM = XFORM;
- PXFORM = ^XFORM;
-
- EMRBITBLT = record
- emr : EMR;
- rclBounds : RECTL;
- xDest : LONG;
- yDest : LONG;
- cxDest : LONG;
- cyDest : LONG;
- dwRop : DWORD;
- xSrc : LONG;
- ySrc : LONG;
- xformSrc : XFORM;
- crBkColorSrc : COLORREF;
- iUsageSrc : DWORD;
- offBmiSrc : DWORD;
- offBitsSrc : DWORD;
- cbBitsSrc : DWORD;
- end;
- tagEMRBITBLT = EMRBITBLT;
- TEMRBITBLT = EMRBITBLT;
- PEMRBITBLT = ^EMRBITBLT;
-
- LOGBRUSH = record
- lbStyle : UINT;
- lbColor : COLORREF;
- lbHatch : LONG;
- end;
- tagLOGBRUSH = LOGBRUSH;
- TLOGBRUSH = LOGBRUSH;
- PLOGBRUSH = ^LOGBRUSH;
-
- EMRCREATEBRUSHINDIRECT = record
- emr : EMR;
- ihBrush : DWORD;
- lb : LOGBRUSH;
- end;
- tagEMRCREATEBRUSHINDIRECT = EMRCREATEBRUSHINDIRECT;
- TEMRCREATEBRUSHINDIRECT = EMRCREATEBRUSHINDIRECT;
- PEMRCREATEBRUSHINDIRECT = ^EMRCREATEBRUSHINDIRECT;
-
- LCSCSTYPE = LONG;
-
- LCSGAMUTMATCH = LONG;
-
- LOGCOLORSPACE = record
- lcsSignature : DWORD;
- lcsVersion : DWORD;
- lcsSize : DWORD;
- lcsCSType : LCSCSTYPE;
- lcsIntent : LCSGAMUTMATCH;
- lcsEndpoints : CIEXYZTRIPLE;
- lcsGammaRed : DWORD;
- lcsGammaGreen : DWORD;
- lcsGammaBlue : DWORD;
- lcsFilename : array[0..(MAX_PATH)-1] of TCHAR;
- end;
- LPLOGCOLORSPACE = ^LOGCOLORSPACE;
- tagLOGCOLORSPACE = LOGCOLORSPACE;
- TLOGCOLORSPACE = LOGCOLORSPACE;
- TLOGCOLORSPACEA = LOGCOLORSPACE;
- PLOGCOLORSPACE = ^LOGCOLORSPACE;
-
- EMRCREATECOLORSPACE = record
- emr : EMR;
- ihCS : DWORD;
- lcs : LOGCOLORSPACE;
- end;
- tagEMRCREATECOLORSPACE = EMRCREATECOLORSPACE;
- TEMRCREATECOLORSPACE = EMRCREATECOLORSPACE;
- PEMRCREATECOLORSPACE = ^EMRCREATECOLORSPACE;
-
- EMRCREATEDIBPATTERNBRUSHPT = record
- emr : EMR;
- ihBrush : DWORD;
- iUsage : DWORD;
- offBmi : DWORD;
- cbBmi : DWORD;
- offBits : DWORD;
- cbBits : DWORD;
- end;
- tagEMRCREATEDIBPATTERNBRUSHPT = EMRCREATEDIBPATTERNBRUSHPT;
- TEMRCREATEDIBPATTERNBRUSHPT = EMRCREATEDIBPATTERNBRUSHPT;
- PEMRCREATEDIBPATTERNBRUSHPT = EMRCREATEDIBPATTERNBRUSHPT;
-
- EMRCREATEMONOBRUSH = record
- emr : EMR;
- ihBrush : DWORD;
- iUsage : DWORD;
- offBmi : DWORD;
- cbBmi : DWORD;
- offBits : DWORD;
- cbBits : DWORD;
- end;
- tagEMRCREATEMONOBRUSH = EMRCREATEMONOBRUSH;
- TEMRCREATEMONOBRUSH = EMRCREATEMONOBRUSH;
- PEMRCREATEMONOBRUSH = ^EMRCREATEMONOBRUSH;
-
- PALETTEENTRY = record
- peRed : BYTE;
- peGreen : BYTE;
- peBlue : BYTE;
- peFlags : BYTE;
- end;
- LPPALETTEENTRY = ^PALETTEENTRY;
- tagPALETTEENTRY = PALETTEENTRY;
- TPALETTEENTRY = PALETTEENTRY;
- PPALETTEENTRY = ^PALETTEENTRY;
-
- LOGPALETTE = record
- palVersion : WORD;
- palNumEntries : WORD;
- palPalEntry : array[0..0] of PALETTEENTRY;
- end;
- LPLOGPALETTE = ^LOGPALETTE;
- tagLOGPALETTE = LOGPALETTE;
- TLOGPALETTE = LOGPALETTE;
- PLOGPALETTE = ^LOGPALETTE;
-
- EMRCREATEPALETTE = record
- emr : EMR;
- ihPal : DWORD;
- lgpl : LOGPALETTE;
- end;
- tagEMRCREATEPALETTE = EMRCREATEPALETTE;
- TEMRCREATEPALETTE = EMRCREATEPALETTE;
- PEMRCREATEPALETTE = ^EMRCREATEPALETTE;
-
- LOGPEN = record
- lopnStyle : UINT;
- lopnWidth : POINT;
- lopnColor : COLORREF;
- end;
- tagLOGPEN = LOGPEN;
- TLOGPEN = LOGPEN;
- PLOGPEN = ^LOGPEN;
-
- EMRCREATEPEN = record
- emr : EMR;
- ihPen : DWORD;
- lopn : LOGPEN;
- end;
- tagEMRCREATEPEN = EMRCREATEPEN;
- TEMRCREATEPEN = EMRCREATEPEN;
- PEMRCREATEPEN = ^EMRCREATEPEN;
-
- EMRELLIPSE = record
- emr : EMR;
- rclBox : RECTL;
- end;
- tagEMRELLIPSE = EMRELLIPSE;
- TEMRELLIPSE = EMRELLIPSE;
- PEMRELLIPSE = ^EMRELLIPSE;
-
- EMRRECTANGLE = EMRELLIPSE;
- TEMRRECTANGLE = EMRELLIPSE;
- PEMRRECTANGLE = ^EMRELLIPSE;
-
- EMREOF = record
- emr : EMR;
- nPalEntries : DWORD;
- offPalEntries : DWORD;
- nSizeLast : DWORD;
- end;
- tagEMREOF = EMREOF;
- TEMREOF = EMREOF;
- PEMREOF = ^EMREOF;
-
- EMREXCLUDECLIPRECT = record
- emr : EMR;
- rclClip : RECTL;
- end;
- tagEMREXCLUDECLIPRECT = EMREXCLUDECLIPRECT;
- TEMREXCLUDECLIPRECT = EMREXCLUDECLIPRECT;
- PEMREXCLUDECLIPRECT = ^EMREXCLUDECLIPRECT;
-
- EMRINTERSECTCLIPRECT = EMREXCLUDECLIPRECT;
- TEMRINTERSECTCLIPRECT = EMREXCLUDECLIPRECT;
- PEMRINTERSECTCLIPRECT = ^EMREXCLUDECLIPRECT;
-
- PANOSE = record
- bFamilyType : BYTE;
- bSerifStyle : BYTE;
- bWeight : BYTE;
- bProportion : BYTE;
- bContrast : BYTE;
- bStrokeVariation : BYTE;
- bArmStyle : BYTE;
- bLetterform : BYTE;
- bMidline : BYTE;
- bXHeight : BYTE;
- end;
- tagPANOSE = PANOSE;
- TPANOSE = PANOSE;
- PPANOSE = ^PANOSE;
-
- EXTLOGFONT = record
- elfLogFont : LOGFONT;
- elfFullName : array[0..(LF_FULLFACESIZE)-1] of BCHAR;
- elfStyle : array[0..(LF_FACESIZE)-1] of BCHAR;
- elfVersion : DWORD;
- elfStyleSize : DWORD;
- elfMatch : DWORD;
- elfReserved : DWORD;
- elfVendorId : array[0..(ELF_VENDOR_SIZE)-1] of BYTE;
- elfCulture : DWORD;
- elfPanose : PANOSE;
- end;
- tagEXTLOGFONT = EXTLOGFONT;
- TEXTLOGFONT = EXTLOGFONT;
- PEXTLOGFONT = ^EXTLOGFONT;
-
- EMREXTCREATEFONTINDIRECTW = record
- emr : EMR;
- ihFont : DWORD;
- elfw : EXTLOGFONT;
- end;
- tagEMREXTCREATEFONTINDIRECTW = EMREXTCREATEFONTINDIRECTW;
- TEMREXTCREATEFONTINDIRECTW = EMREXTCREATEFONTINDIRECTW;
- PEMREXTCREATEFONTINDIRECTW = ^EMREXTCREATEFONTINDIRECTW;
-
-
- EXTLOGPEN = record
- elpPenStyle : UINT;
- elpWidth : UINT;
- elpBrushStyle : UINT;
- elpColor : COLORREF;
- elpHatch : LONG;
- elpNumEntries : DWORD;
- elpStyleEntry : array[0..0] of DWORD;
- end;
- tagEXTLOGPEN = EXTLOGPEN;
- TEXTLOGPEN = EXTLOGPEN;
- PEXTLOGPEN = ^EXTLOGPEN;
-
- EMREXTCREATEPEN = record
- emr : EMR;
- ihPen : DWORD;
- offBmi : DWORD;
- cbBmi : DWORD;
- offBits : DWORD;
- cbBits : DWORD;
- elp : EXTLOGPEN;
- end;
- tagEMREXTCREATEPEN = EMREXTCREATEPEN;
- TEMREXTCREATEPEN = EMREXTCREATEPEN;
- PEMREXTCREATEPEN = ^EMREXTCREATEPEN;
-
- EMREXTFLOODFILL = record
- emr : EMR;
- ptlStart : POINTL;
- crColor : COLORREF;
- iMode : DWORD;
- end;
- tagEMREXTFLOODFILL = EMREXTFLOODFILL;
- TEMREXTFLOODFILL = EMREXTFLOODFILL;
- PEMREXTFLOODFILL = ^EMREXTFLOODFILL;
-
- EMREXTSELECTCLIPRGN = record
- emr : EMR;
- cbRgnData : DWORD;
- iMode : DWORD;
- RgnData : array[0..0] of BYTE;
- end;
- tagEMREXTSELECTCLIPRGN = EMREXTSELECTCLIPRGN;
- TEMREXTSELECTCLIPRGN = EMREXTSELECTCLIPRGN;
- PEMREXTSELECTCLIPRGN = ^EMREXTSELECTCLIPRGN;
-
- EMRTEXT = record
- ptlReference : POINTL;
- nChars : DWORD;
- offString : DWORD;
- fOptions : DWORD;
- rcl : RECTL;
- offDx : DWORD;
- end;
- tagEMRTEXT = EMRTEXT;
- TEMRTEXT = EMRTEXT;
- PEMRTEXT = ^EMRTEXT;
-
- EMREXTTEXTOUTA = record
- emr : EMR;
- rclBounds : RECTL;
- iGraphicsMode : DWORD;
- exScale : Single;
- eyScale : Single;
- emrtext : EMRTEXT;
- end;
- tagEMREXTTEXTOUTA = EMREXTTEXTOUTA;
- TEMREXTTEXTOUTA = EMREXTTEXTOUTA;
- PEMREXTTEXTOUTA = ^EMREXTTEXTOUTA;
-
- EMREXTTEXTOUTW = EMREXTTEXTOUTA;
- TEMREXTTEXTOUTW = EMREXTTEXTOUTA;
- PEMREXTTEXTOUTW = ^EMREXTTEXTOUTA;
-
- EMRFILLPATH = record
- emr : EMR;
- rclBounds : RECTL;
- end;
- tagEMRFILLPATH = EMRFILLPATH;
- TEMRFILLPATH = EMRFILLPATH;
- PEMRFILLPATH = ^EMRFILLPATH;
-
- EMRSTROKEANDFILLPATH = EMRFILLPATH;
- TEMRSTROKEANDFILLPATH = EMRFILLPATH;
- PEMRSTROKEANDFILLPATH = ^EMRFILLPATH;
-
- EMRSTROKEPATH = EMRFILLPATH;
- TEMRSTROKEPATH = EMRFILLPATH;
- PEMRSTROKEPATH = ^EMRFILLPATH;
-
- EMRFILLRGN = record
- emr : EMR;
- rclBounds : RECTL;
- cbRgnData : DWORD;
- ihBrush : DWORD;
- RgnData : array[0..0] of BYTE;
- end;
- tagEMRFILLRGN = EMRFILLRGN;
- TEMRFILLRGN = EMRFILLRGN;
- PEMRFILLRGN = ^EMRFILLRGN;
-
- EMRFORMAT = record
- dSignature : DWORD;
- nVersion : DWORD;
- cbData : DWORD;
- offData : DWORD;
- end;
- tagEMRFORMAT = EMRFORMAT;
- TEMRFORMAT = EMRFORMAT;
- PEMRFORMAT = ^EMRFORMAT;
-
- SIZE = record
- cx : LONG;
- cy : LONG;
- end;
- LPSIZE = ^SIZE;
- tagSIZE = SIZE;
- TSIZE = SIZE;
- PSIZE = ^SIZE;
-
- SIZEL = SIZE; //windef
- TSIZEL = SIZE; //windef
- PSIZEL = ^SIZE;
- LPSIZEL = ^SIZE;
-
- EMRFRAMERGN = record
- emr : EMR;
- rclBounds : RECTL;
- cbRgnData : DWORD;
- ihBrush : DWORD;
- szlStroke : SIZEL;
- RgnData : array[0..0] of BYTE;
- end;
- tagEMRFRAMERGN = EMRFRAMERGN;
- TEMRFRAMERGN = EMRFRAMERGN;
- PEMRFRAMERGN = ^EMRFRAMERGN;
-
- EMRGDICOMMENT = record
- emr : EMR;
- cbData : DWORD;
- Data : array[0..0] of BYTE;
- end;
- tagEMRGDICOMMENT = EMRGDICOMMENT;
- TEMRGDICOMMENT = EMRGDICOMMENT;
- PEMRGDICOMMENT = ^EMRGDICOMMENT;
-
- EMRINVERTRGN = record
- emr : EMR;
- rclBounds : RECTL;
- cbRgnData : DWORD;
- RgnData : array[0..0] of BYTE;
- end;
- tagEMRINVERTRGN = EMRINVERTRGN;
- TEMRINVERTRGN = EMRINVERTRGN;
- PEMRINVERTRGN = ^EMRINVERTRGN;
-
- EMRPAINTRGN = EMRINVERTRGN;
- TEMRPAINTRGN = EMRINVERTRGN;
- PEMRPAINTRGN = ^EMRINVERTRGN;
-
- EMRLINETO = record
- emr : EMR;
- ptl : POINTL;
- end;
- tagEMRLINETO = EMRLINETO;
- TEMRLINETO = EMRLINETO;
- PEMRLINETO = ^EMRLINETO;
-
- EMRMOVETOEX = EMRLINETO;
- TEMRMOVETOEX = EMRLINETO;
- PEMRMOVETOEX = ^EMRLINETO;
-
- EMRMASKBLT = record
- emr : EMR;
- rclBounds : RECTL;
- xDest : LONG;
- yDest : LONG;
- cxDest : LONG;
- cyDest : LONG;
- dwRop : DWORD;
- xSrc : LONG;
- ySrc : LONG;
- xformSrc : XFORM;
- crBkColorSrc : COLORREF;
- iUsageSrc : DWORD;
- offBmiSrc : DWORD;
- cbBmiSrc : DWORD;
- offBitsSrc : DWORD;
- cbBitsSrc : DWORD;
- xMask : LONG;
- yMask : LONG;
- iUsageMask : DWORD;
- offBmiMask : DWORD;
- cbBmiMask : DWORD;
- offBitsMask : DWORD;
- cbBitsMask : DWORD;
- end;
- tagEMRMASKBLT = EMRMASKBLT;
- TEMRMASKBLT = EMRMASKBLT;
- PEMRMASKBLT = ^EMRMASKBLT;
-
- EMRMODIFYWORLDTRANSFORM = record
- emr : EMR;
- xform : XFORM;
- iMode : DWORD;
- end;
- tagEMRMODIFYWORLDTRANSFORM = EMRMODIFYWORLDTRANSFORM;
- TEMRMODIFYWORLDTRANSFORM = EMRMODIFYWORLDTRANSFORM;
- PEMRMODIFYWORLDTRANSFORM = EMRMODIFYWORLDTRANSFORM;
-
- EMROFFSETCLIPRGN = record
- emr : EMR;
- ptlOffset : POINTL;
- end;
- tagEMROFFSETCLIPRGN = EMROFFSETCLIPRGN;
- TEMROFFSETCLIPRGN = EMROFFSETCLIPRGN;
- PEMROFFSETCLIPRGN = ^EMROFFSETCLIPRGN;
-
- EMRPLGBLT = record
- emr : EMR;
- rclBounds : RECTL;
- aptlDest : array[0..2] of POINTL;
- xSrc : LONG;
- ySrc : LONG;
- cxSrc : LONG;
- cySrc : LONG;
- xformSrc : XFORM;
- crBkColorSrc : COLORREF;
- iUsageSrc : DWORD;
- offBmiSrc : DWORD;
- cbBmiSrc : DWORD;
- offBitsSrc : DWORD;
- cbBitsSrc : DWORD;
- xMask : LONG;
- yMask : LONG;
- iUsageMask : DWORD;
- offBmiMask : DWORD;
- cbBmiMask : DWORD;
- offBitsMask : DWORD;
- cbBitsMask : DWORD;
- end;
- tagEMRPLGBLT = EMRPLGBLT;
- TEMRPLGBLT = EMRPLGBLT;
- PEMRPLGBLT = ^EMRPLGBLT;
-
- EMRPOLYDRAW = record
- emr : EMR;
- rclBounds : RECTL;
- cptl : DWORD;
- aptl : array[0..0] of POINTL;
- abTypes : array[0..0] of BYTE;
- end;
- tagEMRPOLYDRAW = EMRPOLYDRAW;
- TEMRPOLYDRAW = EMRPOLYDRAW;
- PEMRPOLYDRAW = ^EMRPOLYDRAW;
-
- EMRPOLYDRAW16 = record
- emr : EMR;
- rclBounds : RECTL;
- cpts : DWORD;
- apts : array[0..0] of POINTS;
- abTypes : array[0..0] of BYTE;
- end;
- tagEMRPOLYDRAW16 = EMRPOLYDRAW16;
- TEMRPOLYDRAW16 = EMRPOLYDRAW16;
- PEMRPOLYDRAW16 = ^EMRPOLYDRAW16;
-
- EMRPOLYLINE = record
- emr : EMR;
- rclBounds : RECTL;
- cptl : DWORD;
- aptl : array[0..0] of POINTL;
- end;
- tagEMRPOLYLINE = EMRPOLYLINE;
- TEMRPOLYLINE = EMRPOLYLINE;
- PEMRPOLYLINE = ^EMRPOLYLINE;
-
- EMRPOLYBEZIER = EMRPOLYLINE;
- TEMRPOLYBEZIER = EMRPOLYLINE;
- PEMRPOLYBEZIER = ^EMRPOLYLINE;
-
- EMRPOLYGON = EMRPOLYLINE;
- TEMRPOLYGON = EMRPOLYLINE;
- PEMRPOLYGON = ^EMRPOLYLINE;
-
- EMRPOLYBEZIERTO = EMRPOLYLINE;
- TEMRPOLYBEZIERTO = EMRPOLYLINE;
- PEMRPOLYBEZIERTO = ^EMRPOLYLINE;
-
- EMRPOLYLINETO = EMRPOLYLINE;
- TEMRPOLYLINETO = EMRPOLYLINE;
- PEMRPOLYLINETO = ^EMRPOLYLINE;
-
- EMRPOLYLINE16 = record
- emr : EMR;
- rclBounds : RECTL;
- cpts : DWORD;
- apts : array[0..0] of POINTL;
- end;
- tagEMRPOLYLINE16 = EMRPOLYLINE16;
- TEMRPOLYLINE16 = EMRPOLYLINE16;
- PEMRPOLYLINE16 = ^EMRPOLYLINE16;
-
- EMRPOLYBEZIER16 = EMRPOLYLINE16;
- TEMRPOLYBEZIER16 = EMRPOLYLINE16;
- PEMRPOLYBEZIER16 = ^EMRPOLYLINE16;
-
- EMRPOLYGON16 = EMRPOLYLINE16;
- TEMRPOLYGON16 = EMRPOLYLINE16;
- PEMRPOLYGON16 = ^EMRPOLYLINE16;
-
- EMRPOLYBEZIERTO16 = EMRPOLYLINE16;
- TEMRPOLYBEZIERTO16 = EMRPOLYLINE16;
- PEMRPOLYBEZIERTO16 = ^EMRPOLYLINE16;
-
- EMRPOLYLINETO16 = EMRPOLYLINE16;
- TEMRPOLYLINETO16 = EMRPOLYLINE16;
- PEMRPOLYLINETO16 = ^EMRPOLYLINE16;
-
- EMRPOLYPOLYLINE = record
- emr : EMR;
- rclBounds : RECTL;
- nPolys : DWORD;
- cptl : DWORD;
- aPolyCounts : array[0..0] of DWORD;
- aptl : array[0..0] of POINTL;
- end;
- tagEMRPOLYPOLYLINE = EMRPOLYPOLYLINE;
- TEMRPOLYPOLYLINE = EMRPOLYPOLYLINE;
- PEMRPOLYPOLYLINE = ^EMRPOLYPOLYLINE;
-
- EMRPOLYPOLYGON = EMRPOLYPOLYLINE;
- TEMRPOLYPOLYGON = EMRPOLYPOLYLINE;
- PEMRPOLYPOLYGON = ^EMRPOLYPOLYLINE;
-
- EMRPOLYPOLYLINE16 = record
- emr : EMR;
- rclBounds : RECTL;
- nPolys : DWORD;
- cpts : DWORD;
- aPolyCounts : array[0..0] of DWORD;
- apts : array[0..0] of POINTS;
- end;
- tagEMRPOLYPOLYLINE16 = EMRPOLYPOLYLINE16;
- TEMRPOLYPOLYLINE16 = EMRPOLYPOLYLINE16;
- PEMRPOLYPOLYLINE16 = ^EMRPOLYPOLYLINE16;
-
- EMRPOLYPOLYGON16 = EMRPOLYPOLYLINE16;
- TEMRPOLYPOLYGON16 = EMRPOLYPOLYLINE16;
- PEMRPOLYPOLYGON16 = ^EMRPOLYPOLYLINE16;
-
- EMRPOLYTEXTOUTA = record
- emr : EMR;
- rclBounds : RECTL;
- iGraphicsMode : DWORD;
- exScale : Single;
- eyScale : Single;
- cStrings : LONG;
- aemrtext : array[0..0] of EMRTEXT;
- end;
- tagEMRPOLYTEXTOUTA = EMRPOLYTEXTOUTA;
- TEMRPOLYTEXTOUTA = EMRPOLYTEXTOUTA;
- PEMRPOLYTEXTOUTA = ^EMRPOLYTEXTOUTA;
-
- EMRPOLYTEXTOUTW = EMRPOLYTEXTOUTA;
- TEMRPOLYTEXTOUTW = EMRPOLYTEXTOUTA;
- PEMRPOLYTEXTOUTW = ^EMRPOLYTEXTOUTA;
-
- EMRRESIZEPALETTE = record
- emr : EMR;
- ihPal : DWORD;
- cEntries : DWORD;
- end;
- tagEMRRESIZEPALETTE = EMRRESIZEPALETTE;
- TEMRRESIZEPALETTE = EMRRESIZEPALETTE;
- PEMRRESIZEPALETTE = ^EMRRESIZEPALETTE;
-
- EMRRESTOREDC = record
- emr : EMR;
- iRelative : LONG;
- end;
- tagEMRRESTOREDC = EMRRESTOREDC;
- TEMRRESTOREDC = EMRRESTOREDC;
- PEMRRESTOREDC = ^EMRRESTOREDC;
-
- EMRROUNDRECT = record
- emr : EMR;
- rclBox : RECTL;
- szlCorner : SIZEL;
- end;
- tagEMRROUNDRECT = EMRROUNDRECT;
- TEMRROUNDRECT = EMRROUNDRECT;
- PEMRROUNDRECT = ^EMRROUNDRECT;
-
- EMRSCALEVIEWPORTEXTEX = record
- emr : EMR;
- xNum : LONG;
- xDenom : LONG;
- yNum : LONG;
- yDenom : LONG;
- end;
- tagEMRSCALEVIEWPORTEXTEX = EMRSCALEVIEWPORTEXTEX;
- TEMRSCALEVIEWPORTEXTEX = EMRSCALEVIEWPORTEXTEX;
- PEMRSCALEVIEWPORTEXTEX = ^EMRSCALEVIEWPORTEXTEX;
-
- EMRSCALEWINDOWEXTEX = EMRSCALEVIEWPORTEXTEX;
- TEMRSCALEWINDOWEXTEX = EMRSCALEVIEWPORTEXTEX;
- PEMRSCALEWINDOWEXTEX = ^EMRSCALEVIEWPORTEXTEX;
-
- EMRSELECTCOLORSPACE = record
- emr : EMR;
- ihCS : DWORD;
- end;
- tagEMRSELECTCOLORSPACE = EMRSELECTCOLORSPACE;
- TEMRSELECTCOLORSPACE = EMRSELECTCOLORSPACE;
- PEMRSELECTCOLORSPACE = ^EMRSELECTCOLORSPACE;
-
- EMRDELETECOLORSPACE = EMRSELECTCOLORSPACE;
- TEMRDELETECOLORSPACE = EMRSELECTCOLORSPACE;
- PEMRDELETECOLORSPACE = ^EMRSELECTCOLORSPACE;
-
- EMRSELECTOBJECT = record
- emr : EMR;
- ihObject : DWORD;
- end;
- tagEMRSELECTOBJECT = EMRSELECTOBJECT;
- TEMRSELECTOBJECT = EMRSELECTOBJECT;
- PEMRSELECTOBJECT = ^EMRSELECTOBJECT;
-
- EMRDELETEOBJECT = EMRSELECTOBJECT;
- TEMRDELETEOBJECT = EMRSELECTOBJECT;
- PEMRDELETEOBJECT = ^EMRSELECTOBJECT;
-
- EMRSELECTPALETTE = record
- emr : EMR;
- ihPal : DWORD;
- end;
- tagEMRSELECTPALETTE = EMRSELECTPALETTE;
- TEMRSELECTPALETTE = EMRSELECTPALETTE;
- PEMRSELECTPALETTE = ^EMRSELECTPALETTE;
-
- EMRSETARCDIRECTION = record
- emr : EMR;
- iArcDirection : DWORD;
- end;
- tagEMRSETARCDIRECTION = EMRSETARCDIRECTION;
- TEMRSETARCDIRECTION = EMRSETARCDIRECTION;
- PEMRSETARCDIRECTION = ^EMRSETARCDIRECTION;
-
- EMRSETBKCOLOR = record
- emr : EMR;
- crColor : COLORREF;
- end;
- tagEMRSETTEXTCOLOR = EMRSETBKCOLOR;
- TEMRSETBKCOLOR = EMRSETBKCOLOR;
- PEMRSETBKCOLOR = ^EMRSETBKCOLOR;
-
- EMRSETTEXTCOLOR = EMRSETBKCOLOR;
- TEMRSETTEXTCOLOR = EMRSETBKCOLOR;
- PEMRSETTEXTCOLOR = ^EMRSETBKCOLOR;
-
- EMRSETCOLORADJUSTMENT = record
- emr : EMR;
- ColorAdjustment : COLORADJUSTMENT;
- end;
- tagEMRSETCOLORADJUSTMENT = EMRSETCOLORADJUSTMENT;
- TEMRSETCOLORADJUSTMENT = EMRSETCOLORADJUSTMENT;
- PEMRSETCOLORADJUSTMENT = ^EMRSETCOLORADJUSTMENT;
-
- EMRSETDIBITSTODEVICE = record
- emr : EMR;
- rclBounds : RECTL;
- xDest : LONG;
- yDest : LONG;
- xSrc : LONG;
- ySrc : LONG;
- cxSrc : LONG;
- cySrc : LONG;
- offBmiSrc : DWORD;
- cbBmiSrc : DWORD;
- offBitsSrc : DWORD;
- cbBitsSrc : DWORD;
- iUsageSrc : DWORD;
- iStartScan : DWORD;
- cScans : DWORD;
- end;
- tagEMRSETDIBITSTODEVICE = EMRSETDIBITSTODEVICE;
- TEMRSETDIBITSTODEVICE = EMRSETDIBITSTODEVICE;
- PEMRSETDIBITSTODEVICE = ^EMRSETDIBITSTODEVICE;
-
- EMRSETMAPPERFLAGS = record
- emr : EMR;
- dwFlags : DWORD;
- end;
- tagEMRSETMAPPERFLAGS = EMRSETMAPPERFLAGS;
- TEMRSETMAPPERFLAGS = EMRSETMAPPERFLAGS;
- PEMRSETMAPPERFLAGS = ^EMRSETMAPPERFLAGS;
-
- EMRSETMITERLIMIT = record
- emr : EMR;
- eMiterLimit : Single;
- end;
- tagEMRSETMITERLIMIT = EMRSETMITERLIMIT;
- TEMRSETMITERLIMIT = EMRSETMITERLIMIT;
- PEMRSETMITERLIMIT = ^EMRSETMITERLIMIT;
-
- EMRSETPALETTEENTRIES = record
- emr : EMR;
- ihPal : DWORD;
- iStart : DWORD;
- cEntries : DWORD;
- aPalEntries : array[0..0] of PALETTEENTRY;
- end;
- tagEMRSETPALETTEENTRIES = EMRSETPALETTEENTRIES;
- TEMRSETPALETTEENTRIES = EMRSETPALETTEENTRIES;
- PEMRSETPALETTEENTRIES = ^EMRSETPALETTEENTRIES;
-
- EMRSETPIXELV = record
- emr : EMR;
- ptlPixel : POINTL;
- crColor : COLORREF;
- end;
- tagEMRSETPIXELV = EMRSETPIXELV;
- TEMRSETPIXELV = EMRSETPIXELV;
- PEMRSETPIXELV = ^EMRSETPIXELV;
-
- EMRSETVIEWPORTEXTEX = record
- emr : EMR;
- szlExtent : SIZEL;
- end;
- tagEMRSETVIEWPORTEXTEX = EMRSETVIEWPORTEXTEX;
- TEMRSETVIEWPORTEXTEX = EMRSETVIEWPORTEXTEX;
- PEMRSETVIEWPORTEXTEX = ^EMRSETVIEWPORTEXTEX;
-
- EMRSETWINDOWEXTEX = EMRSETVIEWPORTEXTEX;
- TEMRSETWINDOWEXTEX = EMRSETVIEWPORTEXTEX;
- PEMRSETWINDOWEXTEX = ^EMRSETVIEWPORTEXTEX;
-
- EMRSETVIEWPORTORGEX = record
- emr : EMR;
- ptlOrigin : POINTL;
- end;
- tagEMRSETVIEWPORTORGEX = EMRSETVIEWPORTORGEX;
- TEMRSETVIEWPORTORGEX = EMRSETVIEWPORTORGEX;
- PEMRSETVIEWPORTORGEX = ^EMRSETVIEWPORTORGEX;
-
- EMRSETWINDOWORGEX = EMRSETVIEWPORTORGEX;
- TEMRSETWINDOWORGEX = EMRSETVIEWPORTORGEX;
- PEMRSETWINDOWORGEX = ^EMRSETVIEWPORTORGEX;
-
- EMRSETBRUSHORGEX = EMRSETVIEWPORTORGEX;
- TEMRSETBRUSHORGEX = EMRSETVIEWPORTORGEX;
- PEMRSETBRUSHORGEX = ^EMRSETVIEWPORTORGEX;
-
- EMRSETWORLDTRANSFORM = record
- emr : EMR;
- xform : XFORM;
- end;
- tagEMRSETWORLDTRANSFORM = EMRSETWORLDTRANSFORM;
- TEMRSETWORLDTRANSFORM = EMRSETWORLDTRANSFORM;
- PEMRSETWORLDTRANSFORM = ^EMRSETWORLDTRANSFORM;
-
- EMRSTRETCHBLT = record
- emr : EMR;
- rclBounds : RECTL;
- xDest : LONG;
- yDest : LONG;
- cxDest : LONG;
- cyDest : LONG;
- dwRop : DWORD;
- xSrc : LONG;
- ySrc : LONG;
- xformSrc : XFORM;
- crBkColorSrc : COLORREF;
- iUsageSrc : DWORD;
- offBmiSrc : DWORD;
- cbBmiSrc : DWORD;
- offBitsSrc : DWORD;
- cbBitsSrc : DWORD;
- cxSrc : LONG;
- cySrc : LONG;
- end;
- tagEMRSTRETCHBLT = EMRSTRETCHBLT;
- TEMRSTRETCHBLT = EMRSTRETCHBLT;
- PEMRSTRETCHBLT = ^EMRSTRETCHBLT;
-
- EMRSTRETCHDIBITS = record
- emr : EMR;
- rclBounds : RECTL;
- xDest : LONG;
- yDest : LONG;
- xSrc : LONG;
- ySrc : LONG;
- cxSrc : LONG;
- cySrc : LONG;
- offBmiSrc : DWORD;
- cbBmiSrc : DWORD;
- offBitsSrc : DWORD;
- cbBitsSrc : DWORD;
- iUsageSrc : DWORD;
- dwRop : DWORD;
- cxDest : LONG;
- cyDest : LONG;
- end;
- tagEMRSTRETCHDIBITS = EMRSTRETCHDIBITS;
- TEMRSTRETCHDIBITS = EMRSTRETCHDIBITS;
- PEMRSTRETCHDIBITS = ^EMRSTRETCHDIBITS;
-
- EMRABORTPATH = record
- emr : EMR;
- end;
- TEMRABORTPATH = EMRABORTPATH;
- PEMRABORTPATH = ^EMRABORTPATH;
-
- tagABORTPATH = EMRABORTPATH;
- TABORTPATH = EMRABORTPATH;
-
- EMRBEGINPATH = EMRABORTPATH;
- TEMRBEGINPATH = EMRABORTPATH;
- PEMRBEGINPATH = ^EMRABORTPATH;
-
- EMRENDPATH = EMRABORTPATH;
- TEMRENDPATH = EMRABORTPATH;
- PEMRENDPATH = ^EMRABORTPATH;
-
- EMRCLOSEFIGURE = EMRABORTPATH;
- TEMRCLOSEFIGURE = EMRABORTPATH;
- PEMRCLOSEFIGURE = ^EMRABORTPATH;
-
- EMRFLATTENPATH = EMRABORTPATH;
- TEMRFLATTENPATH = EMRABORTPATH;
- PEMRFLATTENPATH = ^EMRABORTPATH;
-
- EMRWIDENPATH = EMRABORTPATH;
- TEMRWIDENPATH = EMRABORTPATH;
- PEMRWIDENPATH = ^EMRABORTPATH;
-
- EMRSETMETARGN = EMRABORTPATH;
- TEMRSETMETARGN = EMRABORTPATH;
- PEMRSETMETARGN = ^EMRABORTPATH;
-
- EMRSAVEDC = EMRABORTPATH;
- TEMRSAVEDC = EMRABORTPATH;
- PEMRSAVEDC = ^EMRABORTPATH;
-
- EMRREALIZEPALETTE = EMRABORTPATH;
- TEMRREALIZEPALETTE = EMRABORTPATH;
- PEMRREALIZEPALETTE = ^EMRABORTPATH;
-
- EMRSELECTCLIPPATH = record
- emr : EMR;
- iMode : DWORD;
- end;
- tagEMRSELECTCLIPPATH = EMRSELECTCLIPPATH;
- TEMRSELECTCLIPPATH = EMRSELECTCLIPPATH;
- PEMRSELECTCLIPPATH = ^EMRSELECTCLIPPATH;
-
- EMRSETBKMODE = EMRSELECTCLIPPATH;
- TEMRSETBKMODE = EMRSELECTCLIPPATH;
- PEMRSETBKMODE = ^EMRSELECTCLIPPATH;
-
- EMRSETMAPMODE = EMRSELECTCLIPPATH;
- TEMRSETMAPMODE = EMRSELECTCLIPPATH;
- PEMRSETMAPMODE = ^EMRSELECTCLIPPATH;
-
- EMRSETPOLYFILLMODE = EMRSELECTCLIPPATH;
- TEMRSETPOLYFILLMODE = EMRSELECTCLIPPATH;
- PEMRSETPOLYFILLMODE = ^EMRSELECTCLIPPATH;
-
- EMRSETROP2 = EMRSELECTCLIPPATH;
- TEMRSETROP2 = EMRSELECTCLIPPATH;
- PEMRSETROP2 = ^EMRSELECTCLIPPATH;
-
- EMRSETSTRETCHBLTMODE = EMRSELECTCLIPPATH;
- TEMRSETSTRETCHBLTMODE = EMRSELECTCLIPPATH;
- PEMRSETSTRETCHBLTMODE = ^EMRSELECTCLIPPATH;
-
- EMRSETTEXTALIGN = EMRSELECTCLIPPATH;
- TEMRSETTEXTALIGN = EMRSELECTCLIPPATH;
- PEMRSETTEXTALIGN = ^EMRSELECTCLIPPATH;
-
- EMRENABLEICM = EMRSELECTCLIPPATH;
- TEMRENABLEICM = EMRSELECTCLIPPATH;
- PEMRENABLEICM = ^EMRSELECTCLIPPATH;
-
- NMHDR = record
- hwndFrom : HWND;
- idFrom : UINT;
- code : UINT;
- end;
- tagNMHDR = NMHDR;
- TNMHDR = NMHDR;
- PNMHDR = ^NMHDR;
-
- ENCORRECTTEXT = record
- nmhdr : NMHDR;
- chrg : CHARRANGE;
- seltyp : WORD;
- end;
- _encorrecttext = ENCORRECTTEXT;
- Tencorrecttext = ENCORRECTTEXT;
- Pencorrecttext = ^ENCORRECTTEXT;
-
- ENDROPFILES = record
- nmhdr : NMHDR;
- hDrop : HANDLE;
- cp : LONG;
- fProtected : WINBOOL;
- end;
- _endropfiles = ENDROPFILES;
- Tendropfiles = ENDROPFILES;
- Pendropfiles = ^ENDROPFILES;
-
- ENSAVECLIPBOARD = record
- nmhdr : NMHDR;
- cObjectCount : LONG;
- cch : LONG;
- end;
- TENSAVECLIPBOARD = ENSAVECLIPBOARD;
- PENSAVECLIPBOARD = ^ENSAVECLIPBOARD;
-
- ENOLEOPFAILED = record
- nmhdr : NMHDR;
- iob : LONG;
- lOper : LONG;
- hr : HRESULT;
- end;
- TENOLEOPFAILED = ENOLEOPFAILED;
- PENOLEOPFAILED = ^ENOLEOPFAILED;
-
- ENHMETAHEADER = record
- iType : DWORD;
- nSize : DWORD;
- rclBounds : RECTL;
- rclFrame : RECTL;
- dSignature : DWORD;
- nVersion : DWORD;
- nBytes : DWORD;
- nRecords : DWORD;
- nHandles : WORD;
- sReserved : WORD;
- nDescription : DWORD;
- offDescription : DWORD;
- nPalEntries : DWORD;
- szlDevice : SIZEL;
- szlMillimeters : SIZEL;
- end;
- LPENHMETAHEADER = ^ENHMETAHEADER;
- tagENHMETAHEADER = ENHMETAHEADER;
- TENHMETAHEADER = ENHMETAHEADER;
- PENHMETAHEADER = ^ENHMETAHEADER;
-
- ENHMETARECORD = record
- iType : DWORD;
- nSize : DWORD;
- dParm : array[0..0] of DWORD;
- end;
- LPENHMETARECORD = ^ENHMETARECORD;
- tagENHMETARECORD = ENHMETARECORD;
- TENHMETARECORD = ENHMETARECORD;
- PENHMETARECORD = ^ENHMETARECORD;
-
- ENPROTECTED = record
- nmhdr : NMHDR;
- msg : UINT;
- wParam : WPARAM;
- lParam : LPARAM;
- chrg : CHARRANGE;
- end;
- _enprotected = ENPROTECTED;
- Tenprotected = ENPROTECTED;
- Penprotected = ^ENPROTECTED;
-
- SERVICE_STATUS = record
- dwServiceType : DWORD;
- dwCurrentState : DWORD;
- dwControlsAccepted : DWORD;
- dwWin32ExitCode : DWORD;
- dwServiceSpecificExitCode : DWORD;
- dwCheckPoint : DWORD;
- dwWaitHint : DWORD;
- end;
- LPSERVICE_STATUS = ^SERVICE_STATUS;
- _SERVICE_STATUS = SERVICE_STATUS;
- TSERVICESTATUS = SERVICE_STATUS;
- PSERVICESTATUS = ^SERVICE_STATUS;
-
- ENUM_SERVICE_STATUS = record
- lpServiceName : LPTSTR;
- lpDisplayName : LPTSTR;
- ServiceStatus : SERVICE_STATUS;
- end;
- LPENUM_SERVICE_STATUS = ^ENUM_SERVICE_STATUS;
- _ENUM_SERVICE_STATUS = ENUM_SERVICE_STATUS;
- TENUMSERVICESTATUS = ENUM_SERVICE_STATUS;
- PENUMSERVICESTATUS = ^ENUM_SERVICE_STATUS;
-
- ENUMLOGFONT = record
- elfLogFont : LOGFONT;
- elfFullName : array[0..(LF_FULLFACESIZE)-1] of BCHAR;
- elfStyle : array[0..(LF_FACESIZE)-1] of BCHAR;
- end;
- tagENUMLOGFONT = ENUMLOGFONT;
- TENUMLOGFONT = ENUMLOGFONT;
- PENUMLOGFONT = ^ENUMLOGFONT;
-
- ENUMLOGFONTEX = record
- elfLogFont : LOGFONT;
- elfFullName : array[0..(LF_FULLFACESIZE)-1] of BCHAR;
- elfStyle : array[0..(LF_FACESIZE)-1] of BCHAR;
- elfScript : array[0..(LF_FACESIZE)-1] of BCHAR;
- end;
- tagENUMLOGFONTEX = ENUMLOGFONTEX;
- TENUMLOGFONTEX = ENUMLOGFONTEX;
- PENUMLOGFONTEX = ^ENUMLOGFONTEX;
- {
- Then follow:
-
- TCHAR SourceName[]
- TCHAR Computername[]
- SID UserSid
- TCHAR Strings[]
- BYTE Data[]
- CHAR Pad[]
- DWORD Length;
- }
-
- EVENTLOGRECORD = record
- Length : DWORD;
- Reserved : DWORD;
- RecordNumber : DWORD;
- TimeGenerated : DWORD;
- TimeWritten : DWORD;
- EventID : DWORD;
- EventType : WORD;
- NumStrings : WORD;
- EventCategory : WORD;
- ReservedFlags : WORD;
- ClosingRecordNumber : DWORD;
- StringOffset : DWORD;
- UserSidLength : DWORD;
- UserSidOffset : DWORD;
- DataLength : DWORD;
- DataOffset : DWORD;
- end;
- _EVENTLOGRECORD = EVENTLOGRECORD;
- TEVENTLOGRECORD = EVENTLOGRECORD;
- PEVENTLOGRECORD = ^EVENTLOGRECORD;
-
- EVENTMSG = record
- message : UINT;
- paramL : UINT;
- paramH : UINT;
- time : DWORD;
- hwnd : HWND;
- end;
- tagEVENTMSG = EVENTMSG;
- TEVENTMSG = EVENTMSG;
- PEVENTMSG = ^EVENTMSG;
-
- EXCEPTION_POINTERS = record //winnt
- ExceptionRecord : PEXCEPTION_RECORD;
- ContextRecord : PCONTEXT;
- end;
- LPEXCEPTION_POINTERS = ^EXCEPTION_POINTERS;
- PEXCEPTION_POINTERS = ^EXCEPTION_POINTERS;
- _EXCEPTION_POINTERS = EXCEPTION_POINTERS;
- TEXCEPTIONPOINTERS = EXCEPTION_POINTERS;
- PEXCEPTIONPOINTERS = ^EXCEPTION_POINTERS;
-
- EXT_BUTTON = record
- idCommand : WORD;
- idsHelp : WORD;
- fsStyle : WORD;
- end;
- LPEXT_BUTTON = ^EXT_BUTTON;
- _EXT_BUTTON = EXT_BUTTON;
- TEXTBUTTON = EXT_BUTTON;
- PEXTBUTTON = ^EXT_BUTTON;
-
- FILTERKEYS = record
- cbSize : UINT;
- dwFlags : DWORD;
- iWaitMSec : DWORD;
- iDelayMSec : DWORD;
- iRepeatMSec : DWORD;
- iBounceMSec : DWORD;
- end;
- tagFILTERKEYS = FILTERKEYS;
- TFILTERKEYS = FILTERKEYS;
- PFILTERKEYS = ^FILTERKEYS;
-
- FIND_NAME_BUFFER = record
- length : UCHAR;
- access_control : UCHAR;
- frame_control : UCHAR;
- destination_addr : array[0..5] of UCHAR;
- source_addr : array[0..5] of UCHAR;
- routing_info : array[0..17] of UCHAR;
- end;
- _FIND_NAME_BUFFER = FIND_NAME_BUFFER;
- TFINDNAMEBUFFER = FIND_NAME_BUFFER;
- PFINDNAMEBUFFER = ^FIND_NAME_BUFFER;
-
- FIND_NAME_HEADER = record
- node_count : WORD;
- reserved : UCHAR;
- unique_group : UCHAR;
- end;
- _FIND_NAME_HEADER = FIND_NAME_HEADER;
- TFINDNAMEHEADER = FIND_NAME_HEADER;
- PFINDNAMEHEADER = ^FIND_NAME_HEADER;
-
- FINDREPLACE = record
- lStructSize : DWORD;
- hwndOwner : HWND;
- hInstance : HINST;
- Flags : DWORD;
- lpstrFindWhat : LPTSTR;
- lpstrReplaceWith : LPTSTR;
- wFindWhatLen : WORD;
- wReplaceWithLen : WORD;
- lCustData : LPARAM;
- lpfnHook : LPFRHOOKPROC;
- lpTemplateName : LPCTSTR;
- end;
- LPFINDREPLACE = ^FINDREPLACE;
- TFINDREPLACE = FINDREPLACE;
- PFINDREPLACE = ^FINDREPLACE;
-
- {FINDTEXT = record conflicts with FindText function }
- TFINDTEXT = record
- chrg : CHARRANGE;
- lpstrText : LPSTR;
- end;
- _findtext = TFINDTEXT;
- Pfindtext = ^TFINDTEXT;
-
- FINDTEXTEX = record
- chrg : CHARRANGE;
- lpstrText : LPSTR;
- chrgText : CHARRANGE;
- end;
- _findtextex = FINDTEXTEX;
- Tfindtextex = FINDTEXTEX;
- Pfindtextex = ^FINDTEXTEX;
-
- FMS_GETDRIVEINFO = record
- dwTotalSpace : DWORD;
- dwFreeSpace : DWORD;
- szPath : array[0..259] of TCHAR;
- szVolume : array[0..13] of TCHAR;
- szShare : array[0..127] of TCHAR;
- end;
- _FMS_GETDRIVEINFO = FMS_GETDRIVEINFO;
- TFMSGETDRIVEINFO = FMS_GETDRIVEINFO;
- PFMSGETDRIVEINFO = ^FMS_GETDRIVEINFO;
-
- FMS_GETFILESEL = record
- ftTime : FILETIME;
- dwSize : DWORD;
- bAttr : BYTE;
- szName : array[0..259] of TCHAR;
- end;
- _FMS_GETFILESEL = FMS_GETFILESEL;
- TFMSGETFILESEL = FMS_GETFILESEL;
- PFMSGETFILESEL = ^FMS_GETFILESEL;
-
- FMS_LOAD = record
- dwSize : DWORD;
- szMenuName : array[0..(MENU_TEXT_LEN)-1] of TCHAR;
- hMenu : HMENU;
- wMenuDelta : UINT;
- end;
- _FMS_LOAD = FMS_LOAD;
- TFMSLOAD = FMS_LOAD;
- PFMSLOAD = ^FMS_LOAD;
-
- FMS_TOOLBARLOAD = record
- dwSize : DWORD;
- lpButtons : LPEXT_BUTTON;
- cButtons : WORD;
- cBitmaps : WORD;
- idBitmap : WORD;
- hBitmap : HBITMAP;
- end;
- _FMS_TOOLBARLOAD = FMS_TOOLBARLOAD;
- TFMSTOOLBARLOAD = FMS_TOOLBARLOAD;
- PFMSTOOLBARLOAD = ^FMS_TOOLBARLOAD;
-
- FOCUS_EVENT_RECORD = record
- bSetFocus : WINBOOL;
- end;
- _FOCUS_EVENT_RECORD = FOCUS_EVENT_RECORD;
- TFOCUSEVENTRECORD = FOCUS_EVENT_RECORD;
- PFOCUSEVENTRECORD = ^FOCUS_EVENT_RECORD;
-
- FORM_INFO_1 = record
- Flags : DWORD;
- pName : LPTSTR;
- Size : SIZEL;
- ImageableArea : RECTL;
- end;
- _FORM_INFO_1 = FORM_INFO_1;
- TFORMINFO1 = FORM_INFO_1;
- PFORMINFO1 = ^FORM_INFO_1;
-
- FORMAT_PARAMETERS = record
- MediaType : MEDIA_TYPE;
- StartCylinderNumber : DWORD;
- EndCylinderNumber : DWORD;
- StartHeadNumber : DWORD;
- EndHeadNumber : DWORD;
- end;
- _FORMAT_PARAMETERS = FORMAT_PARAMETERS;
- TFORMATPARAMETERS = FORMAT_PARAMETERS;
- PFORMATPARAMETERS = ^FORMAT_PARAMETERS;
-
- FORMATRANGE = record
- _hdc : HDC;
- hdcTarget : HDC;
- rc : RECT;
- rcPage : RECT;
- chrg : CHARRANGE;
- end;
- _formatrange = FORMATRANGE;
- Tformatrange = FORMATRANGE;
- Pformatrange = ^FORMATRANGE;
-
- GCP_RESULTS = record
- lStructSize : DWORD;
- lpOutString : LPTSTR;
- lpOrder : ^UINT;
- lpDx : ^WINT;
- lpCaretPos : ^WINT;
- lpClass : LPTSTR;
- lpGlyphs : ^UINT;
- nGlyphs : UINT;
- nMaxFit : UINT;
- end;
- LPGCP_RESULTS = ^GCP_RESULTS;
- tagGCP_RESULTS = GCP_RESULTS;
- TGCPRESULTS = GCP_RESULTS;
- PGCPRESULTS = ^GCP_RESULTS;
-//
-// Define the generic mapping array. This is used to denote the
-// mapping of each generic access right to a specific access mask.
-//
- GENERIC_MAPPING = record //winnt
- GenericRead : ACCESS_MASK;
- GenericWrite : ACCESS_MASK;
- GenericExecute : ACCESS_MASK;
- GenericAll : ACCESS_MASK;
- end;
- PGENERIC_MAPPING = ^GENERIC_MAPPING;
- _GENERIC_MAPPING = GENERIC_MAPPING;
- TGENERICMAPPING = GENERIC_MAPPING;
- PGENERICMAPPING = ^GENERIC_MAPPING;
-
- GLYPHMETRICS = record
- gmBlackBoxX : UINT;
- gmBlackBoxY : UINT;
- gmptGlyphOrigin : POINT;
- gmCellIncX : integer;
- gmCellIncY : integer;
- end;
- LPGLYPHMETRICS = ^GLYPHMETRICS;
- _GLYPHMETRICS = GLYPHMETRICS;
- TGLYPHMETRICS = GLYPHMETRICS;
- PGLYPHMETRICS = ^GLYPHMETRICS;
-
- HANDLETABLE = record
- objectHandle : array[0..0] of HGDIOBJ;
- end;
- tagHANDLETABLE = HANDLETABLE;
- THANDLETABLE = HANDLETABLE;
- LPHANDLETABLE = ^HANDLETABLE;
-
- HD_HITTESTINFO = record
- pt : POINT;
- flags : UINT;
- iItem : longint;
- end;
- _HD_HITTESTINFO = HD_HITTESTINFO;
- THDHITTESTINFO = HD_HITTESTINFO;
- PHDHITTESTINFO = ^HD_HITTESTINFO;
-
- HD_ITEM = record
- mask : UINT;
- cxy : longint;
- pszText : LPTSTR;
- hbm : HBITMAP;
- cchTextMax : longint;
- fmt : longint;
- lParam : LPARAM;
- end;
- _HD_ITEM = HD_ITEM;
- THDITEM = HD_ITEM;
- PHDITEM = ^HD_ITEM;
-
- WINDOWPOS = record
- _hwnd : HWND;
- hwndInsertAfter : HWND;
- x : longint;
- y : longint;
- cx : longint;
- cy : longint;
- flags : UINT;
- end;
- LPWINDOWPOS = ^WINDOWPOS;
- _WINDOWPOS = WINDOWPOS;
- TWINDOWPOS = WINDOWPOS;
- PWINDOWPOS = ^WINDOWPOS;
-
- HD_LAYOUT = record
- prc : ^RECT;
- pwpos : ^WINDOWPOS;
- end;
- _HD_LAYOUT = HD_LAYOUT;
- THDLAYOUT = HD_LAYOUT;
- PHDLAYOUT = ^HD_LAYOUT;
-
- HD_NOTIFY = record
- hdr : NMHDR;
- iItem : longint;
- iButton : longint;
- pitem : ^HD_ITEM;
- end;
- _HD_NOTIFY = HD_NOTIFY;
- THDNOTIFY = HD_NOTIFY;
- PHDNOTIFY = ^HD_NOTIFY;
-
- HELPINFO = record
- cbSize : UINT;
- iContextType : longint;
- iCtrlId : longint;
- hItemHandle : HANDLE;
- dwContextId : DWORD;
- MousePos : POINT;
- end;
- LPHELPINFO = ^HELPINFO;
- tagHELPINFO = HELPINFO;
- THELPINFO = HELPINFO;
- PHELPINFO = ^HELPINFO;
-
- HELPWININFO = record
- wStructSize : longint;
- x : longint;
- y : longint;
- dx : longint;
- dy : longint;
- wMax : longint;
- rgchMember : array[0..1] of TCHAR;
- end;
- THELPWININFO = HELPWININFO;
- PHELPWININFO = ^HELPWININFO;
-
- HIGHCONTRAST = record
- cbSize : UINT;
- dwFlags : DWORD;
- lpszDefaultScheme : LPTSTR;
- end;
- LPHIGHCONTRAST = ^HIGHCONTRAST;
- tagHIGHCONTRAST = HIGHCONTRAST;
- THIGHCONTRAST = HIGHCONTRAST;
- PHIGHCONTRAST = ^HIGHCONTRAST;
-
- HSZPAIR = record
- hszSvc : HSZ;
- hszTopic : HSZ;
- end;
- tagHSZPAIR = HSZPAIR;
- THSZPAIR = HSZPAIR;
- PHSZPAIR = ^HSZPAIR;
-
- ICONINFO = record
- fIcon : WINBOOL;
- xHotspot : DWORD;
- yHotspot : DWORD;
- hbmMask : HBITMAP;
- hbmColor : HBITMAP;
- end;
- _ICONINFO = ICONINFO;
- TICONINFO = ICONINFO;
- PICONINFO = ^ICONINFO;
-
- ICONMETRICS = record
- cbSize : UINT;
- iHorzSpacing : longint;
- iVertSpacing : longint;
- iTitleWrap : longint;
- lfFont : LOGFONT;
- end;
- LPICONMETRICS = ^ICONMETRICS;
- tagICONMETRICS = ICONMETRICS;
- TICONMETRICS = ICONMETRICS;
- PICONMETRICS = ^ICONMETRICS;
-
- IMAGELISTDRAWPARAMS = record //+commctrl
- cbSize : DWORD;
- himl : HIMAGELIST;
- i : Integer;
- hdcDst : HDC;
- x : Integer;
- y : Integer;
- cx : Integer;
- cy : Integer;
- xBitmap : Integer; // x offest from the upperleft of bitmap
- yBitmap : Integer; // y offset from the upperleft of bitmap
- rgbBk : COLORREF;
- rgbFg : COLORREF;
- fStyle : UINT;
- dwRop : DWORD;
- end;
-
- _IMAGELISTDRAWPARAMS=IMAGELISTDRAWPARAMS;
- PIMAGELISTDRAWPARAMS=^IMAGELISTDRAWPARAMS;
-
- IMAGEINFO = record
- hbmImage : HBITMAP;
- hbmMask : HBITMAP;
- Unused1 : longint;
- Unused2 : longint;
- rcImage : RECT;
- end;
- _IMAGEINFO = IMAGEINFO;
- TIMAGEINFO = IMAGEINFO;
- PIMAGEINFO = ^IMAGEINFO;
-
- KEY_EVENT_RECORD = packed record
- bKeyDown : WINBOOL;
- wRepeatCount : WORD;
- wVirtualKeyCode : WORD;
- wVirtualScanCode : WORD;
- case longint of
- 0 : ( UnicodeChar : WCHAR;
- dwControlKeyState : DWORD; );
- 1 : ( AsciiChar : CHAR );
- end;
- _KEY_EVENT_RECORD = KEY_EVENT_RECORD;
- TKEYEVENTRECORD = KEY_EVENT_RECORD;
- PKEYEVENTRECORD = ^KEY_EVENT_RECORD;
-
- MOUSE_EVENT_RECORD = record
- dwMousePosition : COORD;
- dwButtonState : DWORD;
- dwControlKeyState : DWORD;
- dwEventFlags : DWORD;
- end;
- _MOUSE_EVENT_RECORD = MOUSE_EVENT_RECORD;
- TMOUSEEVENTRECORD = MOUSE_EVENT_RECORD;
- PMOUSEEVENTRECORD = ^MOUSE_EVENT_RECORD;
-
- WINDOW_BUFFER_SIZE_RECORD = record
- dwSize : COORD;
- end;
- _WINDOW_BUFFER_SIZE_RECORD = WINDOW_BUFFER_SIZE_RECORD;
- TWINDOWBUFFERSIZERECORD = WINDOW_BUFFER_SIZE_RECORD;
- PWINDOWBUFFERSIZERECORD = ^WINDOW_BUFFER_SIZE_RECORD;
-
- MENU_EVENT_RECORD = record
- dwCommandId : UINT;
- end;
- PMENU_EVENT_RECORD = ^MENU_EVENT_RECORD;
- _MENU_EVENT_RECORD = MENU_EVENT_RECORD;
- TMENUEVENTRECORD = MENU_EVENT_RECORD;
- PMENUEVENTRECORD = ^MENU_EVENT_RECORD;
-
- INPUT_RECORD = record
- EventType: Word;
- Reserved: Word;
- Event : record case longint of
- 0 : ( KeyEvent : KEY_EVENT_RECORD );
- 1 : ( MouseEvent : MOUSE_EVENT_RECORD );
- 2 : ( WindowBufferSizeEvent : WINDOW_BUFFER_SIZE_RECORD );
- 3 : ( MenuEvent : MENU_EVENT_RECORD );
- 4 : ( FocusEvent : FOCUS_EVENT_RECORD );
- end;
- end;
- PINPUT_RECORD = ^INPUT_RECORD;
- _INPUT_RECORD = INPUT_RECORD;
- TINPUTRECORD = INPUT_RECORD;
- PINPUTRECORD = ^INPUT_RECORD;
-
- SYSTEMTIME = record
- case integer of
- 1 : (
- wYear : WORD;
- wMonth : WORD;
- wDayOfWeek : WORD;
- wDay : WORD;
- wHour : WORD;
- wMinute : WORD;
- wSecond : WORD;
- wMilliseconds : WORD;
- );
- { Compatibility for FPC }
- 2 : (
- Year : WORD;
- Month : WORD;
- DayOfWeek : WORD;
- Day : WORD;
- Hour : WORD;
- Minute : WORD;
- Second : WORD;
- Millisecond : WORD;
- );
- end;
- LPSYSTEMTIME = ^SYSTEMTIME;
- _SYSTEMTIME = SYSTEMTIME;
- TSYSTEMTIME = SYSTEMTIME;
- PSYSTEMTIME = ^SYSTEMTIME;
-
- JOB_INFO_1 = record
- JobId : DWORD;
- pPrinterName : LPTSTR;
- pMachineName : LPTSTR;
- pUserName : LPTSTR;
- pDocument : LPTSTR;
- pDatatype : LPTSTR;
- pStatus : LPTSTR;
- Status : DWORD;
- Priority : DWORD;
- Position : DWORD;
- TotalPages : DWORD;
- PagesPrinted : DWORD;
- Submitted : SYSTEMTIME;
- end;
- _JOB_INFO_1 = JOB_INFO_1;
- TJOBINFO1 = JOB_INFO_1;
- PJOBINFO1 = ^JOB_INFO_1;
-
- SID_AND_ATTRIBUTES = record //~winnt, moved with SID declarations
- Sid : PSID;
- Attributes : DWORD;
- end;
- _SID_AND_ATTRIBUTES = SID_AND_ATTRIBUTES;
- TSIDANDATTRIBUTES = SID_AND_ATTRIBUTES;
- PSIDANDATTRIBUTES = ^SID_AND_ATTRIBUTES;
-
- SID_AND_ATTRIBUTES_ARRAY = array[0..(ANYSIZE_ARRAY)-1] of SID_AND_ATTRIBUTES; //winnt
- PSID_AND_ATTRIBUTES_ARRAY = ^SID_AND_ATTRIBUTES_ARRAY;
- TSIDANDATTRIBUTESARRAY = SID_AND_ATTRIBUTES_ARRAY;
- PSIDANDATTRIBUTESARRAY = ^SID_AND_ATTRIBUTES_ARRAY;
-
- SECURITY_DESCRIPTOR_CONTROL = WORD;
- PSECURITY_DESCRIPTOR_CONTROL = ^SECURITY_DESCRIPTOR_CONTROL;
- TSECURITYDESCRIPTORCONTROL = SECURITY_DESCRIPTOR_CONTROL;
- PSECURITYDESCRIPTORCONTROL = ^SECURITY_DESCRIPTOR_CONTROL;
-
- SECURITY_DESCRIPTOR = record
- Revision : BYTE;
- Sbz1 : BYTE;
- Control : SECURITY_DESCRIPTOR_CONTROL;
- Owner : PSID;
- Group : PSID;
- Sacl : PACL;
- Dacl : PACL;
- end;
- PSECURITY_DESCRIPTOR = ^SECURITY_DESCRIPTOR;
- _SECURITY_DESCRIPTOR = SECURITY_DESCRIPTOR;
- TSECURITYDESCRIPTOR = SECURITY_DESCRIPTOR;
- PSECURITYDESCRIPTOR = ^SECURITY_DESCRIPTOR;
-
- JOB_INFO_2 = record
- JobId : DWORD;
- pPrinterName : LPTSTR;
- pMachineName : LPTSTR;
- pUserName : LPTSTR;
- pDocument : LPTSTR;
- pNotifyName : LPTSTR;
- pDatatype : LPTSTR;
- pPrintProcessor : LPTSTR;
- pParameters : LPTSTR;
- pDriverName : LPTSTR;
- pDevMode : LPDEVMODE;
- pStatus : LPTSTR;
- pSecurityDescriptor : PSECURITY_DESCRIPTOR;
- Status : DWORD;
- Priority : DWORD;
- Position : DWORD;
- StartTime : DWORD;
- UntilTime : DWORD;
- TotalPages : DWORD;
- Size : DWORD;
- Submitted : SYSTEMTIME;
- Time : DWORD;
- PagesPrinted : DWORD;
- end;
- _JOB_INFO_2 = JOB_INFO_2;
- TJOBINFO2 = JOB_INFO_2;
- PJOBINFO2 = ^JOB_INFO_2;
-
- KERNINGPAIR = record
- wFirst : WORD;
- wSecond : WORD;
- iKernAmount : longint;
- end;
- LPKERNINGPAIR = ^KERNINGPAIR;
- tagKERNINGPAIR = KERNINGPAIR;
- TKERNINGPAIR = KERNINGPAIR;
- PKERNINGPAIR = ^KERNINGPAIR;
-
- LANA_ENUM = record
- length : UCHAR;
- lana : array[0..(MAX_LANA)-1] of UCHAR;
- end;
- _LANA_ENUM = LANA_ENUM;
- TLANAENUM = LANA_ENUM;
- PLANAENUM = ^LANA_ENUM;
- const
- bm_LDT_ENTRY_BaseMid = $FF;
- bp_LDT_ENTRY_BaseMid = 0;
- bm_LDT_ENTRY_Type = $1F00;
- bp_LDT_ENTRY_Type = 8;
- bm_LDT_ENTRY_Dpl = $6000;
- bp_LDT_ENTRY_Dpl = 13;
- bm_LDT_ENTRY_Pres = $8000;
- bp_LDT_ENTRY_Pres = 15;
- bm_LDT_ENTRY_LimitHi = $F0000;
- bp_LDT_ENTRY_LimitHi = 16;
- bm_LDT_ENTRY_Sys = $100000;
- bp_LDT_ENTRY_Sys = 20;
- bm_LDT_ENTRY_Reserved_0 = $200000;
- bp_LDT_ENTRY_Reserved_0 = 21;
- bm_LDT_ENTRY_Default_Big = $400000;
- bp_LDT_ENTRY_Default_Big = 22;
- bm_LDT_ENTRY_Granularity = $800000;
- bp_LDT_ENTRY_Granularity = 23;
- bm_LDT_ENTRY_BaseHi = $FF000000;
- bp_LDT_ENTRY_BaseHi = 24;
-
- type
-
- LOCALESIGNATURE = record
- lsUsb : array[0..3] of DWORD;
- lsCsbDefault : array[0..1] of DWORD;
- lsCsbSupported : array[0..1] of DWORD;
- end;
- tagLOCALESIGNATURE = LOCALESIGNATURE;
- TLOCALESIGNATURE = LOCALESIGNATURE;
- PLOCALESIGNATURE = ^LOCALESIGNATURE;
-
- LOCALGROUP_MEMBERS_INFO_0 = record
- lgrmi0_sid : PSID;
- end;
- _LOCALGROUP_MEMBERS_INFO_0 = LOCALGROUP_MEMBERS_INFO_0;
- TLOCALGROUPMEMBERSINFO0 = LOCALGROUP_MEMBERS_INFO_0;
- PLOCALGROUPMEMBERSINFO0 = ^LOCALGROUP_MEMBERS_INFO_0;
-
- LOCALGROUP_MEMBERS_INFO_3 = record
- lgrmi3_domainandname : LPWSTR;
- end;
- _LOCALGROUP_MEMBERS_INFO_3 = LOCALGROUP_MEMBERS_INFO_3;
- TLOCALGROUPMEMBERSINFO3 = LOCALGROUP_MEMBERS_INFO_3;
- PLOCALGROUPMEMBERSINFO3 = ^LOCALGROUP_MEMBERS_INFO_3;
-
- FXPT16DOT16 = longint;
- LPFXPT16DOT16 = ^FXPT16DOT16;
- TFXPT16DOT16 = FXPT16DOT16;
- PFXPT16DOT16 = ^FXPT16DOT16;
-
- LUID_AND_ATTRIBUTES = record //winnt
- Luid : LUID;
- Attributes : DWORD;
- end;
- _LUID_AND_ATTRIBUTES = LUID_AND_ATTRIBUTES;
- TLUIDANDATTRIBUTES = LUID_AND_ATTRIBUTES;
- PLUIDANDATTRIBUTES = ^LUID_AND_ATTRIBUTES;
-
- LUID_AND_ATTRIBUTES_ARRAY = array[0..(ANYSIZE_ARRAY)-1] of LUID_AND_ATTRIBUTES;
- PLUID_AND_ATTRIBUTES_ARRAY = ^LUID_AND_ATTRIBUTES_ARRAY;
- TLUIDANDATTRIBUTESARRAY = LUID_AND_ATTRIBUTES_ARRAY;
- PLUIDANDATTRIBUTESARRAY = ^LUID_AND_ATTRIBUTES_ARRAY;
-
- LV_COLUMN = record
- mask : UINT;
- fmt : longint;
- cx : longint;
- pszText : LPTSTR;
- cchTextMax : longint;
- iSubItem : longint;
- end;
- _LV_COLUMN = LV_COLUMN;
- TLVCOLUMN = LV_COLUMN;
- PLVCOLUMN = ^LV_COLUMN;
-
- LV_ITEM = record
- mask : UINT;
- iItem : longint;
- iSubItem : longint;
- state : UINT;
- stateMask : UINT;
- pszText : LPTSTR;
- cchTextMax : longint;
- iImage : longint;
- lParam : LPARAM;
- end;
- _LV_ITEM = LV_ITEM;
- TLVITEM = LV_ITEM;
- PLVITEM = ^LV_ITEM;
-
- LV_DISPINFO = record
- hdr : NMHDR;
- item : LV_ITEM;
- end;
- tagLV_DISPINFO = LV_DISPINFO;
- TLVDISPINFO = LV_DISPINFO;
- PLVDISPINFO = ^LV_DISPINFO;
-
- LV_FINDINFO = record
- flags : UINT;
- psz : LPCTSTR;
- lParam : LPARAM;
- pt : POINT;
- vkDirection : UINT;
- end;
- _LV_FINDINFO = LV_FINDINFO;
- TLVFINDINFO = LV_FINDINFO;
- PLVFINDINFO = ^LV_FINDINFO;
-
- LV_HITTESTINFO = record
- pt : POINT;
- flags : UINT;
- iItem : longint;
- end;
- _LV_HITTESTINFO = LV_HITTESTINFO;
- TLVHITTESTINFO = LV_HITTESTINFO;
- PLVHITTESTINFO = ^LV_HITTESTINFO;
-
- LV_KEYDOWN = record
- hdr : NMHDR;
- wVKey : WORD;
- flags : UINT;
- end;
- tagLV_KEYDOWN = LV_KEYDOWN;
- TLVKEYDOWN = LV_KEYDOWN;
- PLVKEYDOWN = ^LV_KEYDOWN;
-
- MAT2 = record
- eM11 : FIXED;
- eM12 : FIXED;
- eM21 : FIXED;
- eM22 : FIXED;
- end;
- _MAT2 = MAT2;
- TMAT2 = MAT2;
- PMAT2 = ^MAT2;
-
- MDICREATESTRUCT = record
- szClass : LPCTSTR;
- szTitle : LPCTSTR;
- hOwner : HANDLE;
- x : longint;
- y : longint;
- cx : longint;
- cy : longint;
- style : DWORD;
- lParam : LPARAM;
- end;
- LPMDICREATESTRUCT = ^MDICREATESTRUCT;
- tagMDICREATESTRUCT = MDICREATESTRUCT;
- TMDICREATESTRUCT = MDICREATESTRUCT;
- PMDICREATESTRUCT = ^MDICREATESTRUCT;
-
- MEASUREITEMSTRUCT = record
- CtlType : UINT;
- CtlID : UINT;
- itemID : UINT;
- itemWidth : UINT;
- itemHeight : UINT;
- itemData : DWORD;
- end;
- LPMEASUREITEMSTRUCT = ^MEASUREITEMSTRUCT;
- tagMEASUREITEMSTRUCT = MEASUREITEMSTRUCT;
- TMEASUREITEMSTRUCT = MEASUREITEMSTRUCT;
- PMEASUREITEMSTRUCT = ^MEASUREITEMSTRUCT;
-
- MEMORY_BASIC_INFORMATION = record
- BaseAddress : PVOID;
- AllocationBase : PVOID;
- AllocationProtect : DWORD;
- RegionSize : DWORD;
- State : DWORD;
- Protect : DWORD;
- _Type : DWORD;
- end;
- PMEMORY_BASIC_INFORMATION = ^MEMORY_BASIC_INFORMATION;
- _MEMORY_BASIC_INFORMATION = MEMORY_BASIC_INFORMATION;
- TMEMORYBASICINFORMATION = MEMORY_BASIC_INFORMATION;
- PMEMORYBASICINFORMATION = ^MEMORY_BASIC_INFORMATION;
-
- MEMORYSTATUS = record
- dwLength : DWORD;
- dwMemoryLoad : DWORD;
- dwTotalPhys : DWORD;
- dwAvailPhys : DWORD;
- dwTotalPageFile : DWORD;
- dwAvailPageFile : DWORD;
- dwTotalVirtual : DWORD;
- dwAvailVirtual : DWORD;
- end;
- LPMEMORYSTATUS = ^MEMORYSTATUS;
- _MEMORYSTATUS = MEMORYSTATUS;
- TMEMORYSTATUS = MEMORYSTATUS;
- PMEMORYSTATUS = ^MEMORYSTATUS;
-
- MENUEX_TEMPLATE_HEADER = record
- wVersion : WORD;
- wOffset : WORD;
- dwHelpId : DWORD;
- end;
- TMENUXTEMPLATEHEADER = MENUEX_TEMPLATE_HEADER;
- PMENUXTEMPLATEHEADER = ^MENUEX_TEMPLATE_HEADER;
-
- MENUEX_TEMPLATE_ITEM = record
- dwType : DWORD;
- dwState : DWORD;
- uId : UINT;
- bResInfo : BYTE;
- szText : array[0..0] of WCHAR;
- dwHelpId : DWORD;
- end;
- TMENUEXTEMPLATEITEM = MENUEX_TEMPLATE_ITEM;
- PMENUEXTEMPLATEITEM = ^MENUEX_TEMPLATE_ITEM;
-
- MENUITEMINFO = record
- cbSize : UINT;
- fMask : UINT;
- fType : UINT;
- fState : UINT;
- wID : UINT;
- hSubMenu : HMENU;
- hbmpChecked : HBITMAP;
- hbmpUnchecked : HBITMAP;
- dwItemData : DWORD;
- dwTypeData : LPTSTR;
- cch : UINT;
- end;
- LPMENUITEMINFO = ^MENUITEMINFO;
- LPCMENUITEMINFO = ^MENUITEMINFO;
- tagMENUITEMINFO = MENUITEMINFO;
- TMENUITEMINFO = MENUITEMINFO;
- TMENUITEMINFOA = MENUITEMINFO;
- PMENUITEMINFO = ^MENUITEMINFO;
-
- MENUITEMTEMPLATE = record
- mtOption : WORD;
- mtID : WORD;
- mtString : array[0..0] of WCHAR;
- end;
- TMENUITEMTEMPLATE = MENUITEMTEMPLATE;
- PMENUITEMTEMPLATE = ^MENUITEMTEMPLATE;
-
- MENUITEMTEMPLATEHEADER = record
- versionNumber : WORD;
- offset : WORD;
- end;
- TMENUITEMTEMPLATEHEADER = MENUITEMTEMPLATEHEADER;
- PMENUITEMTEMPLATEHEADER = ^MENUITEMTEMPLATEHEADER;
-
- MENUTEMPLATE = record
- end;
- LPMENUTEMPLATE = ^MENUTEMPLATE;
- TMENUTEMPLATE = MENUTEMPLATE;
- PMENUTEMPLATE = ^MENUTEMPLATE;
-
- METAFILEPICT = record
- mm : LONG;
- xExt : LONG;
- yExt : LONG;
- hMF : HMETAFILE;
- end;
- LPMETAFILEPICT = ^METAFILEPICT;
- tagMETAFILEPICT = METAFILEPICT;
- TMETAFILEPICT = METAFILEPICT;
- PMETAFILEPICT = ^METAFILEPICT;
-
- METAHEADER = packed record
- mtType : WORD;
- mtHeaderSize : WORD;
- mtVersion : WORD;
- mtSize : DWORD;
- mtNoObjects : WORD;
- mtMaxRecord : DWORD;
- mtNoParameters : WORD;
- end;
- tagMETAHEADER = METAHEADER;
- TMETAHEADER = METAHEADER;
- PMETAHEADER = ^METAHEADER;
-
- METARECORD = record
- rdSize : DWORD;
- rdFunction : WORD;
- rdParm : array[0..0] of WORD;
- end;
- LPMETARECORD = ^METARECORD;
- tagMETARECORD = METARECORD;
- TMETARECORD = METARECORD;
- PMETARECORD = ^METARECORD;
-
- MINIMIZEDMETRICS = record
- cbSize : UINT;
- iWidth : longint;
- iHorzGap : longint;
- iVertGap : longint;
- iArrange : longint;
- end;
- LPMINIMIZEDMETRICS = ^MINIMIZEDMETRICS;
- tagMINIMIZEDMETRICS = MINIMIZEDMETRICS;
- TMINIMIZEDMETRICS = MINIMIZEDMETRICS;
- PMINIMIZEDMETRICS = ^MINIMIZEDMETRICS;
-
- MINMAXINFO = record
- ptReserved : POINT;
- ptMaxSize : POINT;
- ptMaxPosition : POINT;
- ptMinTrackSize : POINT;
- ptMaxTrackSize : POINT;
- end;
- tagMINMAXINFO = MINMAXINFO;
- TMINMAXINFO = MINMAXINFO;
- PMINMAXINFO = ^MINMAXINFO;
-
- MODEMDEVCAPS = record
- dwActualSize : DWORD;
- dwRequiredSize : DWORD;
- dwDevSpecificOffset : DWORD;
- dwDevSpecificSize : DWORD;
- dwModemProviderVersion : DWORD;
- dwModemManufacturerOffset : DWORD;
- dwModemManufacturerSize : DWORD;
- dwModemModelOffset : DWORD;
- dwModemModelSize : DWORD;
- dwModemVersionOffset : DWORD;
- dwModemVersionSize : DWORD;
- dwDialOptions : DWORD;
- dwCallSetupFailTimer : DWORD;
- dwInactivityTimeout : DWORD;
- dwSpeakerVolume : DWORD;
- dwSpeakerMode : DWORD;
- dwModemOptions : DWORD;
- dwMaxDTERate : DWORD;
- dwMaxDCERate : DWORD;
- abVariablePortion : array[0..0] of BYTE;
- end;
- LPMODEMDEVCAPS = ^MODEMDEVCAPS;
- TMODEMDEVCAPS = MODEMDEVCAPS;
- PMODEMDEVCAPS = ^MODEMDEVCAPS;
-
- modemdevcaps_tag = MODEMDEVCAPS;
-
- MODEMSETTINGS = record
- dwActualSize : DWORD;
- dwRequiredSize : DWORD;
- dwDevSpecificOffset : DWORD;
- dwDevSpecificSize : DWORD;
- dwCallSetupFailTimer : DWORD;
- dwInactivityTimeout : DWORD;
- dwSpeakerVolume : DWORD;
- dwSpeakerMode : DWORD;
- dwPreferredModemOptions : DWORD;
- dwNegotiatedModemOptions : DWORD;
- dwNegotiatedDCERate : DWORD;
- abVariablePortion : array[0..0] of BYTE;
- end;
- LPMODEMSETTINGS = ^MODEMSETTINGS;
- TMODEMSETTINGS = MODEMSETTINGS;
- PMODEMSETTINGS = ^MODEMSETTINGS;
-
- modemsettings_tag = MODEMSETTINGS;
-
- MONCBSTRUCT = record
- cb : UINT;
- dwTime : DWORD;
- hTask : HANDLE;
- dwRet : DWORD;
- wType : UINT;
- wFmt : UINT;
- hConv : HCONV;
- hsz1 : HSZ;
- hsz2 : HSZ;
- hData : HDDEDATA;
- dwData1 : DWORD;
- dwData2 : DWORD;
- cc : CONVCONTEXT;
- cbData : DWORD;
- Data : array[0..7] of DWORD;
- end;
- tagMONCBSTRUCT = MONCBSTRUCT;
- TMONCBSTRUCT = MONCBSTRUCT;
- PMONCBSTRUCT = ^MONCBSTRUCT;
-
- MONCONVSTRUCT = record
- cb : UINT;
- fConnect : WINBOOL;
- dwTime : DWORD;
- hTask : HANDLE;
- hszSvc : HSZ;
- hszTopic : HSZ;
- hConvClient : HCONV;
- hConvServer : HCONV;
- end;
- tagMONCONVSTRUCT = MONCONVSTRUCT;
- TMONCONVSTRUCT = MONCONVSTRUCT;
- PMONCONVSTRUCT = ^MONCONVSTRUCT;
-
- MONERRSTRUCT = record
- cb : UINT;
- wLastError : UINT;
- dwTime : DWORD;
- hTask : HANDLE;
- end;
- tagMONERRSTRUCT = MONERRSTRUCT;
- TMONERRSTRUCT = MONERRSTRUCT;
- PMONERRSTRUCT = ^MONERRSTRUCT;
-
- MONHSZSTRUCT = record
- cb : UINT;
- fsAction : WINBOOL;
- dwTime : DWORD;
- hsz : HSZ;
- hTask : HANDLE;
- str : array[0..0] of TCHAR;
- end;
- tagMONHSZSTRUCT = MONHSZSTRUCT;
- TMONHSZSTRUCT = MONHSZSTRUCT;
- PMONHSZSTRUCT = ^MONHSZSTRUCT;
-
- MONITOR_INFO_1 = record
- pName : LPTSTR;
- end;
- _MONITOR_INFO_1 = MONITOR_INFO_1;
- TMONITORINFO1 = MONITOR_INFO_1;
- PMONITORINFO1 = ^MONITOR_INFO_1;
-
- MONITOR_INFO_2 = record
- pName : LPTSTR;
- pEnvironment : LPTSTR;
- pDLLName : LPTSTR;
- end;
- _MONITOR_INFO_2 = MONITOR_INFO_2;
- TMONITORINFO2 = MONITOR_INFO_2;
- PMONITORINFO2 = ^MONITOR_INFO_2;
-
- MONLINKSTRUCT = record
- cb : UINT;
- dwTime : DWORD;
- hTask : HANDLE;
- fEstablished : WINBOOL;
- fNoData : WINBOOL;
- hszSvc : HSZ;
- hszTopic : HSZ;
- hszItem : HSZ;
- wFmt : UINT;
- fServer : WINBOOL;
- hConvServer : HCONV;
- hConvClient : HCONV;
- end;
- tagMONLINKSTRUCT = MONLINKSTRUCT;
- TMONLINKSTRUCT = MONLINKSTRUCT;
- PMONLINKSTRUCT = ^MONLINKSTRUCT;
-
- MONMSGSTRUCT = record
- cb : UINT;
- hwndTo : HWND;
- dwTime : DWORD;
- hTask : HANDLE;
- wMsg : UINT;
- wParam : WPARAM;
- lParam : LPARAM;
- dmhd : DDEML_MSG_HOOK_DATA;
- end;
- tagMONMSGSTRUCT = MONMSGSTRUCT;
- TMONMSGSTRUCT = MONMSGSTRUCT;
- PMONMSGSTRUCT = ^MONMSGSTRUCT;
-
- MOUSEHOOKSTRUCT = record
- pt : POINT;
- hwnd : HWND;
- wHitTestCode : UINT;
- dwExtraInfo : DWORD;
- end;
- LPMOUSEHOOKSTRUCT = ^MOUSEHOOKSTRUCT;
- tagMOUSEHOOKSTRUCT = MOUSEHOOKSTRUCT;
- TMOUSEHOOKSTRUCT = MOUSEHOOKSTRUCT;
- PMOUSEHOOKSTRUCT = ^MOUSEHOOKSTRUCT;
-
- MOUSEKEYS = record
- cbSize : DWORD;
- dwFlags : DWORD;
- iMaxSpeed : DWORD;
- iTimeToMaxSpeed : DWORD;
- iCtrlSpeed : DWORD;
- dwReserved1 : DWORD;
- dwReserved2 : DWORD;
- end;
- TMOUSEKEYS = MOUSEKEYS;
- PMOUSEKEYS = ^MOUSEKEYS;
-
- MSGBOXCALLBACK = procedure (lpHelpInfo:LPHELPINFO);stdcall;
- TMSGBOXCALLBACK = MSGBOXCALLBACK;
-
- MSGBOXPARAMS = record
- cbSize : UINT;
- hwndOwner : HWND;
- hInstance : HINST;
- lpszText : LPCSTR;
- lpszCaption : LPCSTR;
- dwStyle : DWORD;
- lpszIcon : LPCSTR;
- dwContextHelpId : DWORD;
- lpfnMsgBoxCallback : MSGBOXCALLBACK;
- dwLanguageId : DWORD;
- end;
- LPMSGBOXPARAMS = ^MSGBOXPARAMS;
- TMSGBOXPARAMS = MSGBOXPARAMS;
- TMSGBOXPARAMSA = MSGBOXPARAMS;
- PMSGBOXPARAMS = ^MSGBOXPARAMS;
-
- MSGFILTER = record
- nmhdr : NMHDR;
- msg : UINT;
- wParam : WPARAM;
- lParam : LPARAM;
- end;
- _msgfilter = MSGFILTER;
- Tmsgfilter = MSGFILTER;
- Pmsgfilter = ^MSGFILTER;
-
- MULTIKEYHELP = record
- mkSize : DWORD;
- mkKeylist : TCHAR;
- szKeyphrase : array[0..0] of TCHAR;
- end;
- tagMULTIKEYHELP = MULTIKEYHELP;
- TMULTIKEYHELP = MULTIKEYHELP;
- PMULTIKEYHELP = ^MULTIKEYHELP;
-
- EXTENDED_NAME_FORMAT=(
- // unknown name type
- NameUnknown = 0,
- // CN=Spencer Katt, OU=Software, OU=Engineering, O=Widget, C=US
- NameFullyQualifiedDN = 1,
- // Engineering\SpencerK
- NameSamCompatible = 2,
- // Probably "Spencer Katt" but could be something else. I.e. The
- // display name is not necessarily the defining RDN.
- NameDisplay = 3,
- // xxx@engineering.widget.com where xxx could be "SpencerK" or
- // anything else. Could be multi-valued to handle migration and aliasing.
- NameDomainSimple = 4,
- // xxx@widget.com where xxx could be "SpencerK" or anything else.
- // Could be multi-valued to handle migration and aliasing.
- NameEnterpriseSimple = 5,
- // String-ized GUID as returned by IIDFromString().
- // eg: {4fa050f0-f561-11cf-bdd9-00aa003a77b6}
- NameUniqueId = 6,
- // engineering.widget.com/software/spencer katt
- NameCanonical = 7,
- // local logon name
- NameWindowsCeLocal = $80000001); //+winbase
- PEXTENDED_NAME_FORMAT=^EXTENDED_NAME_FORMAT; //+winbase
-
- NAME_BUFFER = record
- name : array[0..(NCBNAMSZ)-1] of UCHAR;
- name_num : UCHAR;
- name_flags : UCHAR;
- end;
- _NAME_BUFFER = NAME_BUFFER;
- TNAMEBUFFER = NAME_BUFFER;
- PNAMEBUFFER = ^NAME_BUFFER;
-
- p_NCB = ^_NCB;
- NCB = record
- ncb_command : UCHAR;
- ncb_retcode : UCHAR;
- ncb_lsn : UCHAR;
- ncb_num : UCHAR;
- ncb_buffer : PUCHAR;
- ncb_length : WORD;
- ncb_callname : array[0..(NCBNAMSZ)-1] of UCHAR;
- ncb_name : array[0..(NCBNAMSZ)-1] of UCHAR;
- ncb_rto : UCHAR;
- ncb_sto : UCHAR;
- ncb_post : procedure (_para1:p_NCB);CDECL;
- ncb_lana_num : UCHAR;
- ncb_cmd_cplt : UCHAR;
- ncb_reserve : array[0..9] of UCHAR;
- ncb_event : HANDLE;
- end;
- _NCB = NCB;
- TNCB = NCB;
- PNCB = ^NCB;
-
- NCCALCSIZE_PARAMS = record
- rgrc : array[0..2] of RECT;
- lppos : PWINDOWPOS;
- end;
- _NCCALCSIZE_PARAMS = NCCALCSIZE_PARAMS;
- TNCCALCSIZEPARAMS = NCCALCSIZE_PARAMS;
- PNCCALCSIZEPARAMS = ^NCCALCSIZE_PARAMS;
-
- NDDESHAREINFO = record
- lRevision : LONG;
- lpszShareName : LPTSTR;
- lShareType : LONG;
- lpszAppTopicList : LPTSTR;
- fSharedFlag : LONG;
- fService : LONG;
- fStartAppFlag : LONG;
- nCmdShow : LONG;
- qModifyId : array[0..1] of LONG;
- cNumItems : LONG;
- lpszItemList : LPTSTR;
- end;
- _NDDESHAREINFO = NDDESHAREINFO;
- TNDDESHAREINFO = NDDESHAREINFO;
- PNDDESHAREINFO = ^NDDESHAREINFO;
-
- NETRESOURCE = record
- dwScope : DWORD;
- dwType : DWORD;
- dwDisplayType : DWORD;
- dwUsage : DWORD;
- lpLocalName : LPTSTR;
- lpRemoteName : LPTSTR;
- lpComment : LPTSTR;
- lpProvider : LPTSTR;
- end;
- LPNETRESOURCE = ^NETRESOURCE;
- _NETRESOURCE = NETRESOURCE;
- TNETRESOURCE = NETRESOURCE;
- TNETRESOURCEA = NETRESOURCE;
- PNETRESOURCE = ^NETRESOURCE;
- PNETRESOURCEA = ^NETRESOURCE;
-
- NETRESOURCEW = record //+winnetwk
- dwScope : DWORD;
- dwType : DWORD;
- dwDisplayType : DWORD;
- dwUsage : DWORD;
- lpLocalName : LPWSTR;
- lpRemoteName : LPWSTR;
- lpComment : LPWSTR;
- lpProvider : LPWSTR;
- end;
- LPNETRESOURCEW = ^NETRESOURCEW; //+winnetwk
- _NETRESOURCEW = NETRESOURCEW; //+winnetwk
-
- NEWCPLINFO = record
- dwSize : DWORD;
- dwFlags : DWORD;
- dwHelpContext : DWORD;
- lData : LONG;
- hIcon : HICON;
- szName : array[0..31] of TCHAR;
- szInfo : array[0..63] of TCHAR;
- szHelpFile : array[0..127] of TCHAR;
- end;
- tagNEWCPLINFO = NEWCPLINFO;
- TNEWCPLINFO = NEWCPLINFO;
- PNEWCPLINFO = ^NEWCPLINFO;
-
- NEWTEXTMETRIC = record
- tmHeight : LONG;
- tmAscent : LONG;
- tmDescent : LONG;
- tmInternalLeading : LONG;
- tmExternalLeading : LONG;
- tmAveCharWidth : LONG;
- tmMaxCharWidth : LONG;
- tmWeight : LONG;
- tmOverhang : LONG;
- tmDigitizedAspectX : LONG;
- tmDigitizedAspectY : LONG;
- tmFirstChar : BCHAR;
- tmLastChar : BCHAR;
- tmDefaultChar : BCHAR;
- tmBreakChar : BCHAR;
- tmItalic : BYTE;
- tmUnderlined : BYTE;
- tmStruckOut : BYTE;
- tmPitchAndFamily : BYTE;
- tmCharSet : BYTE;
- ntmFlags : DWORD;
- ntmSizeEM : UINT;
- ntmCellHeight : UINT;
- ntmAvgWidth : UINT;
- end;
- tagNEWTEXTMETRIC = NEWTEXTMETRIC;
- TNEWTEXTMETRIC = NEWTEXTMETRIC;
- PNEWTEXTMETRIC = ^NEWTEXTMETRIC;
-
- NEWTEXTMETRICEX = record
- ntmentm : NEWTEXTMETRIC;
- ntmeFontSignature : FONTSIGNATURE;
- end;
- tagNEWTEXTMETRICEX = NEWTEXTMETRICEX;
- TNEWTEXTMETRICEX = NEWTEXTMETRICEX;
- PNEWTEXTMETRICEX = ^NEWTEXTMETRICEX;
-
- NM_LISTVIEW = record
- hdr : NMHDR;
- iItem : longint;
- iSubItem : longint;
- uNewState : UINT;
- uOldState : UINT;
- uChanged : UINT;
- ptAction : POINT;
- lParam : LPARAM;
- end;
- tagNM_LISTVIEW = NM_LISTVIEW;
- TNMLISTVIEW = NM_LISTVIEW;
- PNMLISTVIEW = ^NM_LISTVIEW;
-
- TV_ITEM = record
- mask : UINT;
- hItem : HTREEITEM;
- state : UINT;
- stateMask : UINT;
- pszText : LPTSTR;
- cchTextMax : longint;
- iImage : longint;
- iSelectedImage : longint;
- cChildren : longint;
- lParam : LPARAM;
- end;
- LPTV_ITEM = ^TV_ITEM;
- _TV_ITEM = TV_ITEM;
- TTVITEM = TV_ITEM;
- PTVITEM = ^TV_ITEM;
-
- NM_TREEVIEW = record
- hdr : NMHDR;
- action : UINT;
- itemOld : TV_ITEM;
- itemNew : TV_ITEM;
- ptDrag : POINT;
- end;
- LPNM_TREEVIEW = ^NM_TREEVIEW;
- _NM_TREEVIEW = NM_TREEVIEW;
- TNMTREEVIEW = NM_TREEVIEW;
- PNMTREEVIEW = ^NM_TREEVIEW;
-
- NM_UPDOWNW = record
- hdr : NMHDR;
- iPos : longint;
- iDelta : longint;
- end;
- _NM_UPDOWN = NM_UPDOWNW;
- TNMUPDOWN = NM_UPDOWNW;
- PNMUPDOWN = ^NM_UPDOWNW;
-
- NONCLIENTMETRICS = record
- cbSize : UINT;
- iBorderWidth : longint;
- iScrollWidth : longint;
- iScrollHeight : longint;
- iCaptionWidth : longint;
- iCaptionHeight : longint;
- lfCaptionFont : LOGFONT;
- iSmCaptionWidth : longint;
- iSmCaptionHeight : longint;
- lfSmCaptionFont : LOGFONT;
- iMenuWidth : longint;
- iMenuHeight : longint;
- lfMenuFont : LOGFONT;
- lfStatusFont : LOGFONT;
- lfMessageFont : LOGFONT;
- end;
- LPNONCLIENTMETRICS = ^NONCLIENTMETRICS;
- tagNONCLIENTMETRICS = NONCLIENTMETRICS;
- TNONCLIENTMETRICS = NONCLIENTMETRICS;
- PNONCLIENTMETRICS = ^NONCLIENTMETRICS;
-
- SERVICE_ADDRESS = record
- dwAddressType : DWORD;
- dwAddressFlags : DWORD;
- dwAddressLength : DWORD;
- dwPrincipalLength : DWORD;
- lpAddress : ^BYTE;
- lpPrincipal : ^BYTE;
- end;
- _SERVICE_ADDRESS = SERVICE_ADDRESS;
- TSERVICEADDRESS = SERVICE_ADDRESS;
- PSERVICEADDRESS = ^SERVICE_ADDRESS;
-
- SERVICE_ADDRESSES = record
- dwAddressCount : DWORD;
- Addresses : array[0..0] of SERVICE_ADDRESS;
- end;
- LPSERVICE_ADDRESSES = ^SERVICE_ADDRESSES;
- _SERVICE_ADDRESSES = SERVICE_ADDRESSES;
- TSERVICEADDRESSES = SERVICE_ADDRESSES;
- PSERVICEADDRESSES = ^SERVICE_ADDRESSES;
-
- GUID = system.tguid; //winnt
- LPGUID = ^GUID;
- _GUID = GUID;
- TGUID = GUID;
- PGUID = ^GUID;
-
- CLSID = GUID;
- LPCLSID = ^CLSID;
- TCLSID = CLSID;
- PCLSID = ^CLSID;
-
- SERVICE_INFO = record
- lpServiceType : LPGUID;
- lpServiceName : LPTSTR;
- lpComment : LPTSTR;
- lpLocale : LPTSTR;
- dwDisplayHint : DWORD;
- dwVersion : DWORD;
- dwTime : DWORD;
- lpMachineName : LPTSTR;
- lpServiceAddress : LPSERVICE_ADDRESSES;
- ServiceSpecificInfo : BLOB;
- end;
- _SERVICE_INFO = SERVICE_INFO;
- TSERVICEINFO = SERVICE_INFO;
- PSERVICEINFO = ^SERVICE_INFO;
-
- NS_SERVICE_INFO = record
- dwNameSpace : DWORD;
- ServiceInfo : SERVICE_INFO;
- end;
- _NS_SERVICE_INFO = NS_SERVICE_INFO;
- TNSSERVICEINFO = NS_SERVICE_INFO;
- PNSSERVICEINFO = ^NS_SERVICE_INFO;
-
- NUMBERFMT = record
- NumDigits : UINT;
- LeadingZero : UINT;
- Grouping : UINT;
- lpDecimalSep : LPTSTR;
- lpThousandSep : LPTSTR;
- NegativeOrder : UINT;
- end;
- _numberfmt = NUMBERFMT;
- Tnumberfmt = NUMBERFMT;
- Pnumberfmt = ^NUMBERFMT;
-
- OFSTRUCT = record
- cBytes : BYTE;
- fFixedDisk : BYTE;
- nErrCode : WORD;
- Reserved1 : WORD;
- Reserved2 : WORD;
- szPathName : array[0..(OFS_MAXPATHNAME)-1] of CHAR;
- end;
- LPOFSTRUCT = ^OFSTRUCT;
- _OFSTRUCT = OFSTRUCT;
- TOFSTRUCT = OFSTRUCT;
- POFSTRUCT = ^OFSTRUCT;
-
- OPENFILENAME = record
- lStructSize : DWORD;
- hwndOwner : HWND;
- hInstance : HINST;
- lpstrFilter : LPCTSTR;
- lpstrCustomFilter : LPTSTR;
- nMaxCustFilter : DWORD;
- nFilterIndex : DWORD;
- lpstrFile : LPTSTR;
- nMaxFile : DWORD;
- lpstrFileTitle : LPTSTR;
- nMaxFileTitle : DWORD;
- lpstrInitialDir : LPCTSTR;
- lpstrTitle : LPCTSTR;
- Flags : DWORD;
- nFileOffset : WORD;
- nFileExtension : WORD;
- lpstrDefExt : LPCTSTR;
- lCustData : DWORD;
- lpfnHook : LPOFNHOOKPROC;
- lpTemplateName : LPCTSTR;
- end;
- LPOPENFILENAME = ^OPENFILENAME;
- TOPENFILENAME = OPENFILENAME;
- POPENFILENAME = ^OPENFILENAME;
-
- tagOFN = OPENFILENAME;
- TOFN = OPENFILENAME;
- POFN = ^OPENFILENAME;
-
- OPENFILENAMEW = record //+commdlg
- lStructSize : DWORD;
- hwndOwner : HWND;
- hInstance : HINST;
- lpstrFilter : LPCWSTR;
- lpstrCustomFilter : LPWSTR;
- nMaxCustFilter : DWORD;
- nFilterIndex : DWORD;
- lpstrFile : LPWSTR;
- nMaxFile : DWORD;
- lpstrFileTitle : LPWSTR;
- nMaxFileTitle : DWORD;
- lpstrInitialDir : LPCWSTR;
- lpstrTitle : LPCWSTR;
- Flags : DWORD;
- nFileOffset : WORD;
- nFileExtension : WORD;
- lpstrDefExt : LPCWSTR;
- lCustData : LPARAM;
- lpfnHook : LPOFNHOOKPROC;
- lpTemplateName : LPCWSTR;
- end;
- LPOPENFILENAMEW = ^OPENFILENAMEW; //+commdlg
- tagOFNW = OPENFILENAMEW; //+commdlg
-
- OFNOTIFY = record
- hdr : NMHDR;
- lpOFN : LPOPENFILENAME;
- pszFile : LPTSTR;
- end;
- LPOFNOTIFY = ^OFNOTIFY;
- _OFNOTIFY = OFNOTIFY;
- TOFNOTIFY = OFNOTIFY;
- POFNOTIFY = ^OFNOTIFY;
-
- OSVERSIONINFO = record
- dwOSVersionInfoSize : DWORD;
- dwMajorVersion : DWORD;
- dwMinorVersion : DWORD;
- dwBuildNumber : DWORD;
- dwPlatformId : DWORD;
- szCSDVersion : array[0..127] of TCHAR;
- end;
- LPOSVERSIONINFO = ^OSVERSIONINFO;
- _OSVERSIONINFO = OSVERSIONINFO;
- TOSVERSIONINFO = OSVERSIONINFO;
- POSVERSIONINFO = ^OSVERSIONINFO;
-
- OSVERSIONINFOW = record
- dwOSVersionInfoSize : DWORD;
- dwMajorVersion : DWORD;
- dwMinorVersion : DWORD;
- dwBuildNumber : DWORD;
- dwPlatformId : DWORD;
- szCSDVersion : array[0..127] of WCHAR;
- end;
- LPOSVERSIONINFOW = ^OSVERSIONINFOW;
- _OSVERSIONINFOW = OSVERSIONINFOW;
- TOSVERSIONINFOW = OSVERSIONINFOW;
- POSVERSIONINFOW = ^OSVERSIONINFOW;
-
-
-
-
-
- TEXTMETRIC = record
- tmHeight : LONG;
- tmAscent : LONG;
- tmDescent : LONG;
- tmInternalLeading : LONG;
- tmExternalLeading : LONG;
- tmAveCharWidth : LONG;
- tmMaxCharWidth : LONG;
- tmWeight : LONG;
- tmOverhang : LONG;
- tmDigitizedAspectX : LONG;
- tmDigitizedAspectY : LONG;
- tmFirstChar : BCHAR;
- tmLastChar : BCHAR;
- tmDefaultChar : BCHAR;
- tmBreakChar : BCHAR;
- tmItalic : BYTE;
- tmUnderlined : BYTE;
- tmStruckOut : BYTE;
- tmPitchAndFamily : BYTE;
- tmCharSet : BYTE;
- end;
- LPTEXTMETRIC = ^TEXTMETRIC;
- tagTEXTMETRIC = TEXTMETRIC;
- TTEXTMETRIC = TEXTMETRIC;
- PTEXTMETRIC = ^TEXTMETRIC;
-
- TEXTMETRICW = record
- tmHeight : LONG;
- tmAscent : LONG;
- tmDescent : LONG;
- tmInternalLeading : LONG;
- tmExternalLeading : LONG;
- tmAveCharWidth : LONG;
- tmMaxCharWidth : LONG;
- tmWeight : LONG;
- tmOverhang : LONG;
- tmDigitizedAspectX : LONG;
- tmDigitizedAspectY : LONG;
- tmFirstChar : WCHAR;
- tmLastChar : WCHAR;
- tmDefaultChar : WCHAR;
- tmBreakChar : WCHAR;
- tmItalic : BYTE;
- tmUnderlined : BYTE;
- tmStruckOut : BYTE;
- tmPitchAndFamily : BYTE;
- tmCharSet : BYTE;
- end;
- LPTEXTMETRICW = ^TEXTMETRICW;
- tagTEXTMETRICW = TEXTMETRICW;
- TTEXTMETRICW = TEXTMETRICW;
- PTEXTMETRICW = ^TEXTMETRICW;
-
-
- OUTLINETEXTMETRIC = record
- otmSize : UINT;
- otmTextMetrics : TEXTMETRIC;
- otmFiller : BYTE;
- otmPanoseNumber : PANOSE;
- otmfsSelection : UINT;
- otmfsType : UINT;
- otmsCharSlopeRise : longint;
- otmsCharSlopeRun : longint;
- otmItalicAngle : longint;
- otmEMSquare : UINT;
- otmAscent : longint;
- otmDescent : longint;
- otmLineGap : UINT;
- otmsCapEmHeight : UINT;
- otmsXHeight : UINT;
- otmrcFontBox : RECT;
- otmMacAscent : longint;
- otmMacDescent : longint;
- otmMacLineGap : UINT;
- otmusMinimumPPEM : UINT;
- otmptSubscriptSize : POINT;
- otmptSubscriptOffset : POINT;
- otmptSuperscriptSize : POINT;
- otmptSuperscriptOffset : POINT;
- otmsStrikeoutSize : UINT;
- otmsStrikeoutPosition : longint;
- otmsUnderscoreSize : longint;
- otmsUnderscorePosition : longint;
- otmpFamilyName : PSTR;
- otmpFaceName : PSTR;
- otmpStyleName : PSTR;
- otmpFullName : PSTR;
- end;
- LPOUTLINETEXTMETRIC = ^OUTLINETEXTMETRIC;
- _OUTLINETEXTMETRIC = OUTLINETEXTMETRIC;
- TOUTLINETEXTMETRIC = OUTLINETEXTMETRIC;
- POUTLINETEXTMETRIC = ^OUTLINETEXTMETRIC;
-
- OVERLAPPED = record
- Internal : DWORD;
- InternalHigh : DWORD;
- Offset : DWORD;
- OffsetHigh : DWORD;
- hEvent : HANDLE;
- end;
- LPOVERLAPPED = ^OVERLAPPED;
- _OVERLAPPED = OVERLAPPED;
- TOVERLAPPED = OVERLAPPED;
- POVERLAPPED = ^OVERLAPPED;
-
- {PAGESETUPDLG = record conflicts with function PageSetupDlg }
- TPAGESETUPDLG = record
- lStructSize : DWORD;
- hwndOwner : HWND;
- hDevMode : HGLOBAL;
- hDevNames : HGLOBAL;
- Flags : DWORD;
- ptPaperSize : POINT;
- rtMinMargin : RECT;
- rtMargin : RECT;
- hInstance : HINST;
- lCustData : LPARAM;
- lpfnPageSetupHook : LPPAGESETUPHOOK;
- lpfnPagePaintHook : LPPAGEPAINTHOOK;
- lpPageSetupTemplateName : LPCTSTR;
- hPageSetupTemplate : HGLOBAL;
- end;
- LPPAGESETUPDLG = ^TPAGESETUPDLG;
- PPAGESETUPDLG = ^TPAGESETUPDLG;
-
- tagPSD = TPAGESETUPDLG;
- TPSD = TPAGESETUPDLG;
- PPSD = ^TPAGESETUPDLG;
-
- TPAGESETUPDLGW = record //+commdlg
- lStructSize : DWORD;
- hwndOwner : HWND;
- hDevMode : HGLOBAL;
- hDevNames : HGLOBAL;
- Flags : DWORD;
- ptPaperSize : POINT; // ignored in CE
- rtMinMargin : RECT;
- rtMargin : RECT;
- hInstance : HINST;
- lCustData : LPARAM;
- lpfnPageSetupHook : LPPAGESETUPHOOK;
- lpfnPagePaintHook : LPPAGEPAINTHOOK; // ignored in CE
- lpPageSetupTemplateName : LPCWSTR;
- hPageSetupTemplate : HGLOBAL;
- end;
- LPPAGESETUPDLGW = ^TPAGESETUPDLGW; //+commdlg
- tagPSDW = TPAGESETUPDLGW; //+commdlg
-
- PAINTSTRUCT = record
- hdc : HDC;
- fErase : WINBOOL;
- rcPaint : RECT;
- fRestore : WINBOOL;
- fIncUpdate : WINBOOL;
- rgbReserved : array[0..31] of BYTE;
- end;
- LPPAINTSTRUCT = ^PAINTSTRUCT;
- tagPAINTSTRUCT = PAINTSTRUCT;
- TPAINTSTRUCT = PAINTSTRUCT;
- PPAINTSTRUCT = ^PAINTSTRUCT;
-
- PARAFORMAT = record
- cbSize : UINT;
- dwMask : DWORD;
- wNumbering : WORD;
- wReserved : WORD;
- dxStartIndent : LONG;
- dxRightIndent : LONG;
- dxOffset : LONG;
- wAlignment : WORD;
- cTabCount : SHORT;
- rgxTabs : array[0..(MAX_TAB_STOPS)-1] of LONG;
- end;
- _paraformat = PARAFORMAT;
- Tparaformat = PARAFORMAT;
- Pparaformat = ^PARAFORMAT;
-
- PERF_COUNTER_BLOCK = record
- ByteLength : DWORD;
- end;
- _PERF_COUNTER_BLOCK = PERF_COUNTER_BLOCK;
- TPERFCOUNTERBLOCK = PERF_COUNTER_BLOCK;
- PPERFCOUNTERBLOCK = ^PERF_COUNTER_BLOCK;
-
- PERF_COUNTER_DEFINITION = record
- ByteLength : DWORD;
- CounterNameTitleIndex : DWORD;
- CounterNameTitle : LPWSTR;
- CounterHelpTitleIndex : DWORD;
- CounterHelpTitle : LPWSTR;
- DefaultScale : DWORD;
- DetailLevel : DWORD;
- CounterType : DWORD;
- CounterSize : DWORD;
- CounterOffset : DWORD;
- end;
- _PERF_COUNTER_DEFINITION = PERF_COUNTER_DEFINITION;
- TPERFCOUNTERDEFINITION = PERF_COUNTER_DEFINITION;
- PPERFCOUNTERDEFINITION = ^PERF_COUNTER_DEFINITION;
-
- PERF_DATA_BLOCK = record
- Signature : array[0..3] of WCHAR;
- LittleEndian : DWORD;
- Version : DWORD;
- Revision : DWORD;
- TotalByteLength : DWORD;
- HeaderLength : DWORD;
- NumObjectTypes : DWORD;
- DefaultObject : DWORD;
- SystemTime : SYSTEMTIME;
- PerfTime : LARGE_INTEGER;
- PerfFreq : LARGE_INTEGER;
- PerfTime100nSec : LARGE_INTEGER;
- SystemNameLength : DWORD;
- SystemNameOffset : DWORD;
- end;
- _PERF_DATA_BLOCK = PERF_DATA_BLOCK;
- TPERFDATABLOCK = PERF_DATA_BLOCK;
- PPERFDATABLOCK = ^PERF_DATA_BLOCK;
-
- PERF_INSTANCE_DEFINITION = record
- ByteLength : DWORD;
- ParentObjectTitleIndex : DWORD;
- ParentObjectInstance : DWORD;
- UniqueID : DWORD;
- NameOffset : DWORD;
- NameLength : DWORD;
- end;
- _PERF_INSTANCE_DEFINITION = PERF_INSTANCE_DEFINITION;
- TPERFINSTANCEDEFINITION = PERF_INSTANCE_DEFINITION;
- PPERFINSTANCEDEFINITION = PERF_INSTANCE_DEFINITION;
-
- PERF_OBJECT_TYPE = record
- TotalByteLength : DWORD;
- DefinitionLength : DWORD;
- HeaderLength : DWORD;
- ObjectNameTitleIndex : DWORD;
- ObjectNameTitle : LPWSTR;
- ObjectHelpTitleIndex : DWORD;
- ObjectHelpTitle : LPWSTR;
- DetailLevel : DWORD;
- NumCounters : DWORD;
- DefaultCounter : DWORD;
- NumInstances : DWORD;
- CodePage : DWORD;
- PerfTime : LARGE_INTEGER;
- PerfFreq : LARGE_INTEGER;
- end;
- _PERF_OBJECT_TYPE = PERF_OBJECT_TYPE;
- TPERFOBJECTTYPE = PERF_OBJECT_TYPE;
- PPERFOBJECTTYPE = ^PERF_OBJECT_TYPE;
-
- POLYTEXT = record
- x : longint;
- y : longint;
- n : UINT;
- lpstr : LPCTSTR;
- uiFlags : UINT;
- rcl : RECT;
- pdx : ^longint;
- end;
- _POLYTEXT = POLYTEXT;
- TPOLYTEXT = POLYTEXT;
- PPOLYTEXT = ^POLYTEXT;
-
- PORT_INFO_1 = record
- pName : LPTSTR;
- end;
- _PORT_INFO_1 = PORT_INFO_1;
- TPORTINFO1 = PORT_INFO_1;
- PPORTINFO1 = ^PORT_INFO_1;
-
- PORT_INFO_2 = record
- pPortName : LPSTR;
- pMonitorName : LPSTR;
- pDescription : LPSTR;
- fPortType : DWORD;
- Reserved : DWORD;
- end;
- _PORT_INFO_2 = PORT_INFO_2;
- TPORTINFO2 = PORT_INFO_2;
- PPORTINFO2 = ^PORT_INFO_2;
-
- PREVENT_MEDIA_REMOVAL = record
- PreventMediaRemoval : BOOLEAN;
- end;
- _PREVENT_MEDIA_REMOVAL = PREVENT_MEDIA_REMOVAL;
- TPREVENTMEDIAREMOVAL = PREVENT_MEDIA_REMOVAL;
- PPREVENTMEDIAREMOVAL = ^PREVENT_MEDIA_REMOVAL;
-
- {PRINTDLG = record conflicts with PrintDlg function }
- TPRINTDLG = packed record
- lStructSize : DWORD;
- hwndOwner : HWND;
- hDevMode : HANDLE;
- hDevNames : HANDLE;
- hDC : HDC;
- Flags : DWORD;
- nFromPage : WORD;
- nToPage : WORD;
- nMinPage : WORD;
- nMaxPage : WORD;
- nCopies : WORD;
- hInstance : HINST;
- lCustData : DWORD;
- lpfnPrintHook : LPPRINTHOOKPROC;
- lpfnSetupHook : LPSETUPHOOKPROC;
- lpPrintTemplateName : LPCTSTR;
- lpSetupTemplateName : LPCTSTR;
- hPrintTemplate : HANDLE;
- hSetupTemplate : HANDLE;
- end;
- LPPRINTDLG = ^TPRINTDLG;
- PPRINTDLG = ^TPRINTDLG;
-
- tagPD = TPRINTDLG;
- TPD = TPRINTDLG;
- PPD = ^TPRINTDLG;
-
- PRINTER_DEFAULTS = record
- pDatatype : LPTSTR;
- pDevMode : LPDEVMODE;
- DesiredAccess : ACCESS_MASK;
- end;
- _PRINTER_DEFAULTS = PRINTER_DEFAULTS;
- TPRINTERDEFAULTS = PRINTER_DEFAULTS;
- PPRINTERDEFAULTS = ^PRINTER_DEFAULTS;
-
- PRINTER_INFO_1 = record
- Flags : DWORD;
- pDescription : LPTSTR;
- pName : LPTSTR;
- pComment : LPTSTR;
- end;
- LPPRINTER_INFO_1 = ^PRINTER_INFO_1;
- PPRINTER_INFO_1 = ^PRINTER_INFO_1;
- _PRINTER_INFO_1 = PRINTER_INFO_1;
- TPRINTERINFO1 = PRINTER_INFO_1;
- PPRINTERINFO1 = ^PRINTER_INFO_1;
-
- PRINTER_INFO_2 = record
- pServerName : LPTSTR;
- pPrinterName : LPTSTR;
- pShareName : LPTSTR;
- pPortName : LPTSTR;
- pDriverName : LPTSTR;
- pComment : LPTSTR;
- pLocation : LPTSTR;
- pDevMode : LPDEVMODE;
- pSepFile : LPTSTR;
- pPrintProcessor : LPTSTR;
- pDatatype : LPTSTR;
- pParameters : LPTSTR;
- pSecurityDescriptor : PSECURITY_DESCRIPTOR;
- Attributes : DWORD;
- Priority : DWORD;
- DefaultPriority : DWORD;
- StartTime : DWORD;
- UntilTime : DWORD;
- Status : DWORD;
- cJobs : DWORD;
- AveragePPM : DWORD;
- end;
- _PRINTER_INFO_2 = PRINTER_INFO_2;
- TPRINTERINFO2 = PRINTER_INFO_2;
- PPRINTERINFO2 = ^PRINTER_INFO_2;
-
- PRINTER_INFO_3 = record
- pSecurityDescriptor : PSECURITY_DESCRIPTOR;
- end;
- _PRINTER_INFO_3 = PRINTER_INFO_3;
- TPRINTERINFO3 = PRINTER_INFO_3;
- PPRINTERINFO3 = ^PRINTER_INFO_3;
-
- PRINTER_INFO_4 = record
- pPrinterName : LPTSTR;
- pServerName : LPTSTR;
- Attributes : DWORD;
- end;
- _PRINTER_INFO_4 = PRINTER_INFO_4;
- TPRINTERINFO4 = PRINTER_INFO_4;
- PPRINTERINFO4 = ^PRINTER_INFO_4;
-
- PRINTER_INFO_5 = record
- pPrinterName : LPTSTR;
- pPortName : LPTSTR;
- Attributes : DWORD;
- DeviceNotSelectedTimeout : DWORD;
- TransmissionRetryTimeout : DWORD;
- end;
- _PRINTER_INFO_5 = PRINTER_INFO_5;
- TPRINTERINFO5 = PRINTER_INFO_5;
- PPRINTERINFO5 = ^PRINTER_INFO_5;
-
- PRINTER_NOTIFY_INFO_DATA = record
- _Type : WORD;
- Field : WORD;
- Reserved : DWORD;
- Id : DWORD;
- NotifyData : record
- case longint of
- 0 : ( adwData : array[0..1] of DWORD );
- 1 : ( Data : record
- cbBuf : DWORD;
- pBuf : LPVOID;
- end );
- end;
- end;
- _PRINTER_NOTIFY_INFO_DATA = PRINTER_NOTIFY_INFO_DATA;
- TPRINTERNOTIFYINFODATA = PRINTER_NOTIFY_INFO_DATA;
- PPRINTERNOTIFYINFODATA = ^PRINTER_NOTIFY_INFO_DATA;
-
- PRINTER_NOTIFY_INFO = record
- Version : DWORD;
- Flags : DWORD;
- Count : DWORD;
- aData : array[0..0] of PRINTER_NOTIFY_INFO_DATA;
- end;
- _PRINTER_NOTIFY_INFO = PRINTER_NOTIFY_INFO;
- TPRINTERNOTIFYINFO = PRINTER_NOTIFY_INFO;
- PPRINTERNOTIFYINFO = ^PRINTER_NOTIFY_INFO;
-
- PRINTER_NOTIFY_OPTIONS_TYPE = record
- _Type : WORD;
- Reserved0 : WORD;
- Reserved1 : DWORD;
- Reserved2 : DWORD;
- Count : DWORD;
- pFields : PWORD;
- end;
- PPRINTER_NOTIFY_OPTIONS_TYPE = ^PRINTER_NOTIFY_OPTIONS_TYPE;
- _PRINTER_NOTIFY_OPTIONS_TYPE = PRINTER_NOTIFY_OPTIONS_TYPE;
- TPRINTERNOTIFYOPTIONSTYPE = PRINTER_NOTIFY_OPTIONS_TYPE;
- PPRINTERNOTIFYOPTIONSTYPE = ^PRINTER_NOTIFY_OPTIONS_TYPE;
-
- PRINTER_NOTIFY_OPTIONS = record
- Version : DWORD;
- Flags : DWORD;
- Count : DWORD;
- pTypes : PPRINTER_NOTIFY_OPTIONS_TYPE;
- end;
- _PRINTER_NOTIFY_OPTIONS = PRINTER_NOTIFY_OPTIONS;
- TPRINTERNOTIFYOPTIONS = PRINTER_NOTIFY_OPTIONS;
- PPRINTERNOTIFYOPTIONS = ^PRINTER_NOTIFY_OPTIONS;
-
- PRINTPROCESSOR_INFO_1 = record
- pName : LPTSTR;
- end;
- _PRINTPROCESSOR_INFO_1 = PRINTPROCESSOR_INFO_1;
- TPRINTPROCESSORINFO1 = PRINTPROCESSOR_INFO_1;
- PPRINTPROCESSORINFO1 = ^PRINTPROCESSOR_INFO_1;
-
- PRIVILEGE_SET = record
- PrivilegeCount : DWORD;
- Control : DWORD;
- Privilege : array[0..(ANYSIZE_ARRAY)-1] of LUID_AND_ATTRIBUTES;
- end;
- LPPRIVILEGE_SET = ^PRIVILEGE_SET;
- PPRIVILEGE_SET = ^PRIVILEGE_SET;
- _PRIVILEGE_SET = PRIVILEGE_SET;
- TPRIVILEGESET = PRIVILEGE_SET;
- PPRIVILEGESET = ^PRIVILEGE_SET;
-
- PROCESS_HEAPENTRY = record
- lpData : PVOID;
- cbData : DWORD;
- cbOverhead : BYTE;
- iRegionIndex : BYTE;
- wFlags : WORD;
- dwCommittedSize : DWORD;
- dwUnCommittedSize : DWORD;
- lpFirstBlock : LPVOID;
- lpLastBlock : LPVOID;
- hMem : HANDLE;
- end;
- LPPROCESS_HEAP_ENTRY = ^PROCESS_HEAPENTRY;
- _PROCESS_HEAP_ENTRY = PROCESS_HEAPENTRY;
- TPROCESSHEAPENTRY = PROCESS_HEAPENTRY;
- PPROCESSHEAPENTRY = ^PROCESS_HEAPENTRY;
-
- PROCESS_INFORMATION = record
- hProcess : HANDLE;
- hThread : HANDLE;
- dwProcessId : DWORD;
- dwThreadId : DWORD;
- end;
- LPPROCESS_INFORMATION = ^PROCESS_INFORMATION;
- _PROCESS_INFORMATION = PROCESS_INFORMATION;
- TPROCESSINFORMATION = PROCESS_INFORMATION;
- PPROCESSINFORMATION = ^PROCESS_INFORMATION;
-
- LPFNPSPCALLBACK = function (_para1:HWND; _para2:UINT; _para3:LPVOID):UINT;stdcall;
- TFNPSPCALLBACK = LPFNPSPCALLBACK;
-
- PROPSHEETPAGE = record
- dwSize : DWORD;
- dwFlags : DWORD;
- hInstance : HINST;
- case longint of
- 0 : (pszTemplate : LPCTSTR);
- 1 : (pResource : LPCDLGTEMPLATE;
- case longint of
- 0 : (hIcon : HICON);
- 1 : (pszIcon : LPCTSTR;
- pszTitle : LPCTSTR;
- pfnDlgProc : DLGPROC;
- lParam : LPARAM;
- pfnCallback : LPFNPSPCALLBACK;
- pcRefParent : ^UINT;
- );
- );
- end;
- LPPROPSHEETPAGE = ^PROPSHEETPAGE;
- LPCPROPSHEETPAGE = ^PROPSHEETPAGE;
- _PROPSHEETPAGE = PROPSHEETPAGE;
- TPROPSHEETPAGE = PROPSHEETPAGE;
- PPROPSHEETPAGE = ^PROPSHEETPAGE;
-
- emptyrecord = record
- end;
- lpemptyrecord = ^emptyrecord;
- HPROPSHEETPAGE = ^emptyrecord;
-
- PROPSHEETHEADER = record
- dwSize : DWORD;
- dwFlags : DWORD;
- hwndParent : HWND;
- hInstance : HINST;
- case longint of
- 0 : (hIcon : HICON);
- 1 : (pszIcon : LPCTSTR;
- pszCaption : LPCTSTR;
- nPages : UINT;
- case longint of
- 0 : (nStartPage : UINT);
- 1 : (pStartPage : LPCTSTR;
- case longint of
- 0 : (ppsp : LPCPROPSHEETPAGE);
- 1 : (phpage : ^HPROPSHEETPAGE;
- pfnCallback : PFNPROPSHEETCALLBACK;
- case longint of
- 0 : (hbmWatermark : HBITMAP);
- 1 : (pszbmWatermark : LPCTSTR;
- hplWatermark : HPALETTE;
- case longint of
- 0 : (hbmHeader : HBITMAP);
- 1 : (pszbmHeader: PAnsiChar);
- );
- );
- );
- );
- end;
- LPPROPSHEETHEADER = ^PROPSHEETHEADER;
- LPCPROPSHEETHEADER = ^PROPSHEETHEADER;
- _PROPSHEETHEADER = PROPSHEETHEADER;
- TPROPSHEETHEADER = PROPSHEETHEADER;
- PPROPSHEETHEADER = ^PROPSHEETHEADER;
-
- PROPSHEETHEADERW = record //prsht
- dwSize : DWORD;
- dwFlags : DWORD;
- hwndParent : HWND;
- hInstance : HINST;
- case longint of
- 0 : (hIcon : HICON);
- 1 : (pszIcon : LPCWSTR;
- pszCaption : LPCWSTR;
- nPages : UINT;
- case longint of
- 0 : (nStartPage : UINT);
- 1 : (pStartPage : LPCWSTR;
- case longint of
- 0 : (ppsp : LPCPROPSHEETPAGE);
- 1 : (phpage : ^HPROPSHEETPAGE;
- pfnCallback : PFNPROPSHEETCALLBACK;
- );
- );
- );
- end;
- LPCPROPSHEETHEADERW = ^PROPSHEETHEADERW;
- _PROPSHEETHEADERW = PROPSHEETHEADERW;
-
- { PropertySheet callbacks }
- LPFNADDPROPSHEETPAGE = function (_para1:HPROPSHEETPAGE; _para2:LPARAM):WINBOOL;stdcall;
- TFNADDPROPSHEETPAGE = LPFNADDPROPSHEETPAGE;
-
- LPFNADDPROPSHEETPAGES = function (_para1:LPVOID; _para2:LPFNADDPROPSHEETPAGE; _para3:LPARAM):WINBOOL;stdcall;
- TFNADDPROPSHEETPAGES = LPFNADDPROPSHEETPAGES;
-
- PROTOCOL_INFO = record
- dwServiceFlags : DWORD;
- iAddressFamily : WINT;
- iMaxSockAddr : WINT;
- iMinSockAddr : WINT;
- iSocketType : WINT;
- iProtocol : WINT;
- dwMessageSize : DWORD;
- lpProtocol : LPTSTR;
- end;
- _PROTOCOL_INFO = PROTOCOL_INFO;
- TPROTOCOLINFO = PROTOCOL_INFO;
- PPROTOCOLINFO = ^PROTOCOL_INFO;
-
- PROVIDOR_INFO_1 = record
- pName : LPTSTR;
- pEnvironment : LPTSTR;
- pDLLName : LPTSTR;
- end;
- _PROVIDOR_INFO_1 = PROVIDOR_INFO_1;
- TPROVIDORINFO1 = PROVIDOR_INFO_1;
- PPROVIDORINFO1 = ^PROVIDOR_INFO_1;
-
- PSHNOTIFY = record
- hdr : NMHDR;
- lParam : LPARAM;
- end;
- LPPSHNOTIFY = ^PSHNOTIFY;
- _PSHNOTIFY = PSHNOTIFY;
- TPSHNOTIFY = PSHNOTIFY;
- PPSHNOTIFY = ^PSHNOTIFY;
-
- PUNCTUATION = record
- iSize : UINT;
- szPunctuation : LPSTR;
- end;
- _punctuation = PUNCTUATION;
- Tpunctuation = PUNCTUATION;
- Ppunctuation = ^PUNCTUATION;
-
- QUERY_SERVICE_CONFIG = record
- dwServiceType : DWORD;
- dwStartType : DWORD;
- dwErrorControl : DWORD;
- lpBinaryPathName : LPTSTR;
- lpLoadOrderGroup : LPTSTR;
- dwTagId : DWORD;
- lpDependencies : LPTSTR;
- lpServiceStartName : LPTSTR;
- lpDisplayName : LPTSTR;
- end;
- LPQUERY_SERVICE_CONFIG = ^QUERY_SERVICE_CONFIG;
- _QUERY_SERVICE_CONFIG = QUERY_SERVICE_CONFIG;
- TQUERYSERVICECONFIG = QUERY_SERVICE_CONFIG;
- PQUERYSERVICECONFIG = ^QUERY_SERVICE_CONFIG;
-
- QUERY_SERVICE_LOCK_STATUS = record
- fIsLocked : DWORD;
- lpLockOwner : LPTSTR;
- dwLockDuration : DWORD;
- end;
- LPQUERY_SERVICE_LOCK_STATUS = ^QUERY_SERVICE_LOCK_STATUS;
- _QUERY_SERVICE_LOCK_STATUS = QUERY_SERVICE_LOCK_STATUS;
- TQUERYSERVICELOCKSTATUS = QUERY_SERVICE_LOCK_STATUS;
- PQUERYSERVICELOCKSTATUS = ^QUERY_SERVICE_LOCK_STATUS;
-
- RASAMB = record
- dwSize : DWORD;
- dwError : DWORD;
- szNetBiosError : array[0..(NETBIOS_NAME_LEN + 1)-1] of TCHAR;
- bLana : BYTE;
- end;
- _RASAMB = RASAMB;
- TRASAMB = RASAMB;
- PRASAMB = ^RASAMB;
-
- RASCONN = record
- dwSize : DWORD;
- hrasconn : HRASCONN;
- szEntryName : array[0..(RAS_MaxEntryName + 1)-1] of TCHAR;
- szDeviceType : array[0..(RAS_MaxDeviceType + 1)-1] of CHAR;
- szDeviceName : array[0..(RAS_MaxDeviceName + 1)-1] of CHAR;
- end;
- _RASCONN = RASCONN;
- TRASCONN = RASCONN;
- PRASCONN = ^RASCONN;
-
- RASCONNSTATUS = record
- dwSize : DWORD;
- rasconnstate : RASCONNSTATE;
- dwError : DWORD;
- szDeviceType : array[0..(RAS_MaxDeviceType + 1)-1] of TCHAR;
- szDeviceName : array[0..(RAS_MaxDeviceName + 1)-1] of TCHAR;
- end;
- _RASCONNSTATUS = RASCONNSTATUS;
- TRASCONNSTATUS = RASCONNSTATUS;
- PRASCONNSTATUS = ^RASCONNSTATUS;
-
- RASDIALEXTENSIONS = record
- dwSize : DWORD;
- dwfOptions : DWORD;
- hwndParent : HWND;
- reserved : DWORD;
- end;
- _RASDIALEXTENSIONS = RASDIALEXTENSIONS;
- TRASDIALEXTENSIONS = RASDIALEXTENSIONS;
- PRASDIALEXTENSIONS = ^RASDIALEXTENSIONS;
-
- RASDIALPARAMS = record
- dwSize : DWORD;
- szEntryName : array[0..(RAS_MaxEntryName + 1)-1] of TCHAR;
- szPhoneNumber : array[0..(RAS_MaxPhoneNumber + 1)-1] of TCHAR;
- szCallbackNumber : array[0..(RAS_MaxCallbackNumber + 1)-1] of TCHAR;
- szUserName : array[0..(UNLEN + 1)-1] of TCHAR;
- szPassword : array[0..(PWLEN + 1)-1] of TCHAR;
- szDomain : array[0..(DNLEN + 1)-1] of TCHAR;
- end;
- _RASDIALPARAMS = RASDIALPARAMS;
- TRASDIALPARAMS = RASDIALPARAMS;
- PRASDIALPARAMS = ^RASDIALPARAMS;
-
- RASENTRYNAME = record
- dwSize : DWORD;
- szEntryName : array[0..(RAS_MaxEntryName + 1)-1] of TCHAR;
- end;
- _RASENTRYNAME = RASENTRYNAME;
- TRASENTRYNAME = RASENTRYNAME;
- PRASENTRYNAME = ^RASENTRYNAME;
-
- RASPPPIP = record
- dwSize : DWORD;
- dwError : DWORD;
- szIpAddress : array[0..(RAS_MaxIpAddress + 1)-1] of TCHAR;
- end;
- _RASPPPIP = RASPPPIP;
- TRASPPPIP = RASPPPIP;
- PRASPPPIP = ^RASPPPIP;
-
- RASPPPIPX = record
- dwSize : DWORD;
- dwError : DWORD;
- szIpxAddress : array[0..(RAS_MaxIpxAddress + 1)-1] of TCHAR;
- end;
- _RASPPPIPX = RASPPPIPX;
- TRASPPPIPX = RASPPPIPX;
- PRASPPPIPX = ^RASPPPIPX;
-
- RASPPPNBF = record
- dwSize : DWORD;
- dwError : DWORD;
- dwNetBiosError : DWORD;
- szNetBiosError : array[0..(NETBIOS_NAME_LEN + 1)-1] of TCHAR;
- szWorkstationName : array[0..(NETBIOS_NAME_LEN + 1)-1] of TCHAR;
- bLana : BYTE;
- end;
- _RASPPPNBF = RASPPPNBF;
- TRASPPPNBF = RASPPPNBF;
- PRASPPPNBF = ^RASPPPNBF;
-
- RASTERIZER_STATUS = record
- nSize : integer;
- wFlags : integer;
- nLanguageID : integer;
- end;
- LPRASTERIZER_STATUS = ^RASTERIZER_STATUS;
- _RASTERIZER_STATUS = RASTERIZER_STATUS;
- TRASTERIZERSTATUS = RASTERIZER_STATUS;
- PRASTERIZERSTATUS = ^RASTERIZER_STATUS;
-
- REASSIGN_BLOCKS = record
- Reserved : WORD;
- Count : WORD;
- BlockNumber : array[0..0] of DWORD;
- end;
- _REASSIGN_BLOCKS = REASSIGN_BLOCKS;
- TREASSIGNBLOCKS = REASSIGN_BLOCKS;
- PREASSIGNBLOCKS = ^REASSIGN_BLOCKS;
-
- REMOTE_NAME_INFO = record
- lpUniversalName : LPTSTR;
- lpConnectionName : LPTSTR;
- lpRemainingPath : LPTSTR;
- end;
- _REMOTE_NAME_INFO = REMOTE_NAME_INFO;
- TREMOTENAMEINFO = REMOTE_NAME_INFO;
- PREMOTENAMEINFO = ^REMOTE_NAME_INFO;
-
- (*
- TODO: OLE
- typedef struct _reobject {
- DWORD cbStruct;
- LONG cp;
- CLSID clsid;
- LPOLEOBJECT poleobj;
- LPSTORAGE pstg;
- LPOLECLIENTSITE polesite;
- SIZEL sizel;
- DWORD dvaspect;
- DWORD dwFlags;
- DWORD dwUser;
- } REOBJECT;
- *)
-
- REPASTESPECIAL = record
- dwAspect : DWORD;
- dwParam : DWORD;
- end;
- _repastespecial = REPASTESPECIAL;
- Trepastespecial = REPASTESPECIAL;
- Prepastespecial = ^REPASTESPECIAL;
-
- REQRESIZE = record
- nmhdr : NMHDR;
- rc : RECT;
- end;
- _reqresize = REQRESIZE;
- Treqresize = REQRESIZE;
- Preqresize = ^REQRESIZE;
-
- RGNDATAHEADER = record
- dwSize : DWORD;
- iType : DWORD;
- nCount : DWORD;
- nRgnSize : DWORD;
- rcBound : RECT;
- end;
- _RGNDATAHEADER = RGNDATAHEADER;
- TRGNDATAHEADER = RGNDATAHEADER;
- PRGNDATAHEADER = ^RGNDATAHEADER;
-
- RGNDATA = record
- rdh : RGNDATAHEADER;
- Buffer : array[0..0] of char;
- end;
- LPRGNDATA = ^RGNDATA;
- _RGNDATA = RGNDATA;
- TRGNDATA = RGNDATA;
- PRGNDATA = ^RGNDATA;
-
- SCROLLINFO = record
- cbSize : UINT;
- fMask : UINT;
- nMin : longint;
- nMax : longint;
- nPage : UINT;
- nPos : longint;
- nTrackPos : longint;
- end;
- LPSCROLLINFO = ^SCROLLINFO;
- LPCSCROLLINFO = ^SCROLLINFO;
- tagSCROLLINFO = SCROLLINFO;
- TSCROLLINFO = SCROLLINFO;
- PSCROLLINFO = ^SCROLLINFO;
-
- SECURITY_ATTRIBUTES = record
- nLength : DWORD;
- lpSecurityDescriptor : LPVOID;
- bInheritHandle : WINBOOL;
- end;
- LPSECURITY_ATTRIBUTES = ^SECURITY_ATTRIBUTES;
- _SECURITY_ATTRIBUTES = SECURITY_ATTRIBUTES;
- TSECURITYATTRIBUTES = SECURITY_ATTRIBUTES;
- PSECURITYATTRIBUTES = ^SECURITY_ATTRIBUTES;
-
- SECURITY_INFORMATION = DWORD;
- PSECURITY_INFORMATION = ^SECURITY_INFORMATION;
- TSECURITYINFORMATION = SECURITY_INFORMATION;
- PSECURITYINFORMATION = ^SECURITY_INFORMATION;
-
- SELCHANGE = record
- nmhdr : NMHDR;
- chrg : CHARRANGE;
- seltyp : WORD;
- end;
- _selchange = SELCHANGE;
- Tselchange = SELCHANGE;
- Pselchange = ^SELCHANGE;
-
- SERIALKEYS = record
- cbSize : DWORD;
- dwFlags : DWORD;
- lpszActivePort : LPSTR;
- lpszPort : LPSTR;
- iBaudRate : DWORD;
- iPortState : DWORD;
- end;
- LPSERIALKEYS = ^SERIALKEYS;
- tagSERIALKEYS = SERIALKEYS;
- TSERIALKEYS = SERIALKEYS;
- PSERIALKEYS = ^SERIALKEYS;
-
- SERVICE_TABLE_ENTRY = record
- lpServiceName : LPTSTR;
- lpServiceProc : LPSERVICE_MAIN_FUNCTION;
- end;
- LPSERVICE_TABLE_ENTRY = ^SERVICE_TABLE_ENTRY;
- _SERVICE_TABLE_ENTRY = SERVICE_TABLE_ENTRY;
- TSERVICETABLEENTRY = SERVICE_TABLE_ENTRY;
- PSERVICETABLEENTRY = ^SERVICE_TABLE_ENTRY;
-
- SERVICE_TYPE_VALUE_ABS = record
- dwNameSpace : DWORD;
- dwValueType : DWORD;
- dwValueSize : DWORD;
- lpValueName : LPTSTR;
- lpValue : PVOID;
- end;
- _SERVICE_TYPE_VALUE_ABS = SERVICE_TYPE_VALUE_ABS;
- TSERVICETYPEVALUEABS = SERVICE_TYPE_VALUE_ABS;
- PSERVICETYPEVALUEABS = ^SERVICE_TYPE_VALUE_ABS;
-
- SERVICE_TYPE_INFO_ABS = record
- lpTypeName : LPTSTR;
- dwValueCount : DWORD;
- Values : array[0..0] of SERVICE_TYPE_VALUE_ABS;
- end;
- _SERVICE_TYPE_INFO_ABS = SERVICE_TYPE_INFO_ABS;
- TSERVICETYPEINFOABS = SERVICE_TYPE_INFO_ABS;
- PSERVICETYPEINFOABS = ^SERVICE_TYPE_INFO_ABS;
-
- SESSION_BUFFER = record
- lsn : UCHAR;
- state : UCHAR;
- local_name : array[0..(NCBNAMSZ)-1] of UCHAR;
- remote_name : array[0..(NCBNAMSZ)-1] of UCHAR;
- rcvs_outstanding : UCHAR;
- sends_outstanding : UCHAR;
- end;
- _SESSION_BUFFER = SESSION_BUFFER;
- TSESSIONBUFFER = SESSION_BUFFER;
- PSESSIONBUFFER = ^SESSION_BUFFER;
-
- SESSION_HEADER = record
- sess_name : UCHAR;
- num_sess : UCHAR;
- rcv_dg_outstanding : UCHAR;
- rcv_any_outstanding : UCHAR;
- end;
- _SESSION_HEADER = SESSION_HEADER;
- TSESSIONHEADER = SESSION_HEADER;
- PSESSIONHEADER = ^SESSION_HEADER;
-
- SET_PARTITION_INFORMATION = record
- PartitionType : BYTE;
- end;
- _SET_PARTITION_INFORMATION = SET_PARTITION_INFORMATION;
- TSETPARTITIONINFORMATION = SET_PARTITION_INFORMATION;
- PSETPARTITIONINFORMATION = ^SET_PARTITION_INFORMATION;
-
- SHELLEXECUTEINFO = record //+shellapi
- cbSize: DWORD;
- fMask: ULONG;
- hwnd: HWND;
- lpVerb: LPCTSTR;
- lpFile: LPCTSTR;
- lpParameters: LPCTSTR;
- lpDirectory: LPCTSTR;
- nShow: Integer ;
- hInstApp: HINST;
- // Optional fields
- lpIDList: LPVOID;
- lpClass: LPCTSTR;
- hkeyClass: HKEY;
- dwHotKey: DWORD;
- hIcon: HANDLE;
- hProcess :HANDLE;
- end;
- _SHELLEXECUTEINFO=SHELLEXECUTEINFO; //+shellapi
- LPSHELLEXECUTEINFO=^SHELLEXECUTEINFO; //+shellapi
-
- SHCONTF = (SHCONTF_FOLDERS := 32,SHCONTF_NONFOLDERS := 64,
- SHCONTF_INCLUDEHIDDEN := 128);
- tagSHCONTF = SHCONTF;
- TSHCONTF = SHCONTF;
-
- SHFILEINFO = record
- hIcon : HICON;
- iIcon : longint;
- dwAttributes : DWORD;
- szDisplayName : array[0..(MAX_PATH)-1] of char;
- szTypeName : array[0..79] of char;
- end;
- _SHFILEINFO = SHFILEINFO;
- TSHFILEINFO = SHFILEINFO;
- PSHFILEINFO = ^SHFILEINFO;
-
- FILEOP_FLAGS = WORD;
- TFILEOPFLAGS = FILEOP_FLAGS;
- PFILEOPFLAGS = ^FILEOP_FLAGS;
-
- SHFILEOPSTRUCT = record
- hwnd : HWND;
- wFunc : UINT;
- pFrom : LPCSTR;
- pTo : LPCSTR;
- fFlags : FILEOP_FLAGS;
- fAnyOperationsAborted : WINBOOL;
- hNameMappings : LPVOID;
- lpszProgressTitle : LPCSTR;
- end;
- LPSHFILEOPSTRUCT = ^SHFILEOPSTRUCT;
- _SHFILEOPSTRUCT = SHFILEOPSTRUCT;
- TSHFILEOPSTRUCT = SHFILEOPSTRUCT;
- PSHFILEOPSTRUCT = ^SHFILEOPSTRUCT;
-
- SHFILEOPSTRUCTW = record //+shellapi
- hwnd : HWND;
- wFunc : UINT;
- pFrom : LPCWSTR;
- pTo : LPCWSTR;
- fFlags : FILEOP_FLAGS;
- fAnyOperationsAborted : WINBOOL;
- hNameMappings : LPVOID;
- lpszProgressTitle : LPCWSTR;
- end;
- LPSHFILEOPSTRUCTW = ^SHFILEOPSTRUCTW;
-
- SHGNO = (SHGDN_NORMAL := 0,SHGDN_INFOLDER := 1,
- SHGDN_FORPARSING := $8000);
- tagSHGDN = SHGNO;
- TSHGDN = SHGNO;
-
- SHNAMEMAPPING = record
- pszOldPath : LPSTR;
- pszNewPath : LPSTR;
- cchOldPath : longint;
- cchNewPath : longint;
- end;
- LPSHNAMEMAPPING = ^SHNAMEMAPPING;
- _SHNAMEMAPPING = SHNAMEMAPPING;
- TSHNAMEMAPPING = SHNAMEMAPPING;
- PSHNAMEMAPPING = ^SHNAMEMAPPING;
-
- SINGLE_LIST_ENTRY = record
- Next : ^_SINGLE_LIST_ENTRY;
- end;
- _SINGLE_LIST_ENTRY = SINGLE_LIST_ENTRY;
- TSINGLELISTENTRY = SINGLE_LIST_ENTRY;
- PSINGLELISTENTRY = ^SINGLE_LIST_ENTRY;
-
- SOUNDSENTRY = record
- cbSize : UINT;
- dwFlags : DWORD;
- iFSTextEffect : DWORD;
- iFSTextEffectMSec : DWORD;
- iFSTextEffectColorBits : DWORD;
- iFSGrafEffect : DWORD;
- iFSGrafEffectMSec : DWORD;
- iFSGrafEffectColor : DWORD;
- iWindowsEffect : DWORD;
- iWindowsEffectMSec : DWORD;
- lpszWindowsEffectDLL : LPTSTR;
- iWindowsEffectOrdinal : DWORD;
- end;
- LPSOUNDSENTRY = ^SOUNDSENTRY;
- tagSOUNDSENTRY = SOUNDSENTRY;
- TSOUNDSENTRY = SOUNDSENTRY;
- PSOUNDSENTRY = ^SOUNDSENTRY;
-
- STARTUPINFO = record
- cb : DWORD;
- lpReserved : LPTSTR;
- lpDesktop : LPTSTR;
- lpTitle : LPTSTR;
- dwX : DWORD;
- dwY : DWORD;
- dwXSize : DWORD;
- dwYSize : DWORD;
- dwXCountChars : DWORD;
- dwYCountChars : DWORD;
- dwFillAttribute : DWORD;
- dwFlags : DWORD;
- wShowWindow : WORD;
- cbReserved2 : WORD;
- lpReserved2 : LPBYTE;
- hStdInput : HANDLE;
- hStdOutput : HANDLE;
- hStdError : HANDLE;
- end;
- LPSTARTUPINFO = ^STARTUPINFO;
- _STARTUPINFO = STARTUPINFO;
- TSTARTUPINFO = STARTUPINFO;
- PSTARTUPINFO = ^STARTUPINFO;
-
- STICKYKEYS = record
- cbSize : DWORD;
- dwFlags : DWORD;
- end;
- LPSTICKYKEYS = ^STICKYKEYS;
- tagSTICKYKEYS = STICKYKEYS;
- TSTICKYKEYS = STICKYKEYS;
- PSTICKYKEYS = ^STICKYKEYS;
-
- STRRET = record
- uType : UINT;
- DUMMYUNIONNAME : record
- case longint of
- 0 : ( pOleStr : LPWSTR );
- 1 : ( uOffset : UINT );
- 2 : ( cStr : array[0..(MAX_PATH)-1] of char );
- end;
- end;
- LPSTRRET = ^STRRET;
- _STRRET = STRRET;
- TSTRRET = STRRET;
- PSTRRET = ^STRRET;
-
- STYLEBUF = record
- dwStyle : DWORD;
- szDescription : array[0..31] of CHAR;
- end;
- LPSTYLEBUF = ^STYLEBUF;
- _tagSTYLEBUF = STYLEBUF;
- TSTYLEBUF = STYLEBUF;
- PSTYLEBUF = ^STYLEBUF;
-
- STYLESTRUCT = record
- styleOld : DWORD;
- styleNew : DWORD;
- end;
- LPSTYLESTRUCT = ^STYLESTRUCT;
- tagSTYLESTRUCT = STYLESTRUCT;
- TSTYLESTRUCT = STYLESTRUCT;
- PSTYLESTRUCT = ^STYLESTRUCT;
-
- SYSTEM_AUDIT_ACE = record
- Header : ACE_HEADER;
- Mask : ACCESS_MASK;
- SidStart : DWORD;
- end;
- _SYSTEM_AUDIT_ACE = SYSTEM_AUDIT_ACE;
- TSYSTEMAUDITACE = SYSTEM_AUDIT_ACE;
- PSYSTEMAUDITACE = ^SYSTEM_AUDIT_ACE;
-
- SYSTEM_INFO = record
- u : record
- case longint of
- 0 : ( dwOemId : DWORD );
- 1 : ( s : record
- wProcessorArchitecture : WORD;
- wReserved : WORD;
- end );
- end;
- dwPageSize : DWORD;
- lpMinimumApplicationAddress : LPVOID;
- lpMaximumApplicationAddress : LPVOID;
- dwActiveProcessorMask : DWORD;
- dwNumberOfProcessors : DWORD;
- dwProcessorType : DWORD;
- dwAllocationGranularity : DWORD;
- wProcessorLevel : WORD;
- wProcessorRevision : WORD;
- end;
- LPSYSTEM_INFO = ^SYSTEM_INFO;
- _SYSTEM_INFO = SYSTEM_INFO;
- TSYSTEMINFO = SYSTEM_INFO;
- PSYSTEMINFO = ^SYSTEM_INFO;
-
- SYSTEM_POWER_STATUS = record
- ACLineStatus : BYTE;
- BatteryFlag : BYTE;
- BatteryLifePercent : BYTE;
- Reserved1 : BYTE;
- BatteryLifeTime : DWORD;
- BatteryFullLifeTime : DWORD;
- end;
- _SYSTEM_POWER_STATUS = SYSTEM_POWER_STATUS;
- TSYSTEMPOWERSTATUS = SYSTEM_POWER_STATUS;
- PSYSTEMPOWERSTATUS = ^SYSTEM_POWER_STATUS;
-
- LPSYSTEM_POWER_STATUS = ^emptyrecord;
-
- TAPE_ERASE = record
- _Type : ULONG;
- end;
- _TAPE_ERASE = TAPE_ERASE;
- TTAPEERASE = TAPE_ERASE;
- PTAPEERASE = ^TAPE_ERASE;
-
- TAPE_GET_DRIVE_PARAMETERS = record
- ECC : BOOLEAN;
- Compression : BOOLEAN;
- DataPadding : BOOLEAN;
- ReportSetmarks : BOOLEAN;
- DefaultBlockSize : ULONG;
- MaximumBlockSize : ULONG;
- MinimumBlockSize : ULONG;
- MaximumPartitionCount : ULONG;
- FeaturesLow : ULONG;
- FeaturesHigh : ULONG;
- EOTWarningZoneSize : ULONG;
- end;
- _TAPE_GET_DRIVE_PARAMETERS = TAPE_GET_DRIVE_PARAMETERS;
- TTAPEGETDRIVEPARAMETERS = TAPE_GET_DRIVE_PARAMETERS;
- PTAPEGETDRIVEPARAMETERS = ^TAPE_GET_DRIVE_PARAMETERS;
-
- TAPE_GET_MEDIA_PARAMETERS = record
- Capacity : LARGE_INTEGER;
- Remaining : LARGE_INTEGER;
- BlockSize : DWORD;
- PartitionCount : DWORD;
- WriteProtected : BOOLEAN;
- end;
- _TAPE_GET_MEDIA_PARAMETERS = TAPE_GET_MEDIA_PARAMETERS;
- TTAPEGETMEDIAPARAMETERS = TAPE_GET_MEDIA_PARAMETERS;
- PTAPEGETMEDIAPARAMETERS = ^TAPE_GET_MEDIA_PARAMETERS;
-
- TAPE_GET_POSITION = record
- _Type : ULONG;
- Partition : ULONG;
- OffsetLow : ULONG;
- OffsetHigh : ULONG;
- end;
- _TAPE_GET_POSITION = TAPE_GET_POSITION;
- TTAPEGETPOSITION = TAPE_GET_POSITION;
- PTAPEGETPOSITION = ^TAPE_GET_POSITION;
-
- TAPE_PREPARE = record
- Operation : ULONG;
- end;
- _TAPE_PREPARE = TAPE_PREPARE;
- TTAPEPREPARE = TAPE_PREPARE;
- PTAPEPREPARE = ^TAPE_PREPARE;
-
- TAPE_SET_DRIVE_PARAMETERS = record
- ECC : BOOLEAN;
- Compression : BOOLEAN;
- DataPadding : BOOLEAN;
- ReportSetmarks : BOOLEAN;
- EOTWarningZoneSize : ULONG;
- end;
- _TAPE_SET_DRIVE_PARAMETERS = TAPE_SET_DRIVE_PARAMETERS;
- TTAPESETDRIVEPARAMETERS = TAPE_SET_DRIVE_PARAMETERS;
- PTAPESETDRIVEPARAMETERS = ^TAPE_SET_DRIVE_PARAMETERS;
-
- TAPE_SET_MEDIA_PARAMETERS = record
- BlockSize : ULONG;
- end;
- _TAPE_SET_MEDIA_PARAMETERS = TAPE_SET_MEDIA_PARAMETERS;
- TTAPESETMEDIAPARAMETERS = TAPE_SET_MEDIA_PARAMETERS;
- PTAPESETMEDIAPARAMETERS = ^TAPE_SET_MEDIA_PARAMETERS;
-
- TAPE_SET_POSITION = record
- Method : ULONG;
- Partition : ULONG;
- OffsetLow : ULONG;
- OffsetHigh : ULONG;
- end;
- _TAPE_SET_POSITION = TAPE_SET_POSITION;
- TTAPESETPOSITION = TAPE_SET_POSITION;
- PTAPESETPOSITION = ^TAPE_SET_POSITION;
-
- TAPE_WRITE_MARKS = record
- _Type : ULONG;
- Count : ULONG;
- end;
- _TAPE_WRITE_MARKS = TAPE_WRITE_MARKS;
- TTAPEWRITEMARKS = TAPE_WRITE_MARKS;
- PTAPEWRITEMARKS = ^TAPE_WRITE_MARKS;
-
- TBADDBITMAP = record
- hInst : HINST;
- nID : UINT;
- end;
- LPTBADDBITMAP = ^TBADDBITMAP;
- TTBADDBITMAP = TBADDBITMAP;
- PTBADDBITMAP = ^TBADDBITMAP;
-
- TBBUTTON = record
- iBitmap : longint;
- idCommand : longint;
- fsState : BYTE;
- fsStyle : BYTE;
- dwData : DWORD;
- iString : longint;
- end;
- LPTBBUTTON = ^TBBUTTON;
- LPCTBBUTTON = ^TBBUTTON;
- _TBBUTTON = TBBUTTON;
- TTBBUTTON = TBBUTTON;
- PTBBUTTON = ^TBBUTTON;
-
- TBNOTIFY = record
- hdr : NMHDR;
- iItem : longint;
- tbButton : TBBUTTON;
- cchText : longint;
- pszText : LPTSTR;
- end;
- LPTBNOTIFY = ^TBNOTIFY;
- TTBNOTIFY = TBNOTIFY;
- PTBNOTIFY = ^TBNOTIFY;
-
- TBSAVEPARAMS = record
- hkr : HKEY;
- pszSubKey : LPCTSTR;
- pszValueName : LPCTSTR;
- end;
- TTBSAVEPARAMS = TBSAVEPARAMS;
- PTBSAVEPARAMS = ^TBSAVEPARAMS;
-
- TC_HITTESTINFO = record
- pt : POINT;
- flags : UINT;
- end;
- _TC_HITTESTINFO = TC_HITTESTINFO;
- TTCHITTESTINFO = TC_HITTESTINFO;
- PTCHITTESTINFO = ^TC_HITTESTINFO;
-
- TC_ITEM = record
- mask : UINT;
- lpReserved1 : UINT;
- lpReserved2 : UINT;
- pszText : LPTSTR;
- cchTextMax : longint;
- iImage : longint;
- lParam : LPARAM;
- end;
- _TC_ITEM = TC_ITEM;
- TTCITEM = TC_ITEM;
- PTCITEM = ^TC_ITEM;
-
- TC_ITEMHEADER = record
- mask : UINT;
- lpReserved1 : UINT;
- lpReserved2 : UINT;
- pszText : LPTSTR;
- cchTextMax : longint;
- iImage : longint;
- end;
- _TC_ITEMHEADER = TC_ITEMHEADER;
- TTCITEMHEADER = TC_ITEMHEADER;
- PTCITEMHEADER = ^TC_ITEMHEADER;
-
- TC_KEYDOWN = record
- hdr : NMHDR;
- wVKey : WORD;
- flags : UINT;
- end;
- _TC_KEYDOWN = TC_KEYDOWN;
- TTCKEYDOWN = TC_KEYDOWN;
- PTCKEYDOWN = ^TC_KEYDOWN;
-
- TEXTRANGE = record
- chrg : CHARRANGE;
- lpstrText : LPSTR;
- end;
- _textrange = TEXTRANGE;
- Ttextrange = TEXTRANGE;
- Ptextrange = ^TEXTRANGE;
-
- TIME_ZONE_INFORMATION = record
- Bias : LONG;
- StandardName : array[0..31] of WCHAR;
- StandardDate : SYSTEMTIME;
- StandardBias : LONG;
- DaylightName : array[0..31] of WCHAR;
- DaylightDate : SYSTEMTIME;
- DaylightBias : LONG;
- end;
- LPTIME_ZONE_INFORMATION = ^TIME_ZONE_INFORMATION;
- _TIME_ZONE_INFORMATION = TIME_ZONE_INFORMATION;
- TTIMEZONEINFORMATION = TIME_ZONE_INFORMATION;
- PTIMEZONEINFORMATION = ^TIME_ZONE_INFORMATION;
-
- TOGGLEKEYS = record
- cbSize : DWORD;
- dwFlags : DWORD;
- end;
- tagTOGGLEKEYS = TOGGLEKEYS;
- TTOGGLEKEYS = TOGGLEKEYS;
- PTOGGLEKEYS = ^TOGGLEKEYS;
-
- TOKEN_SOURCE = record
- SourceName : array[0..7] of CHAR;
- SourceIdentifier : LUID;
- end;
- _TOKEN_SOURCE = TOKEN_SOURCE;
- TTOKENSOURCE = TOKEN_SOURCE;
- PTOKENSOURCE = ^TOKEN_SOURCE;
-
- TOKEN_CONTROL = record
- TokenId : LUID;
- AuthenticationId : LUID;
- ModifiedId : LUID;
- TokenSource : TOKEN_SOURCE;
- end;
- _TOKEN_CONTROL = TOKEN_CONTROL;
- TTOKENCONTROL = TOKEN_CONTROL;
- PTOKENCONTROL = ^TOKEN_CONTROL;
-
- TOKEN_DEFAULT_DACL = record
- DefaultDacl : PACL;
- end;
- _TOKEN_DEFAULT_DACL = TOKEN_DEFAULT_DACL;
- TTOKENDEFAULTDACL = TOKEN_DEFAULT_DACL;
- PTOKENDEFAULTDACL = ^TOKEN_DEFAULT_DACL;
-
- TOKEN_GROUPS = record
- GroupCount : DWORD;
- Groups : array[0..(ANYSIZE_ARRAY)-1] of SID_AND_ATTRIBUTES;
- end;
- PTOKEN_GROUPS = ^TOKEN_GROUPS;
- LPTOKEN_GROUPS = ^TOKEN_GROUPS;
- _TOKEN_GROUPS = TOKEN_GROUPS;
- TTOKENGROUPS = TOKEN_GROUPS;
- PTOKENGROUPS = ^TOKEN_GROUPS;
-
- TOKEN_OWNER = record
- Owner : PSID;
- end;
- _TOKEN_OWNER = TOKEN_OWNER;
- TTOKENOWNER = TOKEN_OWNER;
- PTOKENOWNER = ^TOKEN_OWNER;
-
- TOKEN_PRIMARY_GROUP = record
- PrimaryGroup : PSID;
- end;
- _TOKEN_PRIMARY_GROUP = TOKEN_PRIMARY_GROUP;
- TTOKENPRIMARYGROUP = TOKEN_PRIMARY_GROUP;
- PTOKENPRIMARYGROUP = ^TOKEN_PRIMARY_GROUP;
-
- TOKEN_PRIVILEGES = packed record
- PrivilegeCount : DWORD;
- Privileges : array[0..(ANYSIZE_ARRAY)-1] of LUID_AND_ATTRIBUTES;
- end;
-
- PTOKEN_PRIVILEGES = ^TOKEN_PRIVILEGES;
- LPTOKEN_PRIVILEGES = ^TOKEN_PRIVILEGES;
- _TOKEN_PRIVILEGES = TOKEN_PRIVILEGES;
- TTOKENPRIVILEGES = TOKEN_PRIVILEGES;
- PTOKENPRIVILEGES = ^TOKEN_PRIVILEGES;
-
- TOKEN_STATISTICS = record
- TokenId : LUID;
- AuthenticationId : LUID;
- ExpirationTime : LARGE_INTEGER;
- TokenType : TOKEN_TYPE;
- ImpersonationLevel : SECURITY_IMPERSONATION_LEVEL;
- DynamicCharged : DWORD;
- DynamicAvailable : DWORD;
- GroupCount : DWORD;
- PrivilegeCount : DWORD;
- ModifiedId : LUID;
- end;
- _TOKEN_STATISTICS = TOKEN_STATISTICS;
- TTOKENSTATISTICS = TOKEN_STATISTICS;
- PTOKENSTATISTICS = ^TOKEN_STATISTICS;
-
- TOKEN_USER = record
- User : SID_AND_ATTRIBUTES;
- end;
- _TOKEN_USER = TOKEN_USER;
- TTOKENUSER = TOKEN_USER;
- PTOKENUSER = ^TOKEN_USER;
-
- TOOLINFO = record
- cbSize : UINT;
- uFlags : UINT;
- hwnd : HWND;
- uId : UINT;
- rect : RECT;
- hinst : HINST;
- lpszText : LPTSTR;
- end;
- LPTOOLINFO = ^TOOLINFO;
- TTOOLINFO = TOOLINFO;
- PTOOLINFO = ^TOOLINFO;
-
- TOOLTIPTEXT = record
- hdr : NMHDR;
- lpszText : LPTSTR;
- szText : array[0..79] of char;
- hinst : HINST;
- uFlags : UINT;
- end;
- LPTOOLTIPTEXT = ^TOOLTIPTEXT;
- TTOOLTIPTEXT = TOOLTIPTEXT;
- PTOOLTIPTEXT = ^TOOLTIPTEXT;
-
- TPMPARAMS = record
- cbSize : UINT;
- rcExclude : RECT;
- end;
- LPTPMPARAMS = ^TPMPARAMS;
- tagTPMPARAMS = TPMPARAMS;
- TTPMPARAMS = TPMPARAMS;
- PTPMPARAMS = ^TPMPARAMS;
-
- TRANSMIT_FILE_BUFFERS = record
- Head : PVOID;
- HeadLength : DWORD;
- Tail : PVOID;
- TailLength : DWORD;
- end;
- _TRANSMIT_FILE_BUFFERS = TRANSMIT_FILE_BUFFERS;
- TTRANSMITFILEBUFFERS = TRANSMIT_FILE_BUFFERS;
- PTRANSMITFILEBUFFERS = ^TRANSMIT_FILE_BUFFERS;
-
- TTHITTESTINFO = record
- hwnd : HWND;
- pt : POINT;
- ti : TOOLINFO;
- end;
- LPHITTESTINFO = ^TTHITTESTINFO;
- _TT_HITTESTINFO = TTHITTESTINFO;
- TTTHITTESTINFO = TTHITTESTINFO;
- PTTHITTESTINFO = ^TTHITTESTINFO;
-
- TTPOLYCURVE = record
- wType : WORD;
- cpfx : WORD;
- apfx : array[0..0] of POINTFX;
- end;
- LPTTPOLYCURVE = ^TTPOLYCURVE;
- tagTTPOLYCURVE = TTPOLYCURVE;
- TTTPOLYCURVE = TTPOLYCURVE;
- PTTPOLYCURVE = ^TTPOLYCURVE;
-
- TTPOLYGONHEADER = record
- cb : DWORD;
- dwType : DWORD;
- pfxStart : POINTFX;
- end;
- LPTTPOLYGONHEADER = ^TTPOLYGONHEADER;
- _TTPOLYGONHEADER = TTPOLYGONHEADER;
- TTTPOLYGONHEADER = TTPOLYGONHEADER;
- PTTPOLYGONHEADER = ^TTPOLYGONHEADER;
-
- TV_DISPINFO = record
- hdr : NMHDR;
- item : TV_ITEM;
- end;
- _TV_DISPINFO = TV_DISPINFO;
- TTVDISPINFO = TV_DISPINFO;
- PTVDISPINFO = ^TV_DISPINFO;
-
- TV_HITTESTINFO = record
- pt : POINT;
- flags : UINT;
- hItem : HTREEITEM;
- end;
- LPTV_HITTESTINFO = ^TV_HITTESTINFO;
- _TVHITTESTINFO = TV_HITTESTINFO;
- TTVHITTESTINFO = TV_HITTESTINFO;
- PTVHITTESTINFO = ^TV_HITTESTINFO;
-
- TV_INSERTSTRUCT = record
- hParent : HTREEITEM;
- hInsertAfter : HTREEITEM;
- item : TV_ITEM;
- end;
- LPTV_INSERTSTRUCT = ^TV_INSERTSTRUCT;
- _TV_INSERTSTRUCT = TV_INSERTSTRUCT;
- TTVINSERTSTRUCT = TV_INSERTSTRUCT;
- PTVINSERTSTRUCT = ^TV_INSERTSTRUCT;
-
- TV_KEYDOWN = record
- hdr : NMHDR;
- wVKey : WORD;
- flags : UINT;
- end;
- _TV_KEYDOWN = TV_KEYDOWN;
- TTVKEYDOWN = TV_KEYDOWN;
- PTVKEYDOWN = ^TV_KEYDOWN;
-
- TV_SORTCB = record
- hParent : HTREEITEM;
- lpfnCompare : PFNTVCOMPARE;
- lParam : LPARAM;
- end;
- LPTV_SORTCB = ^TV_SORTCB;
- _TV_SORTCB = TV_SORTCB;
- TTVSORTCB = TV_SORTCB;
- PTVSORTCB = ^TV_SORTCB;
-
- UDACCEL = record
- nSec : UINT;
- nInc : UINT;
- end;
- TUDACCEL = UDACCEL;
- PUDACCEL = ^UDACCEL;
-
-
- UNIVERSAL_NAME_INFO = record
- lpUniversalName : LPTSTR;
- end;
- _UNIVERSAL_NAME_INFO = UNIVERSAL_NAME_INFO;
- TUNIVERSALNAMEINFO = UNIVERSAL_NAME_INFO;
- PUNIVERSALNAMEINFO = ^UNIVERSAL_NAME_INFO;
-
- USEROBJECTFLAGS = record
- fInherit : WINBOOL;
- fReserved : WINBOOL;
- dwFlags : DWORD;
- end;
- tagUSEROBJECTFLAGS = USEROBJECTFLAGS;
- TUSEROBJECTFLAGS = USEROBJECTFLAGS;
- PUSEROBJECTFLAGS = ^USEROBJECTFLAGS;
-
- VALENT = record
- ve_valuename : LPTSTR;
- ve_valuelen : DWORD;
- ve_valueptr : DWORD;
- ve_type : DWORD;
- end;
- TVALENT = VALENT;
- PVALENT = ^VALENT;
-
- value_ent = VALENT;
- Tvalue_ent = VALENT;
- Pvalue_ent = ^VALENT;
-
- VERIFY_INFORMATION = record
- StartingOffset : LARGE_INTEGER;
- Length : DWORD;
- end;
- _VERIFY_INFORMATION = VERIFY_INFORMATION;
- TVERIFYINFORMATION = VERIFY_INFORMATION;
- PVERIFYINFORMATION = ^VERIFY_INFORMATION;
-
- VS_FIXEDFILEINFO = record
- dwSignature : DWORD;
- dwStrucVersion : DWORD;
- dwFileVersionMS : DWORD;
- dwFileVersionLS : DWORD;
- dwProductVersionMS : DWORD;
- dwProductVersionLS : DWORD;
- dwFileFlagsMask : DWORD;
- dwFileFlags : DWORD;
- dwFileOS : DWORD;
- dwFileType : DWORD;
- dwFileSubtype : DWORD;
- dwFileDateMS : DWORD;
- dwFileDateLS : DWORD;
- end;
- _VS_FIXEDFILEINFO = VS_FIXEDFILEINFO;
- TVSFIXEDFILEINFO = VS_FIXEDFILEINFO;
- PVSFIXEDFILEINFO = ^VS_FIXEDFILEINFO;
-
- WIN32_FIND_DATA = record
- dwFileAttributes : DWORD;
- ftCreationTime : FILETIME;
- ftLastAccessTime : FILETIME;
- ftLastWriteTime : FILETIME;
- nFileSizeHigh : DWORD;
- nFileSizeLow : DWORD;
- dwOID: DWORD;
- cFileName : array[0..MAX_PATH] of TCHAR;
- end;
- LPWIN32_FIND_DATA = ^WIN32_FIND_DATA;
- PWIN32_FIND_DATA = ^WIN32_FIND_DATA;
- _WIN32_FIND_DATA = WIN32_FIND_DATA;
- TWIN32FINDDATA = WIN32_FIND_DATA;
- TWIN32FINDDATAA = WIN32_FIND_DATA;
- PWIN32FINDDATA = ^WIN32_FIND_DATA;
-
- WIN32_FIND_DATAW = record
- dwFileAttributes : DWORD;
- ftCreationTime : FILETIME;
- ftLastAccessTime : FILETIME;
- ftLastWriteTime : FILETIME;
- nFileSizeHigh : DWORD;
- nFileSizeLow : DWORD;
- dwReserved0 : DWORD;
- dwReserved1 : DWORD;
- cFileName : array[0..(MAX_PATH)-1] of WCHAR;
- cAlternateFileName : array[0..13] of WCHAR;
- end;
- LPWIN32_FIND_DATAW = ^WIN32_FIND_DATAW;
- PWIN32_FIND_DATAW = ^WIN32_FIND_DATAW;
- _WIN32_FIND_DATAW = WIN32_FIND_DATAW;
- TWIN32FINDDATAW = WIN32_FIND_DATAW;
- PWIN32FINDDATAW = ^WIN32_FIND_DATAW;
-
- WIN32_STREAM_ID = record
- dwStreamId : DWORD;
- dwStreamAttributes : DWORD;
- Size : LARGE_INTEGER;
- dwStreamNameSize : DWORD;
- cStreamName : ^WCHAR;
- end;
- _WIN32_STREAM_ID = WIN32_STREAM_ID;
- TWIN32STREAMID = WIN32_STREAM_ID;
- PWIN32STREAMID = ^WIN32_STREAM_ID;
-
- WINDOWPLACEMENT = record
- length : UINT;
- flags : UINT;
- showCmd : UINT;
- ptMinPosition : POINT;
- ptMaxPosition : POINT;
- rcNormalPosition : RECT;
- end;
- _WINDOWPLACEMENT = WINDOWPLACEMENT;
- TWINDOWPLACEMENT = WINDOWPLACEMENT;
- PWINDOWPLACEMENT = ^WINDOWPLACEMENT;
-
- WNDCLASS = record
- style : UINT;
- lpfnWndProc : WNDPROC;
- cbClsExtra : longint;
- cbWndExtra : longint;
- hInstance : HANDLE;
- hIcon : HICON;
- hCursor : HCURSOR;
- hbrBackground : HBRUSH;
- lpszMenuName : LPCTSTR;
- lpszClassName : LPCTSTR;
- end;
- LPWNDCLASS = ^WNDCLASS;
- _WNDCLASS = WNDCLASS;
- TWNDCLASS = WNDCLASS;
- TWNDCLASSA = WNDCLASS;
- PWNDCLASS = ^WNDCLASS;
-
-
- WNDCLASSW = record
- style : UINT;
- lpfnWndProc : WNDPROC;
- cbClsExtra : longint;
- cbWndExtra : longint;
- hInstance : HANDLE;
- hIcon : HICON;
- hCursor : HCURSOR;
- hbrBackground : HBRUSH;
- lpszMenuName : LPCWSTR;
- lpszClassName : LPCWSTR;
- end;
- LPWNDCLASSW = ^WNDCLASSW;
- _WNDCLASSW = WNDCLASSW;
- TWNDCLASSW = WNDCLASSW;
- PWNDCLASSW = ^WNDCLASSW;
-
- WNDCLASSEX = record
- cbSize : UINT;
- style : UINT;
- lpfnWndProc : WNDPROC;
- cbClsExtra : longint;
- cbWndExtra : longint;
- hInstance : HANDLE;
- hIcon : HICON;
- hCursor : HCURSOR;
- hbrBackground : HBRUSH;
- lpszMenuName : LPCTSTR;
- lpszClassName : LPCTSTR;
- hIconSm : HANDLE;
- end;
- LPWNDCLASSEX = ^WNDCLASSEX;
- _WNDCLASSEX = WNDCLASSEX;
- TWNDCLASSEX = WNDCLASSEX;
- TWNDCLASSEXA = WNDCLASSEX;
- PWNDCLASSEX = ^WNDCLASSEX;
-
- WNDCLASSEXW = record
- cbSize : UINT;
- style : UINT;
- lpfnWndProc : WNDPROC;
- cbClsExtra : longint;
- cbWndExtra : longint;
- hInstance : HANDLE;
- hIcon : HICON;
- hCursor : HCURSOR;
- hbrBackground : HBRUSH;
- lpszMenuName : LPCWSTR;
- lpszClassName : LPCWSTR;
- hIconSm : HANDLE;
- end;
- LPWNDCLASSEXW = ^WNDCLASSEXW;
- _WNDCLASSEXW = WNDCLASSEXW;
- TWNDCLASSEXW = WNDCLASSEXW;
- PWNDCLASSEXW = ^WNDCLASSEXW;
-
- CONNECTDLGSTRUCT = record
- cbStructure : DWORD;
- hwndOwner : HWND;
- lpConnRes : LPNETRESOURCE;
- dwFlags : DWORD;
- dwDevNum : DWORD;
- end;
- LPCONNECTDLGSTRUCT = ^CONNECTDLGSTRUCT;
- _CONNECTDLGSTRUCT = CONNECTDLGSTRUCT;
- TCONNECTDLGSTRUCT = CONNECTDLGSTRUCT;
- PCONNECTDLGSTRUCT = ^CONNECTDLGSTRUCT;
-
- CONNECTDLGSTRUCTW = record //+winnetwk
- cbStructure : DWORD;
- hwndOwner : HWND;
- lpConnRes : LPNETRESOURCEW;
- dwFlags : DWORD;
- dwDevNum : DWORD;
- end;
- LPCONNECTDLGSTRUCTW = ^CONNECTDLGSTRUCTW; //+winnetwk
- _CONNECTDLGSTRUCTW = CONNECTDLGSTRUCTW; //+winnetwk
-
- DISCDLGSTRUCT = record
- cbStructure : DWORD;
- hwndOwner : HWND;
- lpLocalName : LPTSTR;
- lpRemoteName : LPTSTR;
- dwFlags : DWORD;
- end;
- LPDISCDLGSTRUCT = ^DISCDLGSTRUCT;
- _DISCDLGSTRUCT = DISCDLGSTRUCT;
- TDISCDLGSTRUCT = DISCDLGSTRUCT;
- TDISCDLGSTRUCTA = DISCDLGSTRUCT;
- PDISCDLGSTRUCT = ^DISCDLGSTRUCT;
-
- DISCDLGSTRUCTW = record //+winnetwk
- cbStructure : DWORD;
- hwndOwner : HWND;
- lpLocalName : LPWSTR;
- lpRemoteName : LPWSTR;
- dwFlags : DWORD;
- end;
- LPDISCDLGSTRUCTW = ^DISCDLGSTRUCTW; //+winnetwk
- _DISCDLGSTRUCTW = DISCDLGSTRUCTW; //+winnetwk
-
- NETINFOSTRUCT = record
- cbStructure : DWORD;
- dwProviderVersion : DWORD;
- dwStatus : DWORD;
- dwCharacteristics : DWORD;
- dwHandle : DWORD;
- wNetType : WORD;
- dwPrinters : DWORD;
- dwDrives : DWORD;
- end;
- LPNETINFOSTRUCT = ^NETINFOSTRUCT;
- _NETINFOSTRUCT = NETINFOSTRUCT;
- TNETINFOSTRUCT = NETINFOSTRUCT;
- PNETINFOSTRUCT = ^NETINFOSTRUCT;
-
- NETCONNECTINFOSTRUCT = record
- cbStructure : DWORD;
- dwFlags : DWORD;
- dwSpeed : DWORD;
- dwDelay : DWORD;
- dwOptDataSize : DWORD;
- end;
- LPNETCONNECTINFOSTRUCT = ^NETCONNECTINFOSTRUCT;
- _NETCONNECTINFOSTRUCT = NETCONNECTINFOSTRUCT;
- TNETCONNECTINFOSTRUCT = NETCONNECTINFOSTRUCT;
- PNETCONNECTINFOSTRUCT = ^NETCONNECTINFOSTRUCT;
-
- ENUMMETAFILEPROC = function (_para1:HDC; _para2:HANDLETABLE; _para3:METARECORD; _para4:longint; _para5:LPARAM):longint;stdcall;
-
- ENHMETAFILEPROC = function (_para1:HDC; _para2:HANDLETABLE; _para3:ENHMETARECORD; _para4:longint; _para5:LPARAM):longint;stdcall;
-
- ENUMFONTSPROC = function (_para1:LPLOGFONT; _para2:LPTEXTMETRIC; _para3:DWORD; _para4:LPARAM):longint;stdcall;
-
- FONTENUMPROC = function (var _para1:ENUMLOGFONT; var _para2:NEWTEXTMETRIC; _para3:longint; _para4:LPARAM):longint;stdcall;
-
- FONTENUMEXPROC = function (var _para1:ENUMLOGFONTEX;var _para2:NEWTEXTMETRICEX; _para3:longint; _para4:LPARAM):longint;stdcall;
-
- LPOVERLAPPED_COMPLETION_ROUTINE = procedure (_para1:DWORD; _para2:DWORD; _para3:LPOVERLAPPED);stdcall;
-
- { Structures for the extensions to OpenGL }
-
- POINTFLOAT = record
- x : Single;
- y : Single;
- end;
- _POINTFLOAT = POINTFLOAT;
- TPOINTFLOAT = POINTFLOAT;
- PPOINTFLOAT = ^POINTFLOAT;
-
- GLYPHMETRICSFLOAT = record
- gmfBlackBoxX : Single;
- gmfBlackBoxY : Single;
- gmfptGlyphOrigin : POINTFLOAT;
- gmfCellIncX : Single;
- gmfCellIncY : Single;
- end;
- LPGLYPHMETRICSFLOAT = ^GLYPHMETRICSFLOAT;
- _GLYPHMETRICSFLOAT = GLYPHMETRICSFLOAT;
- TGLYPHMETRICSFLOAT = GLYPHMETRICSFLOAT;
- PGLYPHMETRICSFLOAT = ^GLYPHMETRICSFLOAT;
-
- LAYERPLANEDESCRIPTOR = record
- nSize : WORD;
- nVersion : WORD;
- dwFlags : DWORD;
- iPixelType : BYTE;
- cColorBits : BYTE;
- cRedBits : BYTE;
- cRedShift : BYTE;
- cGreenBits : BYTE;
- cGreenShift : BYTE;
- cBlueBits : BYTE;
- cBlueShift : BYTE;
- cAlphaBits : BYTE;
- cAlphaShift : BYTE;
- cAccumBits : BYTE;
- cAccumRedBits : BYTE;
- cAccumGreenBits : BYTE;
- cAccumBlueBits : BYTE;
- cAccumAlphaBits : BYTE;
- cDepthBits : BYTE;
- cStencilBits : BYTE;
- cAuxBuffers : BYTE;
- iLayerPlane : BYTE;
- bReserved : BYTE;
- crTransparent : COLORREF;
- end;
- LPLAYERPLANEDESCRIPTOR = ^LAYERPLANEDESCRIPTOR;
- tagLAYERPLANEDESCRIPTOR = LAYERPLANEDESCRIPTOR;
- TLAYERPLANEDESCRIPTOR = LAYERPLANEDESCRIPTOR;
- PLAYERPLANEDESCRIPTOR = ^LAYERPLANEDESCRIPTOR;
-
- PIXELFORMATDESCRIPTOR = record
- nSize : WORD;
- nVersion : WORD;
- dwFlags : DWORD;
- iPixelType : BYTE;
- cColorBits : BYTE;
- cRedBits : BYTE;
- cRedShift : BYTE;
- cGreenBits : BYTE;
- cGreenShift : BYTE;
- cBlueBits : BYTE;
- cBlueShift : BYTE;
- cAlphaBits : BYTE;
- cAlphaShift : BYTE;
- cAccumBits : BYTE;
- cAccumRedBits : BYTE;
- cAccumGreenBits : BYTE;
- cAccumBlueBits : BYTE;
- cAccumAlphaBits : BYTE;
- cDepthBits : BYTE;
- cStencilBits : BYTE;
- cAuxBuffers : BYTE;
- iLayerType : BYTE;
- bReserved : BYTE;
- dwLayerMask : DWORD;
- dwVisibleMask : DWORD;
- dwDamageMask : DWORD;
- end;
- LPPIXELFORMATDESCRIPTOR = ^PIXELFORMATDESCRIPTOR;
- tagPIXELFORMATDESCRIPTOR = PIXELFORMATDESCRIPTOR;
- TPIXELFORMATDESCRIPTOR = PIXELFORMATDESCRIPTOR;
- PPIXELFORMATDESCRIPTOR = ^PIXELFORMATDESCRIPTOR;
-
- USER_INFO_2 = record
- usri2_name : LPWSTR;
- usri2_password : LPWSTR;
- usri2_password_age : DWORD;
- usri2_priv : DWORD;
- usri2_home_dir : LPWSTR;
- usri2_comment : LPWSTR;
- usri2_flags : DWORD;
- usri2_script_path : LPWSTR;
- usri2_auth_flags : DWORD;
- usri2_full_name : LPWSTR;
- usri2_usr_comment : LPWSTR;
- usri2_parms : LPWSTR;
- usri2_workstations : LPWSTR;
- usri2_last_logon : DWORD;
- usri2_last_logoff : DWORD;
- usri2_acct_expires : DWORD;
- usri2_max_storage : DWORD;
- usri2_units_per_week : DWORD;
- usri2_logon_hours : PBYTE;
- usri2_bad_pw_count : DWORD;
- usri2_num_logons : DWORD;
- usri2_logon_server : LPWSTR;
- usri2_country_code : DWORD;
- usri2_code_page : DWORD;
- end;
- PUSER_INFO_2 = ^USER_INFO_2;
- LPUSER_INFO_2 = ^USER_INFO_2;
- TUSERINFO2 = USER_INFO_2;
- PUSERINFO2 = ^USER_INFO_2;
-
- USER_INFO_0 = record
- usri0_name : LPWSTR;
- end;
- PUSER_INFO_0 = ^USER_INFO_0;
- LPUSER_INFO_0 = ^USER_INFO_0;
- TUSERINFO0 = USER_INFO_0;
- PUSERINFO0 = ^USER_INFO_0;
-
- USER_INFO_3 = record
- usri3_name : LPWSTR;
- usri3_password : LPWSTR;
- usri3_password_age : DWORD;
- usri3_priv : DWORD;
- usri3_home_dir : LPWSTR;
- usri3_comment : LPWSTR;
- usri3_flags : DWORD;
- usri3_script_path : LPWSTR;
- usri3_auth_flags : DWORD;
- usri3_full_name : LPWSTR;
- usri3_usr_comment : LPWSTR;
- usri3_parms : LPWSTR;
- usri3_workstations : LPWSTR;
- usri3_last_logon : DWORD;
- usri3_last_logoff : DWORD;
- usri3_acct_expires : DWORD;
- usri3_max_storage : DWORD;
- usri3_units_per_week : DWORD;
- usri3_logon_hours : PBYTE;
- usri3_bad_pw_count : DWORD;
- usri3_num_logons : DWORD;
- usri3_logon_server : LPWSTR;
- usri3_country_code : DWORD;
- usri3_code_page : DWORD;
- usri3_user_id : DWORD;
- usri3_primary_group_id : DWORD;
- usri3_profile : LPWSTR;
- usri3_home_dir_drive : LPWSTR;
- usri3_password_expired : DWORD;
- end;
- PUSER_INFO_3 = ^USER_INFO_3;
- LPUSER_INFO_3 = ^USER_INFO_3;
- TUSERINFO3 = USER_INFO_3;
- PUSERINFO3 = ^USER_INFO_3;
-
- GROUP_INFO_2 = record
- grpi2_name : LPWSTR;
- grpi2_comment : LPWSTR;
- grpi2_group_id : DWORD;
- grpi2_attributes : DWORD;
- end;
- PGROUP_INFO_2 = ^GROUP_INFO_2;
- TGROUPINFO2 = GROUP_INFO_2;
- PGROUPINFO2 = ^GROUP_INFO_2;
-
- LOCALGROUP_INFO_0 = record
- lgrpi0_name : LPWSTR;
- end;
- PLOCALGROUP_INFO_0 = ^LOCALGROUP_INFO_0;
- LPLOCALGROUP_INFO_0 = ^LOCALGROUP_INFO_0;
- TLOCALGROUPINFO0 = LOCALGROUP_INFO_0;
- PLOCALGROUPINFO0 = ^LOCALGROUP_INFO_0;
-
- { PE executable header. }
- { Magic number, 0x5a4d }
- { Bytes on last page of file, 0x90 }
- { Pages in file, 0x3 }
- { Relocations, 0x0 }
- { Size of header in paragraphs, 0x4 }
- { Minimum extra paragraphs needed, 0x0 }
- { Maximum extra paragraphs needed, 0xFFFF }
- { Initial (relative) SS value, 0x0 }
- { Initial SP value, 0xb8 }
- { Checksum, 0x0 }
- { Initial IP value, 0x0 }
- { Initial (relative) CS value, 0x0 }
- { File address of relocation table, 0x40 }
- { Overlay number, 0x0 }
- { Reserved words, all 0x0 }
- { OEM identifier (for e_oeminfo), 0x0 }
- { OEM information; e_oemid specific, 0x0 }
- { Reserved words, all 0x0 }
- { File address of new exe header, 0x80 }
- { We leave out the next two fields, since they aren't in the header file }
- { DWORD dos_message[16]; text which always follows dos header }
- { DWORD nt_signature; required NT signature, 0x4550 }
-
- IMAGE_DOS_HEADER = record
- e_magic : WORD;
- e_cblp : WORD;
- e_cp : WORD;
- e_crlc : WORD;
- e_cparhdr : WORD;
- e_minalloc : WORD;
- e_maxalloc : WORD;
- e_ss : WORD;
- e_sp : WORD;
- e_csum : WORD;
- e_ip : WORD;
- e_cs : WORD;
- e_lfarlc : WORD;
- e_ovno : WORD;
- e_res : array[0..3] of WORD;
- e_oemid : WORD;
- e_oeminfo : WORD;
- e_res2 : array[0..9] of WORD;
- e_lfanew : LONG;
- end;
- PIMAGE_DOS_HEADER = ^IMAGE_DOS_HEADER;
- TIMAGEDOSHEADER = IMAGE_DOS_HEADER;
- PIMAGEDOSHEADER = ^IMAGE_DOS_HEADER;
-
- _NOTIFYICONDATAA = record
- cbSize: DWORD;
- Wnd: HWND;
- uID: UINT;
- uFlags: UINT;
- uCallbackMessage: UINT;
- hIcon: HICON;
- szTip: array [0..63] of Char;
- end;
- _NOTIFYICONDATA = _NOTIFYICONDATAA;
-
- _NOTIFYICONDATAW = record
- cbSize: DWORD;
- Wnd: HWND;
- uID: UINT;
- uFlags: UINT;
- uCallbackMessage: UINT;
- hIcon: HICON;
- szTip: array [0..63] of Word;
- end;
- TNotifyIconDataA = _NOTIFYICONDATAA;
- TNotifyIconDataW = _NOTIFYICONDATAW;
- TNotifyIconData = TNotifyIconDataA;
- NOTIFYICONDATAA = _NOTIFYICONDATAA;
- NOTIFYICONDATAW = _NOTIFYICONDATAW;
- NOTIFYICONDATA = NOTIFYICONDATAA;
- PNotifyIconDataA = ^TNotifyIconDataA;
- PNotifyIconDataW = ^TNotifyIconDataW;
- PNotifyIconData = PNotifyIconDataA;
-
- TWOHandleArray = array[0..MAXIMUM_WAIT_OBJECTS-1] of HANDLE;
- PWOHandleArray = ^TWOHandleArray;
-
- MMRESULT = Longint;
-
-type
- PWaveFormatEx = ^TWaveFormatEx;
- TWaveFormatEx = packed record
- wFormatTag: Word; { format type }
- nChannels: Word; { number of channels (i.e. mono, stereo, etc.) }
- nSamplesPerSec: DWORD; { sample rate }
- nAvgBytesPerSec: DWORD; { for buffer estimation }
- nBlockAlign: Word; { block size of data }
- wBitsPerSample: Word; { number of bits per sample of mono data }
- cbSize: Word; { the count in bytes of the size of }
- end;
-
- _WIN32_FILE_ATTRIBUTE_DATA = packed record
- dwFileAttributes: DWORD;
- ftCreationTime: FILETIME;
- ftLastAccessTime: FILETIME;
- ftLastWriteTime: FILETIME;
- nFileSizeHigh: DWORD;
- nFileSizeLow: DWORD;
- end;
- WIN32_FILE_ATTRIBUTE_DATA = _WIN32_FILE_ATTRIBUTE_DATA ;
- LPWIN32_FILE_ATTRIBUTE_DATA = ^_WIN32_FILE_ATTRIBUTE_DATA;
- TWIN32FILEATTRIBUTEDATA = _WIN32_FILE_ATTRIBUTE_DATA ;
- PWIN32FILEATTRIBUTEDATA = ^_WIN32_FILE_ATTRIBUTE_DATA;
-
- // TrackMouseEvent. NT or higher only.
- TTrackMouseEvent = Record
- cbSize : DWORD;
- dwFlags : DWORD;
- hwndTrack : HWND;
- dwHoverTime : DWORD;
- end;
- PTrackMouseEvent = ^TTrackMouseEvent;
-
-{$endif read_interface}
-
-
-{$ifdef read_implementation}
-
- function fBinary(var a : DCB) : DWORD;
- begin
- fBinary:=(a.flags and bm_DCB_fBinary) shr bp_DCB_fBinary;
- end;
-
- procedure set_fBinary(var a : DCB; __fBinary : DWORD);
- begin
- a.flags:=a.flags or ((__fBinary shl bp_DCB_fBinary) and bm_DCB_fBinary);
- end;
-
- function fParity(var a : DCB) : DWORD;
- begin
- fParity:=(a.flags and bm_DCB_fParity) shr bp_DCB_fParity;
- end;
-
- procedure set_fParity(var a : DCB; __fParity : DWORD);
- begin
- a.flags:=a.flags or ((__fParity shl bp_DCB_fParity) and bm_DCB_fParity);
- end;
-
- function fOutxCtsFlow(var a : DCB) : DWORD;
- begin
- fOutxCtsFlow:=(a.flags and bm_DCB_fOutxCtsFlow) shr bp_DCB_fOutxCtsFlow;
- end;
-
- procedure set_fOutxCtsFlow(var a : DCB; __fOutxCtsFlow : DWORD);
- begin
- a.flags:=a.flags or ((__fOutxCtsFlow shl bp_DCB_fOutxCtsFlow) and bm_DCB_fOutxCtsFlow);
- end;
-
- function fOutxDsrFlow(var a : DCB) : DWORD;
- begin
- fOutxDsrFlow:=(a.flags and bm_DCB_fOutxDsrFlow) shr bp_DCB_fOutxDsrFlow;
- end;
-
- procedure set_fOutxDsrFlow(var a : DCB; __fOutxDsrFlow : DWORD);
- begin
- a.flags:=a.flags or ((__fOutxDsrFlow shl bp_DCB_fOutxDsrFlow) and bm_DCB_fOutxDsrFlow);
- end;
-
- function fDtrControl(var a : DCB) : DWORD;
- begin
- fDtrControl:=(a.flags and bm_DCB_fDtrControl) shr bp_DCB_fDtrControl;
- end;
-
- procedure set_fDtrControl(var a : DCB; __fDtrControl : DWORD);
- begin
- a.flags:=a.flags or ((__fDtrControl shl bp_DCB_fDtrControl) and bm_DCB_fDtrControl);
- end;
-
- function fDsrSensitivity(var a : DCB) : DWORD;
- begin
- fDsrSensitivity:=(a.flags and bm_DCB_fDsrSensitivity) shr bp_DCB_fDsrSensitivity;
- end;
-
- procedure set_fDsrSensitivity(var a : DCB; __fDsrSensitivity : DWORD);
- begin
- a.flags:=a.flags or ((__fDsrSensitivity shl bp_DCB_fDsrSensitivity) and bm_DCB_fDsrSensitivity);
- end;
-
- function fTXContinueOnXoff(var a : DCB) : DWORD;
- begin
- fTXContinueOnXoff:=(a.flags and bm_DCB_fTXContinueOnXoff) shr bp_DCB_fTXContinueOnXoff;
- end;
-
- procedure set_fTXContinueOnXoff(var a : DCB; __fTXContinueOnXoff : DWORD);
- begin
- a.flags:=a.flags or ((__fTXContinueOnXoff shl bp_DCB_fTXContinueOnXoff) and bm_DCB_fTXContinueOnXoff);
- end;
-
- function fOutX(var a : DCB) : DWORD;
- begin
- fOutX:=(a.flags and bm_DCB_fOutX) shr bp_DCB_fOutX;
- end;
-
- procedure set_fOutX(var a : DCB; __fOutX : DWORD);
- begin
- a.flags:=a.flags or ((__fOutX shl bp_DCB_fOutX) and bm_DCB_fOutX);
- end;
-
- function fInX(var a : DCB) : DWORD;
- begin
- fInX:=(a.flags and bm_DCB_fInX) shr bp_DCB_fInX;
- end;
-
- procedure set_fInX(var a : DCB; __fInX : DWORD);
- begin
- a.flags:=a.flags or ((__fInX shl bp_DCB_fInX) and bm_DCB_fInX);
- end;
-
- function fErrorChar(var a : DCB) : DWORD;
- begin
- fErrorChar:=(a.flags and bm_DCB_fErrorChar) shr bp_DCB_fErrorChar;
- end;
-
- procedure set_fErrorChar(var a : DCB; __fErrorChar : DWORD);
- begin
- a.flags:=a.flags or ((__fErrorChar shl bp_DCB_fErrorChar) and bm_DCB_fErrorChar);
- end;
-
- function fNull(var a : DCB) : DWORD;
- begin
- fNull:=(a.flags and bm_DCB_fNull) shr bp_DCB_fNull;
- end;
-
- procedure set_fNull(var a : DCB; __fNull : DWORD);
- begin
- a.flags:=a.flags or ((__fNull shl bp_DCB_fNull) and bm_DCB_fNull);
- end;
-
- function fRtsControl(var a : DCB) : DWORD;
- begin
- fRtsControl:=(a.flags and bm_DCB_fRtsControl) shr bp_DCB_fRtsControl;
- end;
-
- procedure set_fRtsControl(var a : DCB; __fRtsControl : DWORD);
- begin
- a.flags:=a.flags or ((__fRtsControl shl bp_DCB_fRtsControl) and bm_DCB_fRtsControl);
- end;
-
- function fAbortOnError(var a : DCB) : DWORD;
- begin
- fAbortOnError:=(a.flags and bm_DCB_fAbortOnError) shr bp_DCB_fAbortOnError;
- end;
-
- procedure set_fAbortOnError(var a : DCB; __fAbortOnError : DWORD);
- begin
- a.flags:=a.flags or ((__fAbortOnError shl bp_DCB_fAbortOnError) and bm_DCB_fAbortOnError);
- end;
-
- function fDummy2(var a : DCB) : DWORD;
- begin
- fDummy2:=(a.flags and bm_DCB_fDummy2) shr bp_DCB_fDummy2;
- end;
-
- procedure set_fDummy2(var a : DCB; __fDummy2 : DWORD);
- begin
- a.flags:=a.flags or ((__fDummy2 shl bp_DCB_fDummy2) and bm_DCB_fDummy2);
- end;
-
- function fCtsHold(var a : COMSTAT) : DWORD;
- begin
- fCtsHold:=(a.flag0 and bm_COMSTAT_fCtsHold) shr bp_COMSTAT_fCtsHold;
- end;
-
- procedure set_fCtsHold(var a : COMSTAT; __fCtsHold : DWORD);
- begin
- a.flag0:=a.flag0 or ((__fCtsHold shl bp_COMSTAT_fCtsHold) and bm_COMSTAT_fCtsHold);
- end;
-
- function fDsrHold(var a : COMSTAT) : DWORD;
- begin
- fDsrHold:=(a.flag0 and bm_COMSTAT_fDsrHold) shr bp_COMSTAT_fDsrHold;
- end;
-
- procedure set_fDsrHold(var a : COMSTAT; __fDsrHold : DWORD);
- begin
- a.flag0:=a.flag0 or ((__fDsrHold shl bp_COMSTAT_fDsrHold) and bm_COMSTAT_fDsrHold);
- end;
-
- function fRlsdHold(var a : COMSTAT) : DWORD;
- begin
- fRlsdHold:=(a.flag0 and bm_COMSTAT_fRlsdHold) shr bp_COMSTAT_fRlsdHold;
- end;
-
- procedure set_fRlsdHold(var a : COMSTAT; __fRlsdHold : DWORD);
- begin
- a.flag0:=a.flag0 or ((__fRlsdHold shl bp_COMSTAT_fRlsdHold) and bm_COMSTAT_fRlsdHold);
- end;
-
- function fXoffHold(var a : COMSTAT) : DWORD;
- begin
- fXoffHold:=(a.flag0 and bm_COMSTAT_fXoffHold) shr bp_COMSTAT_fXoffHold;
- end;
-
- procedure set_fXoffHold(var a : COMSTAT; __fXoffHold : DWORD);
- begin
- a.flag0:=a.flag0 or ((__fXoffHold shl bp_COMSTAT_fXoffHold) and bm_COMSTAT_fXoffHold);
- end;
-
- function fXoffSent(var a : COMSTAT) : DWORD;
- begin
- fXoffSent:=(a.flag0 and bm_COMSTAT_fXoffSent) shr bp_COMSTAT_fXoffSent;
- end;
-
- procedure set_fXoffSent(var a : COMSTAT; __fXoffSent : DWORD);
- begin
- a.flag0:=a.flag0 or ((__fXoffSent shl bp_COMSTAT_fXoffSent) and bm_COMSTAT_fXoffSent);
- end;
-
- function fEof(var a : COMSTAT) : DWORD;
- begin
- fEof:=(a.flag0 and bm_COMSTAT_fEof) shr bp_COMSTAT_fEof;
- end;
-
- procedure set_fEof(var a : COMSTAT; __fEof : DWORD);
- begin
- a.flag0:=a.flag0 or ((__fEof shl bp_COMSTAT_fEof) and bm_COMSTAT_fEof);
- end;
-
- function fTxim(var a : COMSTAT) : DWORD;
- begin
- fTxim:=(a.flag0 and bm_COMSTAT_fTxim) shr bp_COMSTAT_fTxim;
- end;
-
- procedure set_fTxim(var a : COMSTAT; __fTxim : DWORD);
- begin
- a.flag0:=a.flag0 or ((__fTxim shl bp_COMSTAT_fTxim) and bm_COMSTAT_fTxim);
- end;
-
- function fReserved(var a : COMSTAT) : DWORD;
- begin
- fReserved:=(a.flag0 and bm_COMSTAT_fReserved) shr bp_COMSTAT_fReserved;
- end;
-
- procedure set_fReserved(var a : COMSTAT; __fReserved : DWORD);
- begin
- a.flag0:=a.flag0 or ((__fReserved shl bp_COMSTAT_fReserved) and bm_COMSTAT_fReserved);
- end;
-
- function bAppReturnCode(var a : DDEACK) : word;
- begin
- bAppReturnCode:=(a.flag0 and bm_DDEACK_bAppReturnCode) shr bp_DDEACK_bAppReturnCode;
- end;
-
- procedure set_bAppReturnCode(var a : DDEACK; __bAppReturnCode : word);
- begin
- a.flag0:=a.flag0 or ((__bAppReturnCode shl bp_DDEACK_bAppReturnCode) and bm_DDEACK_bAppReturnCode);
- end;
-
- function reserved(var a : DDEACK) : word;
- begin
- reserved:=(a.flag0 and bm_DDEACK_reserved) shr bp_DDEACK_reserved;
- end;
-
- procedure set_reserved(var a : DDEACK; __reserved : word);
- begin
- a.flag0:=a.flag0 or ((__reserved shl bp_DDEACK_reserved) and bm_DDEACK_reserved);
- end;
-
- function fBusy(var a : DDEACK) : word;
- begin
- fBusy:=(a.flag0 and bm_DDEACK_fBusy) shr bp_DDEACK_fBusy;
- end;
-
- procedure set_fBusy(var a : DDEACK; __fBusy : word);
- begin
- a.flag0:=a.flag0 or ((__fBusy shl bp_DDEACK_fBusy) and bm_DDEACK_fBusy);
- end;
-
- function fAck(var a : DDEACK) : word;
- begin
- fAck:=(a.flag0 and bm_DDEACK_fAck) shr bp_DDEACK_fAck;
- end;
-
- procedure set_fAck(var a : DDEACK; __fAck : word);
- begin
- a.flag0:=a.flag0 or ((__fAck shl bp_DDEACK_fAck) and bm_DDEACK_fAck);
- end;
-
- function reserved(var a : DDEADVISE) : word;
- begin
- reserved:=(a.flag0 and bm_DDEADVISE_reserved) shr bp_DDEADVISE_reserved;
- end;
-
- procedure set_reserved(var a : DDEADVISE; __reserved : word);
- begin
- a.flag0:=a.flag0 or ((__reserved shl bp_DDEADVISE_reserved) and bm_DDEADVISE_reserved);
- end;
-
- function fDeferUpd(var a : DDEADVISE) : word;
- begin
- fDeferUpd:=(a.flag0 and bm_DDEADVISE_fDeferUpd) shr bp_DDEADVISE_fDeferUpd;
- end;
-
- procedure set_fDeferUpd(var a : DDEADVISE; __fDeferUpd : word);
- begin
- a.flag0:=a.flag0 or ((__fDeferUpd shl bp_DDEADVISE_fDeferUpd) and bm_DDEADVISE_fDeferUpd);
- end;
-
- function fAckReq(var a : DDEADVISE) : word;
- begin
- fAckReq:=(a.flag0 and bm_DDEADVISE_fAckReq) shr bp_DDEADVISE_fAckReq;
- end;
-
- procedure set_fAckReq(var a : DDEADVISE; __fAckReq : word);
- begin
- a.flag0:=a.flag0 or ((__fAckReq shl bp_DDEADVISE_fAckReq) and bm_DDEADVISE_fAckReq);
- end;
-
- function unused(var a : DDEDATA) : word;
- begin
- unused:=(a.flag0 and bm_DDEDATA_unused) shr bp_DDEDATA_unused;
- end;
-
- procedure set_unused(var a : DDEDATA; __unused : word);
- begin
- a.flag0:=a.flag0 or ((__unused shl bp_DDEDATA_unused) and bm_DDEDATA_unused);
- end;
-
- function fResponse(var a : DDEDATA) : word;
- begin
- fResponse:=(a.flag0 and bm_DDEDATA_fResponse) shr bp_DDEDATA_fResponse;
- end;
-
- procedure set_fResponse(var a : DDEDATA; __fResponse : word);
- begin
- a.flag0:=a.flag0 or ((__fResponse shl bp_DDEDATA_fResponse) and bm_DDEDATA_fResponse);
- end;
-
- function fRelease(var a : DDEDATA) : word;
- begin
- fRelease:=(a.flag0 and bm_DDEDATA_fRelease) shr bp_DDEDATA_fRelease;
- end;
-
- procedure set_fRelease(var a : DDEDATA; __fRelease : word);
- begin
- a.flag0:=a.flag0 or ((__fRelease shl bp_DDEDATA_fRelease) and bm_DDEDATA_fRelease);
- end;
-
- function reserved(var a : DDEDATA) : word;
- begin
- reserved:=(a.flag0 and bm_DDEDATA_reserved) shr bp_DDEDATA_reserved;
- end;
-
- procedure set_reserved(var a : DDEDATA; __reserved : word);
- begin
- a.flag0:=a.flag0 or ((__reserved shl bp_DDEDATA_reserved) and bm_DDEDATA_reserved);
- end;
-
- function fAckReq(var a : DDEDATA) : word;
- begin
- fAckReq:=(a.flag0 and bm_DDEDATA_fAckReq) shr bp_DDEDATA_fAckReq;
- end;
-
- procedure set_fAckReq(var a : DDEDATA; __fAckReq : word);
- begin
- a.flag0:=a.flag0 or ((__fAckReq shl bp_DDEDATA_fAckReq) and bm_DDEDATA_fAckReq);
- end;
-
- function unused(var a : DDELN) : word;
- begin
- unused:=(a.flag0 and bm_DDELN_unused) shr bp_DDELN_unused;
- end;
-
- procedure set_unused(var a : DDELN; __unused : word);
- begin
- a.flag0:=a.flag0 or ((__unused shl bp_DDELN_unused) and bm_DDELN_unused);
- end;
-
- function fRelease(var a : DDELN) : word;
- begin
- fRelease:=(a.flag0 and bm_DDELN_fRelease) shr bp_DDELN_fRelease;
- end;
-
- procedure set_fRelease(var a : DDELN; __fRelease : word);
- begin
- a.flag0:=a.flag0 or ((__fRelease shl bp_DDELN_fRelease) and bm_DDELN_fRelease);
- end;
-
- function fDeferUpd(var a : DDELN) : word;
- begin
- fDeferUpd:=(a.flag0 and bm_DDELN_fDeferUpd) shr bp_DDELN_fDeferUpd;
- end;
-
- procedure set_fDeferUpd(var a : DDELN; __fDeferUpd : word);
- begin
- a.flag0:=a.flag0 or ((__fDeferUpd shl bp_DDELN_fDeferUpd) and bm_DDELN_fDeferUpd);
- end;
-
- function fAckReq(var a : DDELN) : word;
- begin
- fAckReq:=(a.flag0 and bm_DDELN_fAckReq) shr bp_DDELN_fAckReq;
- end;
-
- procedure set_fAckReq(var a : DDELN; __fAckReq : word);
- begin
- a.flag0:=a.flag0 or ((__fAckReq shl bp_DDELN_fAckReq) and bm_DDELN_fAckReq);
- end;
-
- function unused(var a : DDEPOKE) : word;
- begin
- unused:=(a.flag0 and bm_DDEPOKE_unused) shr bp_DDEPOKE_unused;
- end;
-
- procedure set_unused(var a : DDEPOKE; __unused : word);
- begin
- a.flag0:=a.flag0 or ((__unused shl bp_DDEPOKE_unused) and bm_DDEPOKE_unused);
- end;
-
- function fRelease(var a : DDEPOKE) : word;
- begin
- fRelease:=(a.flag0 and bm_DDEPOKE_fRelease) shr bp_DDEPOKE_fRelease;
- end;
-
- procedure set_fRelease(var a : DDEPOKE; __fRelease : word);
- begin
- a.flag0:=a.flag0 or ((__fRelease shl bp_DDEPOKE_fRelease) and bm_DDEPOKE_fRelease);
- end;
-
- function fReserved(var a : DDEPOKE) : word;
- begin
- fReserved:=(a.flag0 and bm_DDEPOKE_fReserved) shr bp_DDEPOKE_fReserved;
- end;
-
- procedure set_fReserved(var a : DDEPOKE; __fReserved : word);
- begin
- a.flag0:=a.flag0 or ((__fReserved shl bp_DDEPOKE_fReserved) and bm_DDEPOKE_fReserved);
- end;
-
- function unused(var a : DDEUP) : word;
- begin
- unused:=(a.flag0 and bm_DDEUP_unused) shr bp_DDEUP_unused;
- end;
-
- procedure set_unused(var a : DDEUP; __unused : word);
- begin
- a.flag0:=a.flag0 or ((__unused shl bp_DDEUP_unused) and bm_DDEUP_unused);
- end;
-
- function fAck(var a : DDEUP) : word;
- begin
- fAck:=(a.flag0 and bm_DDEUP_fAck) shr bp_DDEUP_fAck;
- end;
-
- procedure set_fAck(var a : DDEUP; __fAck : word);
- begin
- a.flag0:=a.flag0 or ((__fAck shl bp_DDEUP_fAck) and bm_DDEUP_fAck);
- end;
-
- function fRelease(var a : DDEUP) : word;
- begin
- fRelease:=(a.flag0 and bm_DDEUP_fRelease) shr bp_DDEUP_fRelease;
- end;
-
- procedure set_fRelease(var a : DDEUP; __fRelease : word);
- begin
- a.flag0:=a.flag0 or ((__fRelease shl bp_DDEUP_fRelease) and bm_DDEUP_fRelease);
- end;
-
- function fReserved(var a : DDEUP) : word;
- begin
- fReserved:=(a.flag0 and bm_DDEUP_fReserved) shr bp_DDEUP_fReserved;
- end;
-
- procedure set_fReserved(var a : DDEUP; __fReserved : word);
- begin
- a.flag0:=a.flag0 or ((__fReserved shl bp_DDEUP_fReserved) and bm_DDEUP_fReserved);
- end;
-
- function fAckReq(var a : DDEUP) : word;
- begin
- fAckReq:=(a.flag0 and bm_DDEUP_fAckReq) shr bp_DDEUP_fAckReq;
- end;
-
- procedure set_fAckReq(var a : DDEUP; __fAckReq : word);
- begin
- a.flag0:=a.flag0 or ((__fAckReq shl bp_DDEUP_fAckReq) and bm_DDEUP_fAckReq);
- end;
-
-{$endif read_implementation}
-
diff --git a/rtl/wince/wininc/unidef.inc b/rtl/wince/wininc/unidef.inc deleted file mode 100644 index 9298b9a904..0000000000 --- a/rtl/wince/wininc/unidef.inc +++ /dev/null @@ -1,592 +0,0 @@ -{
- This file is part of the Free Pascal run time library.
- Copyright (c) 1999-2000 by the Free Pascal development team.
-
- Contains the Unicode functions for windows unit
-
- 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.
-
- **********************************************************************}
-
-{
- UnicodeFunctions.h
-
- Declarations for all the Windows32 API Unicode Functions
-
- Copyright (C) 1996 Free Software Foundation, Inc.
-
- Author: Scott Christley <scottc@net-community.com>
- Date: 1996
-
- This file is part of the Windows32 API Library.
-
- This library is free software; you can redistribute it and/or
- modify it under the terms of the GNU Library General Public
- License as published by the Free Software Foundation; either
- version 2 of the License, or (at your option) any later version.
-
- This library is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- Library General Public License for more details.
-
- If you are interested in a warranty or support for this source code,
- contact Scott Christley <scottc@net-community.com> for more information.
-
- You should have received a copy of the GNU Library General Public
- License along with this library; see the file COPYING.LIB.
- If not, write to the Free Software Foundation,
- 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
- Changes :
-
- 08/22/2005 update for wince4.2 port, orinaudo@gmail.com
-}
-
-{$ifdef read_interface}
-
-//begin common win32 & wince
-
-function AddFontResource(_para1:LPCWSTR):Integer; external GdiDLL name 'AddFontResourceW';
-function AppendMenu(hMenu:HMENU; uFlags:UINT; uIDNewItem:UINT; lpNewItem:LPCWSTR):WINBOOL; external UserDLLCore name 'AppendMenuW';
-function CallWindowProc(lpPrevWndFunc:WNDPROC; hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external UserDLLCore name 'CallWindowProcW';
-function ChangeDisplaySettingsEx( lpszDeviceName:LPCTSTR; lpDevMode:LPDEVMODE; hwnd:HWND; dwflags:DWORD; lParam:LPVOID):LONG; external UserDLLCore name 'ChangeDisplaySettingsEx'; //+windows
-function CharLower(lpsz:LPWSTR):LPWSTR; external UserDLLCore name 'CharLowerW';
-function CharLowerBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; external UserDLLCore name 'CharLowerBuffW';
-function CharNext(lpsz:LPCWSTR):LPWSTR; external UserDLLCore name 'CharNextW';
-function CharPrev(lpszStart:LPCWSTR; lpszCurrent:LPCWSTR):LPWSTR; external UserDLLCore name 'CharPrevW';
-function CharUpper(lpsz:LPWSTR):LPWSTR; external UserDLLCore name 'CharUpperW';
-function CharUpperBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; external UserDLLCore name 'CharUpperBuffW';
-function ChooseFont(_para1:LPCHOOSEFONTW):WINBOOL; external ComdlgDLL name 'ChooseFontW';
-function CommDlg_OpenSave_GetSpec(_hdlg:HWND;_psz:LPWSTR;_cbmax : Integer) : LRESULT;
-function CommDlg_OpenSave_GetFilePath(_hdlg:HWND;_psz:LPWSTR;_cbmax : Integer) : LRESULT;
-function CommDlg_OpenSave_GetFolderPath(_hdlg:HWND;_psz:LPWSTR;_cbmax : Integer) : LRESULT;
-function CompareString(Locale:LCID; dwCmpFlags:DWORD; lpString1:LPCWSTR; cchCount1:Integer; lpString2:LPCWSTR;cchCount2:Integer):Integer; external KernelDLL name 'CompareStringW';
-function CopyFile(lpExistingFileName:LPCWSTR; lpNewFileName:LPCWSTR; bFailIfExists:WINBOOL):WINBOOL; external KernelDLL name 'CopyFileW';
-function CreateAcceleratorTable(_para1:LPACCEL; _para2:Integer):HACCEL; external UserDLLCore name 'CreateAcceleratorTableW';
-function CreateDC(_para1:LPCWSTR; _para2:LPCWSTR; _para3:LPCWSTR; _para4:pDEVMODE):HDC; external GdiDLL name 'CreateDCW';
-function CreateDialogIndirect(hInstance:HINST; lpTemplate:LPCDLGTEMPLATEW; hWndParent:HWND; lpDialogFunc:DLGPROC):HWND;
-function CreateDialogIndirectParam(hInstance:HINST; lpTemplate:LPCDLGTEMPLATEW; hWndParent:HWND; lpDialogFunc:DLGPROC; dwInitParam:LPARAM):HWND; external UserDLLCore name 'CreateDialogIndirectParamW';
-function CreateDirectory(lpPathName:LPCWSTR; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):WINBOOL; external KernelDLL name 'CreateDirectoryW';
-function CreateEvent(lpEventAttributes:LPSECURITY_ATTRIBUTES; bManualReset:WINBOOL; bInitialState:WINBOOL; lpName:LPCWSTR):HANDLE; external KernelDLL name 'CreateEventW';
-function CreateEnhMetaFile(_para1:HDC; _para2:LPCWSTR; _para3:LPRECT; _para4:LPCWSTR):HDC; external GdiDLL name 'CreateEnhMetaFileW';
-function CreateFile(lpFileName:LPCWSTR; dwDesiredAccess:DWORD; dwShareMode:DWORD; lpSecurityAttributes:LPSECURITY_ATTRIBUTES; dwCreationDisposition:DWORD;dwFlagsAndAttributes:DWORD; hTemplateFile:HANDLE):HANDLE; external KernelDLL name 'CreateFileW';
-function CreateFileMapping(hFile:HANDLE; lpFileMappingAttributes:LPSECURITY_ATTRIBUTES; flProtect:DWORD; dwMaximumSizeHigh:DWORD; dwMaximumSizeLow:DWORD;lpName:LPCWSTR):HANDLE; external KernelDLL name 'CreateFileMappingW';
-function CreateFontIndirect(_para1:PLOGFONT):HFONT; external GdiDLL name 'CreateFontIndirectW';
-function CreateMutex(lpMutexAttributes:LPSECURITY_ATTRIBUTES; bInitialOwner:WINBOOL; lpName:LPCWSTR):HANDLE; external KernelDLL name 'CreateMutexW';
-function CreateProcess(pszImageName:LPCWSTR; pszCmdLine:LPCWSTR; psaProcess:LPSECURITY_ATTRIBUTES; psaThread:LPSECURITY_ATTRIBUTES; bInheritHandles:WINBOOL;fdwCreate:DWORD; lpEnvironment:LPVOID;
- pszCurDir:LPCWSTR; psiStartInfo:LPSTARTUPINFO; pProcInfo:LPPROCESS_INFORMATION):WINBOOL; external KernelDLL name 'CreateProcessW';
-function CreatePropertySheetPage(lppsp:LPCPROPSHEETPAGE):HPROPSHEETPAGE; external ComctlDLL name 'CreatePropertySheetPageW';
-function CreateSemaphore(lpSemaphoreAttributes:LPSECURITY_ATTRIBUTES; lInitialCount:LONG; lMaximumCount:LONG; lpName:LPCWSTR):HANDLE; external KernelDLL name 'CreateSemaphoreW';
-function CreateStatusWindow(style:LONG; lpszText:LPCWSTR; hwndParent:HWND; wID:UINT):HWND; external ComctlDll name 'CreateStatusWindowW';
-function CreateWindow(lpClassName:LPCWSTR; lpWindowName:LPCWSTR; dwStyle:DWORD; X:Integer;Y:Integer; nWidth:Integer; nHeight:Integer; hWndParent:HWND; hMenu:HMENU;hInstance:HINST; lpParam:LPVOID):HWND;
-function CreateWindowEx(dwExStyle:DWORD; lpClassName:LPCWSTR; lpWindowName:LPCWSTR; dwStyle:DWORD; X:Integer;Y:Integer; nWidth:Integer; nHeight:Integer; hWndParent:HWND; hMenu:HMENU;hInstance:HINST; lpParam:LPVOID):HWND;
- external UserDLLCore name 'CreateWindowExW';
-function DeleteFile(lpFileName:LPCWSTR):WINBOOL; external KernelDLL name 'DeleteFileW';
-function DefDlgProc(hDlg:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external UserDLLCore name 'DefDlgProcW';
-function DefWindowProc(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external UserDLLCore name 'DefWindowProcW';
-function DialogBoxIndirect(hInstance:HINST; lpTemplate:LPCDLGTEMPLATEW; hWndParent:HWND; lpDialogFunc:DLGPROC):Integer;
-function DialogBoxIndirectParam(hInstance:HINST; hDialogTemplate:LPCDLGTEMPLATEW; hWndParent:HWND; lpDialogFunc:DLGPROC; dwInitParam:LPARAM):Integer; external UserDLLCore name 'DialogBoxIndirectParamW';
-function DispatchMessage(lpMsg:LPMSG):LONG; external UserDLLCore name 'DispatchMessageW';
-function DrawText(hDC:HDC; lpString:LPCWSTR; nCount:Integer; lpRect:LPRECT; uFormat:UINT):Integer; external UserDLLCore name 'DrawTextW';
-procedure DrawStatusText(hDC:HDC; lprc:LPRECT; pszText:LPCWSTR; uFlags:UINT); external ComctlDLL name 'DrawStatusTextW';
-function EnumCalendarInfo(lpCalInfoEnumProc:CALINFO_ENUMPROC; Locale:LCID; Calendar:CALID; CalType:CALTYPE):WINBOOL; external KernelDLL name 'EnumCalendarInfoW';
-function EnumDateFormats(lpDateFmtEnumProc:DATEFMT_ENUMPROC; Locale:LCID; dwFlags:DWORD):WINBOOL; external KernelDLL name 'EnumDateFormatsW';
-function EnumFonts(_para1:HDC; _para2:LPCWSTR; _para3:ENUMFONTSPROC; _para4:LPARAM):Integer; external GdiDLL name 'EnumFontsW';
-function EnumFontFamilies(_para1:HDC; _para2:LPCWSTR; _para3:FONTENUMPROC; _para4:LPARAM):Integer; external GdiDLL name 'EnumFontFamiliesW';
-function EnumSystemCodePages(lpCodePageEnumProc:CODEPAGE_ENUMPROCW; dwFlags:DWORD):WINBOOL; external KernelDLL name 'EnumSystemCodePagesW';
-function EnumSystemLocales(lpLocaleEnumProc:LOCALE_ENUMPROC; dwFlags:DWORD):WINBOOL; external KernelDLL name 'EnumSystemLocalesW';
-function EnumTimeFormats(lpTimeFmtEnumProc:TIMEFMT_ENUMPROC; Locale:LCID; dwFlags:DWORD):WINBOOL; external KernelDLL name 'EnumTimeFormatsW';
-function ExtTextOut(_para1:HDC; _para2:Integer; _para3:Integer; _para4:UINT; _para5:LPRECT;_para6:LPCWSTR; _para7:UINT; _para8:LPINT):WINBOOL; external GdiDLL name 'ExtTextOutW';
-function ExtractIconEx(lpszFile:LPCTSTR; nIconIndex:Integer; phiconLarge: LPHICON; phiconSmall:LPHICON; nIcons:UINT):UINT; external ShellDLLCore name 'ExtractIconExW';
-function FoldString(dwMapFlags:DWORD; lpSrcStr:LPCWSTR; cchSrc:Integer; lpDestStr:LPWSTR; cchDest:Integer):Integer; external KernelDLL name 'FoldStringW';
-function FormatMessage(dwFlags:DWORD; lpSource:LPCVOID; dwMessageId:DWORD; dwLanguageId:DWORD; lpBuffer:LPWSTR;nSize:DWORD; Arguments:va_list):DWORD; external KernelDLL name 'FormatMessageW';
-function FindFirstChangeNotification(lpPathName:LPCWSTR; bWatchSubtree:WINBOOL; dwNotifyFilter:DWORD):HANDLE; external KernelDLL name 'FindFirstChangeNotificationW';
-function FindFirstFile(lpFileName:LPCWSTR; lpFindFileData:LPWIN32_FIND_DATAW):HANDLE; external KernelDLL name 'FindFirstFileW';
-function FindFirstFileEx(lpFileName:LPCWSTR; lpInfoLevelId:FINDEX_INFO_LEVELS; lpFindFileData:LPVOID; fSearchOp:FINDEX_SEARCH_OPS; lpSearchFilter:LPVOID; dwAdditionalFlags:DWORD):HANDLE; external KernelDLL name 'FindFirstFileExW'; //+winbase
-function FindNextFile(hFindFile:HANDLE; lpFindFileData:LPWIN32_FIND_DATAW):WINBOOL; external KernelDLL name 'FindNextFileW';
-function FindResource(hModule:HMODULE; lpName:LPCWSTR; lpType:LPCWSTR):HRSRC; external KernelDLL name 'FindResourceW'; //~winbase hModule is HMODULE
-function FindWindow(lpClassName:LPCWSTR; lpWindowName:LPCWSTR):HWND; external UserDLLCore name 'FindWindowW';
-function GetClassName(hWnd:HWND; lpClassName:LPWSTR; nMaxCount:Integer):Integer; external UserDLLCore name 'GetClassNameW';
-function GetClassInfo(hInstance:HINST; lpClassName:LPCWSTR; lpWndClass:LPWNDCLASS):WINBOOL; external UserDLLCore name 'GetClassInfoW';
-function GetClassLong(hWnd:HWND; nIndex:Integer):DWORD; external UserDLLCore name 'GetClassLongW';
-function GetClipboardFormatName(format:UINT; lpszFormatName:LPWSTR; cchMaxCount:Integer):Integer; external UserDLLCore name 'GetClipboardFormatNameW';
-function GetCommandLine : LPWSTR; external KernelDLL name 'GetCommandLineW';
-function GetCurrencyFormat(Locale:LCID; dwFlags:DWORD; lpValue:LPCWSTR; lpFormat:PCURRENCYFMT; lpCurrencyStr:LPWSTR;cchCurrency:Integer):Integer; external KernelDLL name 'GetCurrencyFormatW';
-function GetDateFormat(Locale:LCID; dwFlags:DWORD; lpDate:LPSYSTEMTIME; lpFormat:LPCWSTR; lpDateStr:LPWSTR;cchDate:Integer):Integer; external KernelDLL name 'GetDateFormatW';
-function GetDiskFreeSpaceEx(lpDirectoryName:LPCWSTR; lpFreeBytesAvailableToCaller:PULARGE_INTEGER; lpTotalNumberOfBytes:PULARGE_INTEGER; lpTotalNumberOfFreeBytes:PULARGE_INTEGER):WINBOOL; external KernelDLL name 'GetDiskFreeSpaceExW'; //+winbase
-function GetDlgItemText(hDlg:HWND; nIDDlgItem:Integer; lpString:LPWSTR; nMaxCount:Integer):UINT; external UserDLLCore name 'GetDlgItemTextW';
-function GetFileAttributes(lpFileName:LPCWSTR):DWORD; external KernelDLL name 'GetFileAttributesW';
-function GetFileAttributesEx(lpFileName:LPCWSTR; fInfoLevelId:GET_FILEEX_INFO_LEVELS; lpFileInformation:LPVOID):WINBOOL; external KernelDLL name 'GetFileAttributesExW'; //+winbase
-function GetFileVersionInfoSize(lptstrFilename:LPWSTR; lpdwHandle:LPDWORD):DWORD; external VersionDLL name 'GetFileVersionInfoSizeW';
-function GetFileVersionInfo(lptstrFilename:LPWSTR; dwHandle:DWORD; dwLen:DWORD; lpData:LPVOID):WINBOOL; external VersionDLL name 'GetFileVersionInfoW';
-function GetKeyboardLayoutName(pwszKLID:LPWSTR):WINBOOL; external UserDLLCore name 'GetKeyboardLayoutNameW';
-function GetLocaleInfo(Locale:LCID; LCType:LCTYPE; lpLCData:LPWSTR; cchData:Integer):Integer; external KernelDLL name 'GetLocaleInfoW';
-function GetMenuItemInfo(_para1:HMENU; _para2:UINT; _para3:WINBOOL; _para4:LPMENUITEMINFO):WINBOOL; external UserDLLCore name 'GetMenuItemInfoW';
-function GetMessage(lpMsg:LPMSG; hWnd:HWND; wMsgFilterMin:UINT; wMsgFilterMax:UINT):WINBOOL; external UserDLLCore name 'GetMessageW';
-function GetModuleFileName(hModule:HMODULE; lpFilename:LPWSTR; nSize:DWORD):DWORD; external KernelDLL name 'GetModuleFileNameW';
-function GetModuleHandle(lpModuleName:LPCWSTR):HMODULE; external KernelDLL name 'GetModuleHandleW';
-function GetNumberFormat(Locale:LCID; dwFlags:DWORD; lpValue:LPCWSTR; lpFormat:PNUMBERFMT; lpNumberStr:LPWSTR;cchNumber:Integer):Integer; external KernelDLL name 'GetNumberFormatW';
-function GetObject(_para1:HGDIOBJ; _para2:Integer; _para3:LPVOID):Integer; external GdiDLL name 'GetObjectW';
-//warning not exported from comdgl32(win32)/commdlg(wince) but coredll
-function GetOpenFileName(_para1:LPOPENFILENAMEW):WINBOOL; external ComdlgDLLCore name 'GetOpenFileNameW';
-//warning not exported from comdgl32(win32)/commdlg(wince) but coredll
-function GetSaveFileName(_para1:LPOPENFILENAMEW):WINBOOL; external ComdlgDLLCore name 'GetSaveFileNameW';
-function GetStringTypeEx(Locale:LCID; dwInfoType:DWORD; lpSrcStr:LPCWSTR; cchSrc:Integer; lpCharType:LPWORD):WINBOOL; external KernelDLL name 'GetStringTypeExW';
-function GetTempFileName(lpPathName:LPCWSTR; lpPrefixString:LPCWSTR; uUnique:UINT; lpTempFileName:LPWSTR):UINT; external KernelDLL name 'GetTempFileNameW';
-function GetTempPath(nBufferLength:DWORD; lpBuffer:LPWSTR):DWORD; external KernelDLL name 'GetTempPathW';
-function GetTextExtentExPoint(_para1:HDC; _para2:LPCWSTR; _para3:Integer; _para4:Integer; _para5:LPINT;_para6:LPINT; _para7:LPSIZE):WINBOOL; external GdiDLL name 'GetTextExtentExPointW';
-function GetTextFace(_para1:HDC; _para2:Integer; _para3:LPWSTR):Integer; external GdiDLL name 'GetTextFaceW';
-function GetTextMetrics(_para1:HDC; _para2:LPTEXTMETRICW):WINBOOL; external GdiDLL name 'GetTextMetricsW';
-function GetTimeFormat(Locale:LCID; dwFlags:DWORD; lpTime:LPSYSTEMTIME; lpFormat:LPCWSTR; lpTimeStr:LPWSTR;cchTime:Integer):Integer; external KernelDLL name 'GetTimeFormatW';
-function GetUserNameEx(NameFormat:EXTENDED_NAME_FORMAT; lpNameBuffer:LPWSTR; nSize:PULONG):WINBOOL; external SecurDLL name 'GetUserNameExW';
-function GetVersionEx(VersionInformation:LPOSVERSIONINFOW):WINBOOL; external KernelDLL name 'GetVersionExW';
-function GetWindowText(hWnd:HWND; lpString:LPWSTR; nMaxCount:Integer):Integer; external UserDLLCore name 'GetWindowTextW';
-function GetWindowTextLength(hWnd:HWND):Integer; external UserDLLCore name 'GetWindowTextLengthW';
-function GetWindowLong(hWnd:HWND; nIndex:Integer):LONG; external UserDLLCore name 'GetWindowLongW';
-function GlobalAddAtom(lpString:LPCWSTR):ATOM; external KernelDLL name 'GlobalAddAtomW';
-function GlobalFindAtom(lpString:LPCWSTR):ATOM; external KernelDLL name 'GlobalFindAtomW';
-function IsDialogMessage(hDlg:HWND; lpMsg:LPMSG):WINBOOL; external UserDLLCore name 'IsDialogMessageW';
-function InsertMenu(hMenu:HMENU; uPosition:UINT; uFlags:UINT; uIDNewItem:UINT; lpNewItem:LPCWSTR):WINBOOL; external UserDLLCore name 'InsertMenuW';
-function LCMapString(Locale:LCID; dwMapFlags:DWORD; lpSrcStr:LPCWSTR; cchSrc:Integer; lpDestStr:LPWSTR;cchDest:Integer):Integer; external KernelDLL name 'LCMapStringW';
-function LoadAccelerators(hInstance:HINST; lpTableName:LPCWSTR):HACCEL; external UserDLLCore name 'LoadAcceleratorsW';
-function LoadBitmap(hInstance:HINST; lpBitmapName:LPCWSTR):HBITMAP; external UserDLLCore name 'LoadBitmapW';
-function LoadCursor(hInstance:HINST; lpCursorName:LPCWSTR):HCURSOR; external UserDLLCore name 'LoadCursorW';
-function LoadIcon(hInstance:HINST; lpIconName:LPCWSTR):HICON; external UserDLLCore name 'LoadIconW';
-function LoadImage(_para1:HINST; _para2:LPCWSTR; _para3:UINT; _para4:Integer; _para5:Integer;_para6:UINT):HANDLE; external UserDLLCore name 'LoadImageW';
-function LoadKeyboardLayout(pwszKLID:LPCWSTR; Flags:UINT):HKL; external UserDLLCore name 'LoadKeyboardLayoutW';
-function LoadLibrary(lpLibFileName:LPCWSTR):HINST; external KernelDLL name 'LoadLibraryW';
-function LoadLibraryEx(lpLibFileName:LPCWSTR; hFile:HANDLE; dwFlags:DWORD):HINST; external KernelDLL name 'LoadLibraryExW';
-function LoadMenu(hInstance:HINST; lpMenuName:LPCWSTR):HMENU; external UserDLLCore name 'LoadMenuW';
-function LoadString(hInstance:HINST; uID:UINT; lpBuffer:LPWSTR; nBufferMax:Integer):Integer; external UserDLLCore name 'LoadStringW';
-function lstrcmp(lpString1:LPCWSTR; lpString2:LPCWSTR):Integer; external KernelDLL name 'lstrcmpW'; //~winbase result is int
-function lstrcmpi(lpString1:LPCWSTR; lpString2:LPCWSTR):Integer; external KernelDLL name 'lstrcmpiW'; //~winbase result is int
-function MapVirtualKey(uCode:UINT; uMapType:UINT):UINT; external UserDLLCore name 'MapVirtualKeyW';
-function MessageBox(hWnd:HWND; lpText:LPCWSTR; lpCaption:LPCWSTR; uType:UINT):Integer; external UserDLLCore name 'MessageBoxW'; //~winuser, result declared as int
-function MoveFile(lpExistingFileName:LPCWSTR; lpNewFileName:LPCWSTR):WINBOOL; external KernelDLL name 'MoveFileW';
-function OpenEvent(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; lpName:LPCWSTR):HANDLE; external KernelDLL name 'OpenEventW';
-procedure OutputDebugString(lpOutputString:LPCWSTR); external KernelDLL name 'OutputDebugStringW';
-function PageSetupDlg(_para1:LPPAGESETUPDLGW):WINBOOL; external ComdlgDLL name 'PageSetupDlgW';
-function PeekMessage(lpMsg:LPMSG; hWnd:HWND; wMsgFilterMin:UINT; wMsgFilterMax:UINT; wRemoveMsg:UINT):WINBOOL; external UserDLLCore name 'PeekMessageW';
-function PostThreadMessage(idThread:DWORD; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL; external UserDLLCore name 'PostThreadMessageW';
-function PostMessage(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL; external UserDLLCore name 'PostMessageW';
-function PropertySheet(lppsph:LPCPROPSHEETHEADERW):Integer; external ComctlDll name 'PropertySheetW';
-function RegCreateKeyEx(hKey:HKEY; lpSubKey:LPCWSTR; Reserved:DWORD; lpClass:LPWSTR; dwOptions:DWORD;samDesired:REGSAM; lpSecurityAttributes:LPSECURITY_ATTRIBUTES; phkResult:PHKEY; lpdwDisposition:LPDWORD):LONG;
- external AdvapiDLLCore name 'RegCreateKeyExW';
-function RegDeleteKey(hKey:HKEY; lpSubKey:LPCWSTR):LONG; external AdvapiDLLCore name 'RegDeleteKeyW';
-function RegDeleteValue(hKey:HKEY; lpValueName:LPCWSTR):LONG; external AdvapiDLLCore name 'RegDeleteValueW';
-function RegEnumKeyEx(hKey:HKEY; dwIndex:DWORD; lpName:LPWSTR; lpcbName:LPDWORD; lpReserved:LPDWORD;lpClass:LPWSTR; lpcbClass:LPDWORD; lpftLastWriteTime:PFILETIME):LONG; external AdvapiDLLCore name 'RegEnumKeyExW';
-function RegEnumValue(hKey:HKEY; dwIndex:DWORD; lpValueName:LPWSTR; lpcbValueName:LPDWORD; lpReserved:LPDWORD;lpType:LPDWORD; lpData:LPBYTE; lpcbData:LPDWORD):LONG; external AdvapiDLLCore name 'RegEnumValueW';
-function RegisterClass(lpWndClass:LPWNDCLASS):ATOM; external UserDLLCore name 'RegisterClassW';
-function RegisterClipboardFormat(lpszFormat:LPCWSTR):UINT; external UserDLLCore name 'RegisterClipboardFormatW';
-function RegisterWindowMessage(lpString:LPCWSTR):UINT; external KernelDLL name 'RegisterWindowMessageW';
-function RegQueryInfoKey(hKey:HKEY; lpClass:LPWSTR; lpcbClass:LPDWORD; lpReserved:LPDWORD; lpcSubKeys:LPDWORD;lpcbMaxSubKeyLen:LPDWORD; lpcbMaxClassLen:LPDWORD; lpcValues:LPDWORD; lpcbMaxValueNameLen:LPDWORD;
- lpcbMaxValueLen:LPDWORD;lpcbSecurityDescriptor:LPDWORD; lpftLastWriteTime:PFILETIME):LONG; external AdvapiDLLCore name 'RegQueryInfoKeyW';
-function RegOpenKeyEx(hKey:HKEY; lpSubKey:LPCWSTR; ulOptions:DWORD; samDesired:REGSAM; phkResult:PHKEY):LONG; external AdvapiDLLCore name 'RegOpenKeyExW';
-function RegQueryValueEx(hKey:HKEY; lpValueName:LPCWSTR; lpReserved:LPDWORD; lpType:LPDWORD; lpData:LPBYTE;lpcbData:LPDWORD):LONG; external AdvapiDLLCore name 'RegQueryValueExW';function RegSetValueEx(hKey:HKEY; lpValueName:LPCWSTR; Reserved:DWORD; dwType:DWORD; lpData:LPBYTE;cbData:DWORD):LONG; external AdvapiDLLCore name 'RegSetValueExW';
-function RemoveDirectory(lpPathName:LPCWSTR):WINBOOL; external KernelDLL name 'RemoveDirectoryW';
-function RemoveFontResource(_para1:LPCWSTR):WINBOOL; external GdiDLL name 'RemoveFontResourceW';
-function SendDlgItemMessage(hDlg:HWND; nIDDlgItem:Integer; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LONG; external UserDLLCore name 'SendDlgItemMessageW';
-function SendMessage(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external UserDLLCore name 'SendMessageW';
-function SendNotifyMessage(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM):WINBOOL; external UserDLLCore name 'SendNotifyMessageW';
-function SetClassLong(hWnd:HWND; nIndex:Integer; dwNewLong:LONG):DWORD; external UserDLLCore name 'SetClassLongW';
-function SetDlgItemText(hDlg:HWND; nIDDlgItem:Integer; lpString:LPCWSTR):WINBOOL; external UserDLLCore name 'SetDlgItemTextW';
-function SetFileAttributes(lpFileName:LPCWSTR; dwFileAttributes:DWORD):WINBOOL; external KernelDLL name 'SetFileAttributesW';
-function SetLocaleInfo(Locale:LCID; LCType:LCTYPE; lpLCData:LPCWSTR):WINBOOL; external KernelDLL name 'SetLocaleInfoW';
-function SetMenuItemInfo(_para1:HMENU; _para2:UINT; _para3:WINBOOL; _para4:LPCMENUITEMINFO):WINBOOL; external UserDLLCore name 'SetMenuItemInfoW';
-function SetWindowsHookEx(idHook:Integer; lpfn:HOOKPROC; hmod:HINST; dwThreadId:DWORD):HHOOK; external UserDLLCore name 'SetWindowsHookExW';
-function SetWindowText(hWnd:HWND; lpString:LPCWSTR):WINBOOL; external UserDLLCore name 'SetWindowTextW';
-function SetWindowLong(hWnd:HWND; nIndex:Integer; dwNewLong:LONG):LONG; external UserDLLCore name 'SetWindowLongW'; //~winuser nIndex is int
-function ShellExecuteEx(lpExecInfo:LPSHELLEXECUTEINFO):WINBOOL; external ShellDLLCore name 'ShellExecuteEx'; //+shellapi
-function SystemParametersInfo(uiAction:UINT; uiParam:UINT; pvParam:PVOID; fWinIni:UINT):WINBOOL; external UserDLLCore name 'SystemParametersInfoW';
-function StartDoc(_para1:HDC; _para2:PDOCINFOW):Integer; external GdiDLL name 'StartDocW';
-function TranslateAccelerator(hWnd:HWND; hAccTable:HACCEL; lpMsg:LPMSG):Integer; external UserDLLCore name 'TranslateAcceleratorW';
-function UnregisterClass(lpClassName:LPCWSTR; hInstance:HINST):WINBOOL; external UserDLLCore name 'UnregisterClassW';
-function VerQueryValue(pBlock:LPVOID; lpSubBlock:LPWSTR; lplpBuffer:LPVOID; puLen:PUINT):WINBOOL; external versionDLL name 'VerQueryValueW';
-function WNetAddConnection3(hwndOwner:HWND; lpNetResource:LPNETRESOURCE; lpPassword:LPCWSTR; lpUserName:LPCWSTR; dwFlags:DWORD):DWORD; external MprDLLCore name 'WNetAddConnection3W';
-function WNetCancelConnection2(lpName:LPCWSTR; dwFlags:DWORD; fForce:WINBOOL):DWORD; external MprDLLCore name 'WNetCancelConnection2W';
-function WNetConnectionDialog1(lpConnDlgStruct:LPCONNECTDLGSTRUCTW):DWORD; external MprDLLCore name 'WNetConnectionDialog1W';
-function WNetDisconnectDialog1(lpConnDlgStruct:LPDISCDLGSTRUCTW):DWORD; external MprDLLCore name 'WNetDisconnectDialog1W';
-function WNetEnumResource(hEnum:HANDLE; lpcCount:LPDWORD; lpBuffer:LPVOID; lpBufferSize:LPDWORD):DWORD; external MprDLLCore name 'WNetEnumResourceW';
-function WNetGetConnection(lpLocalName:LPCWSTR; lpRemoteName:LPWSTR; lpnLength:LPDWORD):DWORD; external MprDLLCore name 'WNetGetConnectionW';
-function WNetGetUniversalName(lpLocalPath:LPCWSTR; dwInfoLevel:DWORD; lpBuffer:LPVOID; lpBufferSize:LPDWORD):DWORD; external MprDLLCore name 'WNetGetUniversalNameW';
-function WNetGetUser(lpName:LPCWSTR; lpUserName:LPWSTR; lpnLength:LPDWORD):DWORD; external MprDLLCore name 'WNetGetUserW';
-function WNetOpenEnum(dwScope:DWORD; dwType:DWORD; dwUsage:DWORD; lpNetResource:LPNETRESOURCEW; lphEnum:LPHANDLE):DWORD; external MprDLLCore name 'WNetOpenEnumW';
-function wsprintf(lpBuffer:LPWSTR; lpFormat:LPCWSTR; const args:array of const):Integer; external UserDLLCore name 'wsprintfW'; //~winuser Result is int, cedcl directive removed, API doc say nothing about calling convention
-function wsprintf(lpBuffer:LPWSTR; lpFormat:LPCWSTR):Integer; external UserDLLCore name 'wsprintfW'; //~winuser Result is int, API doc say nothing about calling convention
-function wvsprintf(_para1:LPWSTR; _para2:LPCWSTR; arglist:va_list):Integer; external UserDLLCore name 'wvsprintfW'; //~winuser nIndex is int
-
-//end common win32 & wince
-
-{$ifdef WINCE}
-//begin wince only
-
-//'ChooseColorW' not exported but 'ChooseColor' yes
-function ChooseColor(_para1:LPCHOOSECOLOR):WINBOOL; external ComdlgDLL name 'ChooseColor';
-//'EnumDisplaySettingsW' not exported but 'EnumDisplaySettings' with widechar header is
-function EnumDisplaySettings(lpszDeviceName:LPCWSTR; iModeNum:DWORD; lpDevMode:LPDEVMODEW):WINBOOL; external UserDLLCore name 'EnumDisplaySettings';
-//'EnumPropsExW' not exported but 'EnumPropsEx' with widechar header is
-function EnumPropsEx(hWnd:HWND; lpEnumFunc:PROPENUMPROCEX; lParam:LPARAM):Integer; external UserDLLCore name 'EnumPropsEx';
-//'...W' not exported but '...' is
-function GetCharABCWidths(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPABC):WINBOOL; external GdiDLL name 'GetCharABCWidths';
-function GetCharWidth32(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPINT):WINBOOL; external GdiDLL name 'GetCharWidth32';
-//wince has W
-function GetProcAddress(hModule:HINST; lpProcName:LPCWSTR):FARPROC; external KernelDLL name 'GetProcAddressW';
-//'GetPropW', not exported but 'GetProp' with widechar header are
-function GetProp(hWnd:HWND; lpString:LPCWSTR):HANDLE; external UserDLLCore name 'GetProp';
-//!header specific to CE, not in comctl32(win32)/commctl(wince) but in coredll
-function ImageList_LoadImage(hi:HINST; lpbmp:LPCSTR; cx:Integer; cGrow:Integer; crMask:COLORREF;uType:UINT; uFlags:UINT):HIMAGELIST; external ComctlDLLCore name 'ImageList_LoadImage';
-//'RemovePropW' not exported but 'RemoveProp' with widechar header is
-function RemoveProp(hWnd:HWND; lpString:LPCWSTR):HANDLE; external UserDLLCore name 'RemoveProp';
-//'SendMessageTimeoutW' not exported but 'SendMessageTimeout' yes
-function SendMessageTimeout(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM; fuFlags:UINT;uTimeout:UINT; lpdwResult:LPDWORD):LRESULT; external UserDLLCore name 'SendMessageTimeout';
-//'SetPropW' not exported but 'SetProp' with widechar header is
-function SetProp(hWnd:HWND; lpString:LPCWSTR; hData:HANDLE):WINBOOL; external UserDLLCore name 'SetProp';
-//not exported as PrintDlgW but PrintDlg
-function PrintDlg(_para1:LPPRINTDLG):WINBOOL; external ComdlgDLL name 'PrintDlg';
-//not exported as RegSaveKeyW but RegSaveKey
-function RegSaveKey(hKey:HKEY; lpFile:LPCTSTR; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):LONG; external AdvapiDLLCore name 'RegSaveKey';
-//not exported as RegReplaceKeyW but RegReplaceKey
-function RegReplaceKey(hKey:HKEY; lpSubKey:LPCTSTR; lpNewFile:LPCTSTR; lpOldFile:LPCTSTR):LONG; external AdvapiDLLCore name 'RegReplaceKey';
-//not exported as Shell_NotifyIconW but Shell_NotifyIcon
-function Shell_NotifyIcon(dwMessage: DWORD; lpData: PNotifyIconDataA): WINBOOL; external ShellDLLCore name 'Shell_NotifyIcon';
-//win32 already have without W or A
-function SHFileOperation(lpFileOp:LPSHFILEOPSTRUCTW): Integer; external ShellDLL name 'SHFileOperationW';
-//end wince only
-
-{$endif WINCE}
-
-{$ifdef WIN32}
-//begin win32 only ie not exist in wince4.2 second release lib imported functions from dlls
-function AbortSystemShutdown(lpMachineName:LPWSTR):WINBOOL; external 'advapi32' name 'AbortSystemShutdownW';
-function AccessCheckAndAuditAlarm(SubsystemName:LPCWSTR; HandleId:LPVOID; ObjectTypeName:LPWSTR; ObjectName:LPWSTR; SecurityDescriptor:PSECURITY_DESCRIPTOR;DesiredAccess:DWORD; GenericMapping:PGENERIC_MAPPING; ObjectCreation:WINBOOL;
-function AddAtom(lpString:LPCWSTR):ATOM; external 'kernel32' name 'AddAtomW';
-function CopyMetaFile(_para1:HMETAFILE; _para2:LPCWSTR):HMETAFILE; external 'gdi32' name 'CopyMetaFileW';
-function CreateFont(_para1:Integer; _para2:Integer; _para3:Integer; _para4:Integer; _para5:Integer;_para6:DWORD; _para7:DWORD; _para8:DWORD; _para9:DWORD; _para10:DWORD;_para11:DWORD; _para12:DWORD; _para13:DWORD; _para14:LPCWSTR):HFONT;
- external 'gdi32' name 'CreateFontW';
-function BackupEventLog(hEventLog:HANDLE; lpBackupFileName:LPCWSTR):WINBOOL; external 'advapi32' name 'BackupEventLogW';
-function BeginUpdateResource(pFileName:LPCWSTR; bDeleteExistingResources:WINBOOL):HANDLE; external 'kernel32' name 'BeginUpdateResourceW';
-function BuildCommDCB(lpDef:LPCWSTR; lpDCB:LPDCB):WINBOOL; external 'kernel32' name 'BuildCommDCBW';
-function BuildCommDCBAndTimeouts(lpDef:LPCWSTR; lpDCB:LPDCB; lpCommTimeouts:LPCOMMTIMEOUTS):WINBOOL; external 'kernel32' name 'BuildCommDCBAndTimeoutsW';
-function CallMsgFilter(lpMsg:LPMSG; nCode:Integer):WINBOOL; external 'user32' name 'CallMsgFilterW';
-function CallNamedPipe(lpNamedPipeName:LPCWSTR; lpInBuffer:LPVOID; nInBufferSize:DWORD; lpOutBuffer:LPVOID; nOutBufferSize:DWORD;lpBytesRead:LPDWORD; nTimeOut:DWORD):WINBOOL; external 'kernel32' name 'CallNamedPipeW';
-function ChangeDisplaySettings(lpDevMode:LPDEVMODE; dwFlags:DWORD):LONG; external 'user32' name 'ChangeDisplaySettingsW';
-function ChangeMenu(hMenu:HMENU; cmd:UINT; lpszNewItem:LPCWSTR; cmdInsert:UINT; flags:UINT):WINBOOL; external 'user32' name 'ChangeMenuW';
-function CharToOem(lpszSrc:LPCWSTR; lpszDst:LPSTR):WINBOOL; external 'user32' name 'CharToOemW';
-function CharToOemBuff(lpszSrc:LPCWSTR; lpszDst:LPSTR; cchDstLength:DWORD):WINBOOL; external 'user32' name 'CharToOemBuffW';
-function ChangeServiceConfig(hService:SC_HANDLE; dwServiceType:DWORD; dwStartType:DWORD; dwErrorControl:DWORD; lpBinaryPathName:LPCWSTR;lpLoadOrderGroup:LPCWSTR; lpdwTagId:LPDWORD; lpDependencies:LPCWSTR; lpServiceStartName:LPCWSTR;
- lpPassword:LPCWSTR;lpDisplayName:LPCWSTR):WINBOOL; external 'advapi32' name 'ChangeServiceConfigW';
-function ChooseColor(_para1:LPCHOOSECOLOR):WINBOOL; external 'comdlg32' name 'ChooseColorW';
-function ClearEventLog(hEventLog:HANDLE; lpBackupFileName:LPCWSTR):WINBOOL; external 'advapi32' name 'ClearEventLogW';
-function CommConfigDialog(lpszName:LPCWSTR; hWnd:HWND; lpCC:LPCOMMCONFIG):WINBOOL; external 'kernel32' name 'CommConfigDialogW';
-function CopyAcceleratorTable(hAccelSrc:HACCEL; lpAccelDst:LPACCEL; cAccelEntries:Integer):Integer; external 'user32' name 'CopyAcceleratorTableW';
-function CopyEnhMetaFile(_para1:HENHMETAFILE; _para2:LPCWSTR):HENHMETAFILE; external 'gdi32' name 'CopyEnhMetaFileW';
-function CreateColorSpace(_para1:LPLOGCOLORSPACE):HCOLORSPACE; external 'gdi32' name 'CreateColorSpaceW';
-function CreateDesktop(lpszDesktop:LPWSTR; lpszDevice:LPWSTR; pDevmode:LPDEVMODE; dwFlags:DWORD; dwDesiredAccess:DWORD;lpsa:LPSECURITY_ATTRIBUTES):HDESK; external 'user32' name 'CreateDesktopW';
-function CreateDialog(hInstance:HINST; lpName:LPCWSTR; hWndParent:HWND; lpDialogFunc:DLGPROC):HWND;
-function CreateDialogParam(hInstance:HINST; lpTemplateName:LPCWSTR; hWndParent:HWND; lpDialogFunc:DLGPROC; dwInitParam:LPARAM):HWND; external 'user32' name 'CreateDialogParamW';
-function CreateDirectoryEx(lpTemplateDirectory:LPCWSTR; lpNewDirectory:LPCWSTR; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):WINBOOL; external 'kernel32' name 'CreateDirectoryExW';
-function CreateIC(_para1:LPCWSTR; _para2:LPCWSTR; _para3:LPCWSTR; _para4:LPDEVMODE):HDC; external 'gdi32' name 'CreateICW';
-function CreateMailslot(lpName:LPCWSTR; nMaxMessageSize:DWORD; lReadTimeout:DWORD; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):HANDLE; external 'kernel32' name 'CreateMailslotW';
-function CreateMDIWindow(lpClassName:LPWSTR; lpWindowName:LPWSTR; dwStyle:DWORD; X:Integer; Y:Integer;nWidth:Integer; nHeight:Integer; hWndParent:HWND; hInstance:HINST; lParam:LPARAM):HWND; external 'user32' name 'CreateMDIWindowW';
-function CreateMetaFile(_para1:LPCWSTR):HDC; external 'gdi32' name 'CreateMetaFileW';
-function CreateNamedPipe(lpName:LPCWSTR; dwOpenMode:DWORD; dwPipeMode:DWORD; nMaxInstances:DWORD; nOutBufferSize:DWORD;nInBufferSize:DWORD; nDefaultTimeOut:DWORD; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):HANDLE;
- external 'kernel32' name 'CreateNamedPipeW';
-function CreateProcessAsUser(_para1:HANDLE; _para2:LPCWSTR; _para3:LPWSTR; _para4:LPSECURITY_ATTRIBUTES; _para5:LPSECURITY_ATTRIBUTES;_para6:WINBOOL; _para7:DWORD; _para8:LPVOID; _para9:LPCWSTR;
- _para10:LPSTARTUPINFO;_para11:LPPROCESS_INFORMATION):WINBOOL; external 'advapi32' name 'CreateProcessAsUserW';
-function CreateScalableFontResource(_para1:DWORD; _para2:LPCWSTR; _para3:LPCWSTR; _para4:LPCWSTR):WINBOOL; external 'gdi32' name 'CreateScalableFontResourceW';
-function CreateService(hSCManager:SC_HANDLE; lpServiceName:LPCWSTR; lpDisplayName:LPCWSTR; dwDesiredAccess:DWORD; dwServiceType:DWORD;dwStartType:DWORD; dwErrorControl:DWORD; lpBinaryPathName:LPCWSTR; lpLoadOrderGroup:LPCWSTR;
- lpdwTagId:LPDWORD;lpDependencies:LPCWSTR; lpServiceStartName:LPCWSTR; lpPassword:LPCWSTR):SC_HANDLE; external AdvapiDLL name 'CreateServiceW';
-function CreateWindowStation(lpwinsta:LPWSTR; dwReserved:DWORD; dwDesiredAccess:DWORD; lpsa:LPSECURITY_ATTRIBUTES):HWINSTA; external 'user32' name 'CreateWindowStationW';
-function DdeCreateStringHandle(_para1:DWORD; _para2:LPCWSTR; _para3:Integer):HSZ; external 'user32' name 'DdeCreateStringHandleW';
-function DdeInitialize(_para1:LPDWORD; _para2:PFNCALLBACK; _para3:DWORD; _para4:DWORD):UINT; external 'user32' name 'DdeInitializeW';
-function DdeQueryString(_para1:DWORD; _para2:HSZ; _para3:LPCWSTR; _para4:DWORD; _para5:Integer):DWORD; external 'user32' name 'DdeQueryStringW';
-function DefineDosDevice(dwFlags:DWORD; lpDeviceName:LPCWSTR; lpTargetPath:LPCWSTR):WINBOOL; external 'kernel32' name 'DefineDosDeviceW';
-function DefFrameProc(hWnd:HWND; hWndMDIClient:HWND; uMsg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'DefFrameProcW';
-function DefMDIChildProc(hWnd:HWND; uMsg:UINT; wParam:WPARAM; lParam:LPARAM):LRESULT; external 'user32' name 'DefMDIChildProcW';
-function DialogBox(hInstance:HINST; lpTemplate:LPCWSTR; hWndParent:HWND; lpDialogFunc:DLGPROC):Integer;
-function DialogBoxParam(hInstance:HINST; lpTemplateName:LPCWSTR; hWndParent:HWND; lpDialogFunc:DLGPROC; dwInitParam:LPARAM):Integer; external 'user32' name 'DialogBoxParamW';
-function DlgDirList(hDlg:HWND; lpPathSpec:LPWSTR; nIDListBox:Integer; nIDStaticPath:Integer; uFileType:UINT):Integer; external 'user32' name 'DlgDirListW';
-function DlgDirSelectEx(hDlg:HWND; lpString:LPWSTR; nCount:Integer; nIDListBox:Integer):WINBOOL; external 'user32' name 'DlgDirSelectExW';
-function DlgDirListComboBox(hDlg:HWND; lpPathSpec:LPWSTR; nIDComboBox:Integer; nIDStaticPath:Integer; uFiletype:UINT):Integer; external 'user32' name 'DlgDirListComboBoxW';
-function DlgDirSelectComboBoxEx(hDlg:HWND; lpString:LPWSTR; nCount:Integer; nIDComboBox:Integer):WINBOOL; external 'user32' name 'DlgDirSelectComboBoxExW';
-function DragQueryFile(_para1:HDROP; _para2:cardinal; _para3:LPCWSTR; _para4:cardinal):cardinal; external 'shell32' name 'DragQueryFileW';
-function DrawState(_para1:HDC; _para2:HBRUSH; _para3:DRAWSTATEPROC; _para4:LPARAM; _para5:WPARAM;_para6:Integer; _para7:Integer; _para8:Integer; _para9:Integer; _para10:UINT):WINBOOL; external 'user32' name 'DrawStateW';
-function DrawTextEx(_para1:HDC; _para2:LPWSTR; _para3:Integer; _para4:LPRECT; _para5:UINT;_para6:LPDRAWTEXTPARAMS):Integer; external 'user32' name 'DrawTextExW';
-function EndUpdateResource(hUpdate:HANDLE; fDiscard:WINBOOL):WINBOOL; external 'kernel32' name 'EndUpdateResourceW';
-function EnumDependentServices(hService:SC_HANDLE; dwServiceState:DWORD; lpServices:LPENUM_SERVICE_STATUS; cbBufSize:DWORD; pcbBytesNeeded:LPDWORD;lpServicesReturned:LPDWORD):WINBOOL; external 'advapi32' name 'EnumDependentServicesW';
-function EnumDesktops(hwinsta:HWINSTA; lpEnumFunc:DESKTOPENUMPROC; lParam:LPARAM):WINBOOL; external 'user32' name 'EnumDesktopsW';
-function EnumDisplaySettings(lpszDeviceName:LPCWSTR; iModeNum:DWORD; lpDevMode:LPDEVMODEW):WINBOOL; external UserDLLCore name 'EnumDisplaySettingsW';
-function EnumFontFamiliesEx(_para1:HDC; _para2:LPLOGFONT; _para3:FONTENUMEXPROC; _para4:LPARAM; _para5:DWORD):Integer; external 'gdi32' name 'EnumFontFamiliesExW';
-function EnumICMProfiles(_para1:HDC; _para2:ICMENUMPROC; _para3:LPARAM):Integer; external 'gdi32' name 'EnumICMProfilesW';
-function EnumProps(hWnd:HWND; lpEnumFunc:PROPENUMPROC):Integer; external 'user32' name 'EnumPropsW';
-function EnumResourceTypes(hModule:HINST; lpEnumFunc:ENUMRESTYPEPROC; lParam:LONG):WINBOOL; external 'kernel32' name 'EnumResourceTypesW';
-function EnumResourceNames(hModule:HINST; lpType:LPCWSTR; lpEnumFunc:ENUMRESNAMEPROC; lParam:LONG):WINBOOL; external 'kernel32' name 'EnumResourceNamesW';
-function EnumResourceLanguages(hModule:HINST; lpType:LPCWSTR; lpName:LPCWSTR; lpEnumFunc:ENUMRESLANGPROC; lParam:LONG):WINBOOL; external 'kernel32' name 'EnumResourceLanguagesW';
-function EnumServicesStatus(hSCManager:SC_HANDLE; dwServiceType:DWORD; dwServiceState:DWORD; lpServices:LPENUM_SERVICE_STATUS; cbBufSize:DWORD;pcbBytesNeeded:LPDWORD; lpServicesReturned:LPDWORD; lpResumeHandle:LPDWORD):WINBOOL;
- external 'advapi32' name 'EnumServicesStatusW';
-function EnumWindowStations(lpEnumFunc:ENUMWINDOWSTATIONPROC; lParam:LPARAM):WINBOOL; external 'user32' name 'EnumWindowStationsW';
-function ExpandEnvironmentStrings(lpSrc:LPCWSTR; lpDst:LPWSTR; nSize:DWORD):DWORD; external 'kernel32' name 'ExpandEnvironmentStringsW';
-function ExtractIcon(_para1:HINST; _para2:LPCWSTR; _para3:cardinal):HICON; external 'shell32' name 'ExtractIconW';
-function ExtractAssociatedIcon(_para1:HINST; _para2:LPCWSTR; _para3:LPWORD):HICON; external 'shell32' name 'ExtractAssociatedIconW';
-procedure FatalAppExit(uAction:UINT; lpMessageText:LPCWSTR); external 'kernel32' name 'FatalAppExitW';
-function FillConsoleOutputCharacter(hConsoleOutput:HANDLE; cCharacter:WCHAR; nLength:DWORD; dwWriteCoord:COORD; lpNumberOfCharsWritten:LPDWORD):WINBOOL; external 'kernel32' name 'FillConsoleOutputCharacterW';
-function FindAtom(lpString:LPCWSTR):ATOM; external 'kernel32' name 'FindAtomW';
-function FindExecutable(_para1:LPCWSTR; _para2:LPCWSTR; _para3:LPCWSTR):HINST; external 'shell32' name 'FindExecutableW';
-function FindResourceEx(hModule:HINST; lpType:LPCWSTR; lpName:LPCWSTR; wLanguage:WORD):HRSRC; external 'kernel32' name 'FindResourceExW';
-function FindText(_para1:LPFINDREPLACE):HWND; external 'comdlg32' name 'FindTextW';
-function FindWindowEx(_para1:HWND; _para2:HWND; _para3:LPCWSTR; _para4:LPCWSTR):HWND; external 'user32' name 'FindWindowExW';
-function FreeEnvironmentStrings(_para1:LPWSTR):WINBOOL; external 'kernel32' name 'FreeEnvironmentStringsW';
-function GetAtomName(nAtom:ATOM; lpBuffer:LPWSTR; nSize:Integer):UINT; external 'kernel32' name 'GetAtomNameW';
-function GetBinaryType(lpApplicationName:LPCWSTR; lpBinaryType:LPDWORD):WINBOOL; external 'kernel32' name 'GetBinaryTypeW';
-function GetCharABCWidthsFloat(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPABCFLOAT):WINBOOL; external 'gdi32' name 'GetCharABCWidthsFloatW';
-function GetCharacterPlacement(_para1:HDC; _para2:LPCWSTR; _para3:Integer; _para4:Integer; _para5:LPGCP_RESULTS;_para6:DWORD):DWORD; external 'gdi32' name 'GetCharacterPlacementW';
-function GetCharWidth(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPINT):WINBOOL; external 'gdi32' name 'GetCharWidthW';
-function GetCharWidthFloat(_para1:HDC; _para2:UINT; _para3:UINT; _para4:PSingle):WINBOOL; external 'gdi32' name 'GetCharWidthFloatW';
-function GetCompressedFileSize(lpFileName:LPCWSTR; lpFileSizeHigh:LPDWORD):DWORD; external 'kernel32' name 'GetCompressedFileSizeW';
-function GetComputerName(lpBuffer:LPWSTR; nSize:LPDWORD):WINBOOL; external 'kernel32' name 'GetComputerNameW';
-function GetCharABCWidths(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPABC):WINBOOL; external GdiDLL name 'GetCharABCWidthsW';
-function GetCharWidth32(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPINT):WINBOOL; external GdiDLL name 'GetCharWidth32W';
-function GetClassInfoEx(_para1:HINST; _para2:LPCWSTR; _para3:LPWNDCLASSEX):WINBOOL; external 'user32' name 'GetClassInfoExW';
-function GetConsoleTitle(lpConsoleTitle:LPWSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetConsoleTitleW';
-function GetCurrentDirectory(nBufferLength:DWORD; lpBuffer:LPWSTR):DWORD; external 'kernel32' name 'GetCurrentDirectoryW';
-function GetDefaultCommConfig(lpszName:LPCWSTR; lpCC:LPCOMMCONFIG; lpdwSize:LPDWORD):WINBOOL; external 'kernel32' name 'GetDefaultCommConfigW';
-function GetDiskFreeSpace(lpRootPathName:LPCWSTR; lpSectorsPerCluster:LPDWORD; lpBytesPerSector:LPDWORD; lpNumberOfFreeClusters:LPDWORD; lpTotalNumberOfClusters:LPDWORD):WINBOOL; external 'kernel32' name 'GetDiskFreeSpaceW';
-function GetDriveType(lpRootPathName:LPCWSTR):UINT; external 'kernel32' name 'GetDriveTypeW';
-function GetEnhMetaFile(_para1:LPCWSTR):HENHMETAFILE; external 'gdi32' name 'GetEnhMetaFileW';
-function GetEnhMetaFileDescription(_para1:HENHMETAFILE; _para2:UINT; _para3:LPWSTR):UINT; external 'gdi32' name 'GetEnhMetaFileDescriptionW';
-function GetEnvironmentStrings : LPWSTR; external 'kernel32' name 'GetEnvironmentStringsW';
-function GetEnvironmentVariable(lpName:LPCWSTR; lpBuffer:LPWSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetEnvironmentVariableW';
-function GetFileSecurity(lpFileName:LPCWSTR; RequestedInformation:SECURITY_INFORMATION; pSecurityDescriptor:PSECURITY_DESCRIPTOR; nLength:DWORD; lpnLengthNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'GetFileSecurityW';
-function GetFileTitle(_para1:LPCWSTR; _para2:LPWSTR; _para3:WORD):integer; external 'comdlg32' name 'GetFileTitleW';
-function GetFullPathName(lpFileName:LPCWSTR; nBufferLength:DWORD; lpBuffer:LPWSTR; var lpFilePart:LPWSTR):DWORD; external 'kernel32' name 'GetFullPathNameW';
-function GetGlyphOutline(_para1:HDC; _para2:UINT; _para3:UINT; _para4:LPGLYPHMETRICS; _para5:DWORD;_para6:LPVOID; _para7:PMAT2):DWORD; external 'gdi32' name 'GetGlyphOutlineW';
-function GetICMProfile(_para1:HDC; _para2:DWORD; _para3:LPWSTR):WINBOOL; external 'gdi32' name 'GetICMProfileW';
-function GetKeyNameText(lParam:LONG; lpString:LPWSTR; nSize:Integer):Integer; external 'user32' name 'GetKeyNameTextW';
-function GetKerningPairs(_para1:HDC; _para2:DWORD; _para3:LPKERNINGPAIR):DWORD; external 'gdi32' name 'GetKerningPairsW';
-function GetLogColorSpace(_para1:HCOLORSPACE; _para2:LPLOGCOLORSPACE; _para3:DWORD):WINBOOL; external 'gdi32' name 'GetLogColorSpaceW';
-function GetLogicalDriveStrings(nBufferLength:DWORD; lpBuffer:LPWSTR):DWORD; external 'kernel32' name 'GetLogicalDriveStringsW';
-function GetMenuString(hMenu:HMENU; uIDItem:UINT; lpString:LPWSTR; nMaxCount:Integer; uFlag:UINT):Integer; external 'user32' name 'GetMenuStringW';
-function GetMetaFile(_para1:LPCWSTR):HMETAFILE; external 'gdi32' name 'GetMetaFileW';
-function GetNamedPipeHandleState(hNamedPipe:HANDLE; lpState:LPDWORD; lpCurInstances:LPDWORD; lpMaxCollectionCount:LPDWORD; lpCollectDataTimeout:LPDWORD;lpUserName:LPWSTR; nMaxUserNameSize:DWORD):WINBOOL;
- external 'kernel32' name 'GetNamedPipeHandleStateW';
-function GetTextExtentPoint(_para1:HDC; _para2:LPCWSTR; _para3:Integer; _para4:LPSIZE):WINBOOL; external 'gdi32' name 'GetTextExtentPointW';
-function GetTextExtentPoint32(_para1:HDC; _para2:LPCWSTR; _para3:Integer; _para4:LPSIZE):WINBOOL; external 'gdi32' name 'GetTextExtentPoint32W';
-function GetOutlineTextMetrics(_para1:HDC; _para2:UINT; _para3:LPOUTLINETEXTMETRIC):UINT; external 'gdi32' name 'GetOutlineTextMetricsW';
-function GetProfileInt(lpAppName:LPCWSTR; lpKeyName:LPCWSTR; nDefault:WINT):UINT; external 'kernel32' name 'GetProfileIntW';
-function GetProfileString(lpAppName:LPCWSTR; lpKeyName:LPCWSTR; lpDefault:LPCWSTR; lpReturnedString:LPWSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetProfileStringW';
-function GetProfileSection(lpAppName:LPCWSTR; lpReturnedString:LPWSTR; nSize:DWORD):DWORD; external 'kernel32' name 'GetProfileSectionW';
-//was in func.inc, wince has W
-function GetProcAddress(hModule:HINST; lpProcName:LPCSTR):FARPROC; external 'kernel32' name 'GetProcAddress';
-function GetProp(hWnd:HWND; lpString:LPCWSTR):HANDLE; external 'user32' name 'GetPropW';
-function GetPrivateProfileInt(lpAppName:LPCWSTR; lpKeyName:LPCWSTR; nDefault:WINT; lpFileName:LPCWSTR):UINT; external 'kernel32' name 'GetPrivateProfileIntW';
-function GetPrivateProfileString(lpAppName:LPCWSTR; lpKeyName:LPCWSTR; lpDefault:LPCWSTR; lpReturnedString:LPWSTR; nSize:DWORD;lpFileName:LPCWSTR):DWORD; external 'kernel32' name 'GetPrivateProfileStringW';
-function GetPrivateProfileSection(lpAppName:LPCWSTR; lpReturnedString:LPWSTR; nSize:DWORD; lpFileName:LPCWSTR):DWORD; external 'kernel32' name 'GetPrivateProfileSectionW';
-function GetServiceKeyName(hSCManager:SC_HANDLE; lpDisplayName:LPCWSTR; lpServiceName:LPWSTR; lpcchBuffer:LPDWORD):WINBOOL; external 'advapi32' name 'GetServiceKeyNameW';
-function GetServiceDisplayName(hSCManager:SC_HANDLE; lpServiceName:LPCWSTR; lpDisplayName:LPWSTR; lpcchBuffer:LPDWORD):WINBOOL; external 'advapi32' name 'GetServiceDisplayNameW';
-function GetShortPathName(lpszLongPath:LPCWSTR; lpszShortPath:LPWSTR; cchBuffer:DWORD):DWORD; external 'kernel32' name 'GetShortPathNameW';
-procedure GetStartupInfo(lpStartupInfo:LPSTARTUPINFO); external 'kernel32' name 'GetStartupInfoW';
-function GetStringType(dwInfoType:DWORD; lpSrcStr:LPCWSTR; cchSrc:Integer; lpCharType:LPWORD):WINBOOL; external 'kernel32' name 'GetStringTypeW';
-function GetSystemDirectory(lpBuffer:LPWSTR; uSize:UINT):UINT; external 'kernel32' name 'GetSystemDirectoryW';
-function GetTabbedTextExtent(hDC:HDC; lpString:LPCWSTR; nCount:Integer; nTabPositions:Integer; lpnTabStopPositions:LPINT):DWORD; external 'user32' name 'GetTabbedTextExtentW';
-function GetUserName(lpBuffer:LPWSTR; nSize:LPDWORD):WINBOOL; external 'advapi32' name 'GetUserNameW';
-function GetUserObjectInformation(hObj:HANDLE; nIndex:Integer; pvInfo:PVOID; nLength:DWORD; lpnLengthNeeded:LPDWORD):WINBOOL; external 'user32' name 'GetUserObjectInformationW';
-function GetVolumeInformation(lpRootPathName:LPCWSTR; lpVolumeNameBuffer:LPWSTR; nVolumeNameSize:DWORD; lpVolumeSerialNumber:LPDWORD; lpMaximumComponentLength:LPDWORD;lpFileSystemFlags:LPDWORD; lpFileSystemNameBuffer:LPWSTR;
- nFileSystemNameSize:DWORD):WINBOOL; external 'kernel32' name 'GetVolumeInformationW';
-function GetWindowsDirectory(lpBuffer:LPWSTR; uSize:UINT):UINT; external 'kernel32' name 'GetWindowsDirectoryW';
-function GlobalGetAtomName(nAtom:ATOM; lpBuffer:LPWSTR; nSize:Integer):UINT; external 'kernel32' name 'GlobalGetAtomNameW';
-function GrayString(hDC:HDC; hBrush:HBRUSH; lpOutputFunc:GRAYSTRINGPROC; lpData:LPARAM; nCount:Integer;X:Integer; Y:Integer; nWidth:Integer; nHeight:Integer):WINBOOL; external 'user32' name 'GrayStringW';
-function ImageList_LoadImage(hi:HINST; lpbmp:LPCWSTR; cx:Integer; cGrow:Integer; crMask:COLORREF;uType:UINT; uFlags:UINT):HIMAGELIST; external 'comctl32' name 'ImageList_LoadImageW';
-function IsBadStringPtr(lpsz:LPCWSTR; ucchMax:UINT):WINBOOL; external 'kernel32' name 'IsBadStringPtrW';
-function IsCharAlpha(ch:WCHAR):WINBOOL; external 'user32' name 'IsCharAlphaW';
-function IsCharAlphaNumeric(ch:WCHAR):WINBOOL; external 'user32' name 'IsCharAlphaNumericW';
-function IsCharUpper(ch:WCHAR):WINBOOL; external 'user32' name 'IsCharUpperW';
-function IsCharLower(ch:WCHAR):WINBOOL; external 'user32' name 'IsCharLowerW';
-function InitiateSystemShutdown(lpMachineName:LPWSTR; lpMessage:LPWSTR; dwTimeout:DWORD; bForceAppsClosed:WINBOOL; bRebootAfterShutdown:WINBOOL):WINBOOL; external 'advapi32' name 'InitiateSystemShutdownW';
-function InsertMenuItem(_para1:HMENU; _para2:UINT; _para3:WINBOOL; _para4:LPCMENUITEMINFO):WINBOOL; external 'user32' name 'InsertMenuItemW';
-function LoadCursorFromFile(lpFileName:LPCWSTR):HCURSOR; external 'user32' name 'LoadCursorFromFileW';
-function LoadMenuIndirect(lpMenuTemplate:LPMENUTEMPLATE):HMENU; external 'user32' name 'LoadMenuIndirectW';
-function LogonUser(_para1:LPWSTR; _para2:LPWSTR; _para3:LPWSTR; _para4:DWORD; _para5:DWORD;_para6:PHANDLE):WINBOOL; external 'advapi32' name 'LogonUserW';
-function LookupAccountName(lpSystemName:LPCWSTR; lpAccountName:LPCWSTR; Sid:PSID; cbSid:LPDWORD; ReferencedDomainName:LPWSTR;cbReferencedDomainName:LPDWORD; peUse:PSID_NAME_USE):WINBOOL; external 'advapi32' name 'LookupAccountNameW';
-function LookupAccountSid(lpSystemName:LPCWSTR; Sid:PSID; Name:LPWSTR; cbName:LPDWORD; ReferencedDomainName:LPWSTR;cbReferencedDomainName:LPDWORD; peUse:PSID_NAME_USE):WINBOOL; external 'advapi32' name 'LookupAccountSidW';
-function LookupPrivilegeDisplayName(lpSystemName:LPCWSTR; lpName:LPCWSTR; lpDisplayName:LPWSTR; cbDisplayName:LPDWORD; lpLanguageId:LPDWORD):WINBOOL; external 'advapi32' name 'LookupPrivilegeDisplayNameW';
-function LookupPrivilegeName(lpSystemName:LPCWSTR; lpLuid:PLUID; lpName:LPWSTR; cbName:LPDWORD):WINBOOL; external 'advapi32' name 'LookupPrivilegeNameW';
-function LookupPrivilegeValue(lpSystemName:LPCWSTR; lpName:LPCWSTR; lpLuid:PLUID):WINBOOL; external 'advapi32' name 'LookupPrivilegeValueW';
-function lstrcat(lpString1:LPWSTR; lpString2:LPCWSTR):LPWSTR; external 'kernel32' name 'lstrcatW';
-function lstrcpyn(lpString1:LPWSTR; lpString2:LPCWSTR; iMaxLength:Integer):LPWSTR; external 'kernel32' name 'lstrcpynW';
-function lstrcpy(lpString1:LPWSTR; lpString2:LPCWSTR):LPWSTR; external 'kernel32' name 'lstrcpyW';
-function lstrlen(lpString:LPCWSTR):Integer; external 'kernel32' name 'lstrlenW';
-function MapVirtualKeyEx(uCode:UINT; uMapType:UINT; dwhkl:HKL):UINT; external 'user32' name 'MapVirtualKeyExW';
-function ModifyMenu(hMnu:HMENU; uPosition:UINT; uFlags:UINT; uIDNewItem:UINT; lpNewItem:LPCWSTR):WINBOOL; external 'user32' name 'ModifyMenuW';
-function MoveFileEx(lpExistingFileName:LPCWSTR; lpNewFileName:LPCWSTR; dwFlags:DWORD):WINBOOL; external 'kernel32' name 'MoveFileExW';
-function MessageBoxEx(hWnd:HWND; lpText:LPCWSTR; lpCaption:LPCWSTR; uType:UINT; wLanguageId:WORD):Integer; external UserDLLCore name 'MessageBoxExW';
-function MessageBoxIndirect(_para1:LPMSGBOXPARAMS):Integer; external UserDLLCore name 'MessageBoxIndirectW';
-function MultinetGetConnectionPerformance(lpNetResource:LPNETRESOURCE; lpNetConnectInfoStruct:LPNETCONNECTINFOSTRUCT):DWORD; external 'mpr' name 'MultinetGetConnectionPerformanceW';
-function ObjectCloseAuditAlarm(SubsystemName:LPCWSTR; HandleId:LPVOID; GenerateOnClose:WINBOOL):WINBOOL; external 'advapi32' name 'ObjectCloseAuditAlarmW';
-function ObjectOpenAuditAlarm(SubsystemName:LPCWSTR; HandleId:LPVOID; ObjectTypeName:LPWSTR; ObjectName:LPWSTR; pSecurityDescriptor:PSECURITY_DESCRIPTOR;ClientToken:HANDLE; DesiredAccess:DWORD; GrantedAccess:DWORD;
- Privileges:PPRIVILEGE_SET; ObjectCreation:WINBOOL;AccessGranted:WINBOOL; GenerateOnClose:LPBOOL):WINBOOL; external 'advapi32' name 'ObjectOpenAuditAlarmW';
-function ObjectPrivilegeAuditAlarm(SubsystemName:LPCWSTR; HandleId:LPVOID; ClientToken:HANDLE; DesiredAccess:DWORD; Privileges:PPRIVILEGE_SET;AccessGranted:WINBOOL):WINBOOL; external 'advapi32' name 'ObjectPrivilegeAuditAlarmW';
-function OemToChar(lpszSrc:LPCSTR; lpszDst:LPWSTR):WINBOOL; external 'user32' name 'OemToCharW';
-function OemToCharBuff(lpszSrc:LPCSTR; lpszDst:LPWSTR; cchDstLength:DWORD):WINBOOL; external 'user32' name 'OemToCharBuffW';
-function OpenBackupEventLog(lpUNCServerName:LPCWSTR; lpFileName:LPCWSTR):HANDLE; external 'advapi32' name 'OpenBackupEventLogW';
-function OpenDesktop(lpszDesktop:LPWSTR; dwFlags:DWORD; fInherit:WINBOOL; dwDesiredAccess:DWORD):HDESK; external 'user32' name 'OpenDesktopW';
-function OpenEventLog(lpUNCServerName:LPCWSTR; lpSourceName:LPCWSTR):HANDLE; external 'advapi32' name 'OpenEventLogW';
-function OpenFileMapping(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; lpName:LPCWSTR):HANDLE; external 'kernel32' name 'OpenFileMappingW';
-function OpenMutex(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; lpName:LPCWSTR):HANDLE; external 'kernel32' name 'OpenMutexW';
-function OpenSCManager(lpMachineName:LPCWSTR; lpDatabaseName:LPCWSTR; dwDesiredAccess:DWORD):SC_HANDLE; external 'advapi32' name 'OpenSCManagerW';
-function OpenSemaphore(dwDesiredAccess:DWORD; bInheritHandle:WINBOOL; lpName:LPCWSTR):HANDLE; external 'kernel32' name 'OpenSemaphoreW';
-function OpenService(hSCManager:SC_HANDLE; lpServiceName:LPCWSTR; dwDesiredAccess:DWORD):SC_HANDLE; external 'advapi32' name 'OpenServiceW';
-function OpenWindowStation(lpszWinSta:LPWSTR; fInherit:WINBOOL; dwDesiredAccess:DWORD):HWINSTA; external 'user32' name 'OpenWindowStationW';
-function PeekConsoleInput(hConsoleInput:HANDLE; lpBuffer:PINPUTRECORD; nLength:DWORD; lpNumberOfEventsRead:LPDWORD):WINBOOL; external 'kernel32' name 'PeekConsoleInputW';
-function PolyTextOut(_para1:HDC; _para2:PPOLYTEXT; _para3:Integer):WINBOOL; external 'gdi32' name 'PolyTextOutW';
-function PrintDlg(_para1:LPPRINTDLG):WINBOOL; external 'comdlg32' name 'PrintDlgW';
-function PrivilegedServiceAuditAlarm(SubsystemName:LPCWSTR; ServiceName:LPCWSTR; ClientToken:HANDLE; Privileges:PPRIVILEGE_SET; AccessGranted:WINBOOL):WINBOOL; external 'advapi32' name 'PrivilegedServiceAuditAlarmW';
-function QueryDosDevice(lpDeviceName:LPCWSTR; lpTargetPath:LPWSTR; ucchMax:DWORD):DWORD; external 'kernel32' name 'QueryDosDeviceW';
-function QueryServiceConfig(hService:SC_HANDLE; lpServiceConfig:LPQUERY_SERVICE_CONFIG; cbBufSize:DWORD; pcbBytesNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'QueryServiceConfigW';
-function QueryServiceLockStatus(hSCManager:SC_HANDLE; lpLockStatus:LPQUERY_SERVICE_LOCK_STATUS; cbBufSize:DWORD; pcbBytesNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'QueryServiceLockStatusW';
-function ReadConsole(hConsoleInput:HANDLE; lpBuffer:LPVOID; nNumberOfCharsToRead:DWORD; lpNumberOfCharsRead:LPDWORD; lpReserved:LPVOID):WINBOOL; external 'kernel32' name 'ReadConsoleW';
-function ReadConsoleInput(hConsoleInput:HANDLE; lpBuffer:PINPUTRECORD; nLength:DWORD; lpNumberOfEventsRead:LPDWORD):WINBOOL; external 'kernel32' name 'ReadConsoleInputW';
-function ReadConsoleOutput(hConsoleOutput:HANDLE; lpBuffer:PCHAR_INFO; dwBufferSize:COORD; dwBufferCoord:COORD; lpReadRegion:PSMALL_RECT):WINBOOL; external 'kernel32' name 'ReadConsoleOutputW';
-function ReadConsoleOutputCharacter(hConsoleOutput:HANDLE; lpCharacter:LPWSTR; nLength:DWORD; dwReadCoord:COORD; lpNumberOfCharsRead:LPDWORD):WINBOOL; external 'kernel32' name 'ReadConsoleOutputCharacterW';
-function ReadEventLog(hEventLog:HANDLE; dwReadFlags:DWORD; dwRecordOffset:DWORD; lpBuffer:LPVOID; nNumberOfBytesToRead:DWORD;pnBytesRead:LPDWORD; pnMinNumberOfBytesNeeded:LPDWORD):WINBOOL; external 'advapi32' name 'ReadEventLogW';
-function RegConnectRegistry(lpMachineName:LPWSTR; hKey:HKEY; phkResult:PHKEY):LONG; external 'advapi32' name 'RegConnectRegistryW';
-function RegisterClassEx(_para1:LPWNDCLASSEXW):ATOM; external 'user32' name 'RegisterClassExW';
-function RegisterEventSource(lpUNCServerName:LPCWSTR; lpSourceName:LPCWSTR):HANDLE; external 'advapi32' name 'RegisterEventSourceW';
-function RegisterServiceCtrlHandler(lpServiceName:LPCWSTR; lpHandlerProc:LPHANDLER_FUNCTION):SERVICE_STATUS_HANDLE; external 'advapi32' name 'RegisterServiceCtrlHandlerW';
-function RegEnumKey(hKey:HKEY; dwIndex:DWORD; lpName:LPWSTR; cbName:DWORD):LONG; external 'advapi32' name 'RegEnumKeyW';
-function RegLoadKey(hKey:HKEY; lpSubKey:LPCWSTR; lpFile:LPCWSTR):LONG; external 'advapi32' name 'RegLoadKeyW';
-function RegOpenKey(hKey:HKEY; lpSubKey:LPCWSTR; phkResult:PHKEY):LONG; external 'advapi32' name 'RegOpenKeyW';
-function RegQueryMultipleValues(hKey:HKEY; val_list:PVALENT; num_vals:DWORD; lpValueBuf:LPWSTR; ldwTotsize:LPDWORD):LONG; external 'advapi32' name 'RegQueryMultipleValuesW';
-function RegQueryValue(hKey:HKEY; lpSubKey:LPCWSTR; lpValue:LPWSTR; lpcbValue:PLONG):LONG; external 'advapi32' name 'RegQueryValueW';
-function RegRestoreKey(hKey:HKEY; lpFile:LPCWSTR; dwFlags:DWORD):LONG; external 'advapi32' name 'RegRestoreKeyW';
-function RegSetValue(hKey:HKEY; lpSubKey:LPCWSTR; dwType:DWORD; lpData:LPCWSTR; cbData:DWORD):LONG; external 'advapi32' name 'RegSetValueW';
-function RegSaveKey(hKey:HKEY; lpFile:LPCWSTR; lpSecurityAttributes:LPSECURITY_ATTRIBUTES):LONG; external 'advapi32' name 'RegSaveKeyW';
-function RegUnLoadKey(hKey:HKEY; lpSubKey:LPCWSTR):LONG; external 'advapi32' name 'RegUnLoadKeyW';
-function RemoveProp(hWnd:HWND; lpString:LPCWSTR):HANDLE; external 'user32' name 'RemovePropW';
-function RegCreateKey(hKey:HKEY; lpSubKey:LPCWSTR; phkResult:PHKEY):LONG; external 'advapi32' name 'RegCreateKeyW';
-function RegReplaceKey(hKey:HKEY; lpSubKey:LPCWSTR; lpNewFile:LPCWSTR; lpOldFile:LPCWSTR):LONG; external 'advapi32' name 'RegReplaceKeyW';
-function ReplaceText(_para1:LPFINDREPLACE):HWND; external 'comdlg32' name 'ReplaceTextW';
-function ReportEvent(hEventLog:HANDLE; wType:WORD; wCategory:WORD; dwEventID:DWORD; lpUserSid:PSID;wNumStrings:WORD; dwDataSize:DWORD; lpStrings:LPCWSTR; lpRawData:LPVOID):WINBOOL; external 'advapi32' name 'ReportEventW';
- GrantedAccess:LPDWORD; AccessStatus:LPBOOL;pfGenerateOnClose:LPBOOL):WINBOOL; external 'advapi32' name 'AccessCheckAndAuditAlarmW';
-function ResetDC(_para1:HDC; _para2:LPDEVMODE):HDC; external 'gdi32' name 'ResetDCW';
-function ScrollConsoleScreenBuffer(hConsoleOutput:HANDLE; lpScrollRectangle:PSMALL_RECT; lpClipRectangle:PSMALL_RECT; dwDestinationOrigin:COORD; lpFill:PCHAR_INFO):WINBOOL; external 'kernel32' name 'ScrollConsoleScreenBufferW';
-function SearchPath(lpPath:LPCWSTR; lpFileName:LPCWSTR; lpExtension:LPCWSTR; nBufferLength:DWORD; lpBuffer:LPWSTR;lpFilePart:LPWSTR):DWORD; external 'kernel32' name 'SearchPathW';
-function SendMessageCallback(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM; lpResultCallBack:SENDASYNCPROC;dwData:DWORD):WINBOOL; external 'user32' name 'SendMessageCallbackW';
-function SendMessageTimeout(hWnd:HWND; Msg:UINT; wParam:WPARAM; lParam:LPARAM; fuFlags:UINT;uTimeout:UINT; lpdwResult:LPDWORD):LRESULT; external 'user32' name 'SendMessageTimeoutW';
-function SetComputerName(lpComputerName:LPCWSTR):WINBOOL; external 'kernel32' name 'SetComputerNameW';
-function SetConsoleTitle(lpConsoleTitle:LPCWSTR):WINBOOL; external 'kernel32' name 'SetConsoleTitleW';
-function SetCurrentDirectory(lpPathName:LPCWSTR):WINBOOL; external 'kernel32' name 'SetCurrentDirectoryW';
-function SetDefaultCommConfig(lpszName:LPCWSTR; lpCC:LPCOMMCONFIG; dwSize:DWORD):WINBOOL; external 'kernel32' name 'SetDefaultCommConfigW';
-function SetEnvironmentVariable(lpName:LPCWSTR; lpValue:LPCWSTR):WINBOOL; external 'kernel32' name 'SetEnvironmentVariableW';
-function SetFileSecurity(lpFileName:LPCWSTR; SecurityInformation:SECURITY_INFORMATION; pSecurityDescriptor:PSECURITY_DESCRIPTOR):WINBOOL; external 'advapi32' name 'SetFileSecurityW';
-function SetICMProfile(_para1:HDC; _para2:LPWSTR):WINBOOL; external 'gdi32' name 'SetICMProfileW';
-function SetProp(hWnd:HWND; lpString:LPCWSTR; hData:HANDLE):WINBOOL; external 'user32' name 'SetPropW';
-function SetUserObjectInformation(hObj:HANDLE; nIndex:Integer; pvInfo:PVOID; nLength:DWORD):WINBOOL; external 'user32' name 'SetUserObjectInformationW';
-function SetVolumeLabel(lpRootPathName:LPCWSTR; lpVolumeName:LPCWSTR):WINBOOL; external 'kernel32' name 'SetVolumeLabelW';
-function ShellAbout(_para1:HWND; _para2:LPCWSTR; _para3:LPCWSTR; _para4:HICON):Integer; external 'shell32' name 'ShellAboutW';
-function ShellExecute(_para1:HWND; _para2:LPCWSTR; _para3:LPCWSTR; _para4:LPCWSTR; _para5:LPCWSTR;_para6:Integer):HINST; external 'shell32' name 'ShellExecuteW';
-function Shell_NotifyIcon(dwMessage: DWORD; lpData: PNotifyIconDataA): WINBOOL; external 'shell32' name 'Shell_NotifyIconW';
-function StartServiceCtrlDispatcher(lpServiceStartTable:LPSERVICE_TABLE_ENTRY):WINBOOL; external 'advapi32' name 'StartServiceCtrlDispatcherW';
-function StartService(hService:SC_HANDLE; dwNumServiceArgs:DWORD; lpServiceArgVectors:LPCWSTR):WINBOOL; external 'advapi32' name 'StartServiceW';
-function TabbedTextOut(hDC:HDC; X:Integer; Y:Integer; lpString:LPCWSTR; nCount:Integer;nTabPositions:Integer; lpnTabStopPositions:LPINT; nTabOrigin:Integer):LONG; external 'user32' name 'TabbedTextOutW';
-function TextOut(_para1:HDC; _para2:Integer; _para3:Integer; _para4:LPCWSTR; _para5:Integer):WINBOOL; external 'gdi32' name 'TextOutW';
-function UpdateICMRegKey(_para1:DWORD; _para2:DWORD; _para3:LPWSTR; _para4:UINT):WINBOOL; external 'gdi32' name 'UpdateICMRegKeyW';
-function UpdateResource(hUpdate:HANDLE; lpType:LPCWSTR; lpName:LPCWSTR; wLanguage:WORD; lpData:LPVOID;cbData:DWORD):WINBOOL; external 'kernel32' name 'UpdateResourceW';
-function VerFindFile(uFlags:DWORD; szFileName:LPWSTR; szWinDir:LPWSTR; szAppDir:LPWSTR; szCurDir:LPWSTR;lpuCurDirLen:PUINT; szDestDir:LPWSTR; lpuDestDirLen:PUINT):DWORD; external 'version' name 'VerFindFileW';
-function VerInstallFile(uFlags:DWORD; szSrcFileName:LPWSTR; szDestFileName:LPWSTR; szSrcDir:LPWSTR; szDestDir:LPWSTR;szCurDir:LPWSTR; szTmpFile:LPWSTR; lpuTmpFileLen:PUINT):DWORD; external 'version' name 'VerInstallFileW';
-function VerLanguageName(wLang:DWORD; szLang:LPWSTR; nSize:DWORD):DWORD; external 'kernel32' name 'VerLanguageNameW';
-function VkKeyScan(ch:WCHAR):SHORT; external 'user32' name 'VkKeyScanW';
-function VkKeyScanEx(ch:WCHAR; dwhkl:HKL):SHORT; external 'user32' name 'VkKeyScanExW';
-function WaitNamedPipe(lpNamedPipeName:LPCWSTR; nTimeOut:DWORD):WINBOOL; external 'kernel32' name 'WaitNamedPipeW';
-function WinHelp(hWndMain:HWND; lpszHelp:LPCWSTR; uCommand:UINT; dwData:DWORD):WINBOOL; external 'user32' name 'WinHelpW';
-function WNetAddConnection(lpRemoteName:LPCWSTR; lpPassword:LPCWSTR; lpLocalName:LPCWSTR):DWORD; external 'mpr' name 'WNetAddConnectionW';
-function WNetAddConnection2(lpNetResource:LPNETRESOURCE; lpPassword:LPCWSTR; lpUserName:LPCWSTR; dwFlags:DWORD):DWORD; external 'mpr' name 'WNetAddConnection2W';
-function WNetCancelConnection(lpName:LPCWSTR; fForce:WINBOOL):DWORD; external 'mpr' name 'WNetCancelConnectionW';
-function WNetGetProviderName(dwNetType:DWORD; lpProviderName:LPWSTR; lpBufferSize:LPDWORD):DWORD; external 'mpr' name 'WNetGetProviderNameW';
-function WNetGetNetworkInformation(lpProvider:LPCWSTR; lpNetInfoStruct:LPNETINFOSTRUCT):DWORD; external 'mpr' name 'WNetGetNetworkInformationW';
-function WNetGetLastError(lpError:LPDWORD; lpErrorBuf:LPWSTR; nErrorBufSize:DWORD; lpNameBuf:LPWSTR; nNameBufSize:DWORD):DWORD; external 'mpr' name 'WNetGetLastErrorW';
-function WNetSetConnection(lpName:LPCWSTR; dwProperties:DWORD; pvValues:LPVOID):DWORD; external 'mpr' name 'WNetSetConnectionW';
-function WNetUseConnection(hwndOwner:HWND; lpNetResource:LPNETRESOURCE; lpUserID:LPCWSTR; lpPassword:LPCWSTR; dwFlags:DWORD;lpAccessName:LPWSTR; lpBufferSize:LPDWORD; lpResult:LPDWORD):DWORD; external 'mpr' name 'WNetUseConnectionW';
-function WriteConsole(hConsoleOutput:HANDLE;lpBuffer:pointer; nNumberOfCharsToWrite:DWORD; lpNumberOfCharsWritten:LPDWORD; lpReserved:LPVOID):WINBOOL; external 'kernel32' name 'WriteConsoleW';
-function WriteConsoleInput(hConsoleInput:HANDLE; lpBuffer:PINPUTRECORD; nLength:DWORD; lpNumberOfEventsWritten:LPDWORD):WINBOOL; external 'kernel32' name 'WriteConsoleInputW';
-function WriteConsoleOutput(hConsoleOutput:HANDLE; lpBuffer:PCHAR_INFO; dwBufferSize:COORD; dwBufferCoord:COORD; lpWriteRegion:PSMALL_RECT):WINBOOL; external 'kernel32' name 'WriteConsoleOutputW';
-function WriteConsoleOutputCharacter(hConsoleOutput:HANDLE; lpCharacter:LPCWSTR; nLength:DWORD; dwWriteCoord:COORD; lpNumberOfCharsWritten:LPDWORD):WINBOOL; external 'kernel32' name 'WriteConsoleOutputCharacterW';
-function WritePrivateProfileSection(lpAppName:LPCWSTR; lpString:LPCWSTR; lpFileName:LPCWSTR):WINBOOL; external 'kernel32' name 'WritePrivateProfileSectionW';
-function WritePrivateProfileString(lpAppName:LPCWSTR; lpKeyName:LPCWSTR; lpString:LPCWSTR; lpFileName:LPCWSTR):WINBOOL; external 'kernel32' name 'WritePrivateProfileStringW';
-function WriteProfileSection(lpAppName:LPCWSTR; lpString:LPCWSTR):WINBOOL; external 'kernel32' name 'WriteProfileSectionW';
-function WriteProfileString(lpAppName:LPCWSTR; lpKeyName:LPCWSTR; lpString:LPCWSTR):WINBOOL; external 'kernel32' name 'WriteProfileStringW';
-
-//end win32 only
-{$endif WIN32}
-
-{$endif read_interface}
-
-
-{$ifdef read_implementation}
-
-//begin common win32 & wince
-
-function CommDlg_OpenSave_GetFolderPath(_hdlg:HWND;_psz:LPWSTR;_cbmax : Integer) : LRESULT;
-begin
- CommDlg_OpenSave_GetFolderPath:=SNDMSG(_hdlg,CDM_GETFOLDERPATH,WPARAM(_cbmax),LPARAM(LPWSTR(_psz)));
-end;
-
-function CommDlg_OpenSave_GetFilePath(_hdlg:HWND;_psz:LPWSTR;_cbmax : Integer) : LRESULT;
-begin
- CommDlg_OpenSave_GetFilePath:=SNDMSG(_hdlg,CDM_GETFILEPATH,WPARAM(_cbmax),LPARAM(_psz));
-end;
-
-function CommDlg_OpenSave_GetSpec(_hdlg:HWND;_psz:LPWSTR;_cbmax : Integer) : LRESULT;
-begin
- CommDlg_OpenSave_GetSpec:=SNDMSG(_hdlg,CDM_GETSPEC,WPARAM(_cbmax),LPARAM(_psz));
-end;
-
-function CreateWindow(lpClassName:LPCWSTR; lpWindowName:LPCWSTR; dwStyle:DWORD; X:Integer;Y:Integer; nWidth:Integer; nHeight:Integer; hWndParent:HWND; hMenu:HMENU;hInstance:HINST; lpParam:LPVOID):HWND;
-begin
- CreateWindow:=CreateWindowEx(0,lpClassName,lpWindowName,dwStyle,x,y,nWidth,nHeight,hWndParent,hMenu,hInstance,lpParam);
-end;
-
-function CreateDialogIndirect(hInstance:HINST; lpTemplate:LPCDLGTEMPLATE; hWndParent:HWND; lpDialogFunc:DLGPROC):HWND;
-begin
- CreateDialogIndirect:=CreateDialogIndirectParam(hInstance,lpTemplate,hWndParent,lpDialogFunc,0);
-end;
-
-function DialogBoxIndirect(hInstance:HINST; lpTemplate:LPCDLGTEMPLATEW; hWndParent:HWND; lpDialogFunc:DLGPROC):Integer;
-begin
- DialogBoxIndirect:=DialogBoxIndirectParam(hInstance,lpTemplate,hWndParent,lpDialogFunc,0);
-end;
-
-//end common win32 & wince
-
-{$ifdef WINCE}
-//begin wince only
-
-//end wince only
-{$endif WINCE}
-
-{$ifdef WIN32}
-//begin win32 only
-
-function CreateDialog(hInstance:HINST; lpName:LPCWSTR; hWndParent:HWND; lpDialogFunc:DLGPROC):HWND;
-begin
- CreateDialog:=CreateDialogParam(hInstance,lpName,hWndParent,lpDialogFunc,0);
-end;
-
-function DialogBox(hInstance:HINST; lpTemplate:LPCWSTR; hWndParent:HWND; lpDialogFunc:DLGPROC):Integer;
-begin
- DialogBox:=DialogBoxParam(hInstance,lpTemplate,hWndParent,lpDialogFunc,0);
-end;
-
-//end win32 only
-
-
-
-{$endif WIN32}
-
-{$endif read_implementation}
-
diff --git a/rtl/wince/winres.inc b/rtl/wince/winres.inc deleted file mode 100644 index 4b55ef7730..0000000000 --- a/rtl/wince/winres.inc +++ /dev/null @@ -1,45 +0,0 @@ -
-function SysFindResource(hModule:HMODULE; lpName: PWideChar; lpType: PWideChar):TResourceHandle; external 'coredll' name 'FindResourceW';
-function SysLoadResource(hModule:HMODULE; hResInfo: TResourceHandle):HGLOBAL; external 'coredll' name 'LoadResource';
-function SysSizeofResource(hModule:HMODULE; hResInfo:TResourceHandle):DWORD; external 'coredll' name 'SizeofResource';
-
-Function HINSTANCE: HMODULE;
-begin
- Result:=sysinstance;
-end;
-
-Function FindResource(ModuleHandle: HMODULE; ResourceName, ResourceType: PChar): TResourceHandle;
-var
- ws1, ws2: PWideChar;
-begin
- ws1:=PCharToPWideChar(ResourceName);
- ws2:=PCharToPWideChar(ResourceType);
- Result:=SysFindResource(ModuleHandle, ws1, ws2);
- FreeMem(ws2);
- FreeMem(ws1);
-end;
-
-Function LoadResource(ModuleHandle: HMODULE; ResHandle: TResourceHandle): HGLOBAL;
-begin
- Result:=SysLoadresource(ModuleHandle,Reshandle);
-end;
-
-Function SizeofResource(ModuleHandle: HMODULE; ResHandle: TResourceHandle): Integer;
-begin
- Result:=SysSizeofResource(ModuleHandle,Reshandle);
-end;
-
-Function LockResource(ResData: HGLOBAL): Pointer;
-begin
- Result:=pointer(ResData);
-end;
-
-Function UnlockResource(ResData: HGLOBAL): LongBool;
-begin
- UnlockResource := True;
-end;
-
-Function FreeResource(ResData: HGLOBAL): LongBool;
-begin
- FreeResource := True;
-end;
diff --git a/rtl/x86_64/math.inc b/rtl/x86_64/math.inc index be7a2fc2fd..cc5f4cad30 100644 --- a/rtl/x86_64/math.inc +++ b/rtl/x86_64/math.inc @@ -1,8 +1,8 @@ { - Implementation of mathematical routines for x86_64 - This file is part of the Free Pascal run time library. - Copyright (c) 1999-2005 by the Free Pascal development team + Copyright (c) 1999-2001 by the Free Pascal development team + + Implementation of mathematical routines (for extended type) See the file COPYING.FPC, included in this distribution, for details about the copyright. @@ -13,30 +13,10 @@ **********************************************************************} -label - FPC_ABSMASK_DOUBLE, - FPC_ABSMASK_SINGLE; - -procedure dummyproc;assembler; - asm - .data - .balign 16 - .globl FPC_ABSMASK_SINGLE -FPC_ABSMASK_SINGLE: - .quad 0x7FFFFFFF7FFFFFFF - .quad 0x7FFFFFFF7FFFFFFF - .globl FPC_ABSMASK_DOUBLE -FPC_ABSMASK_DOUBLE: - .quad 0x7FFFFFFFFFFFFFFF - .quad 0x7FFFFFFFFFFFFFFF - .text - end; - {**************************************************************************** FPU Control word ****************************************************************************} -{$ifndef WIN64} procedure Set8087CW(cw:word);assembler; asm movw cw,%ax @@ -58,7 +38,6 @@ FPC_ABSMASK_DOUBLE: fnstcw (%rsp) popq %rax end; -{$endif WIN64} {**************************************************************************** EXTENDED data type routines @@ -121,7 +100,6 @@ FPC_ABSMASK_DOUBLE: result:=0; end; -{$ifndef WIN64} {$define FPC_SYSTEM_HAS_EXP} function fpc_exp_real(d : ValReal) : ValReal;assembler;compilerproc; asm @@ -222,22 +200,22 @@ FPC_ABSMASK_DOUBLE: {$define FPC_SYSTEM_HAS_POWER} - function power(bas,expo : extended) : extended; - begin - if bas=0 then - begin - if expo<>0 then - power:=0.0 - else - HandleError(207); - end - else if expo=0 then - power:=1 + function power(bas,expo : extended) : extended; + begin + if bas=0 then + begin + if expo<>0 then + power:=0.0 + else + HandleError(207); + end + else if expo=0 then + power:=1 + else + { bas < 0 is not allowed } + if bas<0 then + handleerror(207) else - { bas < 0 is not allowed } - if bas<0 then - handleerror(207) - else - power:=exp(ln(bas)*expo); - end; -{$endif WIN64} + power:=exp(ln(bas)*expo); + end; + diff --git a/rtl/x86_64/x86_64.inc b/rtl/x86_64/x86_64.inc index c7592fff19..8609855d25 100644 --- a/rtl/x86_64/x86_64.inc +++ b/rtl/x86_64/x86_64.inc @@ -370,11 +370,9 @@ const {$define FPC_SYSTEM_HAS_SYSRESETFPU} Procedure SysResetFPU;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} asm -{$ifndef WIN64} { initialize fpu } fninit fwait -{$endif WIN64} {$ifdef FPC_PIC} movq fpucw@GOTPCREL(%rip),%rax fldcw (%rax) @@ -387,3 +385,4 @@ asm ldmxcsr mxcsr {$endif FPC_PIC} end; + diff --git a/tests/Makefile b/tests/Makefile index d68f744635..bb2ccf3e13 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -1,8 +1,8 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/10/17] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/11] # default: allexectests -MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince powerpc64-linux +MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince BSDs = freebsd netbsd openbsd darwin UNIXs = linux $(BSDs) solaris qnx LIMIT83fs = go32v2 os2 emx watcom @@ -1003,7 +1003,7 @@ ifeq ($(CPU_TARGET),i386) FPCCPUOPT:=-OG2p3 else ifeq ($(CPU_TARGET),powerpc) -FPCCPUOPT:=-O1r +FPCCPUOPT:=-O1 else FPCCPUOPT:= endif diff --git a/tests/test/tunroll1.pp b/tests/test/tunroll1.pp deleted file mode 100644 index 717b6b6f9a..0000000000 --- a/tests/test/tunroll1.pp +++ /dev/null @@ -1,17 +0,0 @@ -{ %OPT=-Nu } -var - i : integer; - s : single; - -begin - s:=0.0; - for i:=1 to 2 do - s:=s+1; - for i:=1 to 10 do - s:=s+1; - for i:=1 to 11 do - s:=s+1; - if s<>23 then - halt(1); - writeln('ok'); -end. diff --git a/tests/units/Makefile b/tests/units/Makefile index e67563c8d2..fe4bc12d02 100644 --- a/tests/units/Makefile +++ b/tests/units/Makefile @@ -1,8 +1,8 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/10/17] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/11] # default: all -MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince powerpc64-linux +MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince BSDs = freebsd netbsd openbsd darwin UNIXs = linux $(BSDs) solaris qnx LIMIT83fs = go32v2 os2 emx watcom @@ -338,9 +338,6 @@ endif ifeq ($(FULL_TARGET),arm-wince) override CLEAN_UNITS+=erroru popuperr ptest endif -ifeq ($(FULL_TARGET),powerpc64-linux) -override CLEAN_UNITS+=erroru popuperr ptest -endif override INSTALL_FPCPACKAGE=y ifeq ($(FULL_TARGET),i386-linux) override COMPILER_TARGETDIR+=$(FULL_TARGET) @@ -450,9 +447,6 @@ endif ifeq ($(FULL_TARGET),arm-wince) override COMPILER_TARGETDIR+=$(FULL_TARGET) endif -ifeq ($(FULL_TARGET),powerpc64-linux) -override COMPILER_TARGETDIR+=$(FULL_TARGET) -endif ifdef REQUIRE_UNITSDIR override UNITSDIR+=$(REQUIRE_UNITSDIR) endif @@ -1225,7 +1219,7 @@ ifeq ($(CPU_TARGET),i386) FPCCPUOPT:=-OG2p3 else ifeq ($(CPU_TARGET),powerpc) -FPCCPUOPT:=-O1r +FPCCPUOPT:=-O1 else FPCCPUOPT:= endif diff --git a/tests/utils/Makefile b/tests/utils/Makefile index 9389263408..2cee4f040d 100644 --- a/tests/utils/Makefile +++ b/tests/utils/Makefile @@ -1,8 +1,8 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/10/17] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/11] # default: all -MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince powerpc64-linux +MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince BSDs = freebsd netbsd openbsd darwin UNIXs = linux $(BSDs) solaris qnx LIMIT83fs = go32v2 os2 emx watcom @@ -338,9 +338,6 @@ endif ifeq ($(FULL_TARGET),arm-wince) override TARGET_PROGRAMS+=dotest fail testfail digest $(DBDIGEST) endif -ifeq ($(FULL_TARGET),powerpc64-linux) -override TARGET_PROGRAMS+=dotest fail testfail digest $(DBDIGEST) -endif override INSTALL_FPCPACKAGE=y ifdef REQUIRE_UNITSDIR override UNITSDIR+=$(REQUIRE_UNITSDIR) @@ -1114,7 +1111,7 @@ ifeq ($(CPU_TARGET),i386) FPCCPUOPT:=-OG2p3 else ifeq ($(CPU_TARGET),powerpc) -FPCCPUOPT:=-O1r +FPCCPUOPT:=-O1 else FPCCPUOPT:= endif diff --git a/tests/utils/testsuite/Makefile b/tests/utils/testsuite/Makefile index 24b45b9595..57d307ec3c 100644 --- a/tests/utils/testsuite/Makefile +++ b/tests/utils/testsuite/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/10] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/11] # default: all MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince diff --git a/tests/webtbs/tw2423.pp b/tests/webtbs/tw2423.pp index dba658d94d..fcafaa2aeb 100644 --- a/tests/webtbs/tw2423.pp +++ b/tests/webtbs/tw2423.pp @@ -70,7 +70,7 @@ begin begin setlength(s,i); break; - end; + end; s:=s+'demo.htm'; assign(t,s); rewrite(t,1); diff --git a/tests/webtbs/tw4010.pp b/tests/webtbs/tw4010.pp index 5af8ae42e3..20ec921acc 100644 --- a/tests/webtbs/tw4010.pp +++ b/tests/webtbs/tw4010.pp @@ -30,4 +30,4 @@ begin ar1:= GenByteArray('foo'); MaxByte(ar1); MaxByte(GenByteArray('foo')); // compiler stops here -end. +end.
\ No newline at end of file diff --git a/utils/Makefile b/utils/Makefile index 159878d31c..9f487dd115 100644 --- a/utils/Makefile +++ b/utils/Makefile @@ -879,11 +879,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/utils/debugsvr/Makefile b/utils/debugsvr/Makefile index 66540f35a3..23b17f53b9 100644 --- a/utils/debugsvr/Makefile +++ b/utils/debugsvr/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/10] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/11] # default: all MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince diff --git a/utils/debugsvr/console/Makefile b/utils/debugsvr/console/Makefile index e1ca02e025..be5e28229f 100644 --- a/utils/debugsvr/console/Makefile +++ b/utils/debugsvr/console/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/10] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/11] # default: all MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince diff --git a/utils/debugsvr/gtk/Makefile b/utils/debugsvr/gtk/Makefile index 43649b6103..44d2e25f04 100644 --- a/utils/debugsvr/gtk/Makefile +++ b/utils/debugsvr/gtk/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/10] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/11] # default: all MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince diff --git a/utils/fpcm/Makefile b/utils/fpcm/Makefile index 051049f90f..e8f397ac02 100644 --- a/utils/fpcm/Makefile +++ b/utils/fpcm/Makefile @@ -766,11 +766,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/utils/fpcm/fpcmake.inc b/utils/fpcm/fpcmake.inc index b0da6eca14..cff3b10807 100644 --- a/utils/fpcm/fpcmake.inc +++ b/utils/fpcm/fpcmake.inc @@ -1,2299 +1,2233 @@ {$ifdef Delphi} -const fpcmakeini : array[0..214] of string[240]=( +const fpcmakeini : array[0..205] of string[240]=( {$else Delphi} -const fpcmakeini : array[0..214,1..240] of char=( +const fpcmakeini : array[0..205,1..240] of char=( {$endif Delphi} - ';'#013#010+ - '; Templates used by fpcmake to create a Makefile from Makefile.fpc'#013+ - #010+ - ';'#013#010+ - #013#010+ - '[defines]'#013#010+ - '#####################################################################'#013+ - #010+ - '# Misc defines to be used by anyone'#013#010+ - '#############################################','#######################'+ - '#'#013#010+ - #013#010+ - '# OS categories'#013#010+ - 'BSDs = freebsd netbsd openbsd darwin'#013#010+ - 'UNIXs = linux $(BSDs) solaris qnx'#013#010+ - 'LIMIT83fs = go32v2 os2 emx watcom'#013#010+ - #013#010+ - '#Empty target for rules that always should run. Needed if'#013#010+ - '#the target is non-phoney,',' and there is non-phony prereqisites.'#013#010+ - '#Then add FORCE as an prerequisite'#013#010+ - '#See gnu make manual: 4.7 Rules without Commands or Prerequisites'#013#010+ - 'FORCE:'#013#010+ - '.PHONY: FORCE'#013#010+ - #013#010+ - '[osdetect]'#013#010+ - '#############################################################','#######'+ - '#'#013#010+ - '# Autodetect source OS (Linux or Dos or Windows NT or OS/2 or other)'#013+ - #010+ - '# define inUnix when running under Unix like environment'#013#010+ - '# (Linux,FreeBSD,NetBSD,OpenBSD,Darwin,Cygwin)'#013#010+ - '# define inWinNT when running under WinN','T'#013#010+ - '# define inOS2 when running under OS/2'#013#010+ - '# define inCygwin when running under Cygwin32'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ - '# We need only / in the path also remove the current dir,'#013#010+ - '# also remove trai','ling /'#039's'#013#010+ - 'override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))'#013#010+ - #013#010+ - '# Detect unix'#013#010+ - '# Darwin is handled specially'#013#010+ - 'ifneq ($(findstring darwin,$(OSTYPE)),)'#013#010+ - 'inUnix=1 #darwin'#013#010+ - 'SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))'#013#010+ - 'else'#013#010+ - '# Determine i','f we'#039've a unix searchpath by looking for a ;'#013#010+ - '# that normally doesn'#039't exists in the unix PATH var.'#013#010+ - 'ifeq ($(findstring ;,$(PATH)),)'#013#010+ - 'inUnix=1'#013#010+ - 'SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))'#013#010+ - 'else'#013#010+ - 'SEARCHPATH:=$(subst ;, ,$(PATH))'#013#010+ - 'endif'#013#010, - 'endif'#013#010+ - #013#010+ - '# Add path were make is located'#013#010+ - 'SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))'#013#010+ - #013#010+ - '# Search for PWD'#013#010+ - 'PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))'#013#010+ - 'ifeq ($(PWD),)'#013#010+ - 'PWD:=$(strip $(wildcard $(addsuffix /pwd,','$(SEARCHPATH))))'#013#010+ - 'ifeq ($(PWD),)'#013#010+ - '$(error You need the GNU utils package to use this Makefile)'#013#010+ - 'else'#013#010+ - 'PWD:=$(firstword $(PWD))'#013#010+ - 'SRCEXEEXT='#013#010+ - 'endif'#013#010+ - 'else'#013#010+ - 'PWD:=$(firstword $(PWD))'#013#010+ - 'SRCEXEEXT=.exe'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Detect NT - NT sets OS to Windows_','NT'#013#010+ - '# Detect OS/2 - OS/2 has OS2_SHELL defined'#013#010+ - 'ifndef inUnix'#013#010+ - 'ifeq ($(OS),Windows_NT)'#013#010+ - 'inWinNT=1'#013#010+ - 'else'#013#010+ - 'ifdef OS2_SHELL'#013#010+ - 'inOS2=1'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'else'#013#010+ - 'ifneq ($(findstring cygdrive,$(PATH)),)'#013#010+ - 'inCygWin=1'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# The extension of b','atch files / scripts'#013#010+ - 'ifdef inUnix'#013#010+ - 'SRCBATCHEXT=.sh'#013#010+ - 'else'#013#010+ - 'ifdef inOS2'#013#010+ - 'SRCBATCHEXT=.cmd'#013#010+ - 'else'#013#010+ - 'SRCBATCHEXT=.bat'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ + ';'#010+ + '; Templates used by fpcmake to create a Makefile from Makefile.fpc'#010+ + ';'#010+ + #010+ + '[defines]'#010+ + '#####################################################################'#010+ + '# Misc defines to be used by anyone'#010+ + '####################################################','################'+ + '#'#010+ + #010+ + '# OS categories'#010+ + 'BSDs = freebsd netbsd openbsd darwin'#010+ + 'UNIXs = linux $(BSDs) solaris qnx'#010+ + 'LIMIT83fs = go32v2 os2 emx watcom'#010+ + #010+ + '#Empty target for rules that always should run. Needed if'#010+ + '#the target is non-phoney, and there is n','on-phony prereqisites.'#010+ + '#Then add FORCE as an prerequisite'#010+ + '#See gnu make manual: 4.7 Rules without Commands or Prerequisites'#010+ + 'FORCE:'#010+ + '.PHONY: FORCE'#010+ + #010+ + '[osdetect]'#010+ + '#####################################################################'#010+ + '# Autodetect ','source OS (Linux or Dos or Windows NT or OS/2 or other)'+ + #010+ + '# define inUnix when running under Unix like environment'#010+ + '# (Linux,FreeBSD,NetBSD,OpenBSD,Darwin,Cygwin)'#010+ + '# define inWinNT when running under WinNT'#010+ + '# define inOS2 when runn','ing under OS/2'#010+ + '# define inCygwin when running under Cygwin32'#010+ + '#####################################################################'#010+ + #010+ + '# We need only / in the path also remove the current dir,'#010+ + '# also remove trailing /'#039's'#010+ + 'override PATH:=$(patsub','st %/,%,$(subst \,/,$(PATH)))'#010+ + #010+ + '# Detect unix'#010+ + '# Darwin is handled specially'#010+ + 'ifneq ($(findstring darwin,$(OSTYPE)),)'#010+ + 'inUnix=1 #darwin'#010+ + 'SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))'#010+ + 'else'#010+ + '# Determine if we'#039've a unix searchpath by looking for ','a ;'#010+ + '# that normally doesn'#039't exists in the unix PATH var.'#010+ + 'ifeq ($(findstring ;,$(PATH)),)'#010+ + 'inUnix=1'#010+ + 'SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))'#010+ + 'else'#010+ + 'SEARCHPATH:=$(subst ;, ,$(PATH))'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Add path were make is located'#010+ + 'SEARCHPATH','+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))'#010+ + #010+ + '# Search for PWD'#010+ + 'PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))'#010+ + 'ifeq ($(PWD),)'#010+ + 'PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))'#010+ + 'ifeq ($(PWD),)'#010+ + '$(error You need the GNU ','utils package to use this Makefile)'#010+ + 'else'#010+ + 'PWD:=$(firstword $(PWD))'#010+ + 'SRCEXEEXT='#010+ + 'endif'#010+ + 'else'#010+ + 'PWD:=$(firstword $(PWD))'#010+ + 'SRCEXEEXT=.exe'#010+ + 'endif'#010+ + #010+ + '# Detect NT - NT sets OS to Windows_NT'#010+ + '# Detect OS/2 - OS/2 has OS2_SHELL defined'#010+ + 'ifndef inUnix'#010+ + 'ifeq ($(O','S),Windows_NT)'#010+ + 'inWinNT=1'#010+ + 'else'#010+ + 'ifdef OS2_SHELL'#010+ + 'inOS2=1'#010+ + 'endif'#010+ + 'endif'#010+ + 'else'#010+ + 'ifneq ($(findstring cygdrive,$(PATH)),)'#010+ + 'inCygWin=1'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# The extension of batch files / scripts'#010+ + 'ifdef inUnix'#010+ + 'SRCBATCHEXT=.sh'#010+ + 'else'#010+ + 'ifdef inOS2'#010+ + 'SRCBATCHEXT=.cmd'#010+ + 'e','lse'#010+ + 'SRCBATCHEXT=.bat'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ '# Path Separator, the subst trick is necessary for the \ that can'#039't'+ - ' exists'#013#010+ - '# at the end of a line'#013#010+ - 'ifdef inUn','ix'#013#010+ - 'PATHSEP=/'#013#010+ - 'else'#013#010+ - 'PATHSEP:=$(subst /,\,/)'#013#010+ - '# cygwin bash or sh can not handle backslashs'#013#010+ - 'ifdef inCygWin'#013#010+ - 'PATHSEP=/'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Base dir'#013#010+ - 'ifdef PWD'#013#010+ - 'BASEDIR:=$(subst \,/,$(shell $(PWD)))'#013#010+ - '# For Cygwin we need to replace /cygdrive/','c/ with c:/'#013#010+ - 'ifdef inCygWin'#013#010+ - 'ifneq ($(findstring /cygdrive/,$(BASEDIR)),)'#013#010+ - 'BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))'#013#010+ - 'BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))'#013#010+ - 'BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR)',')'#013+ - #010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'else'#013#010+ - 'BASEDIR=.'#013#010+ - 'endif'#013#010+ - #013#010+ + ' exists'#010+ + '# at the end of a line'#010+ + 'ifdef inUnix'#010+ + 'PATHSEP=/'#010+ + 'else'#010+ + 'PATHSEP:=$(subst /,\,/)'#010+ + '# cygwin bash or sh can not handle backslashs'#010+ + 'ifdef inCy','gWin'#010+ + 'PATHSEP=/'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Base dir'#010+ + 'ifdef PWD'#010+ + 'BASEDIR:=$(subst \,/,$(shell $(PWD)))'#010+ + '# For Cygwin we need to replace /cygdrive/c/ with c:/'#010+ + 'ifdef inCygWin'#010+ + 'ifneq ($(findstring /cygdrive/,$(BASEDIR)),)'#010+ + 'BASENODIR:=$(patsubst /cygdrive%,%,$(BA','SEDIR))'#010+ + 'BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))'#010+ + 'BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))'#010+ + 'endif'#010+ + 'endif'#010+ + 'else'#010+ + 'BASEDIR=.'#010+ + 'endif'#010+ + #010+ '# Echo is an internal command under OS/2 (and others), so it'#039's alw'+ - 'ays found'#013#010+ - 'ifdef inOS2'#013#010+ - 'ifndef ECHO'#013#010+ + 'ays found'#010+ + 'ifde','f inOS2'#010+ + 'ifndef ECHO'#010+ 'ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))'+ - '))'#013#010+ - 'ifeq ($(ECHO),)'#013#010+ - 'ECH','O:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH)'+ - ')))'#013#010+ - 'ifeq ($(ECHO),)'#013#010+ - 'ECHO=echo'#013#010+ - 'else'#013#010+ - 'ECHO:=$(firstword $(ECHO))'#013#010+ - 'endif'#013#010+ - 'else'#013#010+ - 'ECHO:=$(firstword $(ECHO))'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'export ECHO'#013#010+ - 'endif'#013#010+ - #013#010+ - '[fpcdetect]'#013#010+ - '##################','##################################################'+ - '#'#013#010+ - '# FPC Binary and Version Detection'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ - '# Compatibility with old makefiles'#013#010+ - 'ifndef FPC'#013#010+ - 'ifdef PP'#013#010+ - 'FPC=$(PP)'#013#010+ - 'endif'#013#010+ - 'en','dif'#013#010+ - #013#010+ - '# Try to detect the ppcXXX file to use by using "fpc -PB" option'#013#010+ - '# to query for the default ppcXXX the fpc executable tries. When'#013#010+ - '# fpc is not found use ppc386 by default. Also when fpc -PB gives'#013#010+ - '# an error ppc386 will be used.'#013#010+ - 'i','fndef FPC'#013#010+ - '# check if fpc exists'#013#010+ + '))'#010+ + 'ifeq ($(ECHO),)'#010+ + 'ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH)))'+ + ')'#010+ + 'ifeq ($(ECHO),)'#010+ + 'ECHO=echo'#010+ + 'else'#010+ + 'ECHO:=$(firstword $(ECHO))'#010+ + 'e','ndif'#010+ + 'else'#010+ + 'ECHO:=$(firstword $(ECHO))'#010+ + 'endif'#010+ + 'endif'#010+ + 'export ECHO'#010+ + 'endif'#010+ + #010+ + '[fpcdetect]'#010+ + '#####################################################################'#010+ + '# FPC Binary and Version Detection'#010+ + '#######################################################','#############'+ + '#'#010+ + #010+ + '# Compatibility with old makefiles'#010+ + 'ifndef FPC'#010+ + 'ifdef PP'#010+ + 'FPC=$(PP)'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Try to detect the ppcXXX file to use by using "fpc -PB" option'#010+ + '# to query for the default ppcXXX the fpc executable tries. When'#010+ + '# fpc is not fou','nd use ppc386 by default. Also when fpc -PB gives'#010+ + '# an error ppc386 will be used.'#010+ + 'ifndef FPC'#010+ + '# check if fpc exists'#010+ 'FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH)'+ - ')))'#013#010+ - 'ifneq ($(FPCPROG),)'#013#010+ - 'FPCPROG:=$(firstword $(FPCPROG))'#013#010+ - 'FPC:=$(shell $(FPCPROG) -PB)'#013#010+ - '# Older fpc executables didn'#039't support it and ','return'#013#010+ - '# Error: Illegal processor... If found then fallback to ppc386'#013#010+ - 'ifneq ($(findstring Error,$(FPC)),)'#013#010+ - 'override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEX'+ - 'EEXT),$(SEARCHPATH)))))'#013#010+ - 'endif'#013#010+ - 'else'#013#010+ - '# fpc binary not found,',' fallback to ppc386'#013#010+ + ')))'#010+ + 'ifneq ($(FPCPROG),)'#010+ + 'FPCPROG:=$(firstword $(FPCPROG)',')'#010+ + 'FPC:=$(shell $(FPCPROG) -PB)'#010+ + '# Older fpc executables didn'#039't support it and return'#010+ + '# Error: Illegal processor... If found then fallback to ppc386'#010+ + 'ifneq ($(findstring Error,$(FPC)),)'#010+ + 'override FPC=$(firstword $(strip $(wildcard $(addsuffix /','ppc386$(SRC'+ + 'EXEEXT),$(SEARCHPATH)))))'#010+ + 'endif'#010+ + 'else'#010+ + '# fpc binary not found, fallback to ppc386'#010+ 'override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEX'+ - 'EEXT),$(SEARCHPATH)))))'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Get a clean executable name'#013#010+ - 'override FPC:=$(subst $(SRCEXEEXT),,$(FPC))'#013#010+ - 'override FPC:=$(subst \,/,$(FPC)',')$(SRCEXEEXT)'#013#010+ - #013#010+ - '# Try to find the binary direct first, otherwise in the path,'#013#010+ - '# if not found give an error'#013#010+ - 'FOUNDFPC:=$(strip $(wildcard $(FPC)))'#013#010+ - 'ifeq ($(FOUNDFPC),)'#013#010+ - 'FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))'#013#010+ - 'ifeq',' ($(FOUNDFPC),)'#013#010+ - '$(error Compiler $(FPC) not found)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# For 1.1 and up we can use a single compiler call to retrieve'#013#010+ - '# all needed information'#013#010+ - 'ifndef FPC_COMPILERINFO'#013#010+ - 'FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)'#013#010+ - 'endif'#013#010+ - #013#010, - '# FPC version'#013#010+ - 'ifndef FPC_VERSION'#013#010+ - 'FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))'#013#010+ - 'endif'#013#010+ - #013#010+ - 'export FPC FPC_VERSION FPC_COMPILERINFO'#013#010+ - '# CHECKDEPEND should not be exported'#013#010+ - '# This should limit multiple checks'#013#010+ - 'unexport CHECKDEPEND ALLDEPENDENCIES',#013#010+ - #013#010+ - '#####################################################################'#013+ - #010+ - '# FPC Target Detection'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ - '# Fall back to default values if needed'#013#010+ - 'ifndef CPU_TARGET'#013#010+ - 'ifdef CP','U_TARGET_DEFAULT'#013#010+ - 'CPU_TARGET=$(CPU_TARGET_DEFAULT)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'ifndef OS_TARGET'#013#010+ - 'ifdef OS_TARGET_DEFAULT'#013#010+ - 'OS_TARGET=$(OS_TARGET_DEFAULT)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# For 1.0.x we need to use extra calls to retrieve all info'#013#010+ - 'ifneq ($(words $(FPC_C','OMPILERINFO)),5)'#013#010+ - 'FPC_COMPILERINFO+=$(shell $(FPC) -iSP)'#013#010+ - 'FPC_COMPILERINFO+=$(shell $(FPC) -iTP)'#013#010+ - 'FPC_COMPILERINFO+=$(shell $(FPC) -iSO)'#013#010+ - 'FPC_COMPILERINFO+=$(shell $(FPC) -iTO)'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Retrieve Target/Source CPU and Target/Source OS'#013#010+ - 'if','ndef CPU_SOURCE'#013#010+ - 'CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))'#013#010+ - 'endif'#013#010+ - 'ifndef CPU_TARGET'#013#010+ - 'CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))'#013#010+ - 'endif'#013#010+ - 'ifndef OS_SOURCE'#013#010+ - 'OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))'#013#010+ - 'endif'#013#010+ - 'ifndef OS_TARGET'#013#010+ - 'OS_TARGET:=$(word 5',',$(FPC_COMPILERINFO))'#013#010+ - 'endif'#013#010+ - 'FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)'#013#010+ - 'FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)'#013#010+ - #013#010+ - '# Full name of the target, including CPU and OS. For OSs limited'#013#010+ - '# to 8.3 we only use the target OS'#013#010+ - 'ifneq ($(findstring $(OS_S','OURCE),$(LIMIT83fs)),)'#013#010+ - 'TARGETSUFFIX=$(OS_TARGET)'#013#010+ - 'SOURCESUFFIX=$(OS_SOURCE)'#013#010+ - 'else'#013#010+ - 'TARGETSUFFIX=$(FULL_TARGET)'#013#010+ - 'SOURCESUFFIX=$(FULL_SOURCE)'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Cross compile flag'#013#010+ - 'ifneq ($(FULL_TARGET),$(FULL_SOURCE))'#013#010+ - 'CROSSCOMPILE=1'#013#010+ - 'endif'#013#010+ - #013#010+ - '# C','heck if the Makefile supports this target, but not'#013#010+ - '# when the make target is to rebuild the makefile'#013#010+ - 'ifeq ($(findstring makefile,$(MAKECMDGOALS)),)'#013#010+ - 'ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)'#013#010+ - '$(error The Makefile doesn'#039't sup','port target $(FULL_TARGET), plea'+ - 'se run fpcmake first)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - #013#010+ + 'EEXT),$(SEARCHPATH)))))'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Get a clean executable name'#010+ + 'override FPC',':=$(subst $(SRCEXEEXT),,$(FPC))'#010+ + 'override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)'#010+ + #010+ + '# Try to find the binary direct first, otherwise in the path,'#010+ + '# if not found give an error'#010+ + 'FOUNDFPC:=$(strip $(wildcard $(FPC)))'#010+ + 'ifeq ($(FOUNDFPC),)'#010+ + 'FOUNDFPC=$(s','trip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))'#010+ + 'ifeq ($(FOUNDFPC),)'#010+ + '$(error Compiler $(FPC) not found)'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# For 1.1 and up we can use a single compiler call to retrieve'#010+ + '# all needed information'#010+ + 'ifndef FPC_COMPILERINFO'#010+ + 'FPC_COM','PILERINFO:=$(shell $(FPC) -iVSPTPSOTO)'#010+ + 'endif'#010+ + #010+ + '# FPC version'#010+ + 'ifndef FPC_VERSION'#010+ + 'FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))'#010+ + 'endif'#010+ + #010+ + 'export FPC FPC_VERSION FPC_COMPILERINFO'#010+ + '# CHECKDEPEND should not be exported'#010+ + '# This should limit multiple check','s'#010+ + 'unexport CHECKDEPEND ALLDEPENDENCIES'#010+ + #010+ + '#####################################################################'#010+ + '# FPC Target Detection'#010+ + '#####################################################################'#010+ + #010+ + '# Fall back to default values if nee','ded'#010+ + 'ifndef CPU_TARGET'#010+ + 'ifdef CPU_TARGET_DEFAULT'#010+ + 'CPU_TARGET=$(CPU_TARGET_DEFAULT)'#010+ + 'endif'#010+ + 'endif'#010+ + 'ifndef OS_TARGET'#010+ + 'ifdef OS_TARGET_DEFAULT'#010+ + 'OS_TARGET=$(OS_TARGET_DEFAULT)'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# For 1.0.x we need to use extra calls to retrieve all info'#010+ + 'ifn','eq ($(words $(FPC_COMPILERINFO)),5)'#010+ + 'FPC_COMPILERINFO+=$(shell $(FPC) -iSP)'#010+ + 'FPC_COMPILERINFO+=$(shell $(FPC) -iTP)'#010+ + 'FPC_COMPILERINFO+=$(shell $(FPC) -iSO)'#010+ + 'FPC_COMPILERINFO+=$(shell $(FPC) -iTO)'#010+ + 'endif'#010+ + #010+ + '# Retrieve Target/Source CPU and Target/S','ource OS'#010+ + 'ifndef CPU_SOURCE'#010+ + 'CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))'#010+ + 'endif'#010+ + 'ifndef CPU_TARGET'#010+ + 'CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))'#010+ + 'endif'#010+ + 'ifndef OS_SOURCE'#010+ + 'OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))'#010+ + 'endif'#010+ + 'ifndef OS_TARGET'#010+ + 'OS_TARGET:=$(word ','5,$(FPC_COMPILERINFO))'#010+ + 'endif'#010+ + 'FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)'#010+ + 'FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)'#010+ + #010+ + '# Full name of the target, including CPU and OS. For OSs limited'#010+ + '# to 8.3 we only use the target OS'#010+ + 'ifneq ($(findstring $(OS_SOURCE)',',$(LIMIT83fs)),)'#010+ + 'TARGETSUFFIX=$(OS_TARGET)'#010+ + 'SOURCESUFFIX=$(OS_SOURCE)'#010+ + 'else'#010+ + 'TARGETSUFFIX=$(FULL_TARGET)'#010+ + 'SOURCESUFFIX=$(FULL_SOURCE)'#010+ + 'endif'#010+ + #010+ + '# Cross compile flag'#010+ + 'ifneq ($(FULL_TARGET),$(FULL_SOURCE))'#010+ + 'CROSSCOMPILE=1'#010+ + 'endif'#010+ + #010+ + '# Check if the Makefil','e supports this target, but not'#010+ + '# when the make target is to rebuild the makefile'#010+ + 'ifeq ($(findstring makefile,$(MAKECMDGOALS)),)'#010+ + 'ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)'#010+ + '$(error The Makefile doesn'#039't support target $(FULL_TARG','ET), plea'+ + 'se run fpcmake first)'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + #010+ '# Detect BSD, since BSD uses a slightly different directory hierarchy.'+ - #013#010+ - 'ifneq ($(findstring $(OS_TARGET),$(BSDs)),)'#013#010+ - 'BSDhier=1'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Detect Linux, will also use ','its own directory hierarchy.'#013#010+ - 'ifeq ($(OS_TARGET),linux)'#013#010+ - 'linuxHier=1'#013#010+ - 'endif'#013#010+ - #013#010+ + #010+ + 'ifneq ($(findstring $(OS_TARGET),$(BSDs)),)'#010+ + 'BSDhier=1'#010+ + 'endif'#010+ + #010+ + '# Detect Linux, will also use its own directory hierarchy.'#010+ + 'ifeq',' ($(OS_TARGET),linux)'#010+ + 'linuxHier=1'#010+ + 'endif'#010+ + #010+ 'export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOUR'+ - 'CE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE'#013#010+ - #013#010+ - #013#010+ - '[fpcdircheckenv]'#013#010+ - '##########################','##########################################'+ - '#'#013#010+ - '# FPCDIR Setting'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ - '# Test FPCDIR to look if the RTL dir exists'#013#010+ - 'ifdef FPCDIR'#013#010+ - 'override FPCDIR:=$(subst \,/,$(FPCDIR))'#013#010+ - 'ifeq',' ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)'#013#010+ - 'override FPCDIR=wrong'#013#010+ - 'endif'#013#010+ - 'else'#013#010+ - 'override FPCDIR=wrong'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Default FPCDIR from Makefile.fpc'#013#010+ - 'ifdef DEFAULT_FPCDIR'#013#010+ - 'ifeq ($(FPCDIR),wrong)'#013#010+ - 'override FPCDIR:=$(subst \,/,$(DEFAULT_','FPCDIR))'#013#010+ - 'ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)'#013#010+ - 'override FPCDIR=wrong'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '[fpcdirdetect]'#013#010+ - '# Detect FPCDIR'#013#010+ - 'ifeq ($(FPCDIR),wrong)'#013#010+ - 'ifdef inUnix'#013#010+ - 'override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)'#013#010+ - 'ifeq ($','(wildcard $(FPCDIR)/units),)'#013#010+ - 'override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)'#013#010+ - 'endif'#013#010+ - 'else'#013#010+ + 'CE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE'#010+ + #010+ + #010+ + '[fpcdircheckenv]'#010+ + '####################################################################','#'+ + #010+ + '# FPCDIR Setting'#010+ + '#####################################################################'#010+ + #010+ + '# Test FPCDIR to look if the RTL dir exists'#010+ + 'ifdef FPCDIR'#010+ + 'override FPCDIR:=$(subst \,/,$(FPCDIR))'#010+ + 'ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)',#010+ + 'override FPCDIR=wrong'#010+ + 'endif'#010+ + 'else'#010+ + 'override FPCDIR=wrong'#010+ + 'endif'#010+ + #010+ + '# Default FPCDIR from Makefile.fpc'#010+ + 'ifdef DEFAULT_FPCDIR'#010+ + 'ifeq ($(FPCDIR),wrong)'#010+ + 'override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))'#010+ + 'ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)','),)'#010+ + 'override FPCDIR=wrong'#010+ + 'endif'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '[fpcdirdetect]'#010+ + '# Detect FPCDIR'#010+ + 'ifeq ($(FPCDIR),wrong)'#010+ + 'ifdef inUnix'#010+ + 'override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)'#010+ + 'ifeq ($(wildcard $(FPCDIR)/units),)'#010+ + 'override FPCDIR=/usr/lib/fpc/$(FPC_VERSION',')'#010+ + 'endif'#010+ + 'else'#010+ 'override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(add'+ - 'suffix /$(FPC),$(SEARCHPATH))))))'#013#010+ - 'override FPCDIR:=$(FPCDIR)/..'#013#010+ - 'ifeq ($(wildcard',' $(addprefix $(FPCDIR)/,rtl units)),)'#013#010+ - 'override FPCDIR:=$(FPCDIR)/..'#013#010+ - 'ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)'#013#010+ - 'override FPCDIR:=$(BASEDIR)'#013#010+ - 'ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)'#013#010+ - 'override FPCDIR=c:/pp'#013#010+ - 'endif'#013#010+ - 'e','ndif'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Cross binaries dir'#013#010+ - 'ifndef CROSSBINDIR'#013#010+ - 'CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Default binutils prefix for cross compile when the'#013#010+ - '# crossbindir is not set'#013#010+ - 'ifndef BINUTILSPREFIX'#013#010+ - 'i','fndef CROSSBINDIR'#013#010+ - 'ifdef CROSSCOMPILE'#013#010+ - 'BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Try first the full target name, otherwise try only'#013#010+ - '# the OS for backwards compatibility'#013#010+ - 'UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TAR','GETSUFFIX))'#013#010+ - 'ifeq ($(UNITSDIR),)'#013#010+ - 'UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Packages dir'#013#010+ - 'PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/pa'+ - 'ckages/extra)'#013#010+ - #013#010+ - #013#010+ - '[shelltools]'#013#010+ - '##########################','##########################################'+ - '#'#013#010+ - '# Shell tools'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ - '# Echo that can redir (must be able run in the default OS shell)'#013#010+ - 'ifndef ECHOREDIR'#013#010+ - 'ifndef inUnix'#013#010+ - 'ECHOREDI','R=echo'#013#010+ - 'else'#013#010+ - 'ECHOREDIR=$(ECHO)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# To copy pograms'#013#010+ - 'ifndef COPY'#013#010+ - 'COPY:=$(CPPROG) -fp'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Copy a whole tree'#013#010+ - 'ifndef COPYTREE'#013#010+ - 'COPYTREE:=$(CPPROG) -Rfp'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Copy a whole tree'#013#010+ - 'ifndef MKDIRTREE'#013#010+ - 'MKDIRTREE:=$(MKDI','RPROG) -p'#013#010+ - 'endif'#013#010+ - #013#010+ - '# To move pograms'#013#010+ - 'ifndef MOVE'#013#010+ - 'MOVE:=$(MVPROG) -f'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Check delete program'#013#010+ - 'ifndef DEL'#013#010+ - 'DEL:=$(RMPROG) -f'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Check deltree program'#013#010+ - 'ifndef DELTREE'#013#010+ - 'DELTREE:=$(RMPROG) -rf'#013#010+ - 'endif'#013#010+ - #013#010+ - '# To install files'#013#010+ - 'i','fndef INSTALL'#013#010+ - 'ifdef inUnix'#013#010+ - 'INSTALL:=$(GINSTALL) -c -m 644'#013#010+ - 'else'#013#010+ - 'INSTALL:=$(COPY)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# To install programs'#013#010+ - 'ifndef INSTALLEXE'#013#010+ - 'ifdef inUnix'#013#010+ - 'INSTALLEXE:=$(GINSTALL) -c -m 755'#013#010+ - 'else'#013#010+ - 'INSTALLEXE:=$(COPY)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# To ','make a directory.'#013#010+ - 'ifndef MKDIR'#013#010+ - 'MKDIR:=$(GINSTALL) -m 755 -d'#013#010+ - 'endif'#013#010+ - #013#010+ + 'suffix /$(FPC),$(SEARCHPATH))))))'#010+ + 'override FPCDIR:=$(FPCDIR)/..'#010+ + 'ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)'#010+ + 'override FPCDIR:=$(FPCDIR)/..'#010+ + 'ifeq ($(w','ildcard $(addprefix $(FPCDIR)/,rtl units)),)'#010+ + 'override FPCDIR:=$(BASEDIR)'#010+ + 'ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)'#010+ + 'override FPCDIR=c:/pp'#010+ + 'endif'#010+ + 'endif'#010+ + 'endif'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Cross binaries dir'#010+ + 'ifndef CROSSBINDIR'#010+ + 'CROSSBINDIR:=$(wildc','ard $(FPCDIR)/bin/$(TARGETSUFFIX))'#010+ + 'endif'#010+ + #010+ + '# Default binutils prefix for cross compile when the'#010+ + '# crossbindir is not set'#010+ + 'ifndef BINUTILSPREFIX'#010+ + 'ifndef CROSSBINDIR'#010+ + 'ifdef CROSSCOMPILE'#010+ + 'BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-'#010+ + 'endif'#010+ + 'endif'#010+ + 'endif',#010+ + #010+ + '# Try first the full target name, otherwise try only'#010+ + '# the OS for backwards compatibility'#010+ + 'UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))'#010+ + 'ifeq ($(UNITSDIR),)'#010+ + 'UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))'#010+ + 'endif'#010+ + #010+ + '# Packages dir'#010+ + 'P','ACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/'+ + 'packages/extra)'#010+ + #010+ + #010+ + '[shelltools]'#010+ + '#####################################################################'#010+ + '# Shell tools'#010+ + '##########################################################','##########'+ + '#'#010+ + #010+ + '# Echo that can redir (must be able run in the default OS shell)'#010+ + 'ifndef ECHOREDIR'#010+ + 'ifndef inUnix'#010+ + 'ECHOREDIR=echo'#010+ + 'else'#010+ + 'ECHOREDIR=$(ECHO)'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# To copy pograms'#010+ + 'ifndef COPY'#010+ + 'COPY:=$(CPPROG) -fp'#010+ + 'endif'#010+ + #010+ + '# Copy a whole tree'#010+ + 'ifn','def COPYTREE'#010+ + 'COPYTREE:=$(CPPROG) -Rfp'#010+ + 'endif'#010+ + #010+ + '# Copy a whole tree'#010+ + 'ifndef MKDIRTREE'#010+ + 'MKDIRTREE:=$(MKDIRPROG) -p'#010+ + 'endif'#010+ + #010+ + '# To move pograms'#010+ + 'ifndef MOVE'#010+ + 'MOVE:=$(MVPROG) -f'#010+ + 'endif'#010+ + #010+ + '# Check delete program'#010+ + 'ifndef DEL'#010+ + 'DEL:=$(RMPROG) -f'#010+ + 'endif'#010+ + #010+ + '# Check d','eltree program'#010+ + 'ifndef DELTREE'#010+ + 'DELTREE:=$(RMPROG) -rf'#010+ + 'endif'#010+ + #010+ + '# To install files'#010+ + 'ifndef INSTALL'#010+ + 'ifdef inUnix'#010+ + 'INSTALL:=$(GINSTALL) -c -m 644'#010+ + 'else'#010+ + 'INSTALL:=$(COPY)'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# To install programs'#010+ + 'ifndef INSTALLEXE'#010+ + 'ifdef inUnix'#010+ + 'INSTALLEXE:=$(','GINSTALL) -c -m 755'#010+ + 'else'#010+ + 'INSTALLEXE:=$(COPY)'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# To make a directory.'#010+ + 'ifndef MKDIR'#010+ + 'MKDIR:=$(GINSTALL) -m 755 -d'#010+ + 'endif'#010+ + #010+ 'export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKD'+ - 'IR'#013#010+ - #013#010+ - #013#010+ - '[defaultdirs]'#013#010+ - '#####################################################################'#013+ - #010+ - '# De','fault Directories'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ - '# Units dir'#013#010+ - 'ifdef REQUIRE_UNITSDIR'#013#010+ - 'override UNITSDIR+=$(REQUIRE_UNITSDIR)'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Units dir'#013#010+ - 'ifdef REQUIRE_PACKAGESDIR'#013#010+ - 'override PACKAGESDIR+=','$(REQUIRE_PACKAGESDIR)'#013#010+ - 'endif'#013#010+ - #013#010+ - #013#010+ - '# Unixes use unix dirs with /usr/bin, /usr/lib'#013#010+ - '# When zipping use the target os default, when normal install then'#013+ - #010+ - '# use the source os as default'#013#010+ - 'ifdef ZIPINSTALL'#013#010+ - '# Zipinstall'#013#010+ - 'ifneq ($(findstring $(OS_','TARGET),$(UNIXs)),)'#013#010+ - 'UNIXHier=1'#013#010+ - 'endif'#013#010+ - 'else'#013#010+ - '# Normal install'#013#010+ - 'ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)'#013#010+ - 'UNIXHier=1'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# When install prefix is not set try to use prefix'#013#010+ - 'ifndef INSTALL_PREFIX'#013#010+ - 'ifdef PREFIX'#013#010+ - 'INSTALL_PREFI','X=$(PREFIX)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# set the prefix directory where to install everything'#013#010+ - 'ifndef INSTALL_PREFIX'#013#010+ - 'ifdef UNIXHier'#013#010+ - 'INSTALL_PREFIX=/usr/local'#013#010+ - 'else'#013#010+ - 'ifdef INSTALL_FPCPACKAGE'#013#010+ - 'INSTALL_BASEDIR:=/pp'#013#010+ - 'else'#013#010+ - 'INSTALL_BASEDIR:=/$(PACKAGE_N','AME)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'export INSTALL_PREFIX'#013#010+ - #013#010+ - '# Export also INSTALL_SOURCESUBDIR set so it will be'#013#010+ - '# used recursively for all subdirs'#013#010+ - 'ifdef INSTALL_FPCSUBDIR'#013#010+ - 'export INSTALL_FPCSUBDIR'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Where to place the resulting zip fil','es'#013#010+ - 'ifndef DIST_DESTDIR'#013#010+ - 'DIST_DESTDIR:=$(BASEDIR)'#013#010+ - 'endif'#013#010+ - 'export DIST_DESTDIR'#013#010+ - #013#010+ - '# EXE/PPU Target directories'#013#010+ - 'ifndef COMPILER_UNITTARGETDIR'#013#010+ - 'ifdef PACKAGEDIR_MAIN'#013#010+ - 'COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)'#013#010+ - 'else'#013#010+ - 'COMP','ILER_UNITTARGETDIR=units/$(TARGETSUFFIX)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'ifndef COMPILER_TARGETDIR'#013#010+ - 'COMPILER_TARGETDIR=.'#013#010+ - 'endif'#013#010+ - #013#010+ - #013#010+ - '#####################################################################'#013+ - #010+ - '# Install Directories'#013#010+ - '##############################','######################################'+ - '#'#013#010+ - #013#010+ - '# set the base directory where to install everything'#013#010+ - 'ifndef INSTALL_BASEDIR'#013#010+ - 'ifdef UNIXHier'#013#010+ - 'ifdef INSTALL_FPCPACKAGE'#013#010+ - 'INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)'#013#010+ - 'else'#013#010+ - 'INSTALL_BASE','DIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)'#013#010+ - 'endif'#013#010+ - 'else'#013#010+ - 'INSTALL_BASEDIR:=$(INSTALL_PREFIX)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# set the directory where to install the binaries'#013#010+ - 'ifndef INSTALL_BINDIR'#013#010+ - 'ifdef UNIXHier'#013#010+ - 'INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin'#013#010+ - 'el','se'#013#010+ - 'INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin'#013#010+ - '# for FPC packages install the binaries under their target subdir'#013#010+ - 'ifdef INSTALL_FPCPACKAGE'#013#010+ - 'ifdef CROSSCOMPILE'#013#010+ - 'ifdef CROSSINSTALL'#013#010+ - 'INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)'#013#010+ - 'else'#013#010+ - 'INSTAL','L_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)'#013#010+ - 'endif'#013#010+ - 'else'#013#010+ - 'INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# set the directory where to install the units.'#013#010+ - 'ifndef INSTALL_UNITDIR'#013#010+ - 'INSTALL_UNITDIR:=$(INSTALL_B','ASEDIR)/units/$(TARGETSUFFIX)'#013#010+ - 'ifdef INSTALL_FPCPACKAGE'#013#010+ - 'ifdef PACKAGE_NAME'#013#010+ - 'INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Where to install shared libraries'#013#010+ - 'ifndef INSTALL_LIBDIR'#013#010+ - 'ifdef UNIXHier'#013#010+ - 'INSTALL_LIB','DIR:=$(INSTALL_PREFIX)/lib'#013#010+ - 'else'#013#010+ - 'INSTALL_LIBDIR:=$(INSTALL_UNITDIR)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Where the source files will be stored'#013#010+ - 'ifndef INSTALL_SOURCEDIR'#013#010+ - 'ifdef UNIXHier'#013#010+ - 'ifdef BSDhier'#013#010+ - 'SRCPREFIXDIR=share/src'#013#010+ - 'else'#013#010+ - 'ifdef linuxHier'#013#010+ - 'SRCPREFIX','DIR=share/src'#013#010+ - 'else'#013#010+ - 'SRCPREFIXDIR=src'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'ifdef INSTALL_FPCPACKAGE'#013#010+ - 'ifdef INSTALL_FPCSUBDIR'#013#010+ + 'IR'#010+ + #010+ + #010+ + '[defaultdirs]'#010+ + '#####################','###############################################'+ + '#'#010+ + '# Default Directories'#010+ + '#####################################################################'#010+ + #010+ + '# Units dir'#010+ + 'ifdef REQUIRE_UNITSDIR'#010+ + 'override UNITSDIR+=$(REQUIRE_UNITSDIR)'#010+ + 'endif'#010+ + #010+ + '# Units dir'#010+ + 'ifdef',' REQUIRE_PACKAGESDIR'#010+ + 'override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)'#010+ + 'endif'#010+ + #010+ + #010+ + '# Unixes use unix dirs with /usr/bin, /usr/lib'#010+ + '# When zipping use the target os default, when normal install then'#010+ + '# use the source os as default'#010+ + 'ifdef ZIPINSTALL'#010+ + '# Zi','pinstall'#010+ + 'ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)'#010+ + 'UNIXHier=1'#010+ + 'endif'#010+ + 'else'#010+ + '# Normal install'#010+ + 'ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)'#010+ + 'UNIXHier=1'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# When install prefix is not set try to use prefix'#010+ + 'ifndef INSTALL_PREFIX'#010+ + 'ifdef',' PREFIX'#010+ + 'INSTALL_PREFIX=$(PREFIX)'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# set the prefix directory where to install everything'#010+ + 'ifndef INSTALL_PREFIX'#010+ + 'ifdef UNIXHier'#010+ + 'INSTALL_PREFIX=/usr/local'#010+ + 'else'#010+ + 'ifdef INSTALL_FPCPACKAGE'#010+ + 'INSTALL_BASEDIR:=/pp'#010+ + 'else'#010+ + 'INSTALL_BASEDIR:=/$(','PACKAGE_NAME)'#010+ + 'endif'#010+ + 'endif'#010+ + 'endif'#010+ + 'export INSTALL_PREFIX'#010+ + #010+ + '# Export also INSTALL_SOURCESUBDIR set so it will be'#010+ + '# used recursively for all subdirs'#010+ + 'ifdef INSTALL_FPCSUBDIR'#010+ + 'export INSTALL_FPCSUBDIR'#010+ + 'endif'#010+ + #010+ + '# Where to place the resulting zip files'#010, + 'ifndef DIST_DESTDIR'#010+ + 'DIST_DESTDIR:=$(BASEDIR)'#010+ + 'endif'#010+ + 'export DIST_DESTDIR'#010+ + #010+ + '# EXE/PPU Target directories'#010+ + 'ifndef COMPILER_UNITTARGETDIR'#010+ + 'ifdef PACKAGEDIR_MAIN'#010+ + 'COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)'#010+ + 'else'#010+ + 'COMPILER_UNITTARGE','TDIR=units/$(TARGETSUFFIX)'#010+ + 'endif'#010+ + 'endif'#010+ + 'ifndef COMPILER_TARGETDIR'#010+ + 'COMPILER_TARGETDIR=.'#010+ + 'endif'#010+ + #010+ + #010+ + '#####################################################################'#010+ + '# Install Directories'#010+ + '######################################################','##############'+ + '#'#010+ + #010+ + '# set the base directory where to install everything'#010+ + 'ifndef INSTALL_BASEDIR'#010+ + 'ifdef UNIXHier'#010+ + 'ifdef INSTALL_FPCPACKAGE'#010+ + 'INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)'#010+ + 'else'#010+ + 'INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PAC','KAGE_NAME)'#010+ + 'endif'#010+ + 'else'#010+ + 'INSTALL_BASEDIR:=$(INSTALL_PREFIX)'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# set the directory where to install the binaries'#010+ + 'ifndef INSTALL_BINDIR'#010+ + 'ifdef UNIXHier'#010+ + 'INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin'#010+ + 'else'#010+ + 'INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin'#010+ + '#',' for FPC packages install the binaries under their target subdir'#010+ + 'ifdef INSTALL_FPCPACKAGE'#010+ + 'ifdef CROSSCOMPILE'#010+ + 'ifdef CROSSINSTALL'#010+ + 'INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)'#010+ + 'else'#010+ + 'INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)'#010+ + 'endif'#010+ + 'e','lse'#010+ + 'INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)'#010+ + 'endif'#010+ + 'endif'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# set the directory where to install the units.'#010+ + 'ifndef INSTALL_UNITDIR'#010+ + 'INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)'#010+ + 'ifdef INSTALL_FPCPACKAGE'#010+ + 'ifdef P','ACKAGE_NAME'#010+ + 'INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)'#010+ + 'endif'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Where to install shared libraries'#010+ + 'ifndef INSTALL_LIBDIR'#010+ + 'ifdef UNIXHier'#010+ + 'INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib'#010+ + 'else'#010+ + 'INSTALL_LIBDIR:=$(INSTALL_UNITDIR)'#010+ + 'endif'#010, + 'endif'#010+ + #010+ + '# Where the source files will be stored'#010+ + 'ifndef INSTALL_SOURCEDIR'#010+ + 'ifdef UNIXHier'#010+ + 'ifdef BSDhier'#010+ + 'SRCPREFIXDIR=share/src'#010+ + 'else'#010+ + 'ifdef linuxHier'#010+ + 'SRCPREFIXDIR=share/src'#010+ + 'else'#010+ + 'SRCPREFIXDIR=src'#010+ + 'endif'#010+ + 'endif'#010+ + 'ifdef INSTALL_FPCPACKAGE'#010+ + 'ifdef INSTALL','_FPCSUBDIR'#010+ 'INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION'+ - ')/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)'#013#010+ - 'else'#013#010+ - 'INSTALL_SOURCEDIR:=$','(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSI'+ - 'ON)/$(PACKAGE_NAME)'#013#010+ - 'endif'#013#010+ - 'else'#013#010+ - 'INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$'+ - '(PACKAGE_VERSION)'#013#010+ - 'endif'#013#010+ - 'else'#013#010+ - 'ifdef INSTALL_FPCPACKAGE'#013#010+ - 'ifdef INSTALL_FPCSUBDIR'#013#010+ - 'INSTA','LL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$('+ - 'PACKAGE_NAME)'#013#010+ - 'else'#013#010+ - 'INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)'#013#010+ - 'endif'#013#010+ - 'else'#013#010+ - 'INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Where the ','doc files will be stored'#013#010+ - 'ifndef INSTALL_DOCDIR'#013#010+ - 'ifdef UNIXHier'#013#010+ - 'ifdef BSDhier'#013#010+ - 'DOCPREFIXDIR=share/doc'#013#010+ - 'else'#013#010+ - 'ifdef linuxHier'#013#010+ - 'DOCPREFIXDIR=share/doc'#013#010+ - 'else'#013#010+ - 'DOCPREFIXDIR=doc'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'ifdef INSTALL_FPCPACKAGE'#013#010+ - 'INSTALL_DOCDIR:=$(INSTALL','_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)'+ - '/$(PACKAGE_NAME)'#013#010+ - 'else'#013#010+ - 'INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PA'+ - 'CKAGE_VERSION)'#013#010+ - 'endif'#013#010+ - 'else'#013#010+ - 'ifdef INSTALL_FPCPACKAGE'#013#010+ - 'INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE','_NAME)'#013#010+ - 'else'#013#010+ - 'INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Where to install the examples, under linux we use the doc dir'#013#010+ - '# because the copytree command will create a subdir itself'#013#010+ - 'ifndef INSTALL_EXAMPLEDIR'#013#010+ - 'ifdef UNIXH','ier'#013#010+ - 'ifdef INSTALL_FPCPACKAGE'#013#010+ - #013#010+ - 'ifdef BSDhier'#013#010+ + ')/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)'#010+ + 'else'#010+ + 'INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION'+ + ')/$(PACKAGE_NAME)'#010+ + 'endif'#010+ + 'else'#010+ + 'INSTALL_SOURCEDI','R:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)'+ + '-$(PACKAGE_VERSION)'#010+ + 'endif'#010+ + 'else'#010+ + 'ifdef INSTALL_FPCPACKAGE'#010+ + 'ifdef INSTALL_FPCSUBDIR'#010+ + 'INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PA'+ + 'CKAGE_NAME)'#010+ + 'else'#010+ + 'INSTALL_SOURCEDIR:=$(','INSTALL_BASEDIR)/source/$(PACKAGE_NAME)'#010+ + 'endif'#010+ + 'else'#010+ + 'INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source'#010+ + 'endif'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Where the doc files will be stored'#010+ + 'ifndef INSTALL_DOCDIR'#010+ + 'ifdef UNIXHier'#010+ + 'ifdef BSDhier'#010+ + 'DOCPREFIXDIR=share/doc'#010+ + 'else'#010+ + 'ifdef lin','uxHier'#010+ + 'DOCPREFIXDIR=share/doc'#010+ + 'else'#010+ + 'DOCPREFIXDIR=doc'#010+ + 'endif'#010+ + 'endif'#010+ + 'ifdef INSTALL_FPCPACKAGE'#010+ + 'INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$'+ + '(PACKAGE_NAME)'#010+ + 'else'#010+ + 'INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_N','AME)-$('+ + 'PACKAGE_VERSION)'#010+ + 'endif'#010+ + 'else'#010+ + 'ifdef INSTALL_FPCPACKAGE'#010+ + 'INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)'#010+ + 'else'#010+ + 'INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc'#010+ + 'endif'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Where to install the examples, under linux we use the doc di','r'#010+ + '# because the copytree command will create a subdir itself'#010+ + 'ifndef INSTALL_EXAMPLEDIR'#010+ + 'ifdef UNIXHier'#010+ + 'ifdef INSTALL_FPCPACKAGE'#010+ + #010+ + 'ifdef BSDhier'#010+ 'INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION'+ - ')/$(PACKAGE_NAME)'#013#010+ - 'else'#013#010+ - 'ifdef linuxHier'#013#010+ - 'INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples'#013#010+ - 'else'#013#010+ - 'INSTALL_EXAMPLEDIR:=$(INST','ALL_PREFIX)/doc/fpc-$(FPC_VERSION)/example'+ - 's/$(PACKAGE_NAME)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - 'else'#013#010+ - #013#010+ - 'ifdef BSDhier'#013#010+ - 'INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$'+ - '(PACKAGE_VERSION)'#013#010+ - 'else'#013#010+ - 'ifdef linuxHier'#013#010+ - 'INSTALL_EXAMPLEDIR:=$(INSTAL','L_DOCDIR)/examples/$(PACKAGE_NAME)-$(PAC'+ - 'KAGE_VERSION)'#013#010+ - 'else'#013#010+ + ')/$(PACKAGE_NAME)'#010+ + 'else'#010+ + 'ifdef',' linuxHier'#010+ + 'INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples'#010+ + 'else'#010+ + 'INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/'+ + '$(PACKAGE_NAME)'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + 'else'#010+ + #010+ + 'ifdef BSDhier'#010+ + 'INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PAC','KAGE_NAME)'+ + '-$(PACKAGE_VERSION)'#010+ + 'else'#010+ + 'ifdef linuxHier'#010+ + 'INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKA'+ + 'GE_VERSION)'#010+ + 'else'#010+ 'INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VE'+ - 'RSION)'#013#010+ - 'endif'#013#010+ - #013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'else'#013#010+ - 'ifdef INSTALL_FPCPACKAGE'#013#010+ - 'INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/example','s/$(PACKAGE_NAME)'#013#010+ - 'else'#013#010+ - 'INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Where the some extra (data)files will be stored'#013#010+ - 'ifndef INSTALL_DATADIR'#013#010+ - 'INSTALL_DATADIR=$(INSTALL_BASEDIR)'#013#010+ - 'endif'#013#010+ - #013#010+ - '#######################','#############################################'+ - '#'#013#010+ - '# Cross compile dirs'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ - 'ifdef CROSSCOMPILE'#013#010+ - '# Directory where the cross compile tools are stored.'#013#010+ - '# First check if they ','are available in FPCDIR. If no targets/ subdir'+ - #013#010+ - '# is found use the targets/ subdir in INSTALL_BASEDIR.'#013#010+ - 'ifndef CROSSBINDIR'#013#010+ - 'CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))'#013#010+ - 'ifeq ($(CROSSBINDIR),)'#013#010+ - 'CROSSBINDIR:=$(wildcard $(IN','STALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin'+ - '/$(FULL_SOURCE))'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'else'#013#010+ - 'CROSSBINDIR='#013#010+ - 'endif'#013#010+ - #013#010+ - #013#010+ - '[dirlibc]'#013#010+ - '# On linux, try to find where libgcc.a is.'#013#010+ - 'ifeq ($(OS_SOURCE),linux)'#013#010+ - #013#010+ - '# Amd64 to i386?'#013#010+ - 'ifndef GCCLIBDIR'#013#010+ - 'ifeq ($(CPU_TARGE','T),i386)'#013#010+ - 'ifneq ($(findstring x86_64,$(shell uname -a)),)'#013#010+ - 'ifeq ($(BINUTILSPREFIX),)'#013#010+ - 'GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'ifeq ($(CPU_TARGET),powerpc64)'#013#010+ - 'ifeq ($(BINUTILSPREFIX),)'#013#010+ - 'GCCLIBDIR:','=$(shell dirname `gcc -m64 -print-libgcc-file-name`)'#013#010+ - 'endif'#013#010+ - 'endif'#010+ - 'endif'#013#010+ - #013#010+ - '# Try cross gcc'#013#010+ - 'ifndef GCCLIBDIR'#013#010+ - 'CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEE'+ - 'XT),$(SEARCHPATH))))'#013#010+ - 'ifneq ($(CROSSGCC),)'#013#010+ - 'GCCLIBDIR:=$(sh','ell dirname `$(CROSSGCC) -print-libgcc-file-name`)'#013+ - #010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Other libraries from ld.so.conf'#013#010+ - 'ifndef OTHERLIBDIR'#013#010+ + 'RSION)'#010+ + 'endif'#010+ + #010+ + 'endif'#010+ + 'endif'#010+ + 'else'#010+ + 'i','fdef INSTALL_FPCPACKAGE'#010+ + 'INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)'#010+ + 'else'#010+ + 'INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples'#010+ + 'endif'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Where the some extra (data)files will be stored'#010+ + 'ifndef INSTALL_DATADIR'#010+ + 'INSTALL','_DATADIR=$(INSTALL_BASEDIR)'#010+ + 'endif'#010+ + #010+ + '#####################################################################'#010+ + '# Cross compile dirs'#010+ + '#####################################################################'#010+ + #010+ + 'ifdef CROSSCOMPILE'#010+ + '# Directory where the cr','oss compile tools are stored.'#010+ + '# First check if they are available in FPCDIR. If no targets/ subdir'#010+ + '# is found use the targets/ subdir in INSTALL_BASEDIR.'#010+ + 'ifndef CROSSBINDIR'#010+ + 'CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))'#010+ + 'ifeq',' ($(CROSSBINDIR),)'#010+ + 'CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$'+ + '(FULL_SOURCE))'#010+ + 'endif'#010+ + 'endif'#010+ + 'else'#010+ + 'CROSSBINDIR='#010+ + 'endif'#010+ + #010+ + #010+ + '[dirlibc]'#010+ + '# On linux, try to find where libgcc.a is.'#010+ + 'ifeq ($(OS_SOURCE),linux)'#010+ + #010+ + '# Amd64 to i386?'#010+ + 'i','fndef GCCLIBDIR'#010+ + 'ifeq ($(CPU_TARGET),i386)'#010+ + 'ifneq ($(findstring x86_64,$(shell uname -a)),)'#010+ + 'ifeq ($(BINUTILSPREFIX),)'#010+ + 'GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`)'#010+ + 'endif'#010+ + 'endif'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Try cross gcc'#010+ + 'ifndef GCCLIBDIR'#010+ + 'CRO','SSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEX'+ + 'EEXT),$(SEARCHPATH))))'#010+ + 'ifneq ($(CROSSGCC),)'#010+ + 'GCCLIBDIR:=$(shell dirname `$(CROSSGCC) -print-libgcc-file-name`)'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Other libraries from ld.so.conf'#010+ + 'ifndef OTHERLIBDIR',#010+ 'OTHERLIBDIR:=$(shell grep -v "^\#" /etc/ld.so.conf | awk '#039'{ ORS=" '+ - '"; print $1 }'#039')'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - 'ifdef inUnix'#013#010+ - 'ifeq',' ($(OS_SOURCE),netbsd)'#013#010+ - 'OTHERLIBDIR+=/usr/pkg/lib'#013#010+ - 'endif'#013#010+ - 'export GCCLIBDIR OTHERLIB'#013#010+ - 'endif'#013#010+ - #013#010+ - #013#010+ - '[extensions]'#013#010+ - '#####################################################################'#013+ - #010+ - '# Default extensions'#013#010+ - '#####################################','###############################'+ - '#'#013#010+ - #013#010+ - '# Default needed extensions (Go32v2,Linux)'#013#010+ - 'BATCHEXT=.bat'#013#010+ - 'LOADEREXT=.as'#013#010+ - 'EXEEXT=.exe'#013#010+ - 'PPLEXT=.ppl'#013#010+ - 'PPUEXT=.ppu'#013#010+ - 'OEXT=.o'#013#010+ - 'ASMEXT=.s'#013#010+ - 'SMARTEXT=.sl'#013#010+ - 'STATICLIBEXT=.a'#013#010+ - 'SHAREDLIBEXT=.so'#013#010+ - 'STATICLIBPREFIX=libp'#013#010, - 'RSTEXT=.rst'#013#010+ + '"; print $1 }'#039')'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + 'ifdef inUnix'#010+ + 'ifeq ($(OS_SOURCE),netbsd)'#010+ + 'OTHERLIBDIR+=/usr/pkg/lib'#010+ + 'endif'#010+ + 'export GCCLIBDIR OTHERLIB'#010+ + 'endif'#010+ + #010+ + #010+ + '[extensions]'#010+ + '#########################','###########################################'+ + '#'#010+ + '# Default extensions'#010+ + '#####################################################################'#010+ + #010+ + '# Default needed extensions (Go32v2,Linux)'#010+ + 'BATCHEXT=.bat'#010+ + 'LOADEREXT=.as'#010+ + 'EXEEXT=.exe'#010+ + 'PPLEXT=.ppl'#010+ + 'PPUEXT=.','ppu'#010+ + 'OEXT=.o'#010+ + 'ASMEXT=.s'#010+ + 'SMARTEXT=.sl'#010+ + 'STATICLIBEXT=.a'#010+ + 'SHAREDLIBEXT=.so'#010+ + 'STATICLIBPREFIX=libp'#010+ + 'RSTEXT=.rst'#010+ '#DEBUGSYMEXT #for debugger symbol files, define only for targets which'+ - ' has this'#013#010+ - #013#010+ - '# 1.0.x has target specific extensions for ppu files and objects'#013#010+ - 'ifeq ($(findstring 1.0.,$(FPC_VERSION)),)'#013#010+ - '# short version for 1.1 and above -',' no target specific extensions'#013+ - #010+ - #013#010+ - '# Go32v1'#013#010+ - 'ifeq ($(OS_TARGET),go32v1)'#013#010+ - 'STATICLIBPREFIX='#013#010+ - 'SHORTSUFFIX=v1'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Go32v2'#013#010+ - 'ifeq ($(OS_TARGET),go32v2)'#013#010+ - 'STATICLIBPREFIX='#013#010+ - 'SHORTSUFFIX=dos'#013#010+ - 'endif'#013#010+ - #013#010+ - '# watcom'#013#010+ - 'ifeq ($(OS_TARGET),watcom)'#013#010+ - 'STATI','CLIBPREFIX='#013#010+ - 'OEXT=.obj'#013#010+ - 'ASMEXT=.asm'#013#010+ - 'SHAREDLIBEXT=.dll'#013#010+ - 'SHORTSUFFIX=wat'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Linux'#013#010+ - 'ifeq ($(OS_TARGET),linux)'#013#010+ - 'BATCHEXT=.sh'#013#010+ - 'EXEEXT='#013#010+ - 'HASSHAREDLIB=1'#013#010+ - 'SHORTSUFFIX=lnx'#013#010+ - 'endif'#013#010+ - #013#010+ - '# FreeBSD'#013#010+ - 'ifeq ($(OS_TARGET),freebsd)'#013#010+ - 'BATCHEXT=.sh'#013#010+ - 'EXE','EXT='#013#010+ - 'HASSHAREDLIB=1'#013#010+ - 'SHORTSUFFIX=fbs'#013#010+ - 'endif'#013#010+ - #013#010+ - '# NetBSD'#013#010+ - 'ifeq ($(OS_TARGET),netbsd)'#013#010+ - 'BATCHEXT=.sh'#013#010+ - 'EXEEXT='#013#010+ - 'HASSHAREDLIB=1'#013#010+ - 'SHORTSUFFIX=nbs'#013#010+ - 'endif'#013#010+ - #013#010+ - '# OpenBSD'#013#010+ - 'ifeq ($(OS_TARGET),openbsd)'#013#010+ - 'BATCHEXT=.sh'#013#010+ - 'EXEEXT='#013#010+ - 'HASSHAREDLIB=1'#013#010+ - 'SHORTSUFFI','X=obs'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Win32'#013#010+ - 'ifeq ($(OS_TARGET),win32)'#013#010+ - 'SHAREDLIBEXT=.dll'#013#010+ - 'SHORTSUFFIX=w32'#013#010+ - 'endif'#013#010+ - #013#010+ - '# OS/2'#013#010+ - 'ifeq ($(OS_TARGET),os2)'#013#010+ - 'BATCHEXT=.cmd'#013#010+ - 'AOUTEXT=.out'#013#010+ - 'STATICLIBPREFIX='#013#010+ - 'SHAREDLIBEXT=.dll'#013#010+ - 'SHORTSUFFIX=os2'#013#010+ - 'ECHO=echo'#013#010+ - 'endif'#013#010+ - #013#010+ - '# EMX'#013#010, - 'ifeq ($(OS_TARGET),emx)'#013#010+ - 'BATCHEXT=.cmd'#013#010+ - 'AOUTEXT=.out'#013#010+ - 'STATICLIBPREFIX='#013#010+ - 'SHAREDLIBEXT=.dll'#013#010+ - 'SHORTSUFFIX=emx'#013#010+ - 'ECHO=echo'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Amiga'#013#010+ - 'ifeq ($(OS_TARGET),amiga)'#013#010+ - 'EXEEXT='#013#010+ - 'SHAREDLIBEXT=.library'#013#010+ - 'SHORTSUFFIX=amg'#013#010+ - 'endif'#013#010+ - #013#010+ - '# MorphOS'#013#010+ - 'ifeq ($','(OS_TARGET),morphos)'#013#010+ - 'EXEEXT='#013#010+ - 'SHAREDLIBEXT=.library'#013#010+ - 'SHORTSUFFIX=mos'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Atari'#013#010+ - 'ifeq ($(OS_TARGET),atari)'#013#010+ - 'EXEEXT=.ttp'#013#010+ - 'SHORTSUFFIX=ata'#013#010+ - 'endif'#013#010+ - #013#010+ - '# BeOS'#013#010+ - 'ifeq ($(OS_TARGET),beos)'#013#010+ - 'BATCHEXT=.sh'#013#010+ - 'EXEEXT='#013#010+ - 'SHORTSUFFIX=be'#013#010+ - 'endif'#013#010+ - #013#010+ - '# S','olaris'#013#010+ - 'ifeq ($(OS_TARGET),solaris)'#013#010+ - 'BATCHEXT=.sh'#013#010+ - 'EXEEXT='#013#010+ - 'SHORTSUFFIX=sun'#013#010+ - 'endif'#013#010+ - #013#010+ - '# QNX'#013#010+ - 'ifeq ($(OS_TARGET),qnx)'#013#010+ - 'BATCHEXT=.sh'#013#010+ - 'EXEEXT='#013#010+ - 'SHORTSUFFIX=qnx'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Netware clib'#013#010+ - 'ifeq ($(OS_TARGET),netware)'#013#010+ - 'EXEEXT=.nlm'#013#010+ - 'STATICLIBPREFIX','='#013#010+ - 'SHORTSUFFIX=nw'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Netware libc'#013#010+ - 'ifeq ($(OS_TARGET),netwlibc)'#013#010+ - 'EXEEXT=.nlm'#013#010+ - 'STATICLIBPREFIX='#013#010+ - 'SHORTSUFFIX=nwl'#013#010+ - 'endif'#013#010+ - #013#010+ - '# MacOS'#013#010+ - 'ifeq ($(OS_TARGET),macos)'#013#010+ - 'BATCHEXT='#013#010+ - 'EXEEXT='#013#010+ - 'DEBUGSYMEXT=.xcoff'#013#010+ - 'SHORTSUFFIX=mac'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Darwi','n'#013#010+ - 'ifeq ($(OS_TARGET),darwin)'#013#010+ - 'BATCHEXT=.sh'#013#010+ - 'EXEEXT='#013#010+ - 'HASSHAREDLIB=1'#013#010+ - 'SHORTSUFFIX=dwn'#013#010+ - 'endif'#013#010+ - #013#010+ - 'else'#013#010+ - '# long version for 1.0.x - target specific extensions'#013#010+ - #013#010+ - '# Go32v1'#013#010+ - 'ifeq ($(OS_TARGET),go32v1)'#013#010+ - 'PPUEXT=.pp1'#013#010+ - 'OEXT=.o1'#013#010+ - 'ASMEXT=.s1'#013#010+ - 'SMARTEXT','=.sl1'#013#010+ - 'STATICLIBEXT=.a1'#013#010+ - 'SHAREDLIBEXT=.so1'#013#010+ - 'STATICLIBPREFIX='#013#010+ - 'SHORTSUFFIX=v1'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Go32v2'#013#010+ - 'ifeq ($(OS_TARGET),go32v2)'#013#010+ - 'STATICLIBPREFIX='#013#010+ - 'SHORTSUFFIX=dos'#013#010+ - 'endif'#013#010+ - #013#010+ - '# watcom'#013#010+ - 'ifeq ($(OS_TARGET),watcom)'#013#010+ - 'STATICLIBPREFIX='#013#010+ - 'SHORTSUFFIX=wat',#013#010+ - 'endif'#013#010+ - #013#010+ - '# Linux'#013#010+ - 'ifeq ($(OS_TARGET),linux)'#013#010+ - 'BATCHEXT=.sh'#013#010+ - 'EXEEXT='#013#010+ - 'HASSHAREDLIB=1'#013#010+ - 'SHORTSUFFIX=lnx'#013#010+ - 'endif'#013#010+ - #013#010+ - '# FreeBSD'#013#010+ - 'ifeq ($(OS_TARGET),freebsd)'#013#010+ - 'BATCHEXT=.sh'#013#010+ - 'EXEEXT='#013#010+ - 'HASSHAREDLIB=1'#013#010+ - 'SHORTSUFFIX=fbs'#013#010+ - 'endif'#013#010+ - #013#010+ - '# NetBSD'#013#010+ - 'ifeq ($(OS_TA','RGET),netbsd)'#013#010+ - 'BATCHEXT=.sh'#013#010+ - 'EXEEXT='#013#010+ - 'HASSHAREDLIB=1'#013#010+ - 'SHORTSUFFIX=nbs'#013#010+ - 'endif'#013#010+ - #013#010+ - '# OpenBSD'#013#010+ - 'ifeq ($(OS_TARGET),openbsd)'#013#010+ - 'BATCHEXT=.sh'#013#010+ - 'EXEEXT='#013#010+ - 'HASSHAREDLIB=1'#013#010+ - 'SHORTSUFFIX=obs'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Win32'#013#010+ - 'ifeq ($(OS_TARGET),win32)'#013#010+ - 'PPUEXT=.ppw'#013#010+ - 'OEXT=.','ow'#013#010+ - 'ASMEXT=.sw'#013#010+ - 'SMARTEXT=.slw'#013#010+ - 'STATICLIBEXT=.aw'#013#010+ - 'SHAREDLIBEXT=.dll'#013#010+ - 'SHORTSUFFIX=w32'#013#010+ - 'endif'#013#010+ - #013#010+ - '# OS/2'#013#010+ - 'ifeq ($(OS_TARGET),os2)'#013#010+ - 'BATCHEXT=.cmd'#013#010+ - 'PPUEXT=.ppo'#013#010+ - 'ASMEXT=.so2'#013#010+ - 'OEXT=.oo2'#013#010+ - 'AOUTEXT=.out'#013#010+ - 'SMARTEXT=.sl2'#013#010+ - 'STATICLIBPREFIX='#013#010+ - 'STATICLIBEXT=.','ao2'#013#010+ - 'SHAREDLIBEXT=.dll'#013#010+ - 'SHORTSUFFIX=os2'#013#010+ - 'ECHO=echo'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Amiga'#013#010+ - 'ifeq ($(OS_TARGET),amiga)'#013#010+ - 'EXEEXT='#013#010+ - 'PPUEXT=.ppu'#013#010+ - 'ASMEXT=.asm'#013#010+ - 'OEXT=.o'#013#010+ - 'SMARTEXT=.sl'#013#010+ - 'STATICLIBEXT=.a'#013#010+ - 'SHAREDLIBEXT=.library'#013#010+ - 'SHORTSUFFIX=amg'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Atari'#013#010+ - 'ifeq ($(OS','_TARGET),atari)'#013#010+ - 'PPUEXT=.ppu'#013#010+ - 'ASMEXT=.s'#013#010+ - 'OEXT=.o'#013#010+ - 'SMARTEXT=.sl'#013#010+ - 'STATICLIBEXT=.a'#013#010+ - 'EXEEXT=.ttp'#013#010+ - 'SHORTSUFFIX=ata'#013#010+ - 'endif'#013#010+ - #013#010+ - '# BeOS'#013#010+ - 'ifeq ($(OS_TARGET),beos)'#013#010+ - 'BATCHEXT=.sh'#013#010+ - 'PPUEXT=.ppu'#013#010+ - 'ASMEXT=.s'#013#010+ - 'OEXT=.o'#013#010+ - 'SMARTEXT=.sl'#013#010+ - 'STATICLIBEXT=.a'#013#010+ - 'EXEEXT='#013,#010+ - 'SHORTSUFFIX=be'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Solaris'#013#010+ - 'ifeq ($(OS_TARGET),solaris)'#013#010+ - 'BATCHEXT=.sh'#013#010+ - 'PPUEXT=.ppu'#013#010+ - 'ASMEXT=.s'#013#010+ - 'OEXT=.o'#013#010+ - 'SMARTEXT=.sl'#013#010+ - 'STATICLIBEXT=.a'#013#010+ - 'EXEEXT='#013#010+ - 'SHORTSUFFIX=sun'#013#010+ - 'endif'#013#010+ - #013#010+ - '# QNX'#013#010+ - 'ifeq ($(OS_TARGET),qnx)'#013#010+ - 'BATCHEXT=.sh'#013#010+ - 'PPUEXT=.ppu'#013#010+ - 'AS','MEXT=.s'#013#010+ - 'OEXT=.o'#013#010+ - 'SMARTEXT=.sl'#013#010+ - 'STATICLIBEXT=.a'#013#010+ - 'EXEEXT='#013#010+ - 'SHORTSUFFIX=qnx'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Netware'#013#010+ - 'ifeq ($(OS_TARGET),netware)'#013#010+ - 'STATICLIBPREFIX='#013#010+ - 'PPUEXT=.ppu'#013#010+ - 'OEXT=.o'#013#010+ - 'ASMEXT=.s'#013#010+ - 'SMARTEXT=.sl'#013#010+ - 'STATICLIBEXT=.a'#013#010+ - 'SHAREDLIBEXT=.nlm'#013#010+ - 'EXEEXT=.nlm'#013#010+ - 'SH','ORTSUFFIX=nw'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Netware libc'#013#010+ - 'ifeq ($(OS_TARGET),netwlibc)'#013#010+ - 'STATICLIBPREFIX='#013#010+ - 'PPUEXT=.ppu'#013#010+ - 'OEXT=.o'#013#010+ - 'ASMEXT=.s'#013#010+ - 'SMARTEXT=.sl'#013#010+ - 'STATICLIBEXT=.a'#013#010+ - 'SHAREDLIBEXT=.nlm'#013#010+ - 'EXEEXT=.nlm'#013#010+ - 'SHORTSUFFIX=nwl'#013#010+ - 'endif'#013#010+ - #013#010+ - '# MacOS'#013#010+ - 'ifeq ($(OS_TARGET),mac','os)'#013#010+ - 'BATCHEXT='#013#010+ - 'PPUEXT=.ppu'#013#010+ - 'ASMEXT=.s'#013#010+ - 'OEXT=.o'#013#010+ - 'SMARTEXT=.sl'#013#010+ - 'STATICLIBEXT=.a'#013#010+ - 'EXEEXT='#013#010+ - 'DEBUGSYMEXT=.xcoff'#013#010+ - 'SHORTSUFFIX=mac'#013#010+ - 'endif'#013#010+ - #013#010+ - '#end of target specific settings'#013#010+ - 'endif'#013#010+ - #013#010+ - '# For 8.3 limited OS'#039's the short suffixes'#013#010+ - '# Otherwise use the',' full source/target names'#013#010+ - 'ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)'#013#010+ - 'FPCMADE=fpcmade.$(SHORTSUFFIX)'#013#010+ - 'ZIPSUFFIX=$(SHORTSUFFIX)'#013#010+ - 'ZIPCROSSPREFIX='#013#010+ - 'ZIPSOURCESUFFIX=src'#013#010+ - 'ZIPEXAMPLESUFFIX=exm'#013#010+ - 'else'#013#010+ - 'FPCMADE=fpcmade.$(TARGETSUFFIX)'#013#010+ - 'ZIPSOU','RCESUFFIX=.source'#013#010+ - 'ZIPEXAMPLESUFFIX=.examples'#013#010+ - 'ifdef CROSSCOMPILE'#013#010+ - 'ZIPSUFFIX=.$(SOURCESUFFIX)'#013#010+ - 'ZIPCROSSPREFIX=$(TARGETSUFFIX)-'#013#010+ - 'else'#013#010+ - 'ZIPSUFFIX=.$(TARGETSUFFIX)'#013#010+ - 'ZIPCROSSPREFIX='#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '[defaulttools]'#013#010+ - '#############################','#######################################'+ - '#'#013#010+ - '# Default Tools'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ - '# Names of the binutils tools'#013#010+ - 'ASNAME=$(BINUTILSPREFIX)as'#013#010+ - 'LDNAME=$(BINUTILSPREFIX)ld'#013#010+ - 'ARNAME=$(BINUTILSPREF','IX)ar'#013#010+ - 'RCNAME=$(BINUTILSPREFIX)rc'#013#010+ - 'ifneq ($(findstring 1.0.,$(FPC_VERSION)),)'#013#010+ - 'ifeq ($(OS_TARGET),win32)'#013#010+ - 'ifeq ($(CROSSBINDIR),)'#013#010+ - 'ASNAME=asw'#013#010+ - 'LDNAME=ldw'#013#010+ - 'ARNAME=arw'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# assembler, redefine it if cross compiling'#013#010+ - 'ifndef',' ASPROG'#013#010+ - 'ifdef CROSSBINDIR'#013#010+ - 'ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)'#013#010+ - 'else'#013#010+ - 'ASPROG=$(ASNAME)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# linker, but probably not used'#013#010+ - 'ifndef LDPROG'#013#010+ - 'ifdef CROSSBINDIR'#013#010+ - 'LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)'#013#010+ - 'else'#013#010+ - 'LDPROG=$(','LDNAME)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Resource compiler'#013#010+ - 'ifndef RCPROG'#013#010+ - 'ifdef CROSSBINDIR'#013#010+ - 'RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)'#013#010+ - 'else'#013#010+ - 'RCPROG=$(RCNAME)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Archiver'#013#010+ - 'ifndef ARPROG'#013#010+ - 'ifdef CROSSBINDIR'#013#010+ - 'ARPROG=$(CROSSBINDIR)/$(ARNAM','E)$(SRCEXEEXT)'#013#010+ - 'else'#013#010+ - 'ARPROG=$(ARNAME)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Override defaults'#013#010+ - 'AS=$(ASPROG)'#013#010+ - 'LD=$(LDPROG)'#013#010+ - 'RC=$(RCPROG)'#013#010+ - 'AR=$(ARPROG)'#013#010+ - #013#010+ - '# ppas.bat / ppas.sh'#013#010+ - 'PPAS=ppas$(SRCBATCHEXT)'#013#010+ - #013#010+ - '# ldconfig to rebuild .so cache'#013#010+ - 'ifdef inUnix'#013#010+ - 'LDCONFIG=','ldconfig'#013#010+ - 'else'#013#010+ - 'LDCONFIG='#013#010+ - 'endif'#013#010+ - #013#010+ - 'ifdef DATE'#013#010+ - 'DATESTR:=$(shell $(DATE) +%Y%m%d)'#013#010+ - 'else'#013#010+ - 'DATESTR='#013#010+ - 'endif'#013#010+ - #013#010+ - '# Look if UPX is found for go32v2 and win32. We can'#039't use $UPX bec'+ - 'uase'#013#010+ - '# upx uses that one itself (PFV)'#013#010+ - 'ifndef UPXPROG'#013#010+ - 'ifeq ($(OS','_TARGET),go32v2)'#013#010+ - 'UPXPROG:=1'#013#010+ - 'endif'#013#010+ - 'ifeq ($(OS_TARGET),win32)'#013#010+ - 'UPXPROG:=1'#013#010+ - 'endif'#013#010+ - 'ifdef UPXPROG'#013#010+ - 'UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH)'+ - ')))'#013#010+ - 'ifeq ($(UPXPROG),)'#013#010+ - 'UPXPROG='#013#010+ - 'else'#013#010+ - 'UPXPROG:=$(firstword $(UPXPROG)',')'#013#010+ - 'endif'#013#010+ - 'else'#013#010+ - 'UPXPROG='#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'export UPXPROG'#013#010+ - #013#010+ - '# Zip options'#013#010+ - 'ZIPOPT=-9'#013#010+ - 'ZIPEXT=.zip'#013#010+ - #013#010+ - '# Tar options'#013#010+ - 'ifeq ($(USETAR),bz2)'#013#010+ - 'TAROPT=vj'#013#010+ - 'TAREXT=.tar.bz2'#013#010+ - 'else'#013#010+ - 'TAROPT=vz'#013#010+ - 'TAREXT=.tar.gz'#013#010+ - 'endif'#013#010+ - #013#010+ - #013#010+ - '[command_begin]'#013#010+ - '###############','#####################################################'+ - '#'#013#010+ - '# Compiler Command Line'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ - '# Load commandline OPTDEF and add FPC_CPU define, for compiling the'#013+ - #010+ - '# compiler this n','eeds to be turned off'#013#010+ - 'ifndef NOCPUDEF'#013#010+ - 'override FPCOPTDEF=$(CPU_TARGET)'#013#010+ - 'endif'#013#010+ - #013#010+ - #013#010+ - '# Load commandline OPT and add target and unit dir to be sure'#013#010+ - 'ifneq ($(OS_TARGET),$(OS_SOURCE))'#013#010+ - 'override FPCOPT+=-T$(OS_TARGET)'#013#010+ - 'endif'#013#010+ - #013#010+ - 'ifeq ($(OS_SOUR','CE),openbsd)'#013#010+ - 'override FPCOPT+=-FD$(NEW_BINUTILS_PATH)'#013#010+ - 'endif'#013#010+ - #013#010+ - 'ifndef CROSSBOOTSTRAP'#013#010+ - 'ifneq ($(BINUTILSPREFIX),)'#013#010+ - 'override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc'#013#010+ - 'endif'#013#010+ - 'ifneq ($(BINUTILSPREFIX),)'#013#010+ - 'override FPCOPT+=-Xr$(RLINKPATH)'#013#010+ - 'endif'#013#010+ - 'endif',#013#010+ - #013#010+ - '# User dirs should be first, so they are looked at first'#013#010+ - 'ifdef UNITDIR'#013#010+ - 'override FPCOPT+=$(addprefix -Fu,$(UNITDIR))'#013#010+ - 'endif'#013#010+ - 'ifdef LIBDIR'#013#010+ - 'override FPCOPT+=$(addprefix -Fl,$(LIBDIR))'#013#010+ - 'endif'#013#010+ - 'ifdef OBJDIR'#013#010+ - 'override FPCOPT+=$(addprefix -','Fo,$(OBJDIR))'#013#010+ - 'endif'#013#010+ - 'ifdef INCDIR'#013#010+ - 'override FPCOPT+=$(addprefix -Fi,$(INCDIR))'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Smartlinking'#013#010+ - 'ifdef LINKSMART'#013#010+ - 'override FPCOPT+=-XX'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Smartlinking creation'#013#010+ - 'ifdef CREATESMART'#013#010+ - 'override FPCOPT+=-CX'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Debug'#013#010+ - 'if','def DEBUG'#013#010+ - 'override FPCOPT+=-gl'#013#010+ - 'override FPCOPTDEF+=DEBUG'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Release mode (strip, optimize and don'#039't load fpc.cfg)'#013#010+ - 'ifdef RELEASE'#013#010+ - 'ifeq ($(CPU_TARGET),i386)'#013#010+ - 'FPCCPUOPT:=-OG2p3'#013#010+ - 'else'#013#010+ - 'ifeq ($(CPU_TARGET),powerpc)'#013#010+ - 'FPCCPUOPT:=-O1r'#013#010, - 'else'#013#010+ - 'FPCCPUOPT:='#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n'#013#010+ - 'override FPCOPTDEF+=RELEASE'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Strip'#013#010+ - 'ifdef STRIP'#013#010+ - 'override FPCOPT+=-Xs'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Optimizer (i386 only for now)'#013#010+ - 'ifdef OPTIMIZE'#013#010+ - 'ifeq ($(CPU_TARGET),i386)',#013#010+ - 'override FPCOPT+=-OG2p3'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Verbose settings (warning,note,info)'#013#010+ - 'ifdef VERBOSE'#013#010+ - 'override FPCOPT+=-vwni'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Needed compiler options'#013#010+ - 'ifdef COMPILER_OPTIONS'#013#010+ - 'override FPCOPT+=$(COMPILER_OPTIONS)'#013#010+ - 'endif'#013#010+ - 'ifdef COMPILE','R_UNITDIR'#013#010+ - 'override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))'#013#010+ - 'endif'#013#010+ - 'ifdef COMPILER_LIBRARYDIR'#013#010+ - 'override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))'#013#010+ - 'endif'#013#010+ - 'ifdef COMPILER_OBJECTDIR'#013#010+ - 'override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJEC','TDIR))'#013#010+ - 'endif'#013#010+ - 'ifdef COMPILER_INCLUDEDIR'#013#010+ - 'override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Cross compiler utils'#013#010+ - 'ifdef CROSSBINDIR'#013#010+ - 'override FPCOPT+=-FD$(CROSSBINDIR)'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Target dirs and the prefix to use for cle','an/install'#013#010+ - 'ifdef COMPILER_TARGETDIR'#013#010+ - 'override FPCOPT+=-FE$(COMPILER_TARGETDIR)'#013#010+ - 'ifeq ($(COMPILER_TARGETDIR),.)'#013#010+ - 'override TARGETDIRPREFIX='#013#010+ - 'else'#013#010+ - 'override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Unit target dir (default is',' units/<cpu>-<os>/'#013#010+ - 'ifdef COMPILER_UNITTARGETDIR'#013#010+ - 'override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)'#013#010+ - 'ifeq ($(COMPILER_UNITTARGETDIR),.)'#013#010+ - 'override UNITTARGETDIRPREFIX='#013#010+ - 'else'#013#010+ - 'override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/'#013#010+ - 'endif'#013#010+ - 'else'#013#010, - 'ifdef COMPILER_TARGETDIR'#013#010+ - 'override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)'#013#010+ - 'override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Temporary hack to add HASUNIX define for linux 1.0.6 compiler'#013#010+ - 'ifeq ($(OS_TARGET),linux)'#013#010+ - 'if','eq ($(FPC_VERSION),1.0.6)'#013#010+ - 'override FPCOPTDEF+=HASUNIX'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '[command_libc]'#013#010+ - '# Add GCC lib path if asked'#013#010+ - 'ifdef GCCLIBDIR'#013#010+ - 'override FPCOPT+=-Fl$(GCCLIBDIR)'#013#010+ - 'endif'#013#010+ - 'ifdef OTHERLIBDIR'#013#010+ - 'override FPCOPT+=$(addprefix -Fl,$(OTHERLIBDIR','))'#013#010+ - 'endif'#013#010+ - #013#010+ - #013#010+ - '[command_end]'#013#010+ - '# Add commandline options last so they can override'#013#010+ - 'ifdef OPT'#013#010+ - 'override FPCOPT+=$(OPT)'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Add defines from FPCOPTDEF to FPCOPT'#013#010+ - 'ifdef FPCOPTDEF'#013#010+ - 'override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))'#013#010+ - 'endif'#013#010+ - #013,#010+ - '# Was a config file specified ?'#013#010+ - 'ifdef CFGFILE'#013#010+ - 'override FPCOPT+=@$(CFGFILE)'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Use the environment to pass commandline options?'#013#010+ - 'ifdef USEENV'#013#010+ - 'override FPCEXTCMD:=$(FPCOPT)'#013#010+ - 'override FPCOPT:=!FPCEXTCMD'#013#010+ - 'export FPCEXTCMD'#013#010+ - 'endif'#013#010+ - #013,#010+ - '# Compiler commandline'#013#010+ - 'override COMPILER:=$(FPC) $(FPCOPT)'#013#010+ - #013#010+ - '# also call ppas if with command option -s'#013#010+ - '# but only if the FULL_SOURCE and FULL_TARGET are equal'#013#010+ - 'ifeq (,$(findstring -s ,$(COMPILER)))'#013#010+ - 'EXECPPAS='#013#010+ - 'else'#013#010+ - 'ifeq ($(FULL_SOURCE','),$(FULL_TARGET))'#013#010+ - 'EXECPPAS:=@$(PPAS)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - #013#010+ - '[loaderrules]'#013#010+ - '#####################################################################'#013+ - #010+ - '# Loaders'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ - '.PHONY: fpc_l','oaders'#013#010+ - #013#010+ - 'ifneq ($(TARGET_LOADERS),)'#013#010+ - 'override ALLTARGET+=fpc_loaders'#013#010+ - 'override CLEANTARGET+=fpc_loaders_clean'#013#010+ - 'override INSTALLTARGET+=fpc_loaders_install'#013#010+ - #013#010+ - 'override LOADEROFILES:=$(addsuffix $(OEXT),$(TARGET_LOADERS))'#013#010+ - 'endif'#013#010+ - #013#010+ - '%$(OEXT):',' %$(LOADEREXT)'#013#010+ - 'ifdef COMPILER_UNITTARGETDIR'#013#010+ - ' $(AS) -o $(COMPILER_UNITTARGETDIR)/$*$(OEXT) $<'#013#010+ - 'else'#013#010+ - ' $(AS) -o $*$(OEXT) $<'#013#010+ - 'endif'#013#010+ - #013#010+ - 'fpc_loaders: $(COMPILER_UNITTARGETDIR) $(LOADEROFILES)'#013#010+ - #013#010+ - 'fpc_loaders_clean:'#013#010+ - 'ifdef COMPILE','R_UNITTARGETDIR'#013#010+ + ' has this'#010+ + #010+ + '# 1.0.x has target specific extensions for ppu files and o','bjects'#010+ + 'ifeq ($(findstring 1.0.,$(FPC_VERSION)),)'#010+ + '# short version for 1.1 and above - no target specific extensions'#010+ + #010+ + '# Go32v1'#010+ + 'ifeq ($(OS_TARGET),go32v1)'#010+ + 'STATICLIBPREFIX='#010+ + 'SHORTSUFFIX=v1'#010+ + 'endif'#010+ + #010+ + '# Go32v2'#010+ + 'ifeq ($(OS_TARGET),go32v2)'#010+ + 'STATICLIBPREF','IX='#010+ + 'SHORTSUFFIX=dos'#010+ + 'endif'#010+ + #010+ + '# watcom'#010+ + 'ifeq ($(OS_TARGET),watcom)'#010+ + 'STATICLIBPREFIX='#010+ + 'OEXT=.obj'#010+ + 'ASMEXT=.asm'#010+ + 'SHAREDLIBEXT=.dll'#010+ + 'SHORTSUFFIX=wat'#010+ + 'endif'#010+ + #010+ + '# Linux'#010+ + 'ifeq ($(OS_TARGET),linux)'#010+ + 'BATCHEXT=.sh'#010+ + 'EXEEXT='#010+ + 'HASSHAREDLIB=1'#010+ + 'SHORTSUFFIX=lnx'#010+ + 'endif'#010+ + #010+ + '# Fr','eeBSD'#010+ + 'ifeq ($(OS_TARGET),freebsd)'#010+ + 'BATCHEXT=.sh'#010+ + 'EXEEXT='#010+ + 'HASSHAREDLIB=1'#010+ + 'SHORTSUFFIX=fbs'#010+ + 'endif'#010+ + #010+ + '# NetBSD'#010+ + 'ifeq ($(OS_TARGET),netbsd)'#010+ + 'BATCHEXT=.sh'#010+ + 'EXEEXT='#010+ + 'HASSHAREDLIB=1'#010+ + 'SHORTSUFFIX=nbs'#010+ + 'endif'#010+ + #010+ + '# OpenBSD'#010+ + 'ifeq ($(OS_TARGET),openbsd)'#010+ + 'BATCHEXT=.sh'#010+ + 'E','XEEXT='#010+ + 'HASSHAREDLIB=1'#010+ + 'SHORTSUFFIX=obs'#010+ + 'endif'#010+ + #010+ + '# Win32'#010+ + 'ifeq ($(OS_TARGET),win32)'#010+ + 'SHAREDLIBEXT=.dll'#010+ + 'SHORTSUFFIX=w32'#010+ + 'endif'#010+ + #010+ + '# OS/2'#010+ + 'ifeq ($(OS_TARGET),os2)'#010+ + 'BATCHEXT=.cmd'#010+ + 'AOUTEXT=.out'#010+ + 'STATICLIBPREFIX='#010+ + 'SHAREDLIBEXT=.dll'#010+ + 'SHORTSUFFIX=os2'#010+ + 'ECHO=echo'#010+ + 'e','ndif'#010+ + #010+ + '# EMX'#010+ + 'ifeq ($(OS_TARGET),emx)'#010+ + 'BATCHEXT=.cmd'#010+ + 'AOUTEXT=.out'#010+ + 'STATICLIBPREFIX='#010+ + 'SHAREDLIBEXT=.dll'#010+ + 'SHORTSUFFIX=emx'#010+ + 'ECHO=echo'#010+ + 'endif'#010+ + #010+ + '# Amiga'#010+ + 'ifeq ($(OS_TARGET),amiga)'#010+ + 'EXEEXT='#010+ + 'SHAREDLIBEXT=.library'#010+ + 'SHORTSUFFIX=amg'#010+ + 'endif'#010+ + #010+ + '# MorphOS'#010+ + 'ifeq ($(OS_T','ARGET),morphos)'#010+ + 'EXEEXT='#010+ + 'SHAREDLIBEXT=.library'#010+ + 'SHORTSUFFIX=mos'#010+ + 'endif'#010+ + #010+ + '# Atari'#010+ + 'ifeq ($(OS_TARGET),atari)'#010+ + 'EXEEXT=.ttp'#010+ + 'SHORTSUFFIX=ata'#010+ + 'endif'#010+ + #010+ + '# BeOS'#010+ + 'ifeq ($(OS_TARGET),beos)'#010+ + 'BATCHEXT=.sh'#010+ + 'EXEEXT='#010+ + 'SHORTSUFFIX=be'#010+ + 'endif'#010+ + #010+ + '# Solaris'#010+ + 'ifeq ($(OS_TARGET','),solaris)'#010+ + 'BATCHEXT=.sh'#010+ + 'EXEEXT='#010+ + 'SHORTSUFFIX=sun'#010+ + 'endif'#010+ + #010+ + '# QNX'#010+ + 'ifeq ($(OS_TARGET),qnx)'#010+ + 'BATCHEXT=.sh'#010+ + 'EXEEXT='#010+ + 'SHORTSUFFIX=qnx'#010+ + 'endif'#010+ + #010+ + '# Netware clib'#010+ + 'ifeq ($(OS_TARGET),netware)'#010+ + 'EXEEXT=.nlm'#010+ + 'STATICLIBPREFIX='#010+ + 'SHORTSUFFIX=nw'#010+ + 'endif'#010+ + #010+ + '# Netware libc'#010+ + 'if','eq ($(OS_TARGET),netwlibc)'#010+ + 'EXEEXT=.nlm'#010+ + 'STATICLIBPREFIX='#010+ + 'SHORTSUFFIX=nwl'#010+ + 'endif'#010+ + #010+ + '# MacOS'#010+ + 'ifeq ($(OS_TARGET),macos)'#010+ + 'BATCHEXT='#010+ + 'EXEEXT='#010+ + 'DEBUGSYMEXT=.xcoff'#010+ + 'SHORTSUFFIX=mac'#010+ + 'endif'#010+ + #010+ + '# Darwin'#010+ + 'ifeq ($(OS_TARGET),darwin)'#010+ + 'BATCHEXT=.sh'#010+ + 'EXEEXT='#010+ + 'HASSHAREDL','IB=1'#010+ + 'SHORTSUFFIX=dwn'#010+ + 'endif'#010+ + #010+ + 'else'#010+ + '# long version for 1.0.x - target specific extensions'#010+ + #010+ + '# Go32v1'#010+ + 'ifeq ($(OS_TARGET),go32v1)'#010+ + 'PPUEXT=.pp1'#010+ + 'OEXT=.o1'#010+ + 'ASMEXT=.s1'#010+ + 'SMARTEXT=.sl1'#010+ + 'STATICLIBEXT=.a1'#010+ + 'SHAREDLIBEXT=.so1'#010+ + 'STATICLIBPREFIX='#010+ + 'SHORTSUFFIX=v1'#010+ + 'end','if'#010+ + #010+ + '# Go32v2'#010+ + 'ifeq ($(OS_TARGET),go32v2)'#010+ + 'STATICLIBPREFIX='#010+ + 'SHORTSUFFIX=dos'#010+ + 'endif'#010+ + #010+ + '# watcom'#010+ + 'ifeq ($(OS_TARGET),watcom)'#010+ + 'STATICLIBPREFIX='#010+ + 'SHORTSUFFIX=wat'#010+ + 'endif'#010+ + #010+ + '# Linux'#010+ + 'ifeq ($(OS_TARGET),linux)'#010+ + 'BATCHEXT=.sh'#010+ + 'EXEEXT='#010+ + 'HASSHAREDLIB=1'#010+ + 'SHORTSUFFIX=ln','x'#010+ + 'endif'#010+ + #010+ + '# FreeBSD'#010+ + 'ifeq ($(OS_TARGET),freebsd)'#010+ + 'BATCHEXT=.sh'#010+ + 'EXEEXT='#010+ + 'HASSHAREDLIB=1'#010+ + 'SHORTSUFFIX=fbs'#010+ + 'endif'#010+ + #010+ + '# NetBSD'#010+ + 'ifeq ($(OS_TARGET),netbsd)'#010+ + 'BATCHEXT=.sh'#010+ + 'EXEEXT='#010+ + 'HASSHAREDLIB=1'#010+ + 'SHORTSUFFIX=nbs'#010+ + 'endif'#010+ + #010+ + '# OpenBSD'#010+ + 'ifeq ($(OS_TARGET),openbsd)'#010+ + 'B','ATCHEXT=.sh'#010+ + 'EXEEXT='#010+ + 'HASSHAREDLIB=1'#010+ + 'SHORTSUFFIX=obs'#010+ + 'endif'#010+ + #010+ + '# Win32'#010+ + 'ifeq ($(OS_TARGET),win32)'#010+ + 'PPUEXT=.ppw'#010+ + 'OEXT=.ow'#010+ + 'ASMEXT=.sw'#010+ + 'SMARTEXT=.slw'#010+ + 'STATICLIBEXT=.aw'#010+ + 'SHAREDLIBEXT=.dll'#010+ + 'SHORTSUFFIX=w32'#010+ + 'endif'#010+ + #010+ + '# OS/2'#010+ + 'ifeq ($(OS_TARGET),os2)'#010+ + 'BATCHEXT=.cmd',#010+ + 'PPUEXT=.ppo'#010+ + 'ASMEXT=.so2'#010+ + 'OEXT=.oo2'#010+ + 'AOUTEXT=.out'#010+ + 'SMARTEXT=.sl2'#010+ + 'STATICLIBPREFIX='#010+ + 'STATICLIBEXT=.ao2'#010+ + 'SHAREDLIBEXT=.dll'#010+ + 'SHORTSUFFIX=os2'#010+ + 'ECHO=echo'#010+ + 'endif'#010+ + #010+ + '# Amiga'#010+ + 'ifeq ($(OS_TARGET),amiga)'#010+ + 'EXEEXT='#010+ + 'PPUEXT=.ppu'#010+ + 'ASMEXT=.asm'#010+ + 'OEXT=.o'#010+ + 'SMARTEXT=.sl'#010+ + 'STATI','CLIBEXT=.a'#010+ + 'SHAREDLIBEXT=.library'#010+ + 'SHORTSUFFIX=amg'#010+ + 'endif'#010+ + #010+ + '# Atari'#010+ + 'ifeq ($(OS_TARGET),atari)'#010+ + 'PPUEXT=.ppu'#010+ + 'ASMEXT=.s'#010+ + 'OEXT=.o'#010+ + 'SMARTEXT=.sl'#010+ + 'STATICLIBEXT=.a'#010+ + 'EXEEXT=.ttp'#010+ + 'SHORTSUFFIX=ata'#010+ + 'endif'#010+ + #010+ + '# BeOS'#010+ + 'ifeq ($(OS_TARGET),beos)'#010+ + 'BATCHEXT=.sh'#010+ + 'PPUEXT=.ppu',#010+ + 'ASMEXT=.s'#010+ + 'OEXT=.o'#010+ + 'SMARTEXT=.sl'#010+ + 'STATICLIBEXT=.a'#010+ + 'EXEEXT='#010+ + 'SHORTSUFFIX=be'#010+ + 'endif'#010+ + #010+ + '# Solaris'#010+ + 'ifeq ($(OS_TARGET),solaris)'#010+ + 'BATCHEXT=.sh'#010+ + 'PPUEXT=.ppu'#010+ + 'ASMEXT=.s'#010+ + 'OEXT=.o'#010+ + 'SMARTEXT=.sl'#010+ + 'STATICLIBEXT=.a'#010+ + 'EXEEXT='#010+ + 'SHORTSUFFIX=sun'#010+ + 'endif'#010+ + #010+ + '# QNX'#010+ + 'ifeq ($(OS_TARG','ET),qnx)'#010+ + 'BATCHEXT=.sh'#010+ + 'PPUEXT=.ppu'#010+ + 'ASMEXT=.s'#010+ + 'OEXT=.o'#010+ + 'SMARTEXT=.sl'#010+ + 'STATICLIBEXT=.a'#010+ + 'EXEEXT='#010+ + 'SHORTSUFFIX=qnx'#010+ + 'endif'#010+ + #010+ + '# Netware'#010+ + 'ifeq ($(OS_TARGET),netware)'#010+ + 'STATICLIBPREFIX='#010+ + 'PPUEXT=.ppu'#010+ + 'OEXT=.o'#010+ + 'ASMEXT=.s'#010+ + 'SMARTEXT=.sl'#010+ + 'STATICLIBEXT=.a'#010+ + 'SHAREDLIBEXT=.','nlm'#010+ + 'EXEEXT=.nlm'#010+ + 'SHORTSUFFIX=nw'#010+ + 'endif'#010+ + #010+ + '# Netware libc'#010+ + 'ifeq ($(OS_TARGET),netwlibc)'#010+ + 'STATICLIBPREFIX='#010+ + 'PPUEXT=.ppu'#010+ + 'OEXT=.o'#010+ + 'ASMEXT=.s'#010+ + 'SMARTEXT=.sl'#010+ + 'STATICLIBEXT=.a'#010+ + 'SHAREDLIBEXT=.nlm'#010+ + 'EXEEXT=.nlm'#010+ + 'SHORTSUFFIX=nwl'#010+ + 'endif'#010+ + #010+ + '# MacOS'#010+ + 'ifeq ($(OS_TARGET),ma','cos)'#010+ + 'BATCHEXT='#010+ + 'PPUEXT=.ppu'#010+ + 'ASMEXT=.s'#010+ + 'OEXT=.o'#010+ + 'SMARTEXT=.sl'#010+ + 'STATICLIBEXT=.a'#010+ + 'EXEEXT='#010+ + 'DEBUGSYMEXT=.xcoff'#010+ + 'SHORTSUFFIX=mac'#010+ + 'endif'#010+ + #010+ + '#end of target specific settings'#010+ + 'endif'#010+ + #010+ + '# For 8.3 limited OS'#039's the short suffixes'#010+ + '# Otherwise use the full source/ta','rget names'#010+ + 'ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)'#010+ + 'FPCMADE=fpcmade.$(SHORTSUFFIX)'#010+ + 'ZIPSUFFIX=$(SHORTSUFFIX)'#010+ + 'ZIPCROSSPREFIX='#010+ + 'ZIPSOURCESUFFIX=src'#010+ + 'ZIPEXAMPLESUFFIX=exm'#010+ + 'else'#010+ + 'FPCMADE=fpcmade.$(TARGETSUFFIX)'#010+ + 'ZIPSOURCESUFFIX=.source'#010+ + 'ZIPEXA','MPLESUFFIX=.examples'#010+ + 'ifdef CROSSCOMPILE'#010+ + 'ZIPSUFFIX=.$(SOURCESUFFIX)'#010+ + 'ZIPCROSSPREFIX=$(TARGETSUFFIX)-'#010+ + 'else'#010+ + 'ZIPSUFFIX=.$(TARGETSUFFIX)'#010+ + 'ZIPCROSSPREFIX='#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '[defaulttools]'#010+ + '#################################################################','###'+ + '#'#010+ + '# Default Tools'#010+ + '#####################################################################'#010+ + #010+ + '# Names of the binutils tools'#010+ + 'ASNAME=$(BINUTILSPREFIX)as'#010+ + 'LDNAME=$(BINUTILSPREFIX)ld'#010+ + 'ARNAME=$(BINUTILSPREFIX)ar'#010+ + 'RCNAME=$(BINUTILSPREFIX)rc'#010+ + 'ifneq ($(f','indstring 1.0.,$(FPC_VERSION)),)'#010+ + 'ifeq ($(OS_TARGET),win32)'#010+ + 'ifeq ($(CROSSBINDIR),)'#010+ + 'ASNAME=asw'#010+ + 'LDNAME=ldw'#010+ + 'ARNAME=arw'#010+ + 'endif'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# assembler, redefine it if cross compiling'#010+ + 'ifndef ASPROG'#010+ + 'ifdef CROSSBINDIR'#010+ + 'ASPROG=$(CROSSBINDIR)/$(ASNAME',')$(SRCEXEEXT)'#010+ + 'else'#010+ + 'ASPROG=$(ASNAME)'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# linker, but probably not used'#010+ + 'ifndef LDPROG'#010+ + 'ifdef CROSSBINDIR'#010+ + 'LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)'#010+ + 'else'#010+ + 'LDPROG=$(LDNAME)'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Resource compiler'#010+ + 'ifndef RCPROG'#010+ + 'ifdef CROSSBIN','DIR'#010+ + 'RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)'#010+ + 'else'#010+ + 'RCPROG=$(RCNAME)'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Archiver'#010+ + 'ifndef ARPROG'#010+ + 'ifdef CROSSBINDIR'#010+ + 'ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)'#010+ + 'else'#010+ + 'ARPROG=$(ARNAME)'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Override defaults'#010+ + 'AS=$(ASPROG)'#010+ + 'LD','=$(LDPROG)'#010+ + 'RC=$(RCPROG)'#010+ + 'AR=$(ARPROG)'#010+ + #010+ + '# ppas.bat / ppas.sh'#010+ + 'PPAS=ppas$(SRCBATCHEXT)'#010+ + #010+ + '# ldconfig to rebuild .so cache'#010+ + 'ifdef inUnix'#010+ + 'LDCONFIG=ldconfig'#010+ + 'else'#010+ + 'LDCONFIG='#010+ + 'endif'#010+ + #010+ + 'ifdef DATE'#010+ + 'DATESTR:=$(shell $(DATE) +%Y%m%d)'#010+ + 'else'#010+ + 'DATESTR='#010+ + 'endif'#010+ + #010+ + '# Loo','k if UPX is found for go32v2 and win32. We can'#039't use $UPX b'+ + 'ecuase'#010+ + '# upx uses that one itself (PFV)'#010+ + 'ifndef UPXPROG'#010+ + 'ifeq ($(OS_TARGET),go32v2)'#010+ + 'UPXPROG:=1'#010+ + 'endif'#010+ + 'ifeq ($(OS_TARGET),win32)'#010+ + 'UPXPROG:=1'#010+ + 'endif'#010+ + 'ifdef UPXPROG'#010+ + 'UPXPROG:=$(strip $(wildca','rd $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPAT'+ + 'H))))'#010+ + 'ifeq ($(UPXPROG),)'#010+ + 'UPXPROG='#010+ + 'else'#010+ + 'UPXPROG:=$(firstword $(UPXPROG))'#010+ + 'endif'#010+ + 'else'#010+ + 'UPXPROG='#010+ + 'endif'#010+ + 'endif'#010+ + 'export UPXPROG'#010+ + #010+ + '# Zip options'#010+ + 'ZIPOPT=-9'#010+ + 'ZIPEXT=.zip'#010+ + #010+ + '# Tar options'#010+ + 'ifeq ($(USETAR),bz2)'#010+ + 'TAROP','T=vj'#010+ + 'TAREXT=.tar.bz2'#010+ + 'else'#010+ + 'TAROPT=vz'#010+ + 'TAREXT=.tar.gz'#010+ + 'endif'#010+ + #010+ + #010+ + '[command_begin]'#010+ + '#####################################################################'#010+ + '# Compiler Command Line'#010+ + '#####################################################################'#010+ + #010, + '# Load commandline OPTDEF and add FPC_CPU define, for compiling the'#010+ + '# compiler this needs to be turned off'#010+ + 'ifndef NOCPUDEF'#010+ + 'override FPCOPTDEF=$(CPU_TARGET)'#010+ + 'endif'#010+ + #010+ + #010+ + '# Load commandline OPT and add target and unit dir to be sure'#010+ + 'ifneq ($(OS_TA','RGET),$(OS_SOURCE))'#010+ + 'override FPCOPT+=-T$(OS_TARGET)'#010+ + 'endif'#010+ + #010+ + 'ifeq ($(OS_SOURCE),openbsd)'#010+ + 'override FPCOPT+=-FD$(NEW_BINUTILS_PATH)'#010+ + 'endif'#010+ + #010+ + 'ifndef CROSSBOOTSTRAP'#010+ + 'ifneq ($(BINUTILSPREFIX),)'#010+ + 'override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc'#010+ + 'endif'#010+ + 'ifneq ($','(BINUTILSPREFIX),)'#010+ + 'override FPCOPT+=-Xr$(RLINKPATH)'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# User dirs should be first, so they are looked at first'#010+ + 'ifdef UNITDIR'#010+ + 'override FPCOPT+=$(addprefix -Fu,$(UNITDIR))'#010+ + 'endif'#010+ + 'ifdef LIBDIR'#010+ + 'override FPCOPT+=$(addprefix -Fl,$(LIBDI','R))'#010+ + 'endif'#010+ + 'ifdef OBJDIR'#010+ + 'override FPCOPT+=$(addprefix -Fo,$(OBJDIR))'#010+ + 'endif'#010+ + 'ifdef INCDIR'#010+ + 'override FPCOPT+=$(addprefix -Fi,$(INCDIR))'#010+ + 'endif'#010+ + #010+ + '# Smartlinking'#010+ + 'ifdef LINKSMART'#010+ + 'override FPCOPT+=-XX'#010+ + 'endif'#010+ + #010+ + '# Smartlinking creation'#010+ + 'ifdef CREATESMART'#010+ + 'ov','erride FPCOPT+=-CX'#010+ + 'endif'#010+ + #010+ + '# Debug'#010+ + 'ifdef DEBUG'#010+ + 'override FPCOPT+=-gl'#010+ + 'override FPCOPTDEF+=DEBUG'#010+ + 'endif'#010+ + #010+ + '# Release mode (strip, optimize and don'#039't load fpc.cfg)'#010+ + 'ifdef RELEASE'#010+ + 'ifeq ($(CPU_TARGET),i386)'#010+ + 'FPCCPUOPT:=-OG2p3'#010+ + 'else'#010+ + 'ifeq ($(CPU_TARGET),p','owerpc)'#010+ + 'FPCCPUOPT:=-O1r'#010+ + 'else'#010+ + 'FPCCPUOPT:='#010+ + 'endif'#010+ + 'endif'#010+ + 'override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n'#010+ + 'override FPCOPTDEF+=RELEASE'#010+ + 'endif'#010+ + #010+ + '# Strip'#010+ + 'ifdef STRIP'#010+ + 'override FPCOPT+=-Xs'#010+ + 'endif'#010+ + #010+ + '# Optimizer (i386 only for now)'#010+ + 'ifdef OPTIMIZE'#010+ + 'ifeq ($(CPU_TARG','ET),i386)'#010+ + 'override FPCOPT+=-OG2p3'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Verbose settings (warning,note,info)'#010+ + 'ifdef VERBOSE'#010+ + 'override FPCOPT+=-vwni'#010+ + 'endif'#010+ + #010+ + '# Needed compiler options'#010+ + 'ifdef COMPILER_OPTIONS'#010+ + 'override FPCOPT+=$(COMPILER_OPTIONS)'#010+ + 'endif'#010+ + 'ifdef COMPILER_UNI','TDIR'#010+ + 'override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))'#010+ + 'endif'#010+ + 'ifdef COMPILER_LIBRARYDIR'#010+ + 'override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))'#010+ + 'endif'#010+ + 'ifdef COMPILER_OBJECTDIR'#010+ + 'override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))'#010+ + 'endif',#010+ + 'ifdef COMPILER_INCLUDEDIR'#010+ + 'override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))'#010+ + 'endif'#010+ + #010+ + '# Cross compiler utils'#010+ + 'ifdef CROSSBINDIR'#010+ + 'override FPCOPT+=-FD$(CROSSBINDIR)'#010+ + 'endif'#010+ + #010+ + '# Target dirs and the prefix to use for clean/install'#010+ + 'ifdef COMPIL','ER_TARGETDIR'#010+ + 'override FPCOPT+=-FE$(COMPILER_TARGETDIR)'#010+ + 'ifeq ($(COMPILER_TARGETDIR),.)'#010+ + 'override TARGETDIRPREFIX='#010+ + 'else'#010+ + 'override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Unit target dir (default is units/<cpu>-<os>/'#010+ + 'ifdef COMPILER','_UNITTARGETDIR'#010+ + 'override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)'#010+ + 'ifeq ($(COMPILER_UNITTARGETDIR),.)'#010+ + 'override UNITTARGETDIRPREFIX='#010+ + 'else'#010+ + 'override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/'#010+ + 'endif'#010+ + 'else'#010+ + 'ifdef COMPILER_TARGETDIR'#010+ + 'override COMPILER','_UNITTARGETDIR=$(COMPILER_TARGETDIR)'#010+ + 'override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Temporary hack to add HASUNIX define for linux 1.0.6 compiler'#010+ + 'ifeq ($(OS_TARGET),linux)'#010+ + 'ifeq ($(FPC_VERSION),1.0.6)'#010+ + 'override FPCOPTDEF+=HASU','NIX'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '[command_libc]'#010+ + '# Add GCC lib path if asked'#010+ + 'ifdef GCCLIBDIR'#010+ + 'override FPCOPT+=-Fl$(GCCLIBDIR)'#010+ + 'endif'#010+ + 'ifdef OTHERLIBDIR'#010+ + 'override FPCOPT+=$(addprefix -Fl,$(OTHERLIBDIR))'#010+ + 'endif'#010+ + #010+ + #010+ + '[command_end]'#010+ + '# Add commandline options last so th','ey can override'#010+ + 'ifdef OPT'#010+ + 'override FPCOPT+=$(OPT)'#010+ + 'endif'#010+ + #010+ + '# Add defines from FPCOPTDEF to FPCOPT'#010+ + 'ifdef FPCOPTDEF'#010+ + 'override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))'#010+ + 'endif'#010+ + #010+ + '# Was a config file specified ?'#010+ + 'ifdef CFGFILE'#010+ + 'override FPCOPT+=@$(CFGFILE)'#010, + 'endif'#010+ + #010+ + '# Use the environment to pass commandline options?'#010+ + 'ifdef USEENV'#010+ + 'override FPCEXTCMD:=$(FPCOPT)'#010+ + 'override FPCOPT:=!FPCEXTCMD'#010+ + 'export FPCEXTCMD'#010+ + 'endif'#010+ + #010+ + '# Compiler commandline'#010+ + 'override COMPILER:=$(FPC) $(FPCOPT)'#010+ + #010+ + '# also call ppas if with co','mmand option -s'#010+ + '# but only if the FULL_SOURCE and FULL_TARGET are equal'#010+ + 'ifeq (,$(findstring -s ,$(COMPILER)))'#010+ + 'EXECPPAS='#010+ + 'else'#010+ + 'ifeq ($(FULL_SOURCE),$(FULL_TARGET))'#010+ + 'EXECPPAS:=@$(PPAS)'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + #010+ + '[loaderrules]'#010+ + '###############################','#####################################'+ + '#'#010+ + '# Loaders'#010+ + '#####################################################################'#010+ + #010+ + '.PHONY: fpc_loaders'#010+ + #010+ + 'ifneq ($(TARGET_LOADERS),)'#010+ + 'override ALLTARGET+=fpc_loaders'#010+ + 'override CLEANTARGET+=fpc_loaders_clean'#010, + 'override INSTALLTARGET+=fpc_loaders_install'#010+ + #010+ + 'override LOADEROFILES:=$(addsuffix $(OEXT),$(TARGET_LOADERS))'#010+ + 'endif'#010+ + #010+ + '%$(OEXT): %$(LOADEREXT)'#010+ + 'ifdef COMPILER_UNITTARGETDIR'#010+ + ' $(AS) -o $(COMPILER_UNITTARGETDIR)/$*$(OEXT) $<'#010+ + 'else'#010+ + ' $(AS',') -o $*$(OEXT) $<'#010+ + 'endif'#010+ + #010+ + 'fpc_loaders: $(COMPILER_UNITTARGETDIR) $(LOADEROFILES)'#010+ + #010+ + 'fpc_loaders_clean:'#010+ + 'ifdef COMPILER_UNITTARGETDIR'#010+ ' -$(DEL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFILES)'+ - ')'#013#010+ - 'else'#013#010+ - ' -$(DEL) $(LOADEROFILES)'#013#010+ - 'endif'#013#010+ - #013#010+ - 'fpc_loaders_install:'#013#010+ - ' $(MKDIR) $(INSTALL_UNITDIR)'#013#010+ - 'ifdef COMPILER_UNITTARGETDIR'#013#010+ - ' $(INS','TALL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROF'+ - 'ILES)) $(INSTALL_UNITDIR)'#013#010+ - 'else'#013#010+ - ' $(INSTALL) $(LOADEROFILES) $(INSTALL_UNITDIR)'#013#010+ - 'endif'#013#010+ - #013#010+ - #013#010+ - '[unitrules]'#013#010+ - '#####################################################################'#013+ - #010+ - '# ','Units'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ - '.PHONY: fpc_units'#013#010+ - #013#010+ - 'ifneq ($(TARGET_UNITS),)'#013#010+ - 'override ALLTARGET+=fpc_units'#013#010+ - #013#010+ - 'override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))'#013#010+ - 'override IMPLICITU','NITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICI'+ - 'TUNITS))'#013#010+ - 'override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)'#013#010+ - 'override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)'#013#010+ - 'endif'#013#010+ - #013#010+ - 'fpc_units: $(COMPILER_UNITTARGETDIR) $(','UNITPPUFILES)'#013#010+ - #013#010+ - #013#010+ - '[exerules]'#013#010+ - '#####################################################################'#013+ - #010+ - '# Exes'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ - '.PHONY: fpc_exes'#013#010+ - #013#010+ - '# Programs are not needed for a cross',' installation'#013#010+ - 'ifndef CROSSINSTALL'#013#010+ - 'ifneq ($(TARGET_PROGRAMS),)'#013#010+ - 'override EXEFILES=$(addsuffix $(EXEEXT),$(TARGET_PROGRAMS))'#013#010+ - 'override EXEOFILES:=$(addsuffix $(OEXT),$(TARGET_PROGRAMS)) $(addprefi'+ - 'x $(STATICLIBPREFIX),$(addsuffix $(STATICLIB','EXT),$(TARGET_PROGRAMS))'+ - ')'#013#010+ - #013#010+ - 'override ALLTARGET+=fpc_exes'#013#010+ - 'override INSTALLEXEFILES+=$(EXEFILES)'#013#010+ - 'override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES)'#013#010+ - 'ifeq ($(OS_TARGET),os2)'#013#010+ - 'override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_PROGRAMS))'#013, - #010+ - 'endif'#013#010+ - 'ifeq ($(OS_TARGET),emx)'#013#010+ - 'override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_PROGRAMS))'#013+ - #010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - 'fpc_exes: $(COMPILER_TARGETDIR) $(COMPILER_UNITTARGETDIR) $(EXEFILES)'#013+ - #010+ - #013#010+ - #013#010+ - '[rstrules]'#013#010+ - '#############################','#######################################'+ - '#'#013#010+ - '# Resource strings'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ - 'ifdef TARGET_RSTS'#013#010+ - 'override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))'#013#010+ - #013#010+ - 'override CLEANRSTFILES+=$(R','STFILES)'#013#010+ - 'endif'#013#010+ - #013#010+ - #013#010+ - '[examplerules]'#013#010+ - '#####################################################################'#013+ - #010+ - '# Examples'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ - '.PHONY: fpc_examples'#013#010+ - #013#010+ - 'ifneq ($(TARGET_EXAMPLE','S),)'#013#010+ - 'HASEXAMPLES=1'#013#010+ + ')'#010+ + 'else'#010+ + ' -$(DEL) $(LOADEROFILES)'#010+ + 'en','dif'#010+ + #010+ + 'fpc_loaders_install:'#010+ + ' $(MKDIR) $(INSTALL_UNITDIR)'#010+ + 'ifdef COMPILER_UNITTARGETDIR'#010+ + ' $(INSTALL) $(addprefix $(COMPILER_UNITTARGETDIR)/,$(LOADEROFIL'+ + 'ES)) $(INSTALL_UNITDIR)'#010+ + 'else'#010+ + ' $(INSTALL) $(LOADEROFILES) $(INSTALL_UNITD','IR)'#010+ + 'endif'#010+ + #010+ + #010+ + '[unitrules]'#010+ + '#####################################################################'#010+ + '# Units'#010+ + '#####################################################################'#010+ + #010+ + '.PHONY: fpc_units'#010+ + #010+ + 'ifneq ($(TARGET_UNITS),)'#010+ + 'override ALLTARGET+=fpc','_units'#010+ + #010+ + 'override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))'#010+ + 'override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITU'+ + 'NITS))'#010+ + 'override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)'#010+ + 'override CLEANPPUFILES+=$(UN','ITPPUFILES) $(IMPLICITUNITPPUFILES)'#010+ + 'endif'#010+ + #010+ + 'fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES)'#010+ + #010+ + #010+ + '[exerules]'#010+ + '#####################################################################'#010+ + '# Exes'#010+ + '######################################################','##############'+ + '#'#010+ + #010+ + '.PHONY: fpc_exes'#010+ + #010+ + '# Programs are not needed for a cross installation'#010+ + 'ifndef CROSSINSTALL'#010+ + 'ifneq ($(TARGET_PROGRAMS),)'#010+ + 'override EXEFILES=$(addsuffix $(EXEEXT),$(TARGET_PROGRAMS))'#010+ + 'override EXEOFILES:=$(addsuffix $(OEXT),$(TARG','ET_PROGRAMS)) $(addpre'+ + 'fix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS))'+ + ')'#010+ + #010+ + 'override ALLTARGET+=fpc_exes'#010+ + 'override INSTALLEXEFILES+=$(EXEFILES)'#010+ + 'override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES)'#010+ + 'ifeq ($(OS_TARGET),os2)'#010+ + 'overr','ide CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_PROGRAMS))'#010+ + 'endif'#010+ + 'ifeq ($(OS_TARGET),emx)'#010+ + 'override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_PROGRAMS))'#010+ + 'endif'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + 'fpc_exes: $(COMPILER_TARGETDIR) $(COMPILER_UNITTARGETDIR) $(EX','EFILES'+ + ')'#010+ + #010+ + #010+ + '[rstrules]'#010+ + '#####################################################################'#010+ + '# Resource strings'#010+ + '#####################################################################'#010+ + #010+ + 'ifdef TARGET_RSTS'#010+ + 'override RSTFILES=$(addsuffix $(RSTEXT),$','(TARGET_RSTS))'#010+ + #010+ + 'override CLEANRSTFILES+=$(RSTFILES)'#010+ + 'endif'#010+ + #010+ + #010+ + '[examplerules]'#010+ + '#####################################################################'#010+ + '# Examples'#010+ + '#####################################################################'#010+ + #010+ + '.PHONY: fpc_e','xamples'#010+ + #010+ + 'ifneq ($(TARGET_EXAMPLES),)'#010+ + 'HASEXAMPLES=1'#010+ 'override EXAMPLESOURCEFILES:=$(wildcard $(addsuffix .pp,$(TARGET_EXAMP'+ 'LES)) $(addsuffix .pas,$(TARGET_EXAMPLES)) $(addsuffix .lpr,$(TARGET_E'+ - 'XAMPLES)) $(addsuffix .dpr,$(TARGET_EXAMPLES)))'#013#010+ - 'override EXAMPLEFILES:=$(addsu','ffix $(EXEEXT),$(TARGET_EXAMPLES))'#013+ - #010+ + 'XAMPLES)) $(addsuffix .dpr,$(TARGET_EXAMPLES)))'#010+ + 'o','verride EXAMPLEFILES:=$(addsuffix $(EXEEXT),$(TARGET_EXAMPLES))'#010+ 'override EXAMPLEOFILES:=$(addsuffix $(OEXT),$(TARGET_EXAMPLES)) $(addp'+ 'refix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_EXAMPLES'+ - ')))'#013#010+ - #013#010+ - 'override CLEANEXEFILES+=$(EXAMPLEFILES) $(EXAMPLEOFILES)'#013,#010+ - 'ifeq ($(OS_TARGET),os2)'#013#010+ - 'override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_EXAMPLES))'#013+ - #010+ - 'endif'#013#010+ - 'ifeq ($(OS_TARGET),emx)'#013#010+ - 'override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_EXAMPLES))'#013+ - #010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'ifneq ($(TARGET_EXAMPLEDIRS),)'#013#010, - 'HASEXAMPLES=1'#013#010+ - 'endif'#013#010+ - #013#010+ + ')))'#010+ + #010+ + 'override CLEANEXEFILES+=$(EXAMP','LEFILES) $(EXAMPLEOFILES)'#010+ + 'ifeq ($(OS_TARGET),os2)'#010+ + 'override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_EXAMPLES))'#010+ + 'endif'#010+ + 'ifeq ($(OS_TARGET),emx)'#010+ + 'override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_EXAMPLES))'#010+ + 'endif'#010+ + 'endif'#010+ + 'ifneq ($(TARGE','T_EXAMPLEDIRS),)'#010+ + 'HASEXAMPLES=1'#010+ + 'endif'#010+ + #010+ 'fpc_examples: all $(EXAMPLEFILES) $(addsuffix _all,$(TARGET_EXAMPLEDIR'+ - 'S))'#013#010+ - #013#010+ - #013#010+ - '[compilerules]'#013#010+ - '#####################################################################'#013+ + 'S))'#010+ + #010+ + #010+ + '[compilerules]'#010+ + '#####################################################################'#010+ + '# General compile rules'#010+ + '#################','###################################################'+ + '#'#010+ + #010+ + '.PHONY: fpc_all fpc_smart fpc_debug fpc_release'#010+ + #010+ + '$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)'#010+ + ' @$(ECHOREDIR) Compiled > $(FPCMADE)'#010+ + #010+ + 'fpc_all: $(FPCMADE)'#010+ + #010+ + 'fpc_smart:'#010+ + ' $(MAKE) ','all LINKSMART=1 CREATESMART=1'#010+ + #010+ + 'fpc_debug:'#010+ + ' $(MAKE) all DEBUG=1'#010+ + #010+ + 'fpc_release:'#010+ + ' $(MAKE) all RELEASE=1'#010+ #010+ - '# General compile rules'#013#010+ - '#########################','###########################################'+ - '#'#013#010+ - #013#010+ - '.PHONY: fpc_all fpc_smart fpc_debug fpc_release'#013#010+ - #013#010+ - '$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)'#013#010+ - ' @$(ECHOREDIR) Compiled > $(FPCMADE)'#013#010+ - #013#010+ - 'fpc_all: $(FPCMADE)'#013#010+ - #013#010+ - 'fpc_smart:'#013#010+ - ' $(MAKE',') all LINKSMART=1 CREATESMART=1'#013#010+ - #013#010+ - 'fpc_debug:'#013#010+ - ' $(MAKE) all DEBUG=1'#013#010+ - #013#010+ - 'fpc_release:'#013#010+ - ' $(MAKE) all RELEASE=1'#013#010+ - #013#010+ '# General compile rules, available for both possible .pp and .pas exte'+ - 'nsions'#013#010+ - #013#010+ - '.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OE','XT) .pas .lpr .dpr .pp .rc .res'#013+ - #010+ - #013#010+ - '$(COMPILER_UNITTARGETDIR):'#013#010+ - ' $(MKDIRTREE) $(COMPILER_UNITTARGETDIR)'#013#010+ - #013#010+ - '$(COMPILER_TARGETDIR):'#013#010+ - ' $(MKDIRTREE) $(COMPILER_TARGETDIR)'#013#010+ - #013#010+ - '%$(PPUEXT): %.pp'#013#010+ - ' $(COMPILER) $<'#013#010+ - ' $(EXECP','PAS)'#013#010+ - #013#010+ - '%$(PPUEXT): %.pas'#013#010+ - ' $(COMPILER) $<'#013#010+ - ' $(EXECPPAS)'#013#010+ - #013#010+ - '%$(EXEEXT): %.pp'#013#010+ - ' $(COMPILER) $<'#013#010+ - ' $(EXECPPAS)'#013#010+ - #013#010+ - '%$(EXEEXT): %.pas'#013#010+ - ' $(COMPILER) $<'#013#010+ - ' $(EXECPPAS)'#013#010+ - #013#010+ - '%$(EXEEXT): %.lpr'#013#010+ - ' $(COMPIL','ER) $<'#013#010+ - ' $(EXECPPAS)'#013#010+ - #013#010+ - '%$(EXEEXT): %.dpr'#013#010+ - ' $(COMPILER) $<'#013#010+ - ' $(EXECPPAS)'#013#010+ - #013#010+ - '%.res: %.rc'#013#010+ - ' windres -i $< -o $@'#013#010+ - #013#010+ - '# Search paths for .ppu, .pp, .pas, .lpr, .dpr'#013#010+ - 'vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDE','DIR)'#013#010+ - 'vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)'#013#010+ - 'vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)'#013#010+ - 'vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)'#013#010+ - 'vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)'#013#010+ - 'vpath %$(PPUEXT) $','(COMPILER_UNITTARGETDIR)'#013#010+ - #013#010+ - '[libraryrules]'#013#010+ - '#####################################################################'#013+ - #010+ - '# Library'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ - '.PHONY: fpc_shared'#013#010+ - #013#010+ - 'ifndef LIB_FULLNAME',#013#010+ - 'ifdef LIB_VERSION'#013#010+ - 'LIB_FULLNAME=$(LIB_NAME).$(LIB_VERSION)'#013#010+ - 'else'#013#010+ - 'LIB_FULLNAME=$(LIB_NAME)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Default sharedlib units are all unit objects'#013#010+ - 'ifndef LIB_SHAREDUNITS'#013#010+ - 'LIB_SHAREDUNITS:=$(TARGET_UNITS)'#013#010+ - 'endif'#013#010+ - #013#010+ - 'fpc_shared: all',#013#010+ - 'ifdef HASSHAREDLIB'#013#010+ - ' $(PPUMOVE) $(LIB_SHAREDUNITS) -o$(LIB_FULLNAME)'#013#010+ - 'else'#013#010+ - ' @$(ECHO) Shared Libraries not supported'#013#010+ - 'endif'#013#010+ - #013#010+ - #013#010+ - '[installrules]'#013#010+ - '#####################################################################'#013+ - #010+ - '# Instal','l rules'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ - '.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall'#013#010+ - #013#010+ - 'ifdef INSTALL_UNITS'#013#010+ - 'override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))'#013#010+ - 'endif'#013#010+ - #013#010+ - 'i','fdef INSTALL_BUILDUNIT'#013#010+ + 'nsions'#010+ + #010+ + '.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lp','r .dpr .pp .rc .res'#010+ + #010+ + '$(COMPILER_UNITTARGETDIR):'#010+ + ' $(MKDIRTREE) $(COMPILER_UNITTARGETDIR)'#010+ + #010+ + '$(COMPILER_TARGETDIR):'#010+ + ' $(MKDIRTREE) $(COMPILER_TARGETDIR)'#010+ + #010+ + '%$(PPUEXT): %.pp'#010+ + ' $(COMPILER) $<'#010+ + ' $(EXECPPAS)'#010+ + #010+ + '%$(PPUEXT): %.pa','s'#010+ + ' $(COMPILER) $<'#010+ + ' $(EXECPPAS)'#010+ + #010+ + '%$(EXEEXT): %.pp'#010+ + ' $(COMPILER) $<'#010+ + ' $(EXECPPAS)'#010+ + #010+ + '%$(EXEEXT): %.pas'#010+ + ' $(COMPILER) $<'#010+ + ' $(EXECPPAS)'#010+ + #010+ + '%$(EXEEXT): %.lpr'#010+ + ' $(COMPILER) $<'#010+ + ' $(EXECPPAS)'#010+ + #010+ + '%$(EXEEXT','): %.dpr'#010+ + ' $(COMPILER) $<'#010+ + ' $(EXECPPAS)'#010+ + #010+ + '%.res: %.rc'#010+ + ' windres -i $< -o $@'#010+ + #010+ + '# Search paths for .ppu, .pp, .pas, .lpr, .dpr'#010+ + 'vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)'#010+ + 'vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILE','R_INCLUDEDIR)'#010+ + 'vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)'#010+ + 'vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)'#010+ + 'vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)'#010+ + 'vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)'#010+ + #010+ + '[libraryrules]'#010+ + '############','########################################################'+ + '#'#010+ + '# Library'#010+ + '#####################################################################'#010+ + #010+ + '.PHONY: fpc_shared'#010+ + #010+ + 'ifndef LIB_FULLNAME'#010+ + 'ifdef LIB_VERSION'#010+ + 'LIB_FULLNAME=$(LIB_NAME).$(LIB_VERSION)'#010+ + 'els','e'#010+ + 'LIB_FULLNAME=$(LIB_NAME)'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Default sharedlib units are all unit objects'#010+ + 'ifndef LIB_SHAREDUNITS'#010+ + 'LIB_SHAREDUNITS:=$(TARGET_UNITS)'#010+ + 'endif'#010+ + #010+ + 'fpc_shared: all'#010+ + 'ifdef HASSHAREDLIB'#010+ + ' $(PPUMOVE) $(LIB_SHAREDUNITS) -o$(LIB_FULLNAME)',#010+ + 'else'#010+ + ' @$(ECHO) Shared Libraries not supported'#010+ + 'endif'#010+ + #010+ + #010+ + '[installrules]'#010+ + '#####################################################################'#010+ + '# Install rules'#010+ + '#####################################################################'#010+ + #010+ + '.PHONY',': fpc_install fpc_sourceinstall fpc_exampleinstall'#010+ + #010+ + 'ifdef INSTALL_UNITS'#010+ + 'override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))'#010+ + 'endif'#010+ + #010+ + 'ifdef INSTALL_BUILDUNIT'#010+ 'override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$'+ - '(INSTALLPPUFILES))'#013#010+ - 'endif'#013#010+ - #013#010+ - 'ifdef INSTALLPPUFILES'#013#010+ + '(','INSTALLPPUFILES))'#010+ + 'endif'#010+ + #010+ + 'ifdef INSTALLPPUFILES'#010+ 'override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFI'+ - 'LES)) $(addprefix $(STAT','ICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEX'+ - 'T),$(INSTALLPPUFILES)))'#013#010+ - 'ifneq ($(UNITTARGETDIRPREFIX),)'#013#010+ + 'LES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT)'+ + ',$(INSTALLPPUFILES)))'#010+ + 'ifneq ($(UNITTARGETDIRPREFIX),)',#010+ 'override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir '+ - '$(INSTALLPPUFILES)))'#013#010+ - 'override INSTALLPPULINKFILES:=$(wildcard $(add','prefix $(UNITTARGETDIR'+ - 'PREFIX),$(notdir $(INSTALLPPULINKFILES))))'#013#010+ - 'endif'#013#010+ - '# Implicitly install Package.fpc'#013#010+ - 'override INSTALL_CREATEPACKAGEFPC=1'#013#010+ - 'endif'#013#010+ - #013#010+ - 'ifdef INSTALLEXEFILES'#013#010+ - 'ifneq ($(TARGETDIRPREFIX),)'#013#010+ - 'override INSTALLEXEFILES:=$(addpref','ix $(TARGETDIRPREFIX),$(notdir $('+ - 'INSTALLEXEFILES)))'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - 'fpc_install: all $(INSTALLTARGET)'#013#010+ - 'ifdef INSTALLEXEFILES'#013#010+ - ' $(MKDIR) $(INSTALL_BINDIR)'#013#010+ - '# Compress the exes if upx is defined'#013#010+ - 'ifdef UPXPROG'#013#010+ - ' -$(UPXPROG) $(I','NSTALLEXEFILES)'#013#010+ - 'endif'#013#010+ - ' $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)'#013#010+ - 'endif'#013#010+ - 'ifdef INSTALL_CREATEPACKAGEFPC'#013#010+ - 'ifdef FPCMAKE'#013#010+ + '$(INSTALLPPUFILES)))'#010+ + 'override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPR'+ + 'EFIX),$(notdir $(INSTALLPPULINKFILES))))'#010+ + 'endif'#010+ + '# Implicitly install Package.fp','c'#010+ + 'override INSTALL_CREATEPACKAGEFPC=1'#010+ + 'endif'#010+ + #010+ + 'ifdef INSTALLEXEFILES'#010+ + 'ifneq ($(TARGETDIRPREFIX),)'#010+ + 'override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(IN'+ + 'STALLEXEFILES)))'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + 'fpc_install: all $(INSTALLTARGET)'#010+ + 'ifdef INSTA','LLEXEFILES'#010+ + ' $(MKDIR) $(INSTALL_BINDIR)'#010+ + '# Compress the exes if upx is defined'#010+ + 'ifdef UPXPROG'#010+ + ' -$(UPXPROG) $(INSTALLEXEFILES)'#010+ + 'endif'#010+ + ' $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)'#010+ + 'endif'#010+ + 'ifdef INSTALL_CREATEPACKAGEFPC'#010+ + 'i','fdef FPCMAKE'#010+ '# If the fpcpackage variable is set then create and install Package.fp'+ - 'c,'#013#010+ - '# a safety check is done if ','Makefile.fpc is available'#013#010+ - 'ifdef PACKAGE_VERSION'#013#010+ - 'ifneq ($(wildcard Makefile.fpc),)'#013#010+ - ' $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc'#013#010+ - ' $(MKDIR) $(INSTALL_UNITDIR)'#013#010+ - ' $(INSTALL) Package.fpc $(INSTALL_UNITDIR)'#013#010+ - 'en','dif'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'ifdef INSTALLPPUFILES'#013#010+ - ' $(MKDIR) $(INSTALL_UNITDIR)'#013#010+ - ' $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)'#013#010+ - 'ifneq ($(INSTALLPPULINKFILES),)'#013#010+ - ' $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)'#013#010+ - 'e','ndif'#013#010+ - 'ifneq ($(wildcard $(LIB_FULLNAME)),)'#013#010+ - ' $(MKDIR) $(INSTALL_LIBDIR)'#013#010+ - ' $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)'#013#010+ - 'ifdef inUnix'#013#010+ - ' ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - 'ifdef INS','TALL_FILES'#013#010+ - ' $(MKDIR) $(INSTALL_DATADIR)'#013#010+ - ' $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)'#013#010+ - 'endif'#013#010+ - #013#010+ - 'fpc_sourceinstall: distclean'#013#010+ - ' $(MKDIR) $(INSTALL_SOURCEDIR)'#013#010+ - ' $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)'#013#010+ - #013#010, - 'fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))'#013#010+ - 'ifdef HASEXAMPLES'#013#010+ - ' $(MKDIR) $(INSTALL_EXAMPLEDIR)'#013#010+ - 'endif'#013#010+ - 'ifdef EXAMPLESOURCEFILES'#013#010+ - ' $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)'#013#010+ - 'endif'#013#010+ - 'ifdef TARGET_','EXAMPLEDIRS'#013#010+ + 'c,'#010+ + '# a safety check is done if Makefile.fpc is available'#010+ + 'ifdef PACKAGE_VERSION'#010+ + 'ifneq ($(wildcard Makefile.fpc),)'#010+ + ' $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_T','ARGET) Makefile.fpc'#010+ + ' $(MKDIR) $(INSTALL_UNITDIR)'#010+ + ' $(INSTALL) Package.fpc $(INSTALL_UNITDIR)'#010+ + 'endif'#010+ + 'endif'#010+ + 'endif'#010+ + 'endif'#010+ + 'ifdef INSTALLPPUFILES'#010+ + ' $(MKDIR) $(INSTALL_UNITDIR)'#010+ + ' $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNIT','DIR)'#010+ + 'ifneq ($(INSTALLPPULINKFILES),)'#010+ + ' $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)'#010+ + 'endif'#010+ + 'ifneq ($(wildcard $(LIB_FULLNAME)),)'#010+ + ' $(MKDIR) $(INSTALL_LIBDIR)'#010+ + ' $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)'#010+ + 'ifdef inUni','x'#010+ + ' ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)'#010+ + 'endif'#010+ + 'endif'#010+ + 'endif'#010+ + 'ifdef INSTALL_FILES'#010+ + ' $(MKDIR) $(INSTALL_DATADIR)'#010+ + ' $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)'#010+ + 'endif'#010+ + #010+ + 'fpc_sourceinstall: distclean'#010+ + ' $(MK','DIR) $(INSTALL_SOURCEDIR)'#010+ + ' $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)'#010+ + #010+ + 'fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))'#010+ + 'ifdef HASEXAMPLES'#010+ + ' $(MKDIR) $(INSTALL_EXAMPLEDIR)'#010+ + 'endif'#010+ + 'ifdef EXAMPLESOURCEFILES'#010+ + ' ',' $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)'#010+ + 'endif'#010+ + 'ifdef TARGET_EXAMPLEDIRS'#010+ ' $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EX'+ - 'AMPLEDIR)'#013#010+ - 'endif'#013#010+ - #013#010+ - '[distinstallrules]'#013#010+ - '#####################################################################'#013+ - #010+ - '# Dist Install'#013#010+ - '##############################','######################################'+ - '#'#013#010+ - #013#010+ - '.PHONY: fpc_distinstall'#013#010+ - #013#010+ - 'fpc_distinstall: install exampleinstall'#013#010+ - #013#010+ - #013#010+ - '[zipinstallrules]'#013#010+ - '#####################################################################'#013+ - #010+ - '# Zip'#013#010+ - '############################','########################################'+ - '#'#013#010+ - #013#010+ - '.PHONY: fpc_zipinstall fpc_zipsourceinstall fpc_zipexampleinstall'#013#010+ - #013#010+ - '# Temporary path to pack a file, can only use a single deep'#013#010+ - '# subdir, because the deltree can'#039't see the whole tree to remove'#013, - #010+ - 'ifndef PACKDIR'#013#010+ - 'ifndef inUnix'#013#010+ - 'PACKDIR=$(BASEDIR)/../fpc-pack'#013#010+ - 'else'#013#010+ - 'PACKDIR=/tmp/fpc-pack'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Maybe create default zipname from packagename'#013#010+ - 'ifndef ZIPNAME'#013#010+ - 'ifdef DIST_ZIPNAME'#013#010+ - 'ZIPNAME=$(DIST_ZIPNAME)'#013#010+ - 'else'#013#010+ - 'ZIPNAME=$(PACKA','GE_NAME)'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - 'ifndef FULLZIPNAME'#013#010+ - 'FULLZIPNAME=$(ZIPCROSSPREFIX)$(ZIPPREFIX)$(ZIPNAME)$(ZIPSUFFIX)'#013#010+ - 'endif'#013#010+ - #013#010+ - '# ZipTarget'#013#010+ - 'ifndef ZIPTARGET'#013#010+ - 'ifdef DIST_ZIPTARGET'#013#010+ - 'ZIPTARGET=DIST_ZIPTARGET'#013#010+ - 'else'#013#010+ - 'ZIPTARGET=install'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010, - '# Use tar by default under linux'#013#010+ - 'ifndef USEZIP'#013#010+ - 'ifdef inUnix'#013#010+ - 'USETAR=1'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Use a wrapper script by default for Os/2'#013#010+ - 'ifndef inUnix'#013#010+ - 'USEZIPWRAPPER=1'#013#010+ - 'endif'#013#010+ - #013#010+ - '# We need to be able to run in the current OS so fix'#013#010+ - '# the path s','eparator'#013#010+ - 'ifdef USEZIPWRAPPER'#013#010+ - 'ZIPPATHSEP=$(PATHSEP)'#013#010+ - 'ZIPWRAPPER=$(subst /,$(PATHSEP),$(DIST_DESTDIR)/fpczip$(SRCBATCHEXT))'#013+ - #010+ - 'else'#013#010+ - 'ZIPPATHSEP=/'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Create commands to create the zip/tar file'#013#010+ - 'ZIPCMD_CDPACK:=cd $(subst /,$(ZIPPATHSEP','),$(PACKDIR))'#013#010+ - 'ZIPCMD_CDBASE:=cd $(subst /,$(ZIPPATHSEP),$(BASEDIR))'#013#010+ - 'ifdef USETAR'#013#010+ - 'ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(TAREXT)'#013#010+ - 'ZIPCMD_ZIP:=$(TARPROG) cf$(TAROPT) $(ZIPDESTFILE) *'#013#010+ - 'else'#013#010+ - 'ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)','$(ZIPEXT)'#013#010+ + 'AMPLEDIR)'#010+ + 'endif'#010+ + #010+ + '[distinstallrules]'#010+ + '################################################','####################'+ + '#'#010+ + '# Dist Install'#010+ + '#####################################################################'#010+ + #010+ + '.PHONY: fpc_distinstall'#010+ + #010+ + 'fpc_distinstall: install exampleinstall'#010+ + #010+ + #010+ + '[zipinstallrules]'#010+ + '###############################################','#####################'+ + '#'#010+ + '# Zip'#010+ + '#####################################################################'#010+ + #010+ + '.PHONY: fpc_zipinstall fpc_zipsourceinstall fpc_zipexampleinstall'#010+ + #010+ + '# Temporary path to pack a file, can only use a single deep'#010+ + '# subdir, bec','ause the deltree can'#039't see the whole tree to remove'+ + #010+ + 'ifndef PACKDIR'#010+ + 'ifndef inUnix'#010+ + 'PACKDIR=$(BASEDIR)/../fpc-pack'#010+ + 'else'#010+ + 'PACKDIR=/tmp/fpc-pack'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Maybe create default zipname from packagename'#010+ + 'ifndef ZIPNAME'#010+ + 'ifdef DIST_ZIPNAME'#010+ + 'ZIPNAM','E=$(DIST_ZIPNAME)'#010+ + 'else'#010+ + 'ZIPNAME=$(PACKAGE_NAME)'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + 'ifndef FULLZIPNAME'#010+ + 'FULLZIPNAME=$(ZIPCROSSPREFIX)$(ZIPPREFIX)$(ZIPNAME)$(ZIPSUFFIX)'#010+ + 'endif'#010+ + #010+ + '# ZipTarget'#010+ + 'ifndef ZIPTARGET'#010+ + 'ifdef DIST_ZIPTARGET'#010+ + 'ZIPTARGET=DIST_ZIPTARGET'#010+ + 'else'#010+ + 'ZIPTARGET=','install'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Use tar by default under linux'#010+ + 'ifndef USEZIP'#010+ + 'ifdef inUnix'#010+ + 'USETAR=1'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Use a wrapper script by default for Os/2'#010+ + 'ifndef inUnix'#010+ + 'USEZIPWRAPPER=1'#010+ + 'endif'#010+ + #010+ + '# We need to be able to run in the current OS so fix'#010+ + '# th','e path separator'#010+ + 'ifdef USEZIPWRAPPER'#010+ + 'ZIPPATHSEP=$(PATHSEP)'#010+ + 'ZIPWRAPPER=$(subst /,$(PATHSEP),$(DIST_DESTDIR)/fpczip$(SRCBATCHEXT))'#010+ + 'else'#010+ + 'ZIPPATHSEP=/'#010+ + 'endif'#010+ + #010+ + '# Create commands to create the zip/tar file'#010+ + 'ZIPCMD_CDPACK:=cd $(subst /,$(ZIPPATHSEP)',',$(PACKDIR))'#010+ + 'ZIPCMD_CDBASE:=cd $(subst /,$(ZIPPATHSEP),$(BASEDIR))'#010+ + 'ifdef USETAR'#010+ + 'ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(TAREXT)'#010+ + 'ZIPCMD_ZIP:=$(TARPROG) cf$(TAROPT) $(ZIPDESTFILE) *'#010+ + 'else'#010+ + 'ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(ZIPEX','T)'#010+ 'ZIPCMD_ZIP:=$(subst /,$(ZIPPATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDES'+ - 'TFILE) *'#013#010+ - 'endif'#013#010+ - #013#010+ - 'fpc_zipinstall:'#013#010+ - ' $(MAKE) $(ZIPTARGET) INSTALL_PREFIX=$(PACKDIR) ZIPINSTALL=1'#013+ - #010+ - ' $(MKDIR) $(DIST_DESTDIR)'#013#010+ - ' $(DEL) $(ZIP','DESTFILE)'#013#010+ - 'ifdef USEZIPWRAPPER'#013#010+ - '# Handle gecho separate as we need to espace \ with \\'#013#010+ - 'ifneq ($(ECHOREDIR),echo)'#013#010+ + 'TFILE) *'#010+ + 'endif'#010+ + #010+ + 'fpc_zipinstall:'#010+ + ' $(MAKE) $(ZIPTARGET) INSTALL_PREFIX=$(PACKDIR) ZIPINSTALL=1'#010+ + ' $(MKDIR) $(DIST_DESTDIR)'#010+ + ' $(DEL) $(ZIPDESTFILE)'#010+ + 'ifde','f USEZIPWRAPPER'#010+ + '# Handle gecho separate as we need to espace \ with \\'#010+ + 'ifneq ($(ECHOREDIR),echo)'#010+ ' $(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDPACK))" > $(ZIPWRAPPE'+ - 'R)'#013#010+ - ' $(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_ZIP)',')" >> $(ZIPWRAPPE'+ - 'R)'#013#010+ + 'R)'#010+ + ' $(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_ZIP))" >> $(ZIPWRAPPER)', + #010+ ' $(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDBASE))" >> $(ZIPWRAPP'+ - 'ER)'#013#010+ - 'else'#013#010+ - ' echo $(ZIPCMD_CDPACK) > $(ZIPWRAPPER)'#013#010+ - ' echo $(ZIPCMD_ZIP) >> $(ZIPWRAPPER)'#013#010+ - ' echo $(ZIPCMD_CDBASE) >> $(ZIPWRAPPER)',#013#010+ - 'endif'#013#010+ - 'ifdef inUnix'#013#010+ - ' /bin/sh $(ZIPWRAPPER)'#013#010+ - 'else'#013#010+ - ' $(ZIPWRAPPER)'#013#010+ - 'endif'#013#010+ - ' $(DEL) $(ZIPWRAPPER)'#013#010+ - 'else'#013#010+ - ' $(ZIPCMD_CDPACK) ; $(ZIPCMD_ZIP) ; $(ZIPCMD_CDBASE)'#013#010+ - 'endif'#013#010+ - ' $(DELTREE) $(PACKDIR)'#013#010+ - #013#010+ - 'fpc_zipsource','install:'#013#010+ - ' $(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall ZIPSUFFIX=$(ZIP'+ - 'SOURCESUFFIX)'#013#010+ - #013#010+ - 'fpc_zipexampleinstall:'#013#010+ - 'ifdef HASEXAMPLES'#013#010+ + 'ER)'#010+ + 'else'#010+ + ' echo $(ZIPCMD_CDPACK) > $(ZIPWRAPPER)'#010+ + ' echo $(ZIPCMD_ZIP) >> $(ZIPWRAPPER)'#010+ + ' echo $(ZIPCMD_CDBASE) >> $(ZIPWRAPPER)'#010+ + 'endif'#010+ + 'ifdef inUnix'#010+ + ' ',' /bin/sh $(ZIPWRAPPER)'#010+ + 'else'#010+ + ' $(ZIPWRAPPER)'#010+ + 'endif'#010+ + ' $(DEL) $(ZIPWRAPPER)'#010+ + 'else'#010+ + ' $(ZIPCMD_CDPACK) ; $(ZIPCMD_ZIP) ; $(ZIPCMD_CDBASE)'#010+ + 'endif'#010+ + ' $(DELTREE) $(PACKDIR)'#010+ + #010+ + 'fpc_zipsourceinstall:'#010+ + ' $(MAKE) fpc_zipinsta','ll ZIPTARGET=sourceinstall ZIPSUFFIX=$(Z'+ + 'IPSOURCESUFFIX)'#010+ + #010+ + 'fpc_zipexampleinstall:'#010+ + 'ifdef HASEXAMPLES'#010+ ' $(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall ZIPSUFFIX=$(ZI'+ - 'PEXAMPLESUFFIX)'#013#010+ - 'endif'#013#010+ - #013#010+ - 'fpc_','zipdistinstall:'#013#010+ - ' $(MAKE) fpc_zipinstall ZIPTARGET=distinstall'#013#010+ - #013#010+ - #013#010+ - '[cleanrules]'#013#010+ - '#####################################################################'#013+ - #010+ - '# Clean rules'#013#010+ - '#################################################################','###'+ - '#'#013#010+ - #013#010+ - '.PHONY: fpc_clean fpc_cleanall fpc_distclean'#013#010+ - #013#010+ - 'ifdef EXEFILES'#013#010+ + 'PEXAMPLESUFFIX)'#010+ + 'endif'#010+ + #010+ + 'fpc_zipdistinstall:'#010+ + ' $(MAKE) fpc_zipinstal','l ZIPTARGET=distinstall'#010+ + #010+ + #010+ + '[cleanrules]'#010+ + '#####################################################################'#010+ + '# Clean rules'#010+ + '#####################################################################'#010+ + #010+ + '.PHONY: fpc_clean fpc_cleanall fpc_distclean'#010+ + #010, + 'ifdef EXEFILES'#010+ 'override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES'+ - '))'#013#010+ - 'endif'#013#010+ - #013#010+ - 'ifdef CLEAN_UNITS'#013#010+ - 'override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))'#013#010+ - 'end','if'#013#010+ - #013#010+ - 'ifdef CLEANPPUFILES'#013#010+ - 'override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)'+ - ') $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(C'+ - 'LEANPPUFILES)))'#013#010+ - 'ifdef DEBUGSYMEXT'#013#010+ - 'override CLEANPPULINKFILES+=$(subst $','(PPUEXT),$(DEBUGSYMEXT),$(CLEAN'+ - 'PPUFILES))'#013#010+ - 'endif'#013#010+ - 'override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUF'+ - 'ILES))'#013#010+ + '))'#010+ + 'endif'#010+ + #010+ + 'ifdef CLEAN_UNITS'#010+ + 'override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))'#010+ + 'endif'#010+ + #010+ + 'ifdef CLEANPPUFILES'#010+ + 'override CLEANPPULINKFILES:=$(subst $(','PPUEXT),$(OEXT),$(CLEANPPUFILE'+ + 'S)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$'+ + '(CLEANPPUFILES)))'#010+ + 'ifdef DEBUGSYMEXT'#010+ + 'override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPP'+ + 'UFILES))'#010+ + 'endif'#010+ + 'override CLEANPPUFI','LES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPP'+ + 'UFILES))'#010+ 'override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREF'+ - 'IX),$(CLEANPPULINKFILES)))'#013#010+ - 'endif'#013#010+ - #013#010+ - 'fpc_c','lean: $(CLEANTARGET)'#013#010+ - 'ifdef CLEANEXEFILES'#013#010+ - ' -$(DEL) $(CLEANEXEFILES)'#013#010+ - 'endif'#013#010+ - 'ifdef CLEANPPUFILES'#013#010+ - ' -$(DEL) $(CLEANPPUFILES)'#013#010+ - 'endif'#013#010+ - 'ifneq ($(CLEANPPULINKFILES),)'#013#010+ - ' -$(DEL) $(CLEANPPULINKFILES)'#013#010+ - 'endif'#013#010+ - 'ifdef CLEANRSTFILE','S'#013#010+ - ' -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))'#013+ - #010+ - 'endif'#013#010+ - 'ifdef CLEAN_FILES'#013#010+ - ' -$(DEL) $(CLEAN_FILES)'#013#010+ - 'endif'#013#010+ - 'ifdef LIB_NAME'#013#010+ - ' -$(DEL) $(LIB_NAME) $(LIB_FULLNAME)'#013#010+ - 'endif'#013#010+ - ' -$(DEL) $(FPCMADE) Package','.fpc $(PPAS) script.res link.res $'+ - '(FPCEXTFILE) $(REDIRFILE)'#013#010+ - ' -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)'#013#010+ - #013#010+ - 'fpc_cleanall: $(CLEANTARGET)'#013#010+ - 'ifdef CLEANEXEFILES'#013#010+ - ' -$(DEL) $(CLEANEXEFILES)'#013#010+ - 'endif'#013#010+ - 'ifdef COMPILER_UNITTARGETDIR'#013#010+ - 'ifdef CLE','ANPPUFILES'#013#010+ - ' -$(DEL) $(CLEANPPUFILES)'#013#010+ - 'endif'#013#010+ - 'ifneq ($(CLEANPPULINKFILES),)'#013#010+ - ' -$(DEL) $(CLEANPPULINKFILES)'#013#010+ - 'endif'#013#010+ - 'ifdef CLEANRSTFILES'#013#010+ - ' -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))'#013+ - #010+ - 'endif'#013#010+ - 'endif'#013#010+ - ' ',' -$(DELTREE) units'#013#010+ + 'IX),$(CLEANPPULINKFILES)))'#010+ + 'endif'#010+ + #010+ + 'fpc_clean: $(CLEANTARGET)'#010+ + 'ifdef CLEANEXEFILES'#010+ + ' -$(DEL) $(CLEANEXEFILES)',#010+ + 'endif'#010+ + 'ifdef CLEANPPUFILES'#010+ + ' -$(DEL) $(CLEANPPUFILES)'#010+ + 'endif'#010+ + 'ifneq ($(CLEANPPULINKFILES),)'#010+ + ' -$(DEL) $(CLEANPPULINKFILES)'#010+ + 'endif'#010+ + 'ifdef CLEANRSTFILES'#010+ + ' -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))'#010+ + 'endif'#010+ + 'ifdef ','CLEAN_FILES'#010+ + ' -$(DEL) $(CLEAN_FILES)'#010+ + 'endif'#010+ + 'ifdef LIB_NAME'#010+ + ' -$(DEL) $(LIB_NAME) $(LIB_FULLNAME)'#010+ + 'endif'#010+ + ' -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(F'+ + 'PCEXTFILE) $(REDIRFILE)'#010+ + ' -$(DEL) *$(ASMEXT) *_ppa','s$(BATCHEXT)'#010+ + #010+ + 'fpc_cleanall: $(CLEANTARGET)'#010+ + 'ifdef CLEANEXEFILES'#010+ + ' -$(DEL) $(CLEANEXEFILES)'#010+ + 'endif'#010+ + 'ifdef COMPILER_UNITTARGETDIR'#010+ + 'ifdef CLEANPPUFILES'#010+ + ' -$(DEL) $(CLEANPPUFILES)'#010+ + 'endif'#010+ + 'ifneq ($(CLEANPPULINKFILES),)'#010+ + ' -$(DEL) $(CL','EANPPULINKFILES)'#010+ + 'endif'#010+ + 'ifdef CLEANRSTFILES'#010+ + ' -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))'#010+ + 'endif'#010+ + 'endif'#010+ + ' -$(DELTREE) units'#010+ ' -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIB'+ - 'EXT) *$(SHAREDLIBEXT) *$(PPLEXT)'#013#010+ - 'ifneq ($(PPUEXT),.ppu)'#013#010+ - ' -$(DEL) *.o *.ppu *.a'#013#010+ - 'endif'#013#010+ - ' -$(DELTREE) *$(SMARTEXT)'#013#010+ - ' -$(DEL) fpc','made.* Package.fpc $(PPAS) script.res link.res $('+ - 'FPCEXTFILE) $(REDIRFILE)'#013#010+ - ' -$(DEL) *_ppas$(BATCHEXT)'#013#010+ - 'ifdef AOUTEXT'#013#010+ - ' -$(DEL) *$(AOUTEXT)'#013#010+ - 'endif'#013#010+ - 'ifdef DEBUGSYMEXT'#013#010+ - ' -$(DEL) *$(DEBUGSYMEXT)'#013#010+ - 'endif'#013#010+ - #013#010+ - 'fpc_distclean: cle','anall'#013#010+ - #013#010+ - #013#010+ - '[baseinforules]'#013#010+ - '#####################################################################'#013+ - #010+ - '# Base info rules'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ - '.PHONY: fpc_baseinfo'#013#010+ - #013#010+ - 'override INFORULES+=fpc_b','aseinfo'#013#010+ - #013#010+ - 'fpc_baseinfo:'#013#010+ - ' @$(ECHO)'#013#010+ - ' @$(ECHO) == Package info =='#013#010+ - ' @$(ECHO) Package Name..... $(PACKAGE_NAME)'#013#010+ - ' @$(ECHO) Package Version.. $(PACKAGE_VERSION)'#013#010+ - ' @$(ECHO)'#013#010+ - ' @$(ECHO) == Configurat','ion info =='#013#010+ - ' @$(ECHO)'#013#010+ - ' @$(ECHO) FPC.......... $(FPC)'#013#010+ - ' @$(ECHO) FPC Version.. $(FPC_VERSION)'#013#010+ - ' @$(ECHO) Source CPU... $(CPU_SOURCE)'#013#010+ - ' @$(ECHO) Target CPU... $(CPU_TARGET)'#013#010+ - ' @$(ECHO) Source OS','.... $(OS_SOURCE)'#013#010+ - ' @$(ECHO) Target OS.... $(OS_TARGET)'#013#010+ - ' @$(ECHO) Full Source.. $(FULL_SOURCE)'#013#010+ - ' @$(ECHO) Full Target.. $(FULL_TARGET)'#013#010+ - ' @$(ECHO) SourceSuffix. $(SOURCESUFFIX)'#013#010+ - ' @$(ECHO) TargetSuffix','. $(TARGETSUFFIX)'#013#010+ - ' @$(ECHO)'#013#010+ - ' @$(ECHO) == Directory info =='#013#010+ - ' @$(ECHO)'#013#010+ - ' @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES)'#013#010+ - ' @$(ECHO)'#013#010+ - ' @$(ECHO) Basedir......... $(BASEDIR)'#013#010+ - ' @$(ECHO) FPCDir','.......... $(FPCDIR)'#013#010+ - ' @$(ECHO) CrossBinDir..... $(CROSSBINDIR)'#013#010+ - ' @$(ECHO) UnitsDir........ $(UNITSDIR)'#013#010+ - ' @$(ECHO) PackagesDir..... $(PACKAGESDIR)'#013#010+ - ' @$(ECHO)'#013#010+ - ' @$(ECHO) GCC library..... $(GCCLIBDIR)'#013#010+ - ' ',' @$(ECHO) Other library... $(OTHERLIBDIR)'#013#010+ - ' @$(ECHO)'#013#010+ - ' @$(ECHO) == Tools info =='#013#010+ - ' @$(ECHO)'#013#010+ - ' @$(ECHO) As........ $(AS)'#013#010+ - ' @$(ECHO) Ld........ $(LD)'#013#010+ - ' @$(ECHO) Ar........ $(AR)'#013#010+ - ' @$','(ECHO) Rc........ $(RC)'#013#010+ - ' @$(ECHO)'#013#010+ - ' @$(ECHO) Mv........ $(MVPROG)'#013#010+ - ' @$(ECHO) Cp........ $(CPPROG)'#013#010+ - ' @$(ECHO) Rm........ $(RMPROG)'#013#010+ - ' @$(ECHO) GInstall.. $(GINSTALL)'#013#010+ - ' @$(ECHO) Echo...... $(ECH','O)'#013#010+ - ' @$(ECHO) Shell..... $(SHELL)'#013#010+ - ' @$(ECHO) Date...... $(DATE)'#013#010+ - ' @$(ECHO) FPCMake... $(FPCMAKE)'#013#010+ - ' @$(ECHO) PPUMove... $(PPUMOVE)'#013#010+ - ' @$(ECHO) Upx....... $(UPXPROG)'#013#010+ - ' @$(ECHO) Zip....... $(ZIPPR','OG)'#013#010+ - ' @$(ECHO)'#013#010+ - ' @$(ECHO) == Object info =='#013#010+ - ' @$(ECHO)'#013#010+ - ' @$(ECHO) Target Loaders........ $(TARGET_LOADERS)'#013#010+ - ' @$(ECHO) Target Units.......... $(TARGET_UNITS)'#013#010+ - ' @$(ECHO) Target Implicit Units. $(T','ARGET_IMPLICITUNITS)'#013+ - #010+ - ' @$(ECHO) Target Programs....... $(TARGET_PROGRAMS)'#013#010+ - ' @$(ECHO) Target Dirs........... $(TARGET_DIRS)'#013#010+ - ' @$(ECHO) Target Examples....... $(TARGET_EXAMPLES)'#013#010+ - ' @$(ECHO) Target ExampleDirs...','. $(TARGET_EXAMPLEDIRS)'#013#010+ - ' @$(ECHO)'#013#010+ - ' @$(ECHO) Clean Units......... $(CLEAN_UNITS)'#013#010+ - ' @$(ECHO) Clean Files......... $(CLEAN_FILES)'#013#010+ - ' @$(ECHO)'#013#010+ - ' @$(ECHO) Install Units....... $(INSTALL_UNITS)'#013#010+ - ' @$(E','CHO) Install Files....... $(INSTALL_FILES)'#013#010+ - ' @$(ECHO)'#013#010+ - ' @$(ECHO) == Install info =='#013#010+ - ' @$(ECHO)'#013#010+ - ' @$(ECHO) DateStr.............. $(DATESTR)'#013#010+ - ' @$(ECHO) ZipName.............. $(ZIPNAME)'#013#010+ - ' @$(ECHO) ',' ZipPrefix............ $(ZIPPREFIX)'#013#010+ - ' @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX)'#013#010+ - ' @$(ECHO) ZipSuffix............ $(ZIPSUFFIX)'#013#010+ - ' @$(ECHO) FullZipName.......... $(FULLZIPNAME)'#013#010+ - ' @$(ECHO) Install FPC Pack','age.. $(INSTALL_FPCPACKAGE)'#013#010+ - ' @$(ECHO)'#013#010+ - ' @$(ECHO) Install base dir..... $(INSTALL_BASEDIR)'#013#010+ - ' @$(ECHO) Install binary dir... $(INSTALL_BINDIR)'#013#010+ - ' @$(ECHO) Install library dir.. $(INSTALL_LIBDIR)'#013#010+ - ' @$(ECHO',') Install units dir.... $(INSTALL_UNITDIR)'#013#010+ - ' @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR)'#013#010+ - ' @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR)'#013#010+ - ' @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR)'#013#010+ - ' @$(','ECHO) Install data dir..... $(INSTALL_DATADIR)'#013#010+ - ' @$(ECHO)'#013#010+ - ' @$(ECHO) Dist destination dir. $(DIST_DESTDIR)'#013#010+ - ' @$(ECHO) Dist zip name........ $(DIST_ZIPNAME)'#013#010+ - ' @$(ECHO)'#013#010+ - #013#010+ - '[inforules]'#013#010+ - '##########################','##########################################'+ - '#'#013#010+ - '# Info rules'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ - '.PHONY: fpc_info'#013#010+ - #013#010+ - 'fpc_info: $(INFORULES)'#013#010+ - #013#010+ - '[makefilerules]'#013#010+ - '#############################################','#######################'+ - '#'#013#010+ - '# Rebuild Makefile'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ + 'EXT) *$(SHAREDLIBEXT',') *$(PPLEXT)'#010+ + 'ifneq ($(PPUEXT),.ppu)'#010+ + ' -$(DEL) *.o *.ppu *.a'#010+ + 'endif'#010+ + ' -$(DELTREE) *$(SMARTEXT)'#010+ + ' -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FP'+ + 'CEXTFILE) $(REDIRFILE)'#010+ + ' -$(DEL) *_ppas$(BATCHEXT)'#010+ + 'ifdef AO','UTEXT'#010+ + ' -$(DEL) *$(AOUTEXT)'#010+ + 'endif'#010+ + 'ifdef DEBUGSYMEXT'#010+ + ' -$(DEL) *$(DEBUGSYMEXT)'#010+ + 'endif'#010+ + #010+ + 'fpc_distclean: cleanall'#010+ + #010+ + #010+ + '[baseinforules]'#010+ + '#####################################################################'#010+ + '# Base info rules'#010+ + '#############','#######################################################'+ + '#'#010+ + #010+ + '.PHONY: fpc_baseinfo'#010+ + #010+ + 'override INFORULES+=fpc_baseinfo'#010+ + #010+ + 'fpc_baseinfo:'#010+ + ' @$(ECHO)'#010+ + ' @$(ECHO) == Package info =='#010+ + ' @$(ECHO) Package Name..... $(PACKAGE_NAME)'#010+ + ' ',' @$(ECHO) Package Version.. $(PACKAGE_VERSION)'#010+ + ' @$(ECHO)'#010+ + ' @$(ECHO) == Configuration info =='#010+ + ' @$(ECHO)'#010+ + ' @$(ECHO) FPC.......... $(FPC)'#010+ + ' @$(ECHO) FPC Version.. $(FPC_VERSION)'#010+ + ' @$(ECHO) Source CPU','... $(CPU_SOURCE)'#010+ + ' @$(ECHO) Target CPU... $(CPU_TARGET)'#010+ + ' @$(ECHO) Source OS.... $(OS_SOURCE)'#010+ + ' @$(ECHO) Target OS.... $(OS_TARGET)'#010+ + ' @$(ECHO) Full Source.. $(FULL_SOURCE)'#010+ + ' @$(ECHO) Full Target.. $(FULL_','TARGET)'#010+ + ' @$(ECHO) SourceSuffix. $(SOURCESUFFIX)'#010+ + ' @$(ECHO) TargetSuffix. $(TARGETSUFFIX)'#010+ + ' @$(ECHO)'#010+ + ' @$(ECHO) == Directory info =='#010+ + ' @$(ECHO)'#010+ + ' @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES)'#010+ + ' ','@$(ECHO)'#010+ + ' @$(ECHO) Basedir......... $(BASEDIR)'#010+ + ' @$(ECHO) FPCDir.......... $(FPCDIR)'#010+ + ' @$(ECHO) CrossBinDir..... $(CROSSBINDIR)'#010+ + ' @$(ECHO) UnitsDir........ $(UNITSDIR)'#010+ + ' @$(ECHO) PackagesDir..... $(PACKAG','ESDIR)'#010+ + ' @$(ECHO)'#010+ + ' @$(ECHO) GCC library..... $(GCCLIBDIR)'#010+ + ' @$(ECHO) Other library... $(OTHERLIBDIR)'#010+ + ' @$(ECHO)'#010+ + ' @$(ECHO) == Tools info =='#010+ + ' @$(ECHO)'#010+ + ' @$(ECHO) As........ $(AS)'#010+ + ' @$(ECH','O) Ld........ $(LD)'#010+ + ' @$(ECHO) Ar........ $(AR)'#010+ + ' @$(ECHO) Rc........ $(RC)'#010+ + ' @$(ECHO)'#010+ + ' @$(ECHO) Mv........ $(MVPROG)'#010+ + ' @$(ECHO) Cp........ $(CPPROG)'#010+ + ' @$(ECHO) Rm........ $(RMPROG)'#010+ + ' @$(ECHO',') GInstall.. $(GINSTALL)'#010+ + ' @$(ECHO) Echo...... $(ECHO)'#010+ + ' @$(ECHO) Shell..... $(SHELL)'#010+ + ' @$(ECHO) Date...... $(DATE)'#010+ + ' @$(ECHO) FPCMake... $(FPCMAKE)'#010+ + ' @$(ECHO) PPUMove... $(PPUMOVE)'#010+ + ' @$(ECHO) Upx.','...... $(UPXPROG)'#010+ + ' @$(ECHO) Zip....... $(ZIPPROG)'#010+ + ' @$(ECHO)'#010+ + ' @$(ECHO) == Object info =='#010+ + ' @$(ECHO)'#010+ + ' @$(ECHO) Target Loaders........ $(TARGET_LOADERS)'#010+ + ' @$(ECHO) Target Units.......... $(TARGET_UNI','TS)'#010+ + ' @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS)'#010+ + ' @$(ECHO) Target Programs....... $(TARGET_PROGRAMS)'#010+ + ' @$(ECHO) Target Dirs........... $(TARGET_DIRS)'#010+ + ' @$(ECHO) Target Examples....... $(TARGET_EXAMP','LES)'#010+ + ' @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)'#010+ + ' @$(ECHO)'#010+ + ' @$(ECHO) Clean Units......... $(CLEAN_UNITS)'#010+ + ' @$(ECHO) Clean Files......... $(CLEAN_FILES)'#010+ + ' @$(ECHO)'#010+ + ' @$(ECHO) Install Unit','s....... $(INSTALL_UNITS)'#010+ + ' @$(ECHO) Install Files....... $(INSTALL_FILES)'#010+ + ' @$(ECHO)'#010+ + ' @$(ECHO) == Install info =='#010+ + ' @$(ECHO)'#010+ + ' @$(ECHO) DateStr.............. $(DATESTR)'#010+ + ' @$(ECHO) ZipName...........','... $(ZIPNAME)'#010+ + ' @$(ECHO) ZipPrefix............ $(ZIPPREFIX)'#010+ + ' @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX)'#010+ + ' @$(ECHO) ZipSuffix............ $(ZIPSUFFIX)'#010+ + ' @$(ECHO) FullZipName.......... $(FULLZIPNAME)'#010+ + ' ',' @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE)'#010+ + ' @$(ECHO)'#010+ + ' @$(ECHO) Install base dir..... $(INSTALL_BASEDIR)'#010+ + ' @$(ECHO) Install binary dir... $(INSTALL_BINDIR)'#010+ + ' @$(ECHO) Install library dir.. $(INSTALL_','LIBDIR)'#010+ + ' @$(ECHO) Install units dir.... $(INSTALL_UNITDIR)'#010+ + ' @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR)'#010+ + ' @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR)'#010+ + ' @$(ECHO) Install example dir.. $(INSTALL_EXAM','PLEDIR)'#010+ + ' @$(ECHO) Install data dir..... $(INSTALL_DATADIR)'#010+ + ' @$(ECHO)'#010+ + ' @$(ECHO) Dist destination dir. $(DIST_DESTDIR)'#010+ + ' @$(ECHO) Dist zip name........ $(DIST_ZIPNAME)'#010+ + ' @$(ECHO)'#010+ + #010+ + '[inforules]'#010+ + '##############','######################################################'+ + '#'#010+ + '# Info rules'#010+ + '#####################################################################'#010+ + #010+ + '.PHONY: fpc_info'#010+ + #010+ + 'fpc_info: $(INFORULES)'#010+ + #010+ + '[makefilerules]'#010+ + '##########################################','##########################'+ + '#'#010+ + '# Rebuild Makefile'#010+ + '#####################################################################'#010+ + #010+ '.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2'+ - ' \'#013#010+ - ' fpc_makefile_dirs'#013#010+ - #013#010+ - 'fpc_makefile:'#013#010+ - ' ',' $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc'#013#010+ - #013#010+ - 'fpc_makefile_sub1:'#013#010+ - 'ifdef TARGET_DIRS'#013#010+ + ' \'#010+ + ' fpc_makefile_dirs'#010+ + #010+ + 'fpc_makefile:'#010+ + ' ','$(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc'#010+ + #010+ + 'fpc_makefile_sub1:'#010+ + 'ifdef TARGET_DIRS'#010+ ' $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGE'+ - 'T_DIRS))'#013#010+ - 'endif'#013#010+ - 'ifdef TARGET_EXAMPLEDIRS'#013#010+ - ' $(FPCMAKE) -w -T$(OS_TARGET) $','(addsuffix /Makefile.fpc,$(TAR'+ - 'GET_EXAMPLEDIRS))'#013#010+ - 'endif'#013#010+ - #013#010+ + 'T_DIRS))'#010+ + 'endif'#010+ + 'ifdef TARGET_EXAMPLEDIRS'#010+ + ' $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /','Makefile.fpc,$(TAR'+ + 'GET_EXAMPLEDIRS))'#010+ + 'endif'#010+ + #010+ 'fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_'+ - 'EXAMPLEDIRS))'#013#010+ - #013#010+ - 'fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2'#013#010+ - #013#010+ - 'fpc_makefiles: fpc_makefile fpc_makef','ile_dirs'#013#010+ - #013#010+ - '[localmakefile]'#013#010+ - '#####################################################################'#013+ - #010+ - '# Local Makefile'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ - 'ifneq ($(wildcard fpcmake.loc),)'#013#010+ - 'include fpcmake','.loc'#013#010+ - 'endif'#013#010+ - #013#010+ - #013#010+ - '[userrules]'#013#010+ - '#####################################################################'#013+ - #010+ - '# Users rules'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ - '[lclrules]'#013#010+ - '#######################################','#############################'+ - '#'#013#010+ - '# LCL Rules'#013#010+ - '#####################################################################'#013+ - #010+ - #013#010+ - '# LCL Platform'#013#010+ - 'ifndef LCL_PLATFORM'#013#010+ - 'ifeq ($(OS_TARGET),win32)'#013#010+ - 'LCL_PLATFORM=win32'#013#010+ - 'else'#013#010+ - 'LCL_PLATFORM=gtk'#013#010+ - 'endif'#013#010+ - 'endif'#013#010, - 'export LCL_PLATFORM'#013#010+ - #013#010+ - '# Check if the specified LCLDIR is correct'#013#010+ - 'ifdef LCLDIR'#013#010+ - 'override LCLDIR:=$(subst \,/,$(LCLDIR))'#013#010+ - 'ifeq ($(wildcard $(LCLDIR)/units/$(LCL_PLATFORM)),)'#013#010+ - 'override LCLDIR=wrong'#013#010+ - 'endif'#013#010+ - 'else'#013#010+ - 'override LCLDIR=wrong'#013#010+ - 'endif'#013,#010+ - #013#010+ - '# Check if the default LCLDIR is correct'#013#010+ - 'ifdef DEFAULT_LCLDIR'#013#010+ - 'override LCLDIR:=$(subst \,/,$(DEFAULT_LCLDIR))'#013#010+ - 'ifeq ($(wildcard $(LCLDIR)/units/$(LCL_PLATFORM)),)'#013#010+ - 'override LCLDIR=wrong'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Check for development version'#013,#010+ - 'ifeq ($(LCLDIR),wrong)'#013#010+ - 'override LCLDIR=$(subst /units/$(LCL_PLATFORM),,$(firstword $(wildcard'+ - ' $(addsuffix /units/$(LCL_PLATFORM),$(BASEDIR)/lcl $(BASEDIR)))))'#013#010+ - 'ifeq ($(LCLDIR),)'#013#010+ - 'override LCLDIR=wrong'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Check for release ','version'#013#010+ - 'ifeq ($(LCLDIR),wrong)'#013#010+ - 'override LCLDIR=$(subst /units/$(LCL_PLATFORM),,$(firstword $(wildcard'+ - ' $(addsuffix /lib/lazarus/units/$(LCL_PLATFORM),/usr/local /usr))))'#013+ - #010+ - 'ifeq ($(LCLDIR),)'#013#010+ - 'override LCLDIR=wrong'#013#010+ - 'endif'#013#010+ - 'endif'#013#010+ - #013#010+ - '# Generate',' dirs'#013#010+ + 'EXAMPLEDIRS))'#010+ + #010+ + 'fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2'#010+ + #010+ + 'fpc_makefiles: fpc_makefile fpc_makefile_dirs'#010+ + #010+ + '[localmak','efile]'#010+ + '#####################################################################'#010+ + '# Local Makefile'#010+ + '#####################################################################'#010+ + #010+ + 'ifneq ($(wildcard fpcmake.loc),)'#010+ + 'include fpcmake.loc'#010+ + 'endif'#010+ + #010+ + #010+ + '[userrules]'#010+ + '##','##################################################################'+ + '#'#010+ + '# Users rules'#010+ + '#####################################################################'#010+ + #010+ + '[lclrules]'#010+ + '#####################################################################'#010+ + '# LCL ','Rules'#010+ + '#####################################################################'#010+ + #010+ + '# LCL Platform'#010+ + 'ifndef LCL_PLATFORM'#010+ + 'ifeq ($(OS_TARGET),win32)'#010+ + 'LCL_PLATFORM=win32'#010+ + 'else'#010+ + 'LCL_PLATFORM=gtk'#010+ + 'endif'#010+ + 'endif'#010+ + 'export LCL_PLATFORM'#010+ + #010+ + '# Check if the specified LCL','DIR is correct'#010+ + 'ifdef LCLDIR'#010+ + 'override LCLDIR:=$(subst \,/,$(LCLDIR))'#010+ + 'ifeq ($(wildcard $(LCLDIR)/units/$(LCL_PLATFORM)),)'#010+ + 'override LCLDIR=wrong'#010+ + 'endif'#010+ + 'else'#010+ + 'override LCLDIR=wrong'#010+ + 'endif'#010+ + #010+ + '# Check if the default LCLDIR is correct'#010+ + 'ifdef DEFAULT_LCL','DIR'#010+ + 'override LCLDIR:=$(subst \,/,$(DEFAULT_LCLDIR))'#010+ + 'ifeq ($(wildcard $(LCLDIR)/units/$(LCL_PLATFORM)),)'#010+ + 'override LCLDIR=wrong'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Check for development version'#010+ + 'ifeq ($(LCLDIR),wrong)'#010+ + 'override LCLDIR=$(subst /units/$(LCL_PLATFORM)',',,$(firstword $(wildca'+ + 'rd $(addsuffix /units/$(LCL_PLATFORM),$(BASEDIR)/lcl $(BASEDIR)))))'#010+ + 'ifeq ($(LCLDIR),)'#010+ + 'override LCLDIR=wrong'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Check for release version'#010+ + 'ifeq ($(LCLDIR),wrong)'#010+ + 'override LCLDIR=$(subst /units/$(LCL_PLATFORM)',',,$(firstword $(wildca'+ + 'rd $(addsuffix /lib/lazarus/units/$(LCL_PLATFORM),/usr/local /usr))))'#010+ + 'ifeq ($(LCLDIR),)'#010+ + 'override LCLDIR=wrong'#010+ + 'endif'#010+ + 'endif'#010+ + #010+ + '# Generate dirs'#010+ 'override LCLUNITDIR:=$(wildcard $(LCLDIR)/units/$(LCL_PLATFORM) $(LCLD'+ - 'IR)/units)'#013#010+ + 'IR)/units',')'#010+ 'override LCLCOMPONENTDIR:=$(wildcard $(LCLDIR)/.. $(LCLDIR)/../compone'+ - 'nts $(LCLDIR)/components)'#013#010+ - 'export LCLDIR LCLUNITDIR LCLCOMPONENTDIR'#013#010+ - #013#010+ - '# Add LCL ','dirs to paths'#013#010+ - 'override REQUIRE_PACKAGESDIR+=$(LCLCOMPONENTDIR)'#013#010+ - 'override COMPILER_UNITDIR+=$(LCLUNITDIR)'#013#010+ - #013#010+ - '[lclinforules]'#013#010+ - '#####################################################################'#013+ - #010+ - '# LCL Info rules'#013#010+ - '##########################','##########################################'+ - '#'#013#010+ - 'override INFORULES+=lclinfo'#013#010+ - #013#010+ - '.PHONY: lclinfo'#013#010+ - #013#010+ - 'lclinfo:'#013#010+ - ' @$(ECHO) == LCL info =='#013#010+ - ' @$(ECHO)'#013#010+ - ' @$(ECHO) Platform............. $(LCL_PLATFORM)'#013#010+ - ' @$(ECHO) LCLDIR..','............. $(LCLDIR)'#013#010+ - ' @$(ECHO) LCL Unit dir......... $(LCLUNITDIR)'#013#010+ - ' @$(ECHO) LCL Component dir.... $(LCLCOMPONENTDIR)'#013#010+ - ' @$(ECHO)'#013#010 + 'nts $(LCLDIR)/components)'#010+ + 'export LCLDIR LCLUNITDIR LCLCOMPONENTDIR'#010+ + #010+ + '# Add LCL dirs to paths'#010+ + 'override REQUIRE_PACKAGESDIR+=$(LCLCOMPONENTDIR)'#010+ + 'override COMPILER_UNITDIR+=','$(LCLUNITDIR)'#010+ + #010+ + '[lclinforules]'#010+ + '#####################################################################'#010+ + '# LCL Info rules'#010+ + '#####################################################################'#010+ + 'override INFORULES+=lclinfo'#010+ + #010+ + '.PHONY: lclinfo'#010+ + #010+ + 'lclinfo',':'#010+ + ' @$(ECHO) == LCL info =='#010+ + ' @$(ECHO)'#010+ + ' @$(ECHO) Platform............. $(LCL_PLATFORM)'#010+ + ' @$(ECHO) LCLDIR............... $(LCLDIR)'#010+ + ' @$(ECHO) LCL Unit dir......... $(LCLUNITDIR)'#010+ + ' @$(ECHO) LCL Compon','ent dir.... $(LCLCOMPONENTDIR)'#010+ + ' @$(ECHO)'#010 ); diff --git a/utils/fpcm/fpcmake.ini b/utils/fpcm/fpcmake.ini index 9bfed3430c..87f6f02e1b 100644 --- a/utils/fpcm/fpcmake.ini +++ b/utils/fpcm/fpcmake.ini @@ -692,11 +692,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif # Try cross gcc diff --git a/utils/fpdoc/Makefile b/utils/fpdoc/Makefile index 6116cc52bb..05a79c3932 100644 --- a/utils/fpdoc/Makefile +++ b/utils/fpdoc/Makefile @@ -879,11 +879,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/utils/fpdoc/fpde/Makefile b/utils/fpdoc/fpde/Makefile index c614781856..c774d83529 100644 --- a/utils/fpdoc/fpde/Makefile +++ b/utils/fpdoc/fpde/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/10] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/11] # default: all MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince diff --git a/utils/fpmc/Makefile b/utils/fpmc/Makefile index 7bc84dcf6b..14683a24e9 100644 --- a/utils/fpmc/Makefile +++ b/utils/fpmc/Makefile @@ -766,11 +766,6 @@ GCCLIBDIR:=$(shell dirname `gcc -m32 -print-libgcc-file-name`) endif endif endif -ifeq ($(CPU_TARGET),powerpc64) -ifeq ($(BINUTILSPREFIX),) -GCCLIBDIR:=$(shell dirname `gcc -m64 -print-libgcc-file-name`) -endif -endif endif ifndef GCCLIBDIR CROSSGCC=$(strip $(wildcard $(addsuffix /$(BINUTILSPREFIX)gcc$(SRCEXEEXT),$(SEARCHPATH)))) diff --git a/utils/simulator/Makefile b/utils/simulator/Makefile index ce1134eb72..8fb2065018 100644 --- a/utils/simulator/Makefile +++ b/utils/simulator/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/10] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/08/11] # default: all MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince diff --git a/utils/svn2cvs/svn2cvs.lpi b/utils/svn2cvs/svn2cvs.lpi deleted file mode 100644 index 82ece449e3..0000000000 --- a/utils/svn2cvs/svn2cvs.lpi +++ /dev/null @@ -1,193 +0,0 @@ -<?xml version="1.0"?> -<CONFIG> - <ProjectOptions> - <PathDelim Value="/"/> - <Version Value="5"/> - <General> - <Flags> - <MainUnitHasUsesSectionForAllUnits Value="False"/> - <MainUnitHasCreateFormStatements Value="False"/> - <MainUnitHasTitleStatement Value="False"/> - </Flags> - <MainUnit Value="0"/> - <ActiveEditorIndexAtStart Value="0"/> - <IconPath Value="./"/> - <TargetFileExt Value=""/> - <Title Value="svn2cvs"/> - </General> - <JumpHistory Count="30" HistoryIndex="29"> - <Position1> - <Filename Value="svn2cvs.pp"/> - <Caret Line="367" Column="69" TopLine="338"/> - </Position1> - <Position2> - <Filename Value="svn2cvs.pp"/> - <Caret Line="364" Column="12" TopLine="344"/> - </Position2> - <Position3> - <Filename Value="svn2cvs.pp"/> - <Caret Line="370" Column="28" TopLine="347"/> - </Position3> - <Position4> - <Filename Value="svn2cvs.pp"/> - <Caret Line="23" Column="4" TopLine="1"/> - </Position4> - <Position5> - <Filename Value="svn2cvs.pp"/> - <Caret Line="365" Column="12" TopLine="345"/> - </Position5> - <Position6> - <Filename Value="svn2cvs.pp"/> - <Caret Line="376" Column="1" TopLine="345"/> - </Position6> - <Position7> - <Filename Value="svn2cvs.pp"/> - <Caret Line="25" Column="1" TopLine="2"/> - </Position7> - <Position8> - <Filename Value="svn2cvs.pp"/> - <Caret Line="396" Column="8" TopLine="376"/> - </Position8> - <Position9> - <Filename Value="svn2cvs.pp"/> - <Caret Line="397" Column="25" TopLine="377"/> - </Position9> - <Position10> - <Filename Value="svn2cvs.pp"/> - <Caret Line="395" Column="1" TopLine="377"/> - </Position10> - <Position11> - <Filename Value="svn2cvs.pp"/> - <Caret Line="406" Column="1" TopLine="380"/> - </Position11> - <Position12> - <Filename Value="svn2cvs.pp"/> - <Caret Line="357" Column="38" TopLine="337"/> - </Position12> - <Position13> - <Filename Value="svn2cvs.pp"/> - <Caret Line="358" Column="1" TopLine="337"/> - </Position13> - <Position14> - <Filename Value="svn2cvs.pp"/> - <Caret Line="425" Column="1" TopLine="394"/> - </Position14> - <Position15> - <Filename Value="svn2cvs.pp"/> - <Caret Line="40" Column="19" TopLine="1"/> - </Position15> - <Position16> - <Filename Value="svn2cvs.pp"/> - <Caret Line="442" Column="1" TopLine="408"/> - </Position16> - <Position17> - <Filename Value="svn2cvs.pp"/> - <Caret Line="27" Column="50" TopLine="1"/> - </Position17> - <Position18> - <Filename Value="svn2cvs.pp"/> - <Caret Line="508" Column="3" TopLine="476"/> - </Position18> - <Position19> - <Filename Value="svn2cvs.pp"/> - <Caret Line="5" Column="19" TopLine="1"/> - </Position19> - <Position20> - <Filename Value="svn2cvs.pp"/> - <Caret Line="135" Column="7" TopLine="97"/> - </Position20> - <Position21> - <Filename Value="svn2cvs.pp"/> - <Caret Line="165" Column="16" TopLine="161"/> - </Position21> - <Position22> - <Filename Value="svn2cvs.pp"/> - <Caret Line="438" Column="16" TopLine="438"/> - </Position22> - <Position23> - <Filename Value="svn2cvs.pp"/> - <Caret Line="279" Column="3" TopLine="259"/> - </Position23> - <Position24> - <Filename Value="svn2cvs.pp"/> - <Caret Line="369" Column="6" TopLine="363"/> - </Position24> - <Position25> - <Filename Value="svn2cvs.pp"/> - <Caret Line="334" Column="1" TopLine="301"/> - </Position25> - <Position26> - <Filename Value="svn2cvs.pp"/> - <Caret Line="31" Column="23" TopLine="1"/> - </Position26> - <Position27> - <Filename Value="svn2cvs.pp"/> - <Caret Line="335" Column="57" TopLine="315"/> - </Position27> - <Position28> - <Filename Value="svn2cvs.pp"/> - <Caret Line="391" Column="45" TopLine="368"/> - </Position28> - <Position29> - <Filename Value="svn2cvs.pp"/> - <Caret Line="161" Column="1" TopLine="161"/> - </Position29> - <Position30> - <Filename Value="svn2cvs.pp"/> - <Caret Line="404" Column="1" TopLine="381"/> - </Position30> - </JumpHistory> - <Units Count="2"> - <Unit0> - <CursorPos X="16" Y="322"/> - <EditorIndex Value="0"/> - <Filename Value="svn2cvs.pp"/> - <IsPartOfProject Value="True"/> - <Loaded Value="True"/> - <TopLine Value="294"/> - <UnitName Value="svn2cvs"/> - <UsageCount Value="38"/> - </Unit0> - <Unit1> - <CursorPos X="32" Y="26"/> - <EditorIndex Value="1"/> - <Filename Value="/home/michael/fpc/fcl/inc/process.pp"/> - <Loaded Value="True"/> - <TopLine Value="4"/> - <UnitName Value="process"/> - <UsageCount Value="19"/> - </Unit1> - </Units> - <PublishOptions> - <Version Value="2"/> - <IgnoreBinaries Value="False"/> - <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> - <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> - </PublishOptions> - <RunParams> - <local> - <FormatVersion Value="1"/> - <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> - </local> - </RunParams> - </ProjectOptions> - <CompilerOptions> - <Version Value="5"/> - <CodeGeneration> - <Generate Value="Faster"/> - </CodeGeneration> - <Other> - <CompilerPath Value="$(CompPath)"/> - </Other> - </CompilerOptions> - <Debugging> - <Exceptions Count="2"> - <Item1> - <Name Value="ECodetoolError"/> - </Item1> - <Item2> - <Name Value="EFOpenError"/> - </Item2> - </Exceptions> - </Debugging> -</CONFIG> diff --git a/utils/svn2cvs/svn2cvs.pp b/utils/svn2cvs/svn2cvs.pp deleted file mode 100644 index 6c7586e12e..0000000000 --- a/utils/svn2cvs/svn2cvs.pp +++ /dev/null @@ -1,521 +0,0 @@ -{$mode objfpc} -{$H+} -program svn2cvs; - -uses Classes,sysutils,process,DOM,xmlread,custapp,IniFiles; - -Const - SGlobal = 'Global'; - KeyCVSBin = 'CVSBinary'; - KeySVNBin = 'SVNBinary'; - KeySVNURL = 'SVNURL'; - KeyCVSROOT = 'CVSROOT'; - KeyRepository = 'CVSRepository'; - KeyRevision = 'Revision'; - KeyWorkDir = 'WorkingDir'; - -Resourcestring - SErrFailedToCheckOut = 'Failed to check out SVN repository'; - SErrFailedToInitCVS = 'Failed to initialize CVS: '; - SErrNoRepository = 'Cannot initialize CVS: no CVS Repository specified'; - SErrDirectoryFailed = 'Failed to create directory : %s'; - SErrFailedToGetVersions = 'Failed to retrieve SVN versions'; - SErrInValidSVNLog = 'Invalid SVN log.'; - SErrUpdateFailed = 'Update to revision %d failed.'; - SErrFailedToCommit = 'Failed to commit to CVS.'; - SErrFailedToRemove = 'Failed to remove file: %s'; - SErrFailedToAddDirectory = 'Failed to add directory to CVS: %s'; - SErrFailedToAddFile = 'Failed to add file to CVS: %s'; - SErrDirectoryNotInCVS = 'Directory not in CVS: %s'; - SLogRevision = 'Revision %s by %s :'; - SConvertingRevision = 'Converting revision : %d'; - SWarnUnknownAction = 'Warning: Unknown action: "%s" for filename : "%s"'; - SWarnErrorInLine = 'Warning: Erroneous file line : %s'; - SExecuting = 'Executing: %s'; - -Type - - { TSVN2CVSApp } - TVersion = Class(TCollectionItem) - private - FAuthor: String; - FDate: string; - FLogMessage: String; - FRevision: Integer; - Public - Property Revision : Integer read FRevision; - Property LogMessage : String Read FLogMessage; - Property Date : string Read FDate; - Property Author : String Read FAuthor; - end; - - { TVersions } - - TVersions = Class(TCollection) - private - function GetVersion(Index : INteger): TVersion; - procedure SetVersion(Index : INteger; const AValue: TVersion); - Protected - procedure ConvertLogEntry(E : TDomElement); - public - Procedure LoadFromXML(Doc : TXMlDocument); - property Versions[Index : INteger] : TVersion Read GetVersion Write SetVersion; Default; - end; - - { TSVN2CVSApp } - - TSVN2CVSApp = Class(TCustomApplication) - Public - SVNBin : String; - CVSBin : String; - versions : TVersions; - WorkingDir : String; - StartRevision : Integer; - SVNURL : String; - CVSROOT : String; - CVSRepository : String; - Function RunCmd(Cmd: String; CmdOutput: TStream): Boolean; - Function RunSVN(Cmd : String; CmdOutput : TStream) : Boolean; - Function RunCVS(Cmd : String; CmdOutput : TStream) : Boolean; - Function UpdateSVN(Version : TVersion; Files : TStrings) : Boolean; - Procedure WriteLogMessage(Version : TVersion); - Procedure UpdateEntry(AFileName : String); - Procedure DeleteEntry(AFileName : String); - Procedure DoCVSEntries(Version : TVersion;Files : TStrings); - procedure CheckInCVS; - procedure CheckOutSVN(Files : TStrings); - Procedure ConvertVersion(Version : TVersion); - Procedure ConvertRepository; - procedure GetVersions; - procedure ProcessConfigFile; - Function ProcessArguments : Boolean; - Procedure DoRun; override; - end; - - AppError = Class(Exception); - -{ TVersions } - -function TVersions.GetVersion(Index : INteger): TVersion; -begin - Result:=Items[Index] as Tversion; -end; - -procedure TVersions.SetVersion(Index : INteger; const AValue: TVersion); -begin - Items[Index]:=AValue; -end; - -procedure TVersions.ConvertLogEntry(E : TDomElement); - - Function GetNodeText(N : TDomNode) : String; - - begin - N:=N.FirstChild; - If N<>Nil then - Result:=N.NodeValue; - end; - -Var - N : TDomNode; - V : TVersion; - -begin - V:=Add as TVersion; - V.FRevision:=StrToIntDef(E['revision'],-1); - N:=E.FirstChild; - While (N<>Nil) do - begin - If (N.NodeType=ELEMENT_NODE) then - begin - if (N.NodeName='author') then - V.FAuthor:=GetNodeText(N) - else If (N.NodeName='date') then - V.FDate:=GetNodeText(N) - else If (N.NodeName='msg') then - V.FLogMessage:=GetNodeText(N); - end; - N:=N.NextSibling; - end; -end; - -procedure TVersions.LoadFromXML(Doc: TXMlDocument); - -var - L : TDomNode; - E : TDomElement; - -begin - L:=Doc.FirstChild; - While (L<>Nil) and not ((L.NodeType=ELEMENT_NODE) and (L.NodeName='log')) do - L:=L.NextSibling; - if (L=Nil) then - Raise AppError.Create(SErrInValidSVNLog); - L:=L.FirstChild; - While (L<>Nil) do - begin - If (L.NodeType=ELEMENT_NODE) and (L.NodeName='logentry') then - E:=TDomElement(L); - ConvertLogEntry(E); - L:=L.NextSibling; - end; -end; - - -{ TSVN2CVSApp } - -function TSVN2CVSApp.RunCmd(Cmd: String; CmdOutput: TStream): Boolean; - -Var - Buf : Array[1..4096] of Byte; - Count : Integer; - -begin - With TProcess.Create(Self) do - Try - CommandLine:=cmd; - Writeln(Format(SExecuting,[CommandLine])); - if (CmdOutput<>Nil) then - Options:=[poUsePipes]; - Execute; - If (CmdOutPut=Nil) then - WaitOnExit - else - Repeat - Count:=Output.Read(Buf,SizeOf(Buf)); - If (Count>0) then - cmdOutput.Write(Buf,Count); - Until (Count=0); - Result:=(ExitStatus=0); - finally - Free; - end; -end; - -function TSVN2CVSApp.RunSVN(Cmd: String; CmdOutput: TStream): Boolean; - - -begin - Result:=RunCmd(SVNbin+' '+Cmd,CmdOutput); -end; - -function TSVN2CVSApp.RunCVS(Cmd: String; CmdOutput: TStream): Boolean; -begin - Result:=RunCmd(CVSbin+' '+Cmd,CmdOutput); -end; - -procedure TSVN2CVSApp.CheckOutSVN(Files : TStrings); - -Var - S : TStringStream; - -begin - S:=TStringStream.Create(''); - Try - if not RunSVN(Format('co -r %d %s .',[StartRevision,SVNURL]),S) then - Raise AppError.Create(SErrFailedToCheckOut); - Files.Text:=S.DataString; - Finally - FreeAndNil(S); - end; -end; - -procedure TSVN2CVSApp.CheckInCVS; - -Var - F : Text; - -begin - If not ForceDirectories(WorkingDir+'CVS') then - Try - AssignFile(F,WorkingDir+'CVS/Root'); - Rewrite(F); - Try - Writeln(F,CVSRoot); - Finally - CloseFile(F); - end; - AssignFile(F,WorkingDir+'CVS/Repository'); - Rewrite(F); - Try - Writeln(F,CVSRepository); - Finally - Close(F); - end; - AssignFile(F,WorkingDir+'CVS/Entries'); - Rewrite(F); - Try - // Do nothing. - Finally - Close(F); - end; - except - On E : Exception do - begin - E.Message:=SErrFailedToInitCVS+E.Message; - Raise; - end; - end; -end; - -procedure TSVN2CVSApp.Convertrepository; - -Var - InitCVS,INITSVN : Boolean; - I : Integer; - Files : TStringList; - -begin - If Not DirectoryExists(WorkingDir) then - begin - if Not ForceDirectories(WorkingDir) then - Raise AppError.CreateFmt(SErrDirectoryFailed,[WorkingDir]); - InitSVN:=True; - InitCVS:=true; - end - else - begin - if Not DirectoryExists(WorkingDir+'.svn') then - InitSVN:=True; - if Not DirectoryExists(WorkingDir+'CVS') then - InitCVS:=True; - end; - ChDir(WorkingDir); - if InitCVS and (CVSRepository='') then - Raise AppError.Create(SErrNoRepository); - if InitSVN then - begin - Files:=TStringList.Create; - Try - CheckoutSVN(Files); - if InitCVS then - begin - CheckinCVS; - DoCVSEntries(Nil,Files); - end - else - DoCVSEntries(Nil,Files); - finally - FreeAndNil(Files); - end; - end; - GetVersions; - For I:=0 to Versions.Count-1 do - ConvertVersion(Versions[i]); -end; - -procedure TSVN2CVSApp.GetVersions; - -Var - S : TStringStream; - Doc : TXMLDocument; - -begin - Versions:=TVersions.Create(TVersion); - S:=TStringStream.Create(''); - Try - if not RunSVN(Format('log --xml -r %d:HEAD',[StartRevision]),S) then - Raise AppError(SErrFailedToGetVersions); - S.Position:=0; - ReadXMLFile(Doc,S); - Try - Versions.LoadFromXML(Doc); - finally - Doc.Free; - end; - Finally - S.Free; - end; -end; - - -procedure TSVN2CVSApp.ConvertVersion(Version: TVersion); - -Var - Files : TStringList; - -begin - Writeln(Format(SConvertingRevision,[Version.revision])); - Files:=TStringList.Create; - Try - If Not UpdateSVN(Version,Files) then - Raise AppError.CreateFmt(SErrUpdateFailed,[Version.Revision]); - DoCVSEntries(Version,Files); - Finally - Files.Free; - end; -end; - -Function TSVN2CVSApp.UpdateSVN(Version : TVersion; Files : TStrings) : Boolean; - -Var - S : TStringStream; - -begin - S:=TStringStream.Create(''); - Try - Result:=RunSVN(Format('up -r %d',[version.revision]),S); - if Result then - Files.Text:=S.DataString; - Finally - S.Free; - end; -end; - -Procedure TSVN2CVSApp.WriteLogMessage(Version : TVersion); - -Var - F : Text; - -begin - AssignFile(F,'logmsg.txt'); - Rewrite(F); - Try - Writeln(F,Format(SLogRevision,[Version.Revision,Version.Author])); - Writeln(F, Version.LogMessage); - Finally - CloseFile(F); - end; -end; - -Procedure TSVN2CVSApp.DoCVSEntries(Version : TVersion;Files : TStrings); - -Var - I,P : Integer; - Action : Char; - FileName : String; - -begin - For I:=0 to Files.Count-1 do - begin - FileName:=trim(Files[i]); - P:=Pos(' ',FileName); - if (P=0) then - Writeln(StdErr,Format(SWarnErrorInLine,[FileName])) - else - begin - Action:=FileName[1]; - system.Delete(FileName,1,P); - FileName:=Trim(FileName); - end; - Case UpCase(action) of - 'U' : UpdateEntry(FileName); - 'D' : DeleteEntry(FileName); - else - Writeln(stdErr,Format(SWarnUnknownAction,[Action,FileName])); - end; - end; - WriteLogMessage(version); - Try - If not RunCVS('commit -m -F logmsg.txt .',Nil) then - Raise AppError.Create(SErrFailedToCommit); - Finally - if not DeleteFile('logmsg.txt') then - Writeln(StdErr,'Warning: failed to remove log message file.'); - end; -end; - -Procedure TSVN2CVSApp.UpdateEntry(AFileName : String); - -Var - FD : String; - L : TStringList; - I : Integer; - Found : Boolean; - -begin - If ((FileGetAttr(AFileName) and faDirectory)<>0) then - begin - if Not RunCVS('add '+AFileName,Nil) then - Raise AppError.CreateFmt(SErrFailedToAddDirectory,[AFileName]); - end - else // Check if file is under CVS control by checking the Entries file. - begin - FD:=ExtractFilePath(AFileName); - If not DirectoryExists(FD+'Entries') then - Raise AppError.CreateFmt(SErrDirectoryNotInCVS,[FD]); - Found:=False; - L:=TStringList.Create; - Try - L.LoadFromFile(FD+'Entries'); - Found:=False; - I:=0; - While (not found) and (I<L.Count) do - begin - Inc(I); - end; - if not found then - if Not RunCVS('add '+AFileName,Nil) then - Raise AppError.CreateFmt(SErrFailedToAddFile,[AFileName]); - finally - L.Free; - end; - end; -end; - -Procedure TSVN2CVSApp.DeleteEntry(AFileName : String); - -begin - If ((FileGetAttr(AFileName) and faDirectory)=0) then - if Not RunCVS('rm '+AFileName,Nil) then - Raise AppError.CreateFmt(SErrFailedToRemove,[AFileName]); -end; - -procedure TSVN2CVSApp.DoRun; - -begin - If Not ProcessArguments then - exit; - ConvertRepository; -end; - -procedure TSVN2CVSApp.ProcessConfigFile; - -begin - With TMemIniFile.Create(GetAppConfigFile(False)) do - try - SVNURL:=ReadString(SGlobal,KeySVNURL,''); - CVSROOT:=ReadString(SGlobal,KeyCVSROOT,''); - CVSRepository:=ReadString(SGlobal,KeyRepository,''); - WorkingDir:=ReadString(SGLobal,KeyWorkDir,''); - StartRevision:=ReadInteger(SGlobal,KeyRevision,-1)+1; - SVNBin:=ReadString(SGlobal,KeySVNBin,'svn'); - CVSBin:=ReadString(SGlobal,KeyCVSBin,'cvs'); - finally - Free; - end; -end; - - -function TSVN2CVSApp.ProcessArguments: Boolean; - -begin - ProcessConfigFile; - if HasOption('s','svn-repository') then - SVNURL:=GetOptionValue('s','svn-repository'); - if HasOption('c','cvsroot') then - CVSROOT:=GetOptionValue('c','cvsroot'); - if HasOption('c','cvsrepository') then - CVSROOT:=GetOptionValue('p','cvsrepository'); - if HasOption('r','revision') then - StartRevision:=StrToIntDef(GetOptionValue('c'),0); - if HasOption('d','directory') then - WorkingDir:=GetOptionValue('d','directory'); - Result:=(SVNUrl<>'') and (CVSROOT<>''); - If Result then - begin - If (WorkingDir='') then - WorkingDir:=GetCurrentDir; - WorkingDir:=IncludeTrailingPathDelimiter(WorkingDir); - end; -end; - -begin - With TSVN2CVSApp.Create(Nil) do - try - Initialize; - Run; - Finally - free; - end; -end. diff --git a/utils/svn2cvs/test.xml b/utils/svn2cvs/test.xml deleted file mode 100644 index 06eb22a7cc..0000000000 --- a/utils/svn2cvs/test.xml +++ /dev/null @@ -1,86 +0,0 @@ -<?xml version="1.0" encoding="utf-8"?> -<log> -<logentry - revision="42"> -<author>fpc</author> -<date>2005-05-21T09:42:41.620737Z</date> -<msg> * log and id tags removed -</msg> -</logentry> -<logentry - revision="35"> -<author>florian</author> -<date>2005-05-19T22:16:53.958853Z</date> -<msg> * fixed comparisation of booleans and nulls in variants, fixes bug 3953 -</msg> -</logentry> -<logentry - revision="34"> -<author>florian</author> -<date>2005-05-19T22:13:11.823700Z</date> -<msg> * createguid fixed -</msg> -</logentry> -<logentry - revision="33"> -<author>michael</author> -<date>2005-05-19T21:14:45.797276Z</date> -<msg>+ Removed VER1_0 defines</msg> -</logentry> -<logentry - revision="27"> -<author>michael</author> -<date>2005-05-19T17:31:25.033833Z</date> -<msg>+ Implementation of CreateGUID</msg> -</logentry> -<logentry - revision="20"> -<author>fpc</author> -<date>2005-05-18T20:24:09.513140Z</date> -<msg> * property svn:mime-type for most files in main branch fixed -</msg> -</logentry> -<logentry - revision="19"> -<author>fpc</author> -<date>2005-05-18T16:53:52.841566Z</date> -<msg> * eol style property in main branch fixed -</msg> -</logentry> -<logentry - revision="16"> -<author>fpc</author> -<date>2005-05-18T16:16:11.495319Z</date> -<msg> * property svn:eol-style: native set -</msg> -</logentry> -<logentry - revision="15"> -<author>marco</author> -<date>2005-05-18T08:57:17.758875Z</date> -<msg> * Patch from maillist for read() on a file with only a few numerical digits - in them and no crlf -</msg> -</logentry> -<logentry - revision="13"> -<author>florian</author> -<date>2005-05-17T22:27:53.833452Z</date> -<msg>* format(%u",[<qword>]); fixed -* made test working</msg> -</logentry> -<logentry - revision="7"> -<author>peter</author> -<date>2005-05-16T20:59:02.681395Z</date> -<msg> * post 2.0.0 fixes from cvs - -</msg> -</logentry> -<logentry - revision="1"> -<author>fpc</author> -<date>2005-05-16T18:37:41.817974Z</date> -<msg>initial import</msg> -</logentry> -</log> diff --git a/utils/svn2cvs/vers.pp b/utils/svn2cvs/vers.pp deleted file mode 100644 index 1fdcaaf8ff..0000000000 --- a/utils/svn2cvs/vers.pp +++ /dev/null @@ -1,134 +0,0 @@ -{$mode objfpc} -{$h+} -program vers; - -uses Classes,sysutils,process,DOM,xmlread,custapp,IniFiles; - -Type - { TVersion } - TVersion = Class(TCollectionItem) - private - FAuthor: String; - FDate: string; - FLogMessage: String; - FRevision: Integer; - Public - Property Revision : Integer read FRevision; - Property LogMessage : String Read FLogMessage; - Property Date : string Read FDate; - Property Author : String Read FAuthor; - end; - - { TVersions } - - TVersions = Class(TCollection) - private - function GetVersion(Index : INteger): TVersion; - procedure SetVersion(Index : INteger; const AValue: TVersion); - Protected - procedure ConvertLogEntry(E : TDomElement); - public - Procedure LoadFromXML(Doc : TXMlDocument); - property Versions[Index : INteger] : TVersion Read GetVersion Write SetVersion; Default; - end; - - AppError = Class(Exception); - -Resourcestring - SErrInValidSVNLog = 'INvalid SVN log'; - -{ TVersions } - -function TVersions.GetVersion(Index : INteger): TVersion; -begin - Result:=Items[Index] as Tversion; -end; - -procedure TVersions.SetVersion(Index : INteger; const AValue: TVersion); -begin - Items[Index]:=AValue; -end; - -procedure TVersions.ConvertLogEntry(E : TDomElement); - - Function GetNodeText(N : TDomNode) : String; - - begin - N:=N.FirstChild; - If N<>Nil then - Result:=N.NodeValue; - end; - -Var - N : TDomNode; - V : TVersion; - -begin - V:=Add as TVersion; - V.FRevision:=StrToIntDef(E['revision'],-1); - N:=E.FirstChild; - While (N<>Nil) do - begin - If (N.NodeType=ELEMENT_NODE) then - begin - if (N.NodeName='author') then - V.FAuthor:=GetNodeText(N) - else If (N.NodeName='date') then - V.FDate:=GetNodeText(N) - else If (N.NodeName='msg') then - V.FLogMessage:=GetNodeText(N); - end; - N:=N.NextSibling; - end; -end; - -procedure TVersions.LoadFromXML(Doc: TXMlDocument); - -var - L : TDomNode; - E : TDomElement; - -begin - L:=Doc.FirstChild; - While (L<>Nil) and not ((L.NodeType=ELEMENT_NODE) and (L.NodeName='log')) do - L:=L.NextSibling; - if (L=Nil) then - Raise AppError.Create(SErrInValidSVNLog); - L:=L.FirstChild; - While (L<>Nil) do - begin - If (L.NodeType=ELEMENT_NODE) and (L.NodeName='logentry') then - E:=TDomElement(L); - ConvertLogEntry(E); - L:=L.NextSibling; - end; -end; - -Var - Doc : TXMLDocument; - F : TFileStream; - I : Integer; - -begin - With TVersions.Create(TVersion) do - Try - F:=TFileStream.Create('test.xml',fmOpenRead); - Try - ReadXMLFile(Doc,F); - Writeln('Got ',Count,' revisions'); - LoadFromXml(Doc); - For I:=0 to count-1 do - begin - Writeln('Revision ',I,' : '); - Writeln('Revision : ',Versions[i].Revision); - Writeln('Author : ',Versions[i].Author); - Writeln('Date : ',Versions[i].Date); - Writeln('Message : ',Versions[i].LogMessage); - end; - finally - F.Free; - end; - Finally - Free; - end; -end. |