diff --git a/.gitattributes b/.gitattributes index 89487ca324..eee82b63d2 100644 --- a/.gitattributes +++ b/.gitattributes @@ -11912,6 +11912,7 @@ tests/test/tlibrary2.pp svneol=native#text/plain tests/test/tlibrary3.pp svneol=native#text/plain tests/test/tmacbool.pp svneol=native#text/plain tests/test/tmacfunret.pp svneol=native#text/plain +tests/test/tmacfunret2.pp svneol=native#text/plain tests/test/tmaclocalprocparam1.pp svneol=native#text/plain tests/test/tmaclocalprocparam1a.pp svneol=native#text/plain tests/test/tmaclocalprocparam2.pp svneol=native#text/plain @@ -12027,6 +12028,7 @@ tests/test/tobjc4.pp svneol=native#text/plain tests/test/tobjc40.pp svneol=native#text/plain tests/test/tobjc41.pp svneol=native#text/plain tests/test/tobjc42.pp svneol=native#text/plain +tests/test/tobjc43.pp svneol=native#text/plain tests/test/tobjc4a.pp svneol=native#text/plain tests/test/tobjc5.pp svneol=native#text/plain tests/test/tobjc5a.pp svneol=native#text/plain @@ -14319,6 +14321,7 @@ tests/webtbs/tw27424.pp svneol=native#text/pascal tests/webtbs/tw27515.pp svneol=native#text/pascal tests/webtbs/tw2758.pp svneol=native#text/plain tests/webtbs/tw2763.pp svneol=native#text/plain +tests/webtbs/tw27634.pp svneol=native#text/plain tests/webtbs/tw2765.pp svneol=native#text/plain tests/webtbs/tw2767.pp svneol=native#text/plain tests/webtbs/tw2771.pp svneol=native#text/plain diff --git a/compiler/Makefile b/compiler/Makefile index 039dfdeecb..a409fa38db 100644 --- a/compiler/Makefile +++ b/compiler/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-02-23 rev 29972] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-02-24 rev 29972] # default: all MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos aarch64-darwin @@ -3896,11 +3896,14 @@ ppuclean: tempclean: -$(DEL) $(PPCROSSNAME) $(TEMPNAME) $(TEMPNAME1) $(TEMPNAME2) $(TEMPNAME3) $(MSG2INC) pp1.wpo pp2.wpo execlean : - -$(DEL) ppc386$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) ppcppc64$(EXEEXT) ppcarm$(EXEEXT) ppcmips$(EXEEXT) ppcmipsel$(EXEEXT) ppcjvm$(EXEEXT) ppc8086$(EXEEXT) ppca64$(EXEEXT) $(EXENAME) $(TEMPWPONAME1) $(TEMPWPONAME2) + -$(DEL) ppc386$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) ppcppc64$(EXEEXT) + -$(DEL) ppcarm$(EXEEXT) ppcmips$(EXEEXT) ppcmipsel$(EXEEXT) ppcjvm$(EXEEXT) ppc8086$(EXEEXT) ppca64$(EXEEXT) + -$(DEL) $(EXENAME) $(TEMPWPONAME1) $(TEMPWPONAME2) $(addsuffix _clean,$(ALLTARGETS)): -$(DELTREE) $(addprefix $(subst _clean,,$@),/units) -$(DEL) $(addprefix $(subst _clean,,$@)/,*$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)) - -$(DEL) $(addprefix $(subst _clean,,$@)/,ppc386$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) ppcppc64$(EXEEXT) ppcarm$(EXEEXT) ppcmips$(EXEEXT) ppcmipsel$(EXEEXT) ppcjvm$(EXEEXT) ppc8086$(EXEEXT) ppca64$(EXEEXT) $(EXENAME)) + -$(DEL) $(addprefix $(subst _clean,,$@)/,ppc386$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT)) + -$(DEL) $(addprefix $(subst _clean,,$@)/,ppcppc64$(EXEEXT) ppcarm$(EXEEXT) ppcmips$(EXEEXT) ppcmipsel$(EXEEXT) ppcjvm$(EXEEXT) ppc8086$(EXEEXT) ppca64$(EXEEXT) $(EXENAME)) cycleclean: cleanall $(addsuffix _clean,$(CPC_TARGET)) -$(DEL) $(EXENAME) clean: tempclean execlean cleanall $(addsuffix _clean,$(CPC_TARGET)) $(addsuffix _clean,$(TARGET_DIRS)) @@ -4081,10 +4084,10 @@ full: fullcycle fullcycle: $(MAKE) cycle $(MAKE) ppuclean -ifneq ($(CPU_SOURCE),x86_64) +ifneq ($(OS_SOURCE),win64) $(MAKE) $(filter-out $(PPC_TARGET),$(CYCLETARGETS)) 'FPC=$(BASEDIR)/$(EXENAME)' else - $(MAKE) $(filter-out i386,$(filter-out $(PPC_TARGET),$(CYCLETARGETS))) 'FPC=$(BASEDIR)/$(EXENAME)' + $(MAKE) $(filter-out i8086,$(filter-out i386,$(filter-out $(PPC_TARGET),$(CYCLETARGETS)))) 'FPC=$(BASEDIR)/$(EXENAME)' endif htmldocs: $(PASDOC) -p -h -o html$(PATHSEP)$(PPC_TARGET) -d fpc -d gdb -d $(PPC_TARGET) -u $(PPC_TARGET) $(PPC_TARGET)$(PATHSEP)*.pas systems$(PATHSEP)*.pas *.pas @@ -4111,7 +4114,11 @@ endif $(INSTALLEXE) $(INSTALLEXEFILE) $(PPCCPULOCATION)/$(INSTALLEXEFILE) endif fullinstall: +ifneq ($(OS_SOURCE),win64) $(MAKE) $(addsuffix _exe_install,$(filter-out $(PPC_TARGET),$(CYCLETARGETS))) +else + $(MAKE) $(addsuffix _exe_install,$(filter-out i8086,$(filter-out i386,$(filter-out $(PPC_TARGET),$(CYCLETARGETS))))) +endif install: quickinstall ifndef CROSSINSTALL ifdef UNIXHier diff --git a/compiler/Makefile.fpc b/compiler/Makefile.fpc index 99ca2a4b36..783f292951 100644 --- a/compiler/Makefile.fpc +++ b/compiler/Makefile.fpc @@ -461,12 +461,15 @@ tempclean: -$(DEL) $(PPCROSSNAME) $(TEMPNAME) $(TEMPNAME1) $(TEMPNAME2) $(TEMPNAME3) $(MSG2INC) pp1.wpo pp2.wpo execlean : - -$(DEL) ppc386$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) ppcppc64$(EXEEXT) ppcarm$(EXEEXT) ppcmips$(EXEEXT) ppcmipsel$(EXEEXT) ppcjvm$(EXEEXT) ppc8086$(EXEEXT) ppca64$(EXEEXT) $(EXENAME) $(TEMPWPONAME1) $(TEMPWPONAME2) + -$(DEL) ppc386$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) ppcppc64$(EXEEXT) + -$(DEL) ppcarm$(EXEEXT) ppcmips$(EXEEXT) ppcmipsel$(EXEEXT) ppcjvm$(EXEEXT) ppc8086$(EXEEXT) ppca64$(EXEEXT) + -$(DEL) $(EXENAME) $(TEMPWPONAME1) $(TEMPWPONAME2) $(addsuffix _clean,$(ALLTARGETS)): -$(DELTREE) $(addprefix $(subst _clean,,$@),/units) -$(DEL) $(addprefix $(subst _clean,,$@)/,*$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)) - -$(DEL) $(addprefix $(subst _clean,,$@)/,ppc386$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) ppcppc64$(EXEEXT) ppcarm$(EXEEXT) ppcmips$(EXEEXT) ppcmipsel$(EXEEXT) ppcjvm$(EXEEXT) ppc8086$(EXEEXT) ppca64$(EXEEXT) $(EXENAME)) + -$(DEL) $(addprefix $(subst _clean,,$@)/,ppc386$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT)) + -$(DEL) $(addprefix $(subst _clean,,$@)/,ppcppc64$(EXEEXT) ppcarm$(EXEEXT) ppcmips$(EXEEXT) ppcmipsel$(EXEEXT) ppcjvm$(EXEEXT) ppc8086$(EXEEXT) ppca64$(EXEEXT) $(EXENAME)) cycleclean: cleanall $(addsuffix _clean,$(CPC_TARGET)) -$(DEL) $(EXENAME) @@ -746,17 +749,18 @@ cvstest: # 2. remove all .ppufiles # 3. build all supported cross compilers except the # current PPC_TARGET which was already build -# +# unless FPC_SUPPORT_X87_TYPES_ON_WIN64 is set, +# win64 cannot compile i386 or i8086 compiler full: fullcycle fullcycle: $(MAKE) cycle $(MAKE) ppuclean -ifneq ($(CPU_SOURCE),x86_64) +ifneq ($(OS_SOURCE),win64) $(MAKE) $(filter-out $(PPC_TARGET),$(CYCLETARGETS)) 'FPC=$(BASEDIR)/$(EXENAME)' else - $(MAKE) $(filter-out i386,$(filter-out $(PPC_TARGET),$(CYCLETARGETS))) 'FPC=$(BASEDIR)/$(EXENAME)' + $(MAKE) $(filter-out i8086,$(filter-out i386,$(filter-out $(PPC_TARGET),$(CYCLETARGETS)))) 'FPC=$(BASEDIR)/$(EXENAME)' endif ##################################################################### @@ -803,7 +807,11 @@ endif endif fullinstall: +ifneq ($(OS_SOURCE),win64) $(MAKE) $(addsuffix _exe_install,$(filter-out $(PPC_TARGET),$(CYCLETARGETS))) +else + $(MAKE) $(addsuffix _exe_install,$(filter-out i8086,$(filter-out i386,$(filter-out $(PPC_TARGET),$(CYCLETARGETS))))) +endif install: quickinstall ifndef CROSSINSTALL diff --git a/compiler/cgutils.pas b/compiler/cgutils.pas index 738026ff24..d8c4943a04 100644 --- a/compiler/cgutils.pas +++ b/compiler/cgutils.pas @@ -301,25 +301,38 @@ uses {$elseif defined(cpu16bitalu)} OS_64,OS_S64: if getsupreg(locreg.register)1 then - exit(false); + { if the minor version number is two digits on OS X (the case since + OS X 10.10), we also have to add two digits for the patch level} + if length(temp)=2 then + osx_minor_two_digits:=true; end { the minor version number always takes up two digits on iOS } else if length(temp)=1 then @@ -859,9 +865,12 @@ function toption.ParseMacVersionMin(out minstr, emptystr: string; const compvarn { there's only room for a single digit patch level in the version macro for Mac OS X. gcc sets it to zero if there are more digits, but that seems worse than clamping to 9 (don't declare as invalid like with - minor version number, because there is a precedent like 10.4.11) + minor version number, because there is a precedent like 10.4.11). + + As of OS X 10.10 there are two digits for the patch level } - if not ios then + if not ios and + not osx_minor_two_digits then begin if length(temp)<>1 then temp:='9'; @@ -877,7 +886,8 @@ function toption.ParseMacVersionMin(out minstr, emptystr: string; const compvarn if i<=length(value) then exit(false); end - else if not ios then + else if not ios and + not osx_minor_two_digits then compvarvalue:=compvarvalue+'0' else compvarvalue:=compvarvalue+'00'; @@ -3850,7 +3860,7 @@ if (target_info.abi = abi_eabihf) then {$endif ARM} { inline bsf/bsr implementation } -{$if defined(i386) or defined(x86_64) or defined(aarch64)} +{$if defined(i386) or defined(x86_64) or defined(aarch64) or defined(powerpc) or defined(powerpc64)} def_system_macro('FPC_HAS_INTERNAL_BSF'); def_system_macro('FPC_HAS_INTERNAL_BSR'); {$endif} diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas index 0f7c7d4f71..b468370766 100644 --- a/compiler/pdecobj.pas +++ b/compiler/pdecobj.pas @@ -679,9 +679,6 @@ implementation Message1(sym_e_formal_class_not_resolved,childof.objrealname^); end; - { remove forward flag, is resolved } - exclude(current_structdef.objectoptions,oo_is_forward); - if hasparentdefined then begin if current_objectdef.objecttype in [odt_class,odt_objcclass,odt_objcprotocol,odt_javaclass,odt_interfacejava] then @@ -695,6 +692,9 @@ implementation end; consume(_RKLAMMER); end; + + { remove forward flag, is resolved } + exclude(current_structdef.objectoptions,oo_is_forward); end; procedure parse_extended_type(helpertype:thelpertype); diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 5288178efd..ec6472679c 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -3118,10 +3118,21 @@ implementation _RETURN : begin consume(_RETURN); + p1:=nil; if not(token in [_SEMICOLON,_ELSE,_END]) then - p1 := cexitnode.create(comp_expr(true,false)) - else - p1 := cexitnode.create(nil); + begin + p1:=comp_expr(true,false); + if not assigned(current_procinfo) or + (current_procinfo.procdef.proctypeoption in [potype_constructor,potype_destructor]) or + is_void(current_procinfo.procdef.returndef) then + begin + Message(parser_e_void_function); + { recovery } + p1.free; + p1:=nil; + end; + end; + p1 := cexitnode.create(p1); end; _INHERITED : begin diff --git a/compiler/powerpc/cgcpu.pas b/compiler/powerpc/cgcpu.pas index 79aa42f926..a6b55c92e1 100644 --- a/compiler/powerpc/cgcpu.pas +++ b/compiler/powerpc/cgcpu.pas @@ -830,11 +830,8 @@ const usesgpr := firstregint <> 32; usesfpr := firstregfpu <> 32; - if (tppcprocinfo(current_procinfo).needs_frame_pointer) then - begin - a_reg_alloc(list,NR_R12); - list.concat(taicpu.op_reg_reg(A_MR,NR_R12,NR_STACK_POINTER_REG)); - end; + if tppcprocinfo(current_procinfo).needs_frame_pointer then + list.concat(taicpu.op_reg_reg(A_MR,NR_OLD_STACK_POINTER_REG,NR_STACK_POINTER_REG)); end; if usesfpr then diff --git a/compiler/powerpc/cpubase.pas b/compiler/powerpc/cpubase.pas index fe1ed96e5f..4fcbf00f22 100644 --- a/compiler/powerpc/cpubase.pas +++ b/compiler/powerpc/cpubase.pas @@ -291,6 +291,10 @@ uses {# 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; diff --git a/compiler/powerpc64/cgcpu.pas b/compiler/powerpc64/cgcpu.pas index 7c953471b0..524936f6c9 100644 --- a/compiler/powerpc64/cgcpu.pas +++ b/compiler/powerpc64/cgcpu.pas @@ -1193,10 +1193,8 @@ begin save_standard_registers; { save old stack frame pointer } - if (tppcprocinfo(current_procinfo).needs_frame_pointer) then begin - a_reg_alloc(list, NR_OLD_STACK_POINTER_REG); + if (tppcprocinfo(current_procinfo).needs_frame_pointer) then list.concat(taicpu.op_reg_reg(A_MR, NR_OLD_STACK_POINTER_REG, NR_STACK_POINTER_REG)); - end; { create stack frame } if (not nostackframe) and (localsize > 0) and diff --git a/compiler/ppcgen/cgppc.pas b/compiler/ppcgen/cgppc.pas index 5a5c11be3c..dc5fae68ab 100644 --- a/compiler/ppcgen/cgppc.pas +++ b/compiler/ppcgen/cgppc.pas @@ -35,6 +35,8 @@ unit cgppc; tcgppcgen = class(tcg) procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara); override; + procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; srcsize, dstsize: tcgsize; src, dst: TRegister); override; + procedure a_call_reg(list : TAsmList;reg: tregister); override; { stores the contents of register reg to the memory location described by @@ -216,6 +218,54 @@ unit cgppc; end; + procedure tcgppcgen.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; srcsize, dstsize: tcgsize; src, dst: TRegister); + var + tmpreg: tregister; + cntlzop: tasmop; + bitsizem1: longint; + begin + { we only have a cntlz(w|d) instruction, which corresponds to bsr(x) + (well, regsize_in_bits - bsr(x), as x86 numbers bits in reverse). + Fortunately, bsf(x) can be calculated easily based on that, see + "Figure 5-13. Number of Powers of 2 Code Sequence" in the PowerPC + Compiler Writer's Guide + } + if srcsize in [OS_64,OS_S64] then + begin +{$ifdef powerpc64} + cntlzop:=A_CNTLZD; +{$else} + internalerror(2015022601); +{$endif} + bitsizem1:=63; + end + else + begin + cntlzop:=A_CNTLZW; + bitsizem1:=31; + end; + if not reverse then + begin + { cntlzw(src and -src) } + tmpreg:=getintregister(list,srcsize); + { don't use a_op_reg_reg, as this will adjust the result + after the neg in case of a non-32/64 bit operation, which + is not necessary since we're only using it as an + AND-mask } + list.concat(taicpu.op_reg_reg(A_NEG,tmpreg,src)); + a_op_reg_reg(list,OP_AND,srcsize,src,tmpreg); + end + else + tmpreg:=src; + { count leading zeroes } + list.concat(taicpu.op_reg_reg(cntlzop,dst,tmpreg)); + { (bitsize-1) - cntlz (which is 32/64 in case src was 0) } + list.concat(taicpu.op_reg_reg_const(A_SUBFIC,dst,dst,bitsizem1)); + { set to 255 is source was 0 } + a_op_const_reg(list,OP_AND,dstsize,255,dst); + end; + + procedure tcgppcgen.g_maybe_got_init(list: TAsmList); var instr: taicpu; diff --git a/compiler/ppcgen/hlcgppc.pas b/compiler/ppcgen/hlcgppc.pas index f41c9ac5f2..3eee7122f6 100644 --- a/compiler/ppcgen/hlcgppc.pas +++ b/compiler/ppcgen/hlcgppc.pas @@ -36,12 +36,15 @@ type thlcgppcgen = class(thlcg2ll) protected procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tdef; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); override; + public + procedure gen_load_para_value(list: TAsmList); override; end; implementation uses cpubase,globtype, + procinfo,cpupi, symdef,defutil; { thlcgppc } @@ -80,5 +83,19 @@ implementation a_load_subsetreg_subsetreg(list,subsetsize,subsetsize,fromsreg,tosreg); end; + + procedure thlcgppcgen.gen_load_para_value(list: TAsmList); + begin + { get the register that contains the stack pointer before the procedure + entry, which is used to access the parameters in their original + callee-side location } + if (tppcprocinfo(current_procinfo).needs_frame_pointer) then + getcpuregister(list,NR_OLD_STACK_POINTER_REG); + inherited; + { free it again } + if (tppcprocinfo(current_procinfo).needs_frame_pointer) then + ungetcpuregister(list,NR_OLD_STACK_POINTER_REG); + end; + end. diff --git a/compiler/symdef.pas b/compiler/symdef.pas index df48c66b6c..59168669a7 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -3991,9 +3991,15 @@ implementation begin if tsym(symtable.symlist[i]).typ<>fieldvarsym then continue; - if assigned(tfieldvarsym(symtable.symlist[i]).vardef) and - tstoreddef(tfieldvarsym(symtable.symlist[i]).vardef).is_fpuregable then - exit; + if assigned(tfieldvarsym(symtable.symlist[i]).vardef) then + begin + if tstoreddef(tfieldvarsym(symtable.symlist[i]).vardef).is_fpuregable then + exit; + { search recursively } + if (tstoreddef(tfieldvarsym(symtable.symlist[i]).vardef).typ=recorddef) and + (tabstractrecorddef(tfieldvarsym(symtable.symlist[i]).vardef).contains_float_field) then + exit; + end; end; result:=false; end; diff --git a/ide/fpconst.pas b/ide/fpconst.pas index 1d1f223507..07f9480fdb 100644 --- a/ide/fpconst.pas +++ b/ide/fpconst.pas @@ -55,9 +55,11 @@ const {$endif cpu68k} {$endif i386} {$ifdef SUPPORT_REMOTE} - {$define USE_SPECIAL_BASENAME} - { this uses PPC_TARGET env. variable from Makefile } - FPBaseName = 'fp_'+{$i %PPC_TARGET%}; + {$ifndef USE_SPECIAL_BASENAME} + { this uses PPC_TARGET env. variable from Makefile } + FPBaseName = 'fp_'+{$i %PPC_TARGET%}; + {$define USE_SPECIAL_BASENAME} + {$endif ndef USE_SPECIAL_BASENAME} {$endif SUPPORT_REMOTE} {$endif not USE_FPBASENAME} {$ifndef USE_SPECIAL_BASENAME} diff --git a/ide/fpdebug.pas b/ide/fpdebug.pas index ba64687304..3112317fbb 100644 --- a/ide/fpdebug.pas +++ b/ide/fpdebug.pas @@ -1477,10 +1477,6 @@ begin begin S:=PrintCommand(GetStr(PB^.Name)); got_error:=false; - If Pos('=',S)>0 then - S:=Copy(S,Pos('=',S)+1,255); - If S[Length(S)]=#10 then - Delete(S,Length(S),1); if Assigned(PB^.OldValue) then DisposeStr(PB^.OldValue); PB^.OldValue:=PB^.CurrentValue; diff --git a/ide/fpmopts.inc b/ide/fpmopts.inc index 4a27f2e989..9ff1f5b3ea 100644 --- a/ide/fpmopts.inc +++ b/ide/fpmopts.inc @@ -548,7 +548,8 @@ begin L:=0; CB2^.SetData(L); {$ifdef GDB_WINDOWS_ALWAYS_USE_ANOTHER_CONSOLE} - CB2^.EnableMask := CB2^.EnableMask and $fffffffe; + { EnableMask type is longint, avoid range check error here } + CB2^.EnableMask := CB2^.EnableMask and longint($7ffffffe); {$endif GDB_WINDOWS_ALWAYS_USE_ANOTHER_CONSOLE} R2.Move(0,-1); Insert(New(PLabel, Init(R2,label_debugger_redirection, CB2))); diff --git a/ide/gdbmiint.pas b/ide/gdbmiint.pas index 8678daed2f..4306ebb47d 100644 --- a/ide/gdbmiint.pas +++ b/ide/gdbmiint.pas @@ -434,7 +434,7 @@ Ignore: end; 'exited': begin - ExitCode := GDB.ExecAsyncOutput.Parameters['exit-code'].AsLongInt; + ExitCode := LongInt(GDB.ExecAsyncOutput.Parameters['exit-code'].AsLongWord); DebuggerScreen; current_pc := 0; Debuggee_started := False; diff --git a/ide/gdbmiwrap.pas b/ide/gdbmiwrap.pas index 954db67d4c..2198aef469 100644 --- a/ide/gdbmiwrap.pas +++ b/ide/gdbmiwrap.pas @@ -37,7 +37,10 @@ type TGDBMI_ListValue = class; TGDBMI_Value = class function AsString: string; + function AsInt64: Int64; + function AsQWord: QWord; function AsLongInt: LongInt; + function AsLongWord: LongWord; function AsCoreAddr: CORE_ADDR; function AsTuple: TGDBMI_TupleValue; function AsList: TGDBMI_ListValue; @@ -173,19 +176,42 @@ begin Result := (self as TGDBMI_StringValue).StringValue; end; +function TGDBMI_Value.AsInt64: Int64; +begin + Result := StrToInt64(C2PascalNumberPrefix(AsString)); +end; + +function TGDBMI_Value.AsQWord: QWord; +begin + Result := StrToQWord(C2PascalNumberPrefix(AsString)); +end; + function TGDBMI_Value.AsLongInt: LongInt; begin Result := StrToInt(C2PascalNumberPrefix(AsString)); end; +function TGDBMI_Value.AsLongWord: LongWord; +const + SInvalidInteger = '"%s" is an invalid integer'; +var + S: string; + Error: LongInt; +begin + S := C2PascalNumberPrefix(AsString); + Val(S, Result, Error); + if Error <> 0 then + raise EConvertError.CreateFmt(SInvalidInteger,[S]); +end; + function TGDBMI_Value.AsCoreAddr: CORE_ADDR; begin {$if defined(TARGET_IS_64BIT)} - Result := StrToQWord(C2PascalNumberPrefix(AsString)); + Result := AsQWord; {$elseif defined(CPU64)} - Result := StrToInt64(C2PascalNumberPrefix(AsString)); + Result := AsQWord; {$else} - Result := StrToInt(C2PascalNumberPrefix(AsString)); + Result := AsLongWord; {$endif} end; diff --git a/ide/globdir.inc b/ide/globdir.inc index 7fc7468724..b8370a77d4 100644 --- a/ide/globdir.inc +++ b/ide/globdir.inc @@ -217,5 +217,7 @@ {$ifdef DEBUG} {$define GDB_RAW_OUTPUT} {$endif DEBUG} - {$define GDB_WINDOWS_ALWAYS_USE_ANOTHER_CONSOLE} -{$endif GDBMI} \ No newline at end of file + {$ifdef Windows} + {$define GDB_WINDOWS_ALWAYS_USE_ANOTHER_CONSOLE} + {$endif Windows} +{$endif GDBMI} diff --git a/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc b/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc index 28bbe884d3..cb8ad8af2b 100644 --- a/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc +++ b/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc @@ -214,8 +214,8 @@ implementation uses dbconst, - strutils, - dateutils, + StrUtils, + DateUtils, FmtBCD; const @@ -838,7 +838,7 @@ begin Result := StrToInt(S); end; -function InternalStrToFloat(S: string): Extended; +function InternalStrToFloat(const S: string): Extended; var I: Integer; @@ -856,7 +856,7 @@ begin Result := StrToFloat(Tmp); end; -function InternalStrToCurrency(S: string): Extended; +function InternalStrToCurrency(const S: string): Currency; var I: Integer; @@ -874,7 +874,7 @@ begin Result := StrToCurr(Tmp); end; -function InternalStrToDate(S: string): TDateTime; +function InternalStrToDate(const S: string): TDateTime; var EY, EM, ED: Word; @@ -889,7 +889,26 @@ begin Result:=EncodeDate(EY, EM, ED); end; -function InternalStrToDateTime(S: string): TDateTime; +function StrToMSecs(const S: string): Word; +var C: char; + d, MSecs: double; +begin +{$IFDEF MYSQL56_UP} + // datetime(n), where n is fractional seconds precision (between 0 and 6) + MSecs := 0; + d := 100; + for C in S do + begin + MSecs := MSecs + (ord(C)-ord('0'))*d; + d := d / 10; + end; + Result := Round(MSecs); +{$ELSE} + Result := 0; +{$ENDIF} +end; + +function InternalStrToDateTime(const S: string): TDateTime; var EY, EM, ED: Word; @@ -902,19 +921,15 @@ begin EH := StrToInt(Copy(S, 12, 2)); EN := StrToInt(Copy(S, 15, 2)); ES := StrToInt(Copy(S, 18, 2)); - EMS:=0; -{$IFDEF mysql56} - if (Copy(S, 21, 3)<>'') then - EMS := StrToIntDef(Copy(S, 21, 3),0); -{$ENDIF} + EMS:= StrToMSecs(Copy(S, 21, 6)); if (EY = 0) or (EM = 0) or (ED = 0) then Result := 0 else Result := EncodeDate(EY, EM, ED); - Result := ComposeDateTime(Result,EncodeTime(EH, EN, ES, EMS)); + Result := ComposeDateTime(Result, EncodeTime(EH, EN, ES, EMS)); end; -function InternalStrToTime(S: string): TDateTime; +function InternalStrToTime(const S: string): TDateTime; var EH, EM, ES, EMS: Word; @@ -922,24 +937,20 @@ var begin p := 1; - EMS:=0; EH := StrToInt(ExtractSubstr(S, p, [':'])); //hours can be 2 or 3 digits EM := StrToInt(ExtractSubstr(S, p, [':'])); ES := StrToInt(ExtractSubstr(S, p, ['.'])); -{$IFDEF mysql56} - EMS:= StrToIntDef(ExtractSubstr(S, p, ['.']),0); -{$ENDIF} + EMS:= StrToMSecs(Copy(S, p, 6)); Result := EncodeTimeInterval(EH, EM, ES, EMS); end; -function InternalStrToTimeStamp(S: string): TDateTime; +function InternalStrToTimeStamp(const S: string): TDateTime; var EY, EM, ED: Word; EH, EN, ES, EMS: Word; begin - EMS:=0; {$IFNDEF mysql40} EY := StrToInt(Copy(S, 1, 4)); EM := StrToInt(Copy(S, 6, 2)); @@ -947,10 +958,7 @@ begin EH := StrToInt(Copy(S, 12, 2)); EN := StrToInt(Copy(S, 15, 2)); ES := StrToInt(Copy(S, 18, 2)); -{$IFDEF mysql56} - if (Copy(S, 21, 3)<>'') then - EMS := StrToIntDef(Copy(S, 21, 3),0); -{$ENDIF} + EMS:= StrToMSecs(Copy(S, 21, 6)); {$ELSE} EY := StrToInt(Copy(S, 1, 4)); EM := StrToInt(Copy(S, 5, 2)); @@ -958,6 +966,7 @@ begin EH := StrToInt(Copy(S, 9, 2)); EN := StrToInt(Copy(S, 11, 2)); ES := StrToInt(Copy(S, 13, 2)); + EMS:= 0; {$ENDIF} if (EY = 0) or (EM = 0) or (ED = 0) then Result := 0 diff --git a/packages/iosxlocale/src/iosxwstr.pp b/packages/iosxlocale/src/iosxwstr.pp index 6b300dbe71..cdbc31f3f1 100644 --- a/packages/iosxlocale/src/iosxwstr.pp +++ b/packages/iosxlocale/src/iosxwstr.pp @@ -237,7 +237,7 @@ implementation mstr:=CFStringCreateMutableCopy(nil,0,str); { lowercase } locale:=CFLocaleCopyCurrent; - CFStringLowercase(mstr,CFLocaleCopyCurrent); + CFStringLowercase(mstr,locale); CFRelease(locale); { extract the data again } range.location:=0; diff --git a/packages/sqlite/src/sqlite3.inc b/packages/sqlite/src/sqlite3.inc index 7f8b3e1fc8..c1adcd1820 100644 --- a/packages/sqlite/src/sqlite3.inc +++ b/packages/sqlite/src/sqlite3.inc @@ -256,10 +256,11 @@ type DlSym : function(vfs: psqlite3_vfs; addr: pointer; zSymbol: pansichar): pointer; cdecl; DlClose : procedure(vfs: psqlite3_vfs; addr: pointer); cdecl; Randomness : function(vfs: psqlite3_vfs; nByte: cint; zOut: pansichar): cint; cdecl; - Sleep : function(vfs: psqlite3_vfs; microseconds: cint): cint; cdecl; - GetLastError : function(vfs: psqlite3_vfs; code: cint; msg : pchar): cint; cdecl; + Sleep : function(vfs: psqlite3_vfs; microseconds: cint): cint; cdecl; CurrentTime : function(vfs: psqlite3_vfs; time: pcdouble): cint; cdecl; - xSetSystemCall : function(vfs: psqlite3_vfs; zName: pansichar; sqlite3_syscall_ptr : pointer) : cint; + GetLastError : function(vfs: psqlite3_vfs; code: cint; msg: pansichar): cint; cdecl; + CurrentTimeInt64 : function(vfs: psqlite3_vfs; time: psqlite3_int64): cint; cdecl; + xSetSystemCall : function(vfs: psqlite3_vfs; zName: pansichar; sqlite3_syscall_ptr : pointer) : cint; cdecl; xGetSystemCall : function(vfs: psqlite3_vfs; zName: pansichar) : pointer; cdecl; xNextSystemCall : function(vfs: psqlite3_vfs; zName: pansichar) : pansichar; cdecl; end; diff --git a/rtl/inc/cgeneric.inc b/rtl/inc/cgeneric.inc index 1fb91ac424..aadf96e44e 100644 --- a/rtl/inc/cgeneric.inc +++ b/rtl/inc/cgeneric.inc @@ -49,7 +49,14 @@ end; {$ifndef FPC_SYSTEM_HAS_INDEXBYTE} {$define FPC_SYSTEM_HAS_INDEXBYTE} +{$ifdef LINUX} + {$define BUGGYMEMCHR} +{$endif} + function memchr(const buf; b: cint; len: size_t): pointer; cdecl; external 'c'; +{$ifdef BUGGYMEMCHR} +function rawmemchr(const buf; b: cint): pointer; cdecl; external 'c'; +{$endif BUGGYMEMCHR} function IndexByte(Const buf;len:sizeint;b:byte):sizeint;{$ifdef SYSTEMINLINE}inline;{$endif} var @@ -60,7 +67,12 @@ begin { simulate assembler implementations behaviour, which is expected } { fpc_pchar_to_ansistr in astrings.inc (interpret values < 0 as } { unsigned) } - res := memchr(buf,cint(b),size_t(sizeuint(len))); +{$ifdef BUGGYMEMCHR} + if len = -1 then + res := rawmemchr(buf,cint(b)) + else +{$endif BUGGYMEMCHR} + res := memchr(buf,cint(b),size_t(sizeuint(len))); if (res <> nil) then IndexByte := SizeInt(res-@buf) else diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc index 35ba88b9b4..2b94aa618f 100644 --- a/rtl/inc/systemh.inc +++ b/rtl/inc/systemh.inc @@ -987,23 +987,23 @@ function fpc_SarInt64(Const AValue : Int64;const Shift : Byte): Int64;compilerpr {$endif FPC_HAS_INTERNAL_SAR_QWORD} {$ifdef FPC_HAS_INTERNAL_BSF} -{$if defined(cpui386) or defined(cpux86_64) or defined(cpuarm) or defined(cpuaarch64)} +{$if defined(cpui386) or defined(cpux86_64) or defined(cpuarm) or defined(cpuaarch64) or defined(cpupowerpc32) or defined(cpupowerpc64)} {$define FPC_HAS_INTERNAL_BSF_BYTE} {$define FPC_HAS_INTERNAL_BSF_WORD} {$define FPC_HAS_INTERNAL_BSF_DWORD} {$endif} -{$if defined(cpux86_64) or defined(cpuaarch64)} +{$if defined(cpux86_64) or defined(cpuaarch64) or defined(cpupowerpc64)} {$define FPC_HAS_INTERNAL_BSF_QWORD} {$endif} {$endif} {$ifdef FPC_HAS_INTERNAL_BSR} -{$if defined(cpui386) or defined(cpux86_64) or defined(cpuarm) or defined(cpuaarch64)} +{$if defined(cpui386) or defined(cpux86_64) or defined(cpuarm) or defined(cpuaarch64) or defined(cpupowerpc32) or defined(cpupowerpc64)} {$define FPC_HAS_INTERNAL_BSR_BYTE} {$define FPC_HAS_INTERNAL_BSR_WORD} {$define FPC_HAS_INTERNAL_BSR_DWORD} {$endif} -{$if defined(cpux86_64) or defined(cpuaarch64)} +{$if defined(cpux86_64) or defined(cpuaarch64) or defined(cpupowerpc64)} {$define FPC_HAS_INTERNAL_BSR_QWORD} {$endif} {$endif} diff --git a/rtl/msdos/Makefile b/rtl/msdos/Makefile index af8c939e76..18d99722b9 100644 --- a/rtl/msdos/Makefile +++ b/rtl/msdos/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-01-04 rev 29399] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2015-02-24 rev 29972] # default: all MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-dragonfly arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-msdos aarch64-darwin @@ -2726,25 +2726,24 @@ makefiles: fpc_makefiles ifneq ($(wildcard fpcmake.loc),) include fpcmake.loc endif -.NOTPARALLEL: include $(INC)/makefile.inc SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES)) include $(PROCINC)/makefile.cpu SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES)) SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS) -prt0s$(OEXT) : prt0s.asm prt0comn.asm +prt0s$(OEXT) : prt0s.asm prt0comn.asm $(COMPILER_UNITTARGETDIR) $(NASM) -f obj -o $(UNITTARGETDIRPREFIX)prt0s$(OEXT) prt0s.asm -prt0t$(OEXT) : prt0t.asm prt0comn.asm +prt0t$(OEXT) : prt0t.asm prt0comn.asm $(COMPILER_UNITTARGETDIR) $(NASM) -f obj -o $(UNITTARGETDIRPREFIX)prt0t$(OEXT) prt0t.asm -prt0m$(OEXT) : prt0m.asm prt0comn.asm +prt0m$(OEXT) : prt0m.asm prt0comn.asm $(COMPILER_UNITTARGETDIR) $(NASM) -f obj -o $(UNITTARGETDIRPREFIX)prt0m$(OEXT) prt0m.asm -prt0c$(OEXT) : prt0c.asm prt0comn.asm +prt0c$(OEXT) : prt0c.asm prt0comn.asm $(COMPILER_UNITTARGETDIR) $(NASM) -f obj -o $(UNITTARGETDIRPREFIX)prt0c$(OEXT) prt0c.asm -prt0l$(OEXT) : prt0l.asm prt0comn.asm +prt0l$(OEXT) : prt0l.asm prt0comn.asm $(COMPILER_UNITTARGETDIR) $(NASM) -f obj -o $(UNITTARGETDIRPREFIX)prt0l$(OEXT) prt0l.asm -prt0h$(OEXT) : prt0h.asm prt0comn.asm +prt0h$(OEXT) : prt0h.asm prt0comn.asm $(COMPILER_UNITTARGETDIR) $(NASM) -f obj -o $(UNITTARGETDIRPREFIX)prt0h$(OEXT) prt0h.asm -system$(PPUEXT) : system.pp $(SYSDEPS) +system$(PPUEXT) : system.pp $(SYSDEPS) $(INC)/tnyheaph.inc $(INC)/tinyheap.inc registers.inc $(COMPILER) -Us -Sg system.pp $(EXECPPAS) uuchar$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(INC)/uuchar.pp @@ -2755,90 +2754,71 @@ objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc system$(PPUEXT) $(EXECPPAS) strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \ + $(INC)/genstr.inc $(INC)/genstrs.inc \ system$(PPUEXT) $(COMPILER) $(INC)/strings.pp $(EXECPPAS) iso7185$(PPUEXT) : $(INC)/iso7185.pp system$(PPUEXT) $(COMPILER) $(INC)/iso7185.pp $(EXECPPAS) -initc$(PPUEXT) : initc.pp system$(PPUEXT) -profile$(PPUEXT) : profile.pp dpmiexcp$(PPUEXT) go32$(PPUEXT) -dxetype$(PPUEXT) : dxetype.pp system$(PPUEXT) -dxeload$(PPUEXT) : dxeload.pp dxetype$(PPUEXT) system$(PPUEXT) -emu387$(PPUEXT) : emu387.pp fpu$(OEXT) strings$(PPUEXT) dxeload$(PPUEXT) \ - dpmiexcp$(PPUEXT) ports$(PPUEXT) : ports.pp objpas$(PPUEXT) system$(PPUEXT) $(COMPILER) ports.pp $(EXECPPAS) -dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \ +dos$(PPUEXT) : dos.pp registers.inc \ + $(INC)/dosh.inc $(INC)/dos.inc $(INC)/fexpand.inc \ strings$(PPUEXT) system$(PPUEXT) $(COMPILER) dos.pp $(EXECPPAS) sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \ - objpas$(PPUEXT) dos$(PPUEXT) sysconst$(PPUEXT) + objpas$(PPUEXT) dos$(PPUEXT) sysconst$(PPUEXT) system$(PPUEXT) $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp $(EXECPPAS) classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \ - sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) types$(PPUEXT) fgl$(PPUEXT) + sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) types$(PPUEXT) fgl$(PPUEXT) objpas$(PPUEXT) system$(PPUEXT) $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp $(EXECPPAS) -fgl$(PPUEXT) : $(OBJPASDIR)/fgl.pp objpas$(PPUEXT) types$(PPUEXT) system$(PPUEXT) sysutils$(PPUEXT) +fgl$(PPUEXT) : $(OBJPASDIR)/fgl.pp types$(PPUEXT) sysutils$(PPUEXT) rtlconst$(PPUEXT) objpas$(PPUEXT) system$(PPUEXT) $(COMPILER) $(OBJPASDIR)/fgl.pp $(EXECPPAS) -math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT) +math$(PPUEXT): $(OBJPASDIR)/math.pp $(PROCINC)/mathu.inc objpas$(PPUEXT) sysutils$(PPUEXT) system$(PPUEXT) $(COMPILER) $(OBJPASDIR)/math.pp $(EXECPPAS) -typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) rtlconst$(PPUEXT) +typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp sysutils$(PPUEXT) objpas$(PPUEXT) rtlconst$(PPUEXT) system$(PPUEXT) $(COMPILER) -Sg -Fi$(OBJPASDIR) $(OBJPASDIR)/typinfo.pp $(EXECPPAS) -types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) +types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) system$(PPUEXT) $(COMPILER) $(OBJPASDIR)/types.pp $(EXECPPAS) -rtlconst$(PPUEXT) : $(OBJPASDIR)/rtlconst.pp +rtlconst$(PPUEXT) : $(OBJPASDIR)/rtlconst.pp $(OBJPASDIR)/rtlconst.inc objpas$(PPUEXT) system$(PPUEXT) $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/rtlconst.pp $(EXECPPAS) -sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) +sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) system$(PPUEXT) $(COMPILER) $(OBJPASDIR)/sysconst.pp $(EXECPPAS) -macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT) +macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT) system$(PPUEXT) $(COMPILER) $(INC)/macpas.pp $(REDIR) $(EXECPPAS) -cpu$(PPUEXT) : $(PROCINC)/cpu.pp system$(PPUEXT) - $(COMPILER) (PROCINC)/cpu.pp $(REDIR) - $(EXECPPAS) -mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) system$(PPUEXT) - $(COMPILER) (PROCINC)/mmx.pp $(REDIR) - $(EXECPPAS) getopts$(PPUEXT) : $(INC)/getopts.pp system$(PPUEXT) $(COMPILER) $(INC)/getopts.pp $(REDIR) $(EXECPPAS) heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT) $(COMPILER) -Sg $(INC)/heaptrc.pp $(EXECPPAS) -lineinfo$(PPUEXT) : $(INC)/lineinfo.pp system$(PPUEXT) +lineinfo$(PPUEXT) : $(INC)/lineinfo.pp exeinfo$(PPUEXT) strings$(PPUEXT) system$(PPUEXT) $(COMPILER) $(INC)/lineinfo.pp $(EXECPPAS) -lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp system$(PPUEXT) - $(COMPILER) $(INC)/lnfodwrf.pp +exeinfo$(PPUEXT) : $(INC)/exeinfo.pp strings$(PPUEXT) system$(PPUEXT) + $(COMPILER) $(INC)/exeinfo.pp $(EXECPPAS) -charset$(PPUEXT) : $(INC)/charset.pp system$(PPUEXT) +charset$(PPUEXT) : $(INC)/charset.pp objpas$(PPUEXT) system$(PPUEXT) $(COMPILER) $(INC)/charset.pp $(EXECPPAS) cpall$(PPUEXT): $(RTL)/charmaps/cpall.pas system$(PPUEXT) charset$(PPUEXT) $(COMPILER) -Fu$(INC) -Fi$(RTL)/charmaps $(RTL)/charmaps/cpall.pas $(EXECPPAS) -matrix$(PPUEXT) : $(INC)/matrix.pp system$(PPUEXT) - $(COMPILER) $(INC)/matrix.pp - $(EXECPPAS) -ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) system$(PPUEXT) - $(COMPILER) $(INC)/ucomplex.pp $(REDIR) - $(EXECPPAS) msmouse$(PPUEXT) : msmouse.pp system$(PPUEXT) $(COMPILER) msmouse.pp $(REDIR) $(EXECPPAS) -callspec$(PPUEXT) : $(INC)/callspec.pp system$(PPUEXT) - $(COMPILER) $(INC)/callspec.pp $(REDIR) - $(EXECPPAS) ctypes$(PPUEXT) : $(INC)/ctypes.pp system$(PPUEXT) $(COMPILER) $(INC)/ctypes.pp $(REDIR) $(EXECPPAS) diff --git a/rtl/msdos/Makefile.fpc b/rtl/msdos/Makefile.fpc index 46a4b453be..1f5e4ff568 100644 --- a/rtl/msdos/Makefile.fpc +++ b/rtl/msdos/Makefile.fpc @@ -49,7 +49,6 @@ ifdef NO_EXCEPTIONS_IN_SYSTEM override FPCOPT+=-dNO_EXCEPTIONS_IN_SYSTEM endif [rules] -.NOTPARALLEL: # Get the system independent include file names. # This will set the following variables : # SYSINCNAMES @@ -65,22 +64,22 @@ SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS) # # Loaders # -prt0s$(OEXT) : prt0s.asm prt0comn.asm +prt0s$(OEXT) : prt0s.asm prt0comn.asm $(COMPILER_UNITTARGETDIR) $(NASM) -f obj -o $(UNITTARGETDIRPREFIX)prt0s$(OEXT) prt0s.asm -prt0t$(OEXT) : prt0t.asm prt0comn.asm +prt0t$(OEXT) : prt0t.asm prt0comn.asm $(COMPILER_UNITTARGETDIR) $(NASM) -f obj -o $(UNITTARGETDIRPREFIX)prt0t$(OEXT) prt0t.asm -prt0m$(OEXT) : prt0m.asm prt0comn.asm +prt0m$(OEXT) : prt0m.asm prt0comn.asm $(COMPILER_UNITTARGETDIR) $(NASM) -f obj -o $(UNITTARGETDIRPREFIX)prt0m$(OEXT) prt0m.asm -prt0c$(OEXT) : prt0c.asm prt0comn.asm +prt0c$(OEXT) : prt0c.asm prt0comn.asm $(COMPILER_UNITTARGETDIR) $(NASM) -f obj -o $(UNITTARGETDIRPREFIX)prt0c$(OEXT) prt0c.asm -prt0l$(OEXT) : prt0l.asm prt0comn.asm +prt0l$(OEXT) : prt0l.asm prt0comn.asm $(COMPILER_UNITTARGETDIR) $(NASM) -f obj -o $(UNITTARGETDIRPREFIX)prt0l$(OEXT) prt0l.asm -prt0h$(OEXT) : prt0h.asm prt0comn.asm +prt0h$(OEXT) : prt0h.asm prt0comn.asm $(COMPILER_UNITTARGETDIR) $(NASM) -f obj -o $(UNITTARGETDIRPREFIX)prt0h$(OEXT) prt0h.asm # # System Units (System, Objpas, Strings) # -system$(PPUEXT) : system.pp $(SYSDEPS) +system$(PPUEXT) : system.pp $(SYSDEPS) $(INC)/tnyheaph.inc $(INC)/tinyheap.inc registers.inc $(COMPILER) -Us -Sg system.pp $(EXECPPAS) @@ -94,6 +93,7 @@ objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc system$(PPUEXT) strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \ $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \ + $(INC)/genstr.inc $(INC)/genstrs.inc \ system$(PPUEXT) $(COMPILER) $(INC)/strings.pp $(EXECPPAS) @@ -104,13 +104,6 @@ iso7185$(PPUEXT) : $(INC)/iso7185.pp system$(PPUEXT) # # System Dependent Units # -initc$(PPUEXT) : initc.pp system$(PPUEXT) -profile$(PPUEXT) : profile.pp dpmiexcp$(PPUEXT) go32$(PPUEXT) -dxetype$(PPUEXT) : dxetype.pp system$(PPUEXT) -dxeload$(PPUEXT) : dxeload.pp dxetype$(PPUEXT) system$(PPUEXT) - -emu387$(PPUEXT) : emu387.pp fpu$(OEXT) strings$(PPUEXT) dxeload$(PPUEXT) \ - dpmiexcp$(PPUEXT) ports$(PPUEXT) : ports.pp objpas$(PPUEXT) system$(PPUEXT) $(COMPILER) ports.pp @@ -118,7 +111,8 @@ ports$(PPUEXT) : ports.pp objpas$(PPUEXT) system$(PPUEXT) # # TP7 Compatible RTL Units # -dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \ +dos$(PPUEXT) : dos.pp registers.inc \ + $(INC)/dosh.inc $(INC)/dos.inc $(INC)/fexpand.inc \ strings$(PPUEXT) system$(PPUEXT) $(COMPILER) dos.pp $(EXECPPAS) @@ -127,57 +121,49 @@ dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \ # Delphi Compatible Units # sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \ - objpas$(PPUEXT) dos$(PPUEXT) sysconst$(PPUEXT) + objpas$(PPUEXT) dos$(PPUEXT) sysconst$(PPUEXT) system$(PPUEXT) $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp $(EXECPPAS) classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \ - sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) types$(PPUEXT) fgl$(PPUEXT) + sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) types$(PPUEXT) fgl$(PPUEXT) objpas$(PPUEXT) system$(PPUEXT) $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp $(EXECPPAS) -fgl$(PPUEXT) : $(OBJPASDIR)/fgl.pp objpas$(PPUEXT) types$(PPUEXT) system$(PPUEXT) sysutils$(PPUEXT) +fgl$(PPUEXT) : $(OBJPASDIR)/fgl.pp types$(PPUEXT) sysutils$(PPUEXT) rtlconst$(PPUEXT) objpas$(PPUEXT) system$(PPUEXT) $(COMPILER) $(OBJPASDIR)/fgl.pp $(EXECPPAS) -math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT) +math$(PPUEXT): $(OBJPASDIR)/math.pp $(PROCINC)/mathu.inc objpas$(PPUEXT) sysutils$(PPUEXT) system$(PPUEXT) $(COMPILER) $(OBJPASDIR)/math.pp $(EXECPPAS) -typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) rtlconst$(PPUEXT) +typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp sysutils$(PPUEXT) objpas$(PPUEXT) rtlconst$(PPUEXT) system$(PPUEXT) $(COMPILER) -Sg -Fi$(OBJPASDIR) $(OBJPASDIR)/typinfo.pp $(EXECPPAS) -types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) +types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) system$(PPUEXT) $(COMPILER) $(OBJPASDIR)/types.pp $(EXECPPAS) -rtlconst$(PPUEXT) : $(OBJPASDIR)/rtlconst.pp +rtlconst$(PPUEXT) : $(OBJPASDIR)/rtlconst.pp $(OBJPASDIR)/rtlconst.inc objpas$(PPUEXT) system$(PPUEXT) $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/rtlconst.pp $(EXECPPAS) -sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) +sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) system$(PPUEXT) $(COMPILER) $(OBJPASDIR)/sysconst.pp $(EXECPPAS) # # Mac Pascal Model # -macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT) +macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT) system$(PPUEXT) $(COMPILER) $(INC)/macpas.pp $(REDIR) $(EXECPPAS) # # Other system-independent RTL Units # -cpu$(PPUEXT) : $(PROCINC)/cpu.pp system$(PPUEXT) - $(COMPILER) (PROCINC)/cpu.pp $(REDIR) - $(EXECPPAS) - -mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) system$(PPUEXT) - $(COMPILER) (PROCINC)/mmx.pp $(REDIR) - $(EXECPPAS) - getopts$(PPUEXT) : $(INC)/getopts.pp system$(PPUEXT) $(COMPILER) $(INC)/getopts.pp $(REDIR) $(EXECPPAS) @@ -186,15 +172,15 @@ heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT) $(COMPILER) -Sg $(INC)/heaptrc.pp $(EXECPPAS) -lineinfo$(PPUEXT) : $(INC)/lineinfo.pp system$(PPUEXT) +lineinfo$(PPUEXT) : $(INC)/lineinfo.pp exeinfo$(PPUEXT) strings$(PPUEXT) system$(PPUEXT) $(COMPILER) $(INC)/lineinfo.pp $(EXECPPAS) -lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp system$(PPUEXT) - $(COMPILER) $(INC)/lnfodwrf.pp +exeinfo$(PPUEXT) : $(INC)/exeinfo.pp strings$(PPUEXT) system$(PPUEXT) + $(COMPILER) $(INC)/exeinfo.pp $(EXECPPAS) -charset$(PPUEXT) : $(INC)/charset.pp system$(PPUEXT) +charset$(PPUEXT) : $(INC)/charset.pp objpas$(PPUEXT) system$(PPUEXT) $(COMPILER) $(INC)/charset.pp $(EXECPPAS) @@ -202,14 +188,6 @@ cpall$(PPUEXT): $(RTL)/charmaps/cpall.pas system$(PPUEXT) charset$(PPUEXT) $(COMPILER) -Fu$(INC) -Fi$(RTL)/charmaps $(RTL)/charmaps/cpall.pas $(EXECPPAS) -matrix$(PPUEXT) : $(INC)/matrix.pp system$(PPUEXT) - $(COMPILER) $(INC)/matrix.pp - $(EXECPPAS) - -ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) system$(PPUEXT) - $(COMPILER) $(INC)/ucomplex.pp $(REDIR) - $(EXECPPAS) - # # Other system-dependent RTL Units # @@ -217,10 +195,6 @@ msmouse$(PPUEXT) : msmouse.pp system$(PPUEXT) $(COMPILER) msmouse.pp $(REDIR) $(EXECPPAS) -callspec$(PPUEXT) : $(INC)/callspec.pp system$(PPUEXT) - $(COMPILER) $(INC)/callspec.pp $(REDIR) - $(EXECPPAS) - ctypes$(PPUEXT) : $(INC)/ctypes.pp system$(PPUEXT) $(COMPILER) $(INC)/ctypes.pp $(REDIR) $(EXECPPAS) diff --git a/rtl/netbsd/ptypes.inc b/rtl/netbsd/ptypes.inc index a1a116dc0d..aaf55fa4dd 100644 --- a/rtl/netbsd/ptypes.inc +++ b/rtl/netbsd/ptypes.inc @@ -169,7 +169,8 @@ struct statfs12 { 1: (_mbstateL: cint64); { for alignment } end; pmbstate_t = ^mbstate_t; - + +{ records transcripted fromm NetBSD 5.1 libpthread sources } pthread_t = pointer; pthread_attr_t = record pta_magic : cuint; @@ -181,8 +182,21 @@ struct statfs12 { ptma_magic : cint; ptma_private : pointer; end; - pthread_cond_t = pointer; - pthread_condattr_t = pointer; + pthread_spin_t = char; + pthread_queue_t = record + first, last : pointer; + end; + pthread_cond_t = record + ptc_magic : cuint; + ptc_lock : pthread_spin_t; + ptc_waiters : pthread_queue_t; + ptc_mutex : ^pthread_mutex_t; + ptc_private : pointer; + end; + pthread_condattr_t = record + ptca_magic : cuint; + ptca_private : pointer; + end; pthread_key_t = cint; pthread_rwlock_t = pointer; pthread_rwlockattr_t = pointer; diff --git a/rtl/objpas/classes/classes.inc b/rtl/objpas/classes/classes.inc index 715de5b8f1..a4d959f7bb 100644 --- a/rtl/objpas/classes/classes.inc +++ b/rtl/objpas/classes/classes.inc @@ -334,68 +334,72 @@ procedure TThread.Synchronize(AMethod: TThreadMethod); TThread.Synchronize(self,AMethod); end; +Function PopThreadQueueHead : TThread.PThreadQueueEntry; + +begin + Result:=ThreadQueueHead; + if (Result<>Nil) then + begin + System.EnterCriticalSection(ThreadQueueLock); + try + Result:=ThreadQueueHead; + if Result<>Nil then + ThreadQueueHead:=ThreadQueueHead^.Next; + if Not Assigned(ThreadQueueHead) then + ThreadQueueTail := Nil; + finally + System.LeaveCriticalSection(ThreadQueueLock); + end; + end; +end; function CheckSynchronize(timeout : longint=0) : boolean; - { assumes being called from GUI thread } - var - exceptobj: Exception; - tmpentry: TThread.PThreadQueueEntry; - begin - result:=false; - { first sanity check } - if Not IsMultiThread then - Exit - { second sanity check } - else if GetCurrentThreadID<>MainThreadID then - raise EThread.CreateFmt(SCheckSynchronizeError,[GetCurrentThreadID]) + +{ assumes being called from GUI thread } +var + ExceptObj: Exception; + tmpentry: TThread.PThreadQueueEntry; + +begin + result:=false; + { first sanity check } + if Not IsMultiThread then + Exit + { second sanity check } + else if GetCurrentThreadID<>MainThreadID then + raise EThread.CreateFmt(SCheckSynchronizeError,[GetCurrentThreadID]); + if timeout>0 then + RtlEventWaitFor(SynchronizeTimeoutEvent,timeout) + else + RtlEventResetEvent(SynchronizeTimeoutEvent); + tmpentry := PopThreadQueueHead; + while Assigned(tmpentry) do + begin + { step 2: execute the method } + exceptobj := Nil; + try + ExecuteThreadQueueEntry(tmpentry); + except + exceptobj := Exception(AcquireExceptionObject); + end; + { step 3: error handling and cleanup } + if Assigned(tmpentry^.SyncEvent) then + begin + { for Synchronize entries we pass back the Exception and trigger + the event that Synchronize waits in } + tmpentry^.Exception := exceptobj; + RtlEventSetEvent(tmpentry^.SyncEvent) + end else begin - if timeout>0 then - begin - RtlEventWaitFor(SynchronizeTimeoutEvent,timeout); - end - else - RtlEventResetEvent(SynchronizeTimeoutEvent); - - System.EnterCriticalSection(ThreadQueueLock); - try - { Note: we don't need to pay attention to recursive calls to - Synchronize as those calls will be executed in the context of - the GUI thread and thus will be executed immediatly instead of - queuing them } - while Assigned(ThreadQueueHead) do begin - { step 1: update the list } - tmpentry := ThreadQueueHead; - ThreadQueueHead := ThreadQueueHead^.Next; - if not Assigned(ThreadQueueHead) then - ThreadQueueTail := Nil; - - { step 2: execute the method } - exceptobj := Nil; - try - ExecuteThreadQueueEntry(tmpentry); - except - exceptobj := Exception(AcquireExceptionObject); - end; - - { step 3: error handling and cleanup } - if Assigned(tmpentry^.SyncEvent) then begin - { for Synchronize entries we pass back the Exception and trigger - the event that Synchronize waits in } - tmpentry^.Exception := exceptobj; - RtlEventSetEvent(tmpentry^.SyncEvent) - end else begin - { for Queue entries we dispose the entry and raise the exception } - Dispose(tmpentry); - if Assigned(exceptobj) then - raise exceptobj; - end; - end; - finally - System.LeaveCriticalSection(ThreadQueueLock); - end; + { for Queue entries we dispose the entry and raise the exception } + Dispose(tmpentry); + if Assigned(exceptobj) then + raise exceptobj; end; - end; + tmpentry := PopThreadQueueHead; + end; +end; class function TThread.GetCurrentThread: TThread; diff --git a/rtl/wii/sysdir.inc b/rtl/wii/sysdir.inc index 4cbd8ea523..a96a8ac6cc 100644 --- a/rtl/wii/sysdir.inc +++ b/rtl/wii/sysdir.inc @@ -20,22 +20,36 @@ *****************************************************************************} procedure do_mkdir(const s: rawbytestring); begin - + { TODO: convert callback to use rawbytestring to avoid conversion } + if FileIODevice.DirIO.DoMkdir <> nil then + FileIODevice.DirIO.DoMkdir(s); end; procedure do_rmdir(const s: rawbytestring); begin - + { TODO: convert callback to use rawbytestring to avoid conversion } + if FileIODevice.DirIO.DoRmdir <> nil then + FileIODevice.DirIO.DoRmdir(s); end; procedure do_chdir(const s: rawbytestring); begin - + { TODO: convert callback to use rawbytestring to avoid conversion } + if FileIODevice.DirIO.DoChdir <> nil then + FileIODevice.DirIO.DoChdir(pchar(s)); end; procedure do_GetDir(DriveNr: byte; var Dir: RawByteString); +var + TmpDir: ShortString; begin - + { TODO: convert callback to use rawbytestring to avoid conversion } + if FileIODevice.DirIO.DoGetdir <> nil then + begin + FileIODevice.DirIO.DoGetdir(DriveNr, TmpDir); + Dir:=TmpDir; + SetCodePage(Dir,DefaultFileSystemCodePage,false); + end; end; diff --git a/tests/test/tbsx1.pp b/tests/test/tbsx1.pp index fe5aa1b524..f53d4ede7a 100644 --- a/tests/test/tbsx1.pp +++ b/tests/test/tbsx1.pp @@ -10,16 +10,16 @@ begin for i:=0 to 7 do begin x8:=1 shl i; - f:=BsfByte(x8); + f:=BsfByte(x8 or ((7-i) shl i)); if (f<>i) then begin - writeln('BsfByte(',x8,') returned ',f,', should be ',i); + writeln('BsfByte($',hexstr(x8 or ((7-i) shl i),2),') returned ',f,', should be ',i); exit(false); end; - r:=BsrByte(x8); + r:=BsrByte(x8 or i); if r<>i then begin - writeln('BsrByte(',x8,') returned ',r,', should be ',i); + writeln('BsrByte($',hexstr(x8 or i,2),') returned ',r,', should be ',i); exit(false); end; end; @@ -47,13 +47,13 @@ begin for i:=0 to 15 do begin x16:=1 shl i; - f:=BsfWord(x16); + f:=BsfWord(x16 or ((15-i) shl i)); if (f<>i) then begin writeln('BsfWord(',x16,') returned ',f,', should be ',i); exit(false); end; - r:=BsrWord(x16); + r:=BsrWord(x16 or i); if r<>i then begin writeln('BsrWord(',x16,') returned ',r,', should be ',i); @@ -84,13 +84,13 @@ begin for i:=0 to 31 do begin x32:=cardinal(1) shl i; - f:=BsfDWord(x32); + f:=BsfDWord(x32 or ((31-i) shl i)); if (f<>i) then begin writeln('BsfDWord(',x32,') returned ',f,', should be ',i); exit(false); end; - r:=BsrDWord(x32); + r:=BsrDWord(x32 or i); if r<>i then begin writeln('BsrDWord(',x32,') returned ',r,', should be ',i); @@ -121,12 +121,12 @@ begin for i:=0 to 63 do begin x64:=uint64(1) shl i; - f:=BsfQWord(x64); + f:=BsfQWord(x64 or (uint64(63-i) shl i)); if f<>i then begin writeln('BsfQWord(',x64,') returned ',f,', should be ',i); exit(false); end; - r:=BsrQWord(x64); + r:=BsrQWord(x64 or i); if r<>i then begin writeln('BsrQWord(',x64,') returned ',r,', should be ',i); exit(false); diff --git a/tests/test/tmacfunret2.pp b/tests/test/tmacfunret2.pp new file mode 100644 index 0000000000..bc74898601 --- /dev/null +++ b/tests/test/tmacfunret2.pp @@ -0,0 +1,12 @@ +{ %fail } + +{$mode macpas} + +procedure Example; + +begin +return false; // compiler catches this, but crashes instead of reporting an error +end; + +begin +end. diff --git a/tests/test/tobjc43.pp b/tests/test/tobjc43.pp new file mode 100644 index 0000000000..2c2d25e01e --- /dev/null +++ b/tests/test/tobjc43.pp @@ -0,0 +1,11 @@ +{ %target=darwin } +{ %fail } + +{$modeswitch objectivec2} + +type + prot = objcprotocol(prot) + end; + +begin +end. diff --git a/tests/webtbs/tw27634.pp b/tests/webtbs/tw27634.pp new file mode 100644 index 0000000000..b33dd096df --- /dev/null +++ b/tests/webtbs/tw27634.pp @@ -0,0 +1,66 @@ +type + MBHelpPtr = pointer; + MenuRecord = record end; + MenuItemsPtr = pointer; + MenuIconHandle = pointer; + MenuRef = pointer; + int16 = word; + int32 = longint; + OSStatus = int32; + Str255 = ShortString; + + function MacMenuAddItemInternal + ( var theMenuRecord : MenuRecord; + theMenuOrSubMenuID : Int32; + theOptBeforeItemIndex : Int32; + var theMenuRef : MenuRef; + var theItemsPtr : MenuItemsPtr; + const theItemStr : Str255; + theItemIconHandle : MenuIconHandle; + theEnableFlag : boolean; + theCheckFlag : boolean; + theCommandChar : char; + theCommandModifiers : Int16; + theItemCmdID : Int32; + const theItemAppStr : AnsiString; + var theNewItemIndex : Int32): OSStatus; +begin +end; + + function MBMenuAddItemInternal + ( var theMenuRecord : MenuRecord; + theMenuOrSubMenuID : Int32; + theOptBeforeItemIndex : Int32; + var theMenuRef : MenuRef; + var theItemsPtr : MenuItemsPtr; + const theItemStr : Str255; + theItemIconHandle : MenuIconHandle; + theEnableFlag : boolean; + theCheckFlag : boolean; + theCommandChar : char; + theCommandGlyph : Int16; { unused here } + theCommandModifiers : Int16; + theItemCmdID : Int32; + const theItemAppStr : AnsiString; + theItemHelpPtr : MBHelpPtr; { unused here } + var theNewItemIndex : Int32): OSStatus; + var + theErr : OSStatus; + begin + theItemsPtr := nil; + theNewItemIndex := 0; + theErr := MacMenuAddItemInternal + ( theMenuRecord, theMenuOrSubMenuID, theOptBeforeItemIndex, theMenuRef, theItemsPtr, + theItemStr, theItemIconHandle, theEnableFlag, theCheckFlag, theCommandChar, + theCommandModifiers, theItemCmdID, theItemAppStr, theNewItemIndex); + MBMenuAddItemInternal := theErr + end; + +var + theMenuRecord: MenuRecord; + theMenuRef: MenuRef; + theItemsPtr: MenuItemsPtr; + theNewItemIndex: Int32; +begin + MBMenuAddItemInternal(theMenuRecord,1,2,theMenuRef,theItemsPtr,'abc',nil,true,false,'b',3,4,5,'def',nil,theNewItemIndex); +end.