From 495ffec968167c9a9d7a0c8594921909aec224a8 Mon Sep 17 00:00:00 2001 From: peter Date: Mon, 6 Feb 2006 08:51:13 +0000 Subject: [PATCH] Merged revisions 2282,2290,2292-2295,2297,2299,2302,2304 via svnmerge from http://peter@svn.freepascal.org/svn/fpc/trunk ........ r2282 | florian | 2006-01-14 13:55:26 +0100 (Sat, 14 Jan 2006) | 2 lines * cleanup ........ r2290 | marco | 2006-01-15 01:08:15 +0100 (Sun, 15 Jan 2006) | 2 lines * .size stuff for GOT ........ r2292 | marco | 2006-01-15 13:00:49 +0100 (Sun, 15 Jan 2006) | 2 lines * picified syscall code ........ r2293 | vincents | 2006-01-15 15:12:42 +0100 (Sun, 15 Jan 2006) | 1 line write pointer values using 16 hexadecimal digits on 64 bits platforms ........ r2294 | marco | 2006-01-15 15:33:30 +0100 (Sun, 15 Jan 2006) | 2 lines * some patches related to shared linking + some AMD64 checks. ........ r2295 | marco | 2006-01-15 15:56:20 +0100 (Sun, 15 Jan 2006) | 2 lines * more "shared" fixes ........ r2297 | marco | 2006-01-15 16:22:29 +0100 (Sun, 15 Jan 2006) | 2 lines * shared lib i_ and t_ changes. Some small comments cleanup to t_ ........ r2299 | peter | 2006-01-15 20:36:56 +0100 (Sun, 15 Jan 2006) | 2 lines * remove $ifdef WINDOWS which was broken for fpc ........ r2302 | olle | 2006-01-15 22:55:07 +0100 (Sun, 15 Jan 2006) | 1 line added test cases for comming macpas features ........ r2304 | peter | 2006-01-16 11:48:21 +0100 (Mon, 16 Jan 2006) | 2 lines * support section names with length > 8 ........ git-svn-id: branches/fixes_2_0@2456 - --- .gitattributes | 3 + compiler/ogcoff.pas | 27 ++++-- packages/extra/unzip/unzip.pp | 151 +------------------------------ rtl/bsd/i386/syscall.inc | 47 +++++----- rtl/freebsd/i386/cprt0.as | 30 +++++- rtl/freebsd/i386/prt0.as | 31 +++++-- rtl/freebsd/ptypes.inc | 28 ++++-- rtl/inc/heaptrc.pp | 18 ++-- rtl/inc/objpas.inc | 8 -- rtl/unix/cwstring.pp | 7 +- tests/test/tmaclocalprocparam.pp | 43 +++++++++ tests/test/tmacnonlocalexit.pp | 35 +++++++ tests/test/tmacnonlocalgoto.pp | 38 ++++++++ 13 files changed, 248 insertions(+), 218 deletions(-) create mode 100644 tests/test/tmaclocalprocparam.pp create mode 100644 tests/test/tmacnonlocalexit.pp create mode 100644 tests/test/tmacnonlocalgoto.pp diff --git a/.gitattributes b/.gitattributes index c5acd08984..021d7c5c5c 100644 --- a/.gitattributes +++ b/.gitattributes @@ -5346,6 +5346,9 @@ tests/test/tintuint.pp svneol=native#text/plain tests/test/tlibrary1.pp svneol=native#text/plain tests/test/tlibrary2.pp svneol=native#text/plain tests/test/tmacfunret.pp svneol=native#text/plain +tests/test/tmaclocalprocparam.pp svneol=native#text/plain +tests/test/tmacnonlocalexit.pp svneol=native#text/plain +tests/test/tmacnonlocalgoto.pp svneol=native#text/plain tests/test/tmacpas1.pp svneol=native#text/plain tests/test/tmacpas2.pp svneol=native#text/plain tests/test/tmacpas3.pp svneol=native#text/plain diff --git a/compiler/ogcoff.pas b/compiler/ogcoff.pas index 2eb31a4336..a67c96e7c7 100644 --- a/compiler/ogcoff.pas +++ b/compiler/ogcoff.pas @@ -168,7 +168,7 @@ implementation uses strings, cutils,verbose, - globals,fmodule; + globals,fmodule,aasmtai; const COFF_FLAG_NORELOCS = $0001; @@ -563,9 +563,15 @@ const go32v2stub : array[0..2047] of byte=( '.debug_frame', '.fpc' ); + var + secname : string; begin - { No support for named sections, because section names are limited to 8 chars } - result:=secnames[atype]; + secname:=secnames[atype]; + if use_smartlink_section and + (aname<>'') then + result:=secname+'$'+aname + else + result:=secname; end; @@ -936,9 +942,9 @@ const go32v2stub : array[0..2047] of byte=( procedure tcoffobjectoutput.write_symbols(data:TAsmObjectData); var filename : string[18]; - value : longint; sectionval, - globalval : byte; + globalval, + value : longint; p : tasmsymbol; begin with tcoffobjectdata(data) do @@ -1004,12 +1010,17 @@ const go32v2stub : array[0..2047] of byte=( var sechdr : coffsechdr; s : string; + strpos : longint; begin fillchar(sechdr,sizeof(sechdr),0); s:=tasmsection(p).name; - { section names are limited to 8 chars } if length(s)>8 then - internalerror(200403312); + begin + strpos:=FCoffStrs.size+4; + FCoffStrs.writestr(s); + FCoffStrs.writestr(#0); + s:='/'+ToStr(strpos); + end; move(s[1],sechdr.name,length(s)); if not win32 then begin @@ -1764,7 +1775,7 @@ const go32v2stub : array[0..2047] of byte=( asmbin : ''; asmcmd : ''; supported_target : system_i386_win32; - flags : [af_outputbinary]; + flags : [af_outputbinary,af_smartlink_sections]; labelprefix : '.L'; comment : ''; ); diff --git a/packages/extra/unzip/unzip.pp b/packages/extra/unzip/unzip.pp index cfbcc2b512..b9683bc407 100644 --- a/packages/extra/unzip/unzip.pp +++ b/packages/extra/unzip/unzip.pp @@ -65,21 +65,9 @@ INTERFACE {$R-} {No range checking} USES -{$ifdef windows} -wintypes, -winprocs, -{$ifdef Delphi} -Messages, -Sysutils, -{$else Delphi} -strings, -windos, -{$endif Delphi} -{$else Windows} -strings, -dos, -{$endif Windows} -ziptypes; + strings, + dos, + ziptypes; {**********************************************************************} {**********************************************************************} @@ -89,8 +77,6 @@ ziptypes; FUNCTION FileUnzip ( SourceZipFile, TargetDirectory, FileSpecs : pChar; Report : UnzipReportProc;Question : UnzipQuestionProc ) : integer; -{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows} -{$ifdef DPMI} EXPORT; {$endif DPMI} { high level unzip @@ -110,8 +96,6 @@ e.g., } FUNCTION FileUnzipEx ( SourceZipFile, TargetDirectory, FileSpecs : pChar ) : integer; -{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows} -{$ifdef DPMI} EXPORT; {$endif DPMI} { high level unzip with no callback parameters; passes ZipReport & ZipQuestion internally, so you @@ -122,8 +106,6 @@ e.g., } FUNCTION ViewZip ( SourceZipFile, FileSpecs : pChar; Report : UnzipReportProc ) : integer; -{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows} -{$ifdef DPMI} EXPORT; {$endif DPMI} { view contents of zip file usage: @@ -138,8 +120,6 @@ e.g., } FUNCTION SetUnZipReportProc ( aProc : UnzipReportProc ) : Pointer; -{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows} -{$ifdef DPMI} EXPORT; {$endif DPMI} { sets the internal unzip report procedure to aproc Returns: pointer to the original report procedure @@ -150,8 +130,6 @@ e.g., } FUNCTION SetUnZipQuestionProc ( aProc : UnzipQuestionProc ) : Pointer; -{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows} -{$ifdef DPMI} EXPORT; {$endif DPMI} { sets the internal unzip question procedure to aproc Returns: pointer to the original "question" procedure @@ -162,8 +140,6 @@ SetUnZipQuestionProc(QueryFileExistProc); } FUNCTION UnzipSize ( SourceZipFile : pChar;VAR Compressed : Longint ) : longint; -{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows} -{$ifdef DPMI} EXPORT; {$endif DPMI} { uncompressed and compressed zip size usage: SourceZipFile = the zip file @@ -179,15 +155,11 @@ e.g., } PROCEDURE ChfUnzip_Init; -{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows} -{$ifdef DPMI} EXPORT; {$endif DPMI} { initialise or reinitialise the shared data: !!! use with care !!! } FUNCTION SetNoRecurseDirs ( DontRecurse : Boolean ) : Boolean; -{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows} -{$ifdef DPMI} EXPORT; {$endif DPMI} { determine whether the UNZIP function should recreate the subdirectory structure; @@ -201,14 +173,10 @@ the subdirectory structure; {**********************************************************************} {**********************************************************************} FUNCTION GetSupportedMethods : longint; -{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows} -{$ifdef DPMI} EXPORT; {$endif DPMI} {Checks which pack methods are supported by the dll} {bit 8=1 -> Format 8 supported, etc.} FUNCTION UnzipFile ( in_name : pchar;out_name : pchar;offset : longint;hFileAction : word;cm_index : integer ) : integer; -{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows} -{$ifdef DPMI} EXPORT; {$endif DPMI} {usage: in_name: name of zip file with full path out_name: desired name for out file @@ -244,8 +212,6 @@ FUNCTION UnzipFile ( in_name : pchar;out_name : pchar;offset : longint;hFileActi } FUNCTION GetFirstInZip ( zipfilename : pchar;VAR zprec : tZipRec ) : integer; -{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows} -{$ifdef DPMI} EXPORT; {$endif DPMI} { Get first entry from ZIP file e.g., @@ -253,8 +219,6 @@ FUNCTION GetFirstInZip ( zipfilename : pchar;VAR zprec : tZipRec ) : integer; } FUNCTION GetNextInZip ( VAR Zprec : tZiprec ) : integer; -{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows} -{$ifdef DPMI} EXPORT; {$endif DPMI} { Get next entry from ZIP file @@ -263,8 +227,6 @@ FUNCTION GetNextInZip ( VAR Zprec : tZiprec ) : integer; } FUNCTION IsZip ( filename : pchar ) : boolean; -{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows} -{$ifdef DPMI} EXPORT; {$endif DPMI} { VERY simple test for zip file @@ -273,8 +235,6 @@ FUNCTION IsZip ( filename : pchar ) : boolean; } PROCEDURE CloseZipFile ( VAR Zprec : tZiprec ); {Only free buffer, file only open in Getfirstinzip} -{$ifdef Windows}{$ifdef Win32}STDCALL;{$else}EXPORT;{$endif Win32}{$endif Windows} -{$ifdef DPMI} EXPORT; {$endif DPMI} { free ZIP buffers @@ -384,10 +344,6 @@ TYPE VAR slide : pchar; {Sliding dictionary for unzipping} inbuf : iobuf; {input buffer} inpos, readpos : integer; {position in input buffer, position read from file} -{$ifdef windows} - dlghandle : word; {optional: handle of a cancel and "%-done"-dialog} - dlgnotify : integer; {notification code to tell dialog how far the decompression is} -{$endif} VAR w : longint; {Current Position in slide} b : longint; {Bit Buffer} @@ -402,10 +358,6 @@ VAR w : longint; {Current Position in slide} totalabort, {User pressed abort button, set in showpercent!} zipeof : boolean; {read over end of zip section for this file} inuse : boolean; {is unit already in use -> don't call it again!!!} -{$ifdef windows} - oldpercent : integer; {last percent value shown} - lastusedtime : longint; {Time of last usage in timer ticks for timeout!} -{$endif} (***************************************************************************) {.$I z_tables.pas} {Tables for bit masking, huffman codes and CRC checking} @@ -574,38 +526,6 @@ BEGIN {$endif} END; -{************************* tell dialog to show % ******************************} -{$ifdef windows} -PROCEDURE messageloop; -VAR msg : tmsg; -BEGIN - lastusedtime := gettickcount; - WHILE PeekMessage ( Msg, 0, 0, 0, PM_Remove ) DO - IF ( dlghandle = 0 ) OR NOT IsDialogMessage ( dlghandle, msg ) THEN BEGIN - TranslateMessage ( Msg ); - DispatchMessage ( Msg ); - END; -END; -PROCEDURE showpercent; {use this with the low level functions only !!!} -VAR percent : word; -BEGIN - IF compsize <> 0 THEN BEGIN - percent := reachedsize * 100 DIV compsize; - IF percent > 100 THEN percent := 100; - IF ( percent <> oldpercent ) THEN BEGIN - oldpercent := percent; - IF dlghandle <> 0 THEN BEGIN {Use dialog box for aborting} - {Sendmessage returns directly -> ppercent contains result} - sendmessage ( dlghandle, wm_command, dlgnotify, longint ( @percent ) ); - totalabort := ( percent = $FFFF ); {Abort pressed!} - END ELSE - IF dlgnotify <> 0 THEN - totalabort := getasynckeystate ( dlgnotify ) < 0; {break Key pressed!} - END; - END; -END; -{$endif} - {************************** fill inbuf from infile *********************} PROCEDURE readbuf; @@ -614,10 +534,6 @@ BEGIN readpos := sizeof ( inbuf ); {Simulates reading -> no blocking} zipeof := TRUE END ELSE BEGIN - {$ifdef windows} - messageloop; {Other programs, or in DOS: keypressed?} - showpercent; {Before, because it shows the data processed, not read!} - {$endif} {$I-} blockread ( infile, inbuf, sizeof ( inbuf ), readpos ); {$I+} @@ -1422,10 +1338,6 @@ BEGIN exit END; inc ( reachedsize, outcnt ); - {$ifdef windows} - messageloop; {Other programs, or in DOS: keypressed?} - showpercent; - {$endif} END; IF NOT totalabort THEN copystored := unzip_Ok @@ -2326,22 +2238,6 @@ VAR err : integer; oldcurdir : string [ 80 ]; BEGIN - {$ifdef windows} - IF inuse THEN BEGIN - {take care of crashed applications!} - IF ( lastusedtime <> 0 ) AND - ( abs ( gettickcount -lastusedtime ) > 30000 ) THEN BEGIN {1/2 minute timeout!!!} - {do not close files or free slide, they were already freed when application crashed!} - inuse := FALSE; - {memory for huffman trees is lost} - END ELSE BEGIN - unzipfile := unzip_inuse; - exit - END; - END;{inuse} - - inuse := TRUE; - {$endif} getmem ( slide, wsize ); fillchar ( slide [ 0 ], wsize, #0 ); assign ( infile, in_name ); @@ -2439,44 +2335,23 @@ BEGIN IF ( p <> NIL ) AND ( p [ 1 ] = ':' ) THEN BEGIN strcopy ( buf0, 'c:\' ); {set drive} buf0 [ 0 ] := p [ 0 ]; - {$ifdef windows} - setcurdir ( buf0 ); - {$else} {$I-} chdir ( buf0 ); {$I+} err := ioresult; - {$endif} p := strtok ( NIL, '\' ); END; {$endif} WHILE ( p <> NIL ) AND ( p <> p1 ) DO BEGIN - {$ifdef windows} - {$ifdef Delphi} - {$I-} - chdir ( strpas ( p ) ); - {$I+} - err := ioresult; - {$else Delphi} - setcurdir ( p ); - err := doserror; - {$endif Delphi} - {$else Windows} {$I-} chdir ( strpas ( p ) ); {$I+} err := ioresult; - {$endif} IF err <> 0 THEN BEGIN - {$ifdef windows} - createdir ( p ); - err := doserror; - {$else} {$I-} mkdir ( strpas ( p ) ); {$I+} err := ioresult; - {$endif} IF err = 0 THEN {$I-} chdir ( strpas ( p ) ); @@ -2516,13 +2391,6 @@ BEGIN totalabort := FALSE; zipeof := FALSE; - {$ifdef windows} - dlghandle := hFileAction; - dlgnotify := cm_index; - messageloop; - oldpercent := 0; - {$endif} - crc32val := $FFFFFFFF; {Unzip correct type} @@ -2555,11 +2423,6 @@ BEGIN unzipfile := unzip_CRCErr; erase ( outfile ); END ELSE BEGIN - {$ifdef windows} - oldpercent := 100; {100 percent} - IF dlghandle <> 0 THEN - sendmessage ( dlghandle, wm_command, dlgnotify, longint ( @oldpercent ) ); - {$endif} filemode := 2; reset ( outfile ); filemode := storefilemode; @@ -2953,13 +2816,11 @@ END; {$endif Delphi} PROCEDURE DummyReport ( Retcode : longint;Rec : pReportRec ); -{$ifdef Windows}{$ifdef win32}STDCALL;{$else}EXPORT;{$endif}{$endif} {dummy report procedure} BEGIN END; FUNCTION DummyQuestion( Rec : pReportRec ) : Boolean; -{$ifdef Windows}{$ifdef win32}STDCALL;{$else}EXPORT;{$endif}{$endif} {dummy question procedure} begin DummyQuestion:=true; @@ -3106,7 +2967,7 @@ BEGIN END; END ELSE BEGIN rc := unzipfile ( thename, buf, r.headeroffset, 0, - {$ifdef windows}vk_escape{$else}27{$endif} ); {Escape interrupts} + 27 ); {Escape interrupts} END; IF rc = unzip_ok @@ -3303,10 +3164,6 @@ END; { SetNoRecurseDirs } PROCEDURE ChfUnzip_Init; BEGIN slide := NIL; {unused} - {$ifdef windows} - inuse := FALSE; {Not yet in use!} - lastusedtime := 0; {Not yet used} - {$endif} if inuse then; { to remove warning } SetUnZipReportProc ( NIL ); SetUnZipQuestionProc ( NIL ); diff --git a/rtl/bsd/i386/syscall.inc b/rtl/bsd/i386/syscall.inc index 446074a15b..ecf8258b17 100644 --- a/rtl/bsd/i386/syscall.inc +++ b/rtl/bsd/i386/syscall.inc @@ -31,44 +31,43 @@ These functions are the same over all three BSDs, except that some have a {$DEFINE ErrnoWord} {$endif} +Procedure fpc_geteipasebx;[external name 'fpc_geteipasebx']; + procedure actualsyscall; assembler; {inline requires a dummy push IIRC} asm int $0x80 jb .LErrorcode ret .LErrorcode: -{$ifdef REGCALL} +{$ifdef FPC_PIC} + call fpc_geteipasebx + addl $_GLOBAL_OFFSET_TABLE_,%ebx + movl fpc_threadvar_relocate_proc@GOT(%ebx),%ecx + movl (%ecx),%ecx + movl Errno@GOT(%ebx),%edi +{$else FPC_PIC} + leal Errno,%edi movl fpc_threadvar_relocate_proc,%ecx +{$endif FPC_PIC} testl %ecx,%ecx jne .LThread - movl %eax,Errno+4 + {$ifdef ErrnoWord} + movw %ax,4(%edi) + {$else} + movl %eax,4(%edi) + {$endif} jmp .LNoThread .LThread: movl %eax,%ebx - movl Errno,%eax + movl (%edi),%eax call *%ecx - movl %ebx,(%eax) + {$ifdef ErrnoWord} + movw %bx,4(%eax) + {$else} + movl %ebx,4(%eax) + {$endif} .LNoThread: -{$else} - movl %eax,%edx - movl fpc_threadvar_relocate_proc,%eax - testl %eax,%eax - jne .LThread - movl %edx,Errno+4 - jmp .LNoThread -.LThread: - pushl %edx - pushl Errno - call *%eax - popl %edx - {$ifdef ErrnoWord} - movw %dx,(%eax) - {$else} - movl %edx,(%eax) - {$endif} -.LNoThread: -{$endif REGCALL} - mov $-1,%eax + movl $-1,%eax end; function FpSysCall(sysnr:TSysParam):TSysResult; oldfpccall; assembler; [public,alias:'FPC_DOSYS0']; diff --git a/rtl/freebsd/i386/cprt0.as b/rtl/freebsd/i386/cprt0.as index 43611ab158..ff7af4a531 100644 --- a/rtl/freebsd/i386/cprt0.as +++ b/rtl/freebsd/i386/cprt0.as @@ -32,15 +32,18 @@ abitag: .section .rodata.str1.1,"aMS",@progbits,1 .LC0: .string "" -.globl __progname .data .p2align 2 + .globl __progname .type __progname,@object .size __progname,4 __progname: .long .LC0 .text .p2align 2,,3 + .type __fpucw,@object + .size __fpucw,4 + .global __fpucw ___fpucw: .long 0x1332 .globl ___fpc_brk_addr /* heap management */ @@ -165,8 +168,25 @@ get_rtld_cleanup: .weak _DYNAMIC .ident "GCC: (GNU) 3.4.2 - FPC: 2.0.2" + .bss - .comm operatingsystem_parameter_envp,4 - .comm operatingsystem_parameter_argc,4 - .comm operatingsystem_parameter_argv,4 - + .type __stkptr,@object + .size __stkptr,4 + .global __stkptr +__stkptr: + .skip 4 + + .type operatingsystem_parameters,@object + .size operatingsystem_parameters,12 +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 + +//.section .threadvar,"aw",@nobits + .comm ___fpc_threadvar_offset,4 diff --git a/rtl/freebsd/i386/prt0.as b/rtl/freebsd/i386/prt0.as index 7b4ccb5295..7f5ea4b933 100644 --- a/rtl/freebsd/i386/prt0.as +++ b/rtl/freebsd/i386/prt0.as @@ -20,17 +20,20 @@ .file "prt1.as" .version "01.01" gcc2_compiled.: -.globl __progname .section .rodata .LC0: .ascii "\0" .data .p2align 2 + .globl __progname .type __progname,@object .size __progname,4 __progname: .long .LC0 .align 4 + .type __fpucw,@object + .size __fpucw,4 + .global __fpucw ___fpucw: .long 0x1332 @@ -40,7 +43,6 @@ ___fpucw: ___fpc_brk_addr: .long 0 - .text .p2align 2 .globl _start @@ -123,8 +125,25 @@ _actualsyscall: .weak _DYNAMIC .ident "GCC: (GNU) 2.7.2.1" + .bss - .comm operatingsystem_parameter_envp,4 - .comm operatingsystem_parameter_argc,4 - .comm operatingsystem_parameter_argv,4 - + .type __stkptr,@object + .size __stkptr,4 + .global __stkptr +__stkptr: + .skip 4 + + .type operatingsystem_parameters,@object + .size operatingsystem_parameters,12 +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 + +//.section .threadvar,"aw",@nobits + .comm ___fpc_threadvar_offset,4 diff --git a/rtl/freebsd/ptypes.inc b/rtl/freebsd/ptypes.inc index edc227aadf..0d731411e7 100644 --- a/rtl/freebsd/ptypes.inc +++ b/rtl/freebsd/ptypes.inc @@ -32,7 +32,11 @@ type TGid = gid_t; pGid = ^gid_t; - ino_t = clong; { used for file serial numbers } + {$ifdef CPU64} + ino_t = cuint32; { used for file serial numbers } + {$else} + ino_t = clong; { used for file serial numbers } + {$endif} TIno = ino_t; pIno = ^ino_t; @@ -148,9 +152,12 @@ type Const - MNAMLEN = 80; // slightly machine specific. - + MNAMLEN = 80; // slightly machine specific. + MFSNamLen = 16; type + fsid_t = array[0..1] of cint; + +// Kernel statfs TStatfs = packed record spare2, { place holder} @@ -161,13 +168,13 @@ type bavail, { block available for mortal users} files, { Total file nodes} ffree : clong ; { file nodes free} - fsid : array[0..1] of longint; // fsid_t + fsid : fsid_t; fowner : tuid; {mounter uid} ftype : cint; fflags : cint; {copy of mount flags} fsyncwrites, - fasyncwrites : cint; - fstypename : array[0..15] of char; + fasyncwrites : clong; + fstypename : array[0..MFSNamLen-1] of char; mountpoint : array[0..MNAMLEN-1] of char; fsyncreads, { count of sync reads since mount } fasyncreads : clong; @@ -183,7 +190,6 @@ type It_Value : TimeVal; end; - const _PTHREAD_MUTEX_DEFAULT = _PTHREAD_MUTEX_ERRORCHECK; _MUTEX_TYPE_FAST = _PTHREAD_MUTEX_NORMAL; @@ -193,14 +199,18 @@ const _PTHREAD_STACK_MIN = 1024; { System limits, POSIX value in parentheses, used for buffer and stack allocation } +{$ifdef CPU64} + ARG_MAX = 262144; {4096} { Maximum number of argument size } +{$else} ARG_MAX = 65536; {4096} { Maximum number of argument size } +{$endif} + NAME_MAX = 255; {14} { Maximum number of bytes in filename } PATH_MAX = 1024; {255} { Maximum number of bytes in pathname } - SYS_NMLN = 32; {BSD utsname struct limit, kernel mode} SIG_MAXSIG = 128; // highest signal version -// wordsinsigset = 4; // words in sigset_t +// wordsinsigset = 4; // words in sigset_t { For getting/setting priority } diff --git a/rtl/inc/heaptrc.pp b/rtl/inc/heaptrc.pp index b047c63740..56c33615a9 100644 --- a/rtl/inc/heaptrc.pp +++ b/rtl/inc/heaptrc.pp @@ -227,7 +227,7 @@ procedure call_stack(pp : pheap_mem_info;var ptext : text); var i : ptrint; begin - writeln(ptext,'Call trace for block $',hexstr(ptrint(pointer(pp)+sizeof(theap_mem_info)),8),' size ',pp^.size); + writeln(ptext,'Call trace for block $',hexstr(ptrint(pointer(pp)+sizeof(theap_mem_info)),2*sizeof(pointer)),' size ',pp^.size); for i:=1 to tracesize do if pp^.calls[i]<>nil then writeln(ptext,BackTraceStrFunc(pp^.calls[i])); @@ -243,7 +243,7 @@ procedure call_free_stack(pp : pheap_mem_info;var ptext : text); var i : ptrint; begin - writeln(ptext,'Call trace for block at $',hexstr(ptrint(pointer(pp)+sizeof(theap_mem_info)),8),' size ',pp^.size); + writeln(ptext,'Call trace for block at $',hexstr(ptrint(pointer(pp)+sizeof(theap_mem_info)),2*sizeof(pointer)),' size ',pp^.size); for i:=1 to tracesize div 2 do if pp^.calls[i]<>nil then writeln(ptext,BackTraceStrFunc(pp^.calls[i])); @@ -261,7 +261,7 @@ end; procedure dump_already_free(p : pheap_mem_info;var ptext : text); begin - Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),8),' released'); + Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),2*sizeof(pointer)),' released'); call_free_stack(p,ptext); Writeln(ptext,'freed again at'); dump_stack(ptext,get_caller_frame(get_frame)); @@ -269,7 +269,7 @@ end; procedure dump_error(p : pheap_mem_info;var ptext : text); begin - Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),8),' invalid'); + Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),2*sizeof(pointer)),' invalid'); Writeln(ptext,'Wrong signature $',hexstr(p^.sig,8),' instead of ',hexstr(calculate_sig(p),8)); dump_stack(ptext,get_caller_frame(get_frame)); end; @@ -279,20 +279,20 @@ procedure dump_change_after(p : pheap_mem_info;var ptext : text); var pp : pchar; i : ptrint; begin - Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),8),' invalid'); + Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),2*sizeof(pointer)),' invalid'); Writeln(ptext,'Wrong release CRC $',hexstr(p^.release_sig,8),' instead of ',hexstr(calculate_release_sig(p),8)); Writeln(ptext,'This memory was changed after call to freemem !'); call_free_stack(p,ptext); pp:=pointer(p)+sizeof(theap_mem_info); for i:=0 to p^.size-1 do if byte(pp[i])<>$F0 then - Writeln(ptext,'offset',i,':$',hexstr(i,8),'"',pp[i],'"'); + Writeln(ptext,'offset',i,':$',hexstr(i,2*sizeof(pointer)),'"',pp[i],'"'); end; {$endif EXTRA} procedure dump_wrong_size(p : pheap_mem_info;size : ptrint;var ptext : text); begin - Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),8),' invalid'); + Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),2*sizeof(pointer)),' invalid'); Writeln(ptext,'Wrong size : ',p^.size,' allocated ',size,' freed'); dump_stack(ptext,get_caller_frame(get_frame)); { the check is done to be sure that the procvar is not overwritten } @@ -869,7 +869,7 @@ begin goto _exit else begin - writeln(ptext^,'pointer $',hexstr(ptrint(p),8),' points into invalid memory block'); + writeln(ptext^,'pointer $',hexstr(ptrint(p),2*sizeof(pointer)),' points into invalid memory block'); dump_error(pp,ptext^); runerror(204); end; @@ -881,7 +881,7 @@ begin halt(1); end; end; - writeln(ptext^,'pointer $',hexstr(ptrint(p),8),' does not point to valid memory block'); + writeln(ptext^,'pointer $',hexstr(ptrint(p),2*sizeof(pointer)),' does not point to valid memory block'); runerror(204); _exit: end; diff --git a/rtl/inc/objpas.inc b/rtl/inc/objpas.inc index e24e1e361b..515ac3731a 100644 --- a/rtl/inc/objpas.inc +++ b/rtl/inc/objpas.inc @@ -713,11 +713,3 @@ ****************************************************************************} {$i except.inc} - -{**************************************************************************** - Initialize -****************************************************************************} - - - - diff --git a/rtl/unix/cwstring.pp b/rtl/unix/cwstring.pp index d460bbbdf7..93d0aeb988 100644 --- a/rtl/unix/cwstring.pp +++ b/rtl/unix/cwstring.pp @@ -26,7 +26,10 @@ implementation {$linklib c} {$ifndef linux} // Linux (and maybe glibc platforms in general), have iconv in glibc. -{$linklib iconv} +{$ifndef FreeBSD5} + {$linklib iconv} + {$define useiconv} +{$endif} {$endif linux} Uses @@ -38,7 +41,7 @@ Uses initc; Const -{$ifdef Linux} +{$ifndef useiconv} libiconvname='c'; // is in libc under Linux. {$else} libiconvname='iconv'; diff --git a/tests/test/tmaclocalprocparam.pp b/tests/test/tmaclocalprocparam.pp new file mode 100644 index 0000000000..65ec6e00a6 --- /dev/null +++ b/tests/test/tmaclocalprocparam.pp @@ -0,0 +1,43 @@ +program tmaclocalprocparam; +{$MODE MACPAS} + + var + failed: Boolean; + + + procedure Outside (procedure P); + begin + P; + end; + + procedure Global; + + var + nonlocalvar: integer; + + procedure Local; + begin + nonlocalvar := 42; + end; + + begin + nonlocalvar := 24; + Outside(Local); + failed := (nonlocalvar <> 42); + end; + + + +begin + Global; + + if failed then + writeln('Failed') + else + writeln('Succeded'); + + {$IFC UNDEFINED THINK_Pascal} + if failed then + Halt(1); + {$ENDC} +end. diff --git a/tests/test/tmacnonlocalexit.pp b/tests/test/tmacnonlocalexit.pp new file mode 100644 index 0000000000..c77b4038de --- /dev/null +++ b/tests/test/tmacnonlocalexit.pp @@ -0,0 +1,35 @@ +program tmacnonlocalexit; +{$MODE MACPAS} + + var + failed: Boolean; + + procedure Global; + + procedure Local; + begin + Exit(Global); + failed := true; + end; + + begin + Local; + failed := true; + end; + + +begin + failed := false; + + Global; + + if failed then + writeln('Failed') + else + writeln('Succeded'); + + {$IFC NOT UNDEFINED FPC} + if failed then + Halt(1); + {$ENDC} +end. diff --git a/tests/test/tmacnonlocalgoto.pp b/tests/test/tmacnonlocalgoto.pp new file mode 100644 index 0000000000..0c233bfdd8 --- /dev/null +++ b/tests/test/tmacnonlocalgoto.pp @@ -0,0 +1,38 @@ +program tmacnonlocalgoto; +{$MODE MACPAS} + + label + 1; + + var + failed: Boolean; + + procedure Global; + + procedure Local; + begin + goto 1; + failed := true; + end; + + begin + Local; + failed := true; + end; + + +begin + failed := false; + + Global; +1: + if failed then + writeln('Failed') + else + writeln('Succeded'); + + {$IFC NOT UNDEFINED FPC} + if failed then + Halt(1); + {$ENDC} +end.