Merged revisions 2282,2290,2292-2295,2297,2299,2302,2304 via svnmerge from

http://[email protected]/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

@@ -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

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 : '';
           );

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 );

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)
-.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}
+ {$ifdef ErrnoWord}
+  movw   %bx,4(%eax)
+ {$else}
+  movl  %ebx,4(%eax)
+ {$endif}
 .LNoThread:
-{$endif REGCALL}
-  mov $-1,%eax
+  movl  $-1,%eax
 end;
 
 function FpSysCall(sysnr:TSysParam):TSysResult; oldfpccall; assembler; [public,alias:'FPC_DOSYS0'];

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

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

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 }

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;

rtl/inc/objpas.inc

@@ -713,11 +713,3 @@
 ****************************************************************************}
 
 {$i except.inc}
-
-{****************************************************************************
-                                Initialize
-****************************************************************************}
-
-
-
-

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';

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.

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.

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.