Merged revisions 10408,10702,10704,10726-10727,10750 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r10408 | jonas | 2008-03-01 14:26:14 +0100 (Sat, 01 Mar 2008) | 2 lines

  * fixed external declaration of FPCMacOSXGraphMain

........
r10702 | jonas | 2008-04-18 18:07:34 +0200 (Fri, 18 Apr 2008) | 2 lines

  * don't run, it's a unit

........
r10704 | jonas | 2008-04-18 18:56:44 +0200 (Fri, 18 Apr 2008) | 3 lines

  * return an empty string for paramstr(value>paramcount) (already correct
    for other targets, mantis #11169)

........
r10726 | jonas | 2008-04-19 23:54:48 +0200 (Sat, 19 Apr 2008) | 3 lines

  * fixed opcode decoding after r10418 ("shortint and $80" now becomes
    a byte instead of remaining a shortint) + fixed (harmless) range error

........
r10727 | jonas | 2008-04-19 23:58:23 +0200 (Sat, 19 Apr 2008) | 3 lines

  + add support for different modes on startup instead of only one
    hardcoded one

........
r10750 | jonas | 2008-04-21 16:42:53 +0200 (Mon, 21 Apr 2008) | 2 lines

  * fixed md2/md4/md5 for big endian systems (mdtest now passes on ppc)

........

git-svn-id: branches/fixes_2_2@10776 -

.gitattributes

@@ -7939,6 +7939,7 @@ tests/webtbs/tw11006.pp svneol=native#text/plain
 tests/webtbs/tw1103.pp svneol=native#text/plain
 tests/webtbs/tw1104.pp svneol=native#text/plain
 tests/webtbs/tw1111.pp svneol=native#text/plain
+tests/webtbs/tw11169.pp svneol=native#text/plain
 tests/webtbs/tw1117.pp svneol=native#text/plain
 tests/webtbs/tw1122.pp svneol=native#text/plain
 tests/webtbs/tw1123.pp svneol=native#text/plain

packages/graph/src/inc/gtext.inc

@@ -203,7 +203,7 @@ end;
        b1:=shortint(byte1);
        b2:=shortint(byte2);
        { Decode the CHR OPCODE }
-       Decode:=smallint(((b1 and $80) shr 6)+((b2 and $80) shr 7));
+       Decode:=byte((shortint(b1 and $80) shr 6)+(shortint(b2 and $80) shr 7));
        { Now get the X,Y coordinates        }
        { bit 0..7 only which are considered }
        { signed values.                     }

packages/graph/src/macosx/graph.pp

@@ -933,15 +933,82 @@ begin
 end;
 
 
+   procedure qaddmode(modenr,xres,yres,colors: longint);
+   var
+     mode: TModeInfo;
+   begin
+     InitMode(Mode);
+     With Mode do
+       begin
+         ModeNumber := modenr;
+         ModeName := ModeNames[modenr];
+         // Always pretend we are VGA.
+         DriverNumber := VGA;
+         // MaxX is number of pixels in X direction - 1
+         MaxX := xres-1;
+         // same for MaxY
+         MaxY := yres-1;
+         YAspect := 10000;
+         XAspect := 10000;
+         MaxColor := colors;
+         PaletteSize := MaxColor;
+         directcolor := colors>256;
+         HardwarePages := 0;
+         // necessary hooks ...
+         DirectPutPixel := @q_DirectPixelProc;
+         GetPixel       := @q_GetPixelProc;
+         PutPixel       := @q_PutPixelProc;
+         { May be implemented later: }
+         HLine          := @q_HLineProc;
+         VLine          := @q_VLineProc;
+  {           GetScanLine    := @q_GetScanLineProc;}
+         ClearViewPort  := @q_ClrViewProc;
+         SetRGBPalette  := @q_SetRGBPaletteProc;
+         GetRGBPalette  := @q_GetRGBPaletteProc;
+         { These are not really implemented yet:
+         PutImage       := @q_PutImageProc;
+         GetImage       := @q_GetImageProc;}
+  {          If you use the default getimage/putimage, you also need the default
+         imagesize! (JM)
+          ImageSize      := @q_ImageSizeProc; }
+         { Add later maybe ?
+         SetVisualPage  := SetVisualPageProc;
+         SetActivePage  := SetActivePageProc; }
+         Line           := @q_LineProc;
+  {
+         InternalEllipse:= @q_EllipseProc;
+         PatternLine    := @q_PatternLineProc;
+         }
+         InitMode       := @SendInitGraph;
+       end;
+     AddMode(Mode);
+   end;
+
+
+  function toval(const s: string): size_t;
+    var
+      err: longint;
+    begin
+      val(s,toval,err);
+      if (err<>0) then
+        begin
+          writeln('Error decoding mode: ',s,' ',err);
+          runerror(218);
+        end;
+    end;
+
+
   function QueryAdapterInfo:PModeInfo;
   { This routine returns the head pointer to the list }
   { of supported graphics modes.                      }
   { Returns nil if no graphics mode supported.        }
   { This list is READ ONLY!                           }
    var
-    mode: TModeInfo;
-    i : longint;
-
+     colorstr: string;
+     i, hpos, cpos : longint;
+     xres, yres, colors,
+     dispxres, dispyres: longint;
+     dispcolors: int64;
    begin
      QueryAdapterInfo := ModeList;
      { If the mode listing already exists... }
@@ -949,64 +1016,45 @@ end;
      { anything...                           }
      if assigned(ModeList) then
        exit;
+     dispxres:=CGDisplayPixelsWide(kCGDirectMainDisplay);
+     { adjust for the menu bar and window title height }
+     { (the latter approximated to the same as the menu bar) }
+     dispyres:=CGDisplayPixelsHigh(kCGDirectMainDisplay)-GetMBarHeight*2;
+     dispcolors:=int64(1) shl CGDisplayBitsPerPixel(kCGDirectMainDisplay);
      SaveVideoState:=@q_savevideostate;
      RestoreVideoState:=@q_restorevideostate;
-//     For I:=0 to GLastMode do
-     i := 10;
+     for i := 1 to GLASTMODE do
        begin
-         begin
-         InitMode(Mode);
-         With Mode do
-           begin
-           ModeNumber:=I;
-           ModeName:=ModeNames[i];
-           // Always pretend we are VGA.
-           DriverNumber := VGA;
-           // MaxX is number of pixels in X direction - 1
-           MaxX:=640-1;
-           // same for MaxY
-           MaxY:=480-1;
-           YAspect:=10000;
-           if ((MaxX+1)*35=(MaxY+1)*64) then
-             XAspect:=7750
-           else if ((MaxX+1)*20=(MaxY+1)*64) then
-             XAspect:=4500
-           else if ((MaxX+1)*40=(MaxY+1)*64) then
-             XAspect:=8333
-           else { assume 4:3 }
-             XAspect:=10000;
-           MaxColor := 256;
-           PaletteSize := MaxColor;
-           HardwarePages := 0;
-           // necessary hooks ...
-           DirectPutPixel := @q_DirectPixelProc;
-           GetPixel       := @q_GetPixelProc;
-           PutPixel       := @q_PutPixelProc;
-           { May be implemented later: }
-           HLine          := @q_HLineProc;
-           VLine          := @q_VLineProc;
-{           GetScanLine    := @q_GetScanLineProc;}
-           ClearViewPort  := @q_ClrViewProc;
-           SetRGBPalette  := @q_SetRGBPaletteProc;
-           GetRGBPalette  := @q_GetRGBPaletteProc;
-           { These are not really implemented yet:
-           PutImage       := @q_PutImageProc;
-           GetImage       := @q_GetImageProc;}
-{          If you use the default getimage/putimage, you also need the default
-           imagesize! (JM)
-            ImageSize      := @q_ImageSizeProc; }
-           { Add later maybe ?
-           SetVisualPage  := SetVisualPageProc;
-           SetActivePage  := SetActivePageProc; }
-           Line           := @q_LineProc;
+         { get the mode info from the names }
+         hpos:=2;
+         while modenames[i][hpos]<>'x' do
+           inc(hpos);
+         inc(hpos);
+         cpos:=hpos;
+         while modenames[i][cpos]<>'x' do
+           inc(cpos);
+         inc(cpos);
+         xres:=toval(copy(modenames[i],2,hpos-3));
+         yres:=toval(copy(modenames[i],hpos,cpos-hpos-1));
+         colorstr:=copy(modenames[i],cpos,255);
+         if (colorstr='16') then
+           colors:=16
+         else if (colorstr='256') then
+           colors:=256
 {
-           InternalEllipse:= @q_EllipseProc;
-           PatternLine    := @q_PatternLineProc;
-           }
-           InitMode       := @SendInitGraph;
-           end;
-         AddMode(Mode);
-         end;
+         These don't work very well 
+         else if (colorstr='32K') then
+           colors:=32768
+         else if (colorstr='64K') then
+           colors:=65536
+}
+         else 
+//           1/24/32 bit not supported
+           continue;
+         if (xres <= dispxres) and
+            (yres <= dispyres) and
+            (colors <= dispcolors) then
+           qaddmode(i,xres,yres,colors);
        end;
    end;
 
@@ -1063,7 +1111,7 @@ type
     envp: ppchar;
   end;
 
-procedure FPCMacOSXGraphMain(argcpara: cint; argvpara, envppara: ppchar); external name '_FPCMacOSXGraphMain';
+procedure FPCMacOSXGraphMain(argcpara: cint; argvpara, envppara: ppchar); cdecl; external;
 
 function wrapper(p: pointer): pointer; cdecl;
   var

packages/hash/src/md5.pp

@@ -448,7 +448,11 @@ end;
 
 procedure MDFinal(var Context: TMDContext; var Digest: TMDDigest);
 const
+{$ifdef FPC_BIG_ENDIAN}
+  PADDING_MD45: array[0..15] of Cardinal = ($80000000,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
+{$else FPC_BIG_ENDIAN}
   PADDING_MD45: array[0..15] of Cardinal = ($80,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
+{$endif FPC_BIG_ENDIAN}
 var
   Length: QWord;
   Pads: Cardinal;
@@ -468,7 +472,7 @@ begin
         MDUpdate(Context, PADDING_MD45, Pads);
 
         // 3. Append length of the stream
-        Invert(@Length, @Length, 8);
+        Length := NtoLE(Length);
         MDUpdate(Context, Length, 8);
 
         // 4. Invert state to digest
@@ -478,7 +482,7 @@ begin
     MD_VERSION_2:
       begin
         Pads := 16 - Context.BufCnt;
-        Length := Pads;
+        Length := NtoLE(QWord(Pads));
         while Pads > 0 do
         begin
           MDUpdate(Context, Length, 1);

rtl/beos/system.pp

@@ -272,11 +272,12 @@ begin
   begin
     paramstr := execpathstr;
   end
-  else
+  else if (l < argc) then
   begin
-    paramstr := '';
     paramstr:=strpas(argv[l]);
-  end;
+  end
+  else
+    paramstr := '';
 end;
 
 Procedure Randomize;

rtl/bsd/system.pp

@@ -103,7 +103,10 @@ function paramstr(l: longint) : string;
 //       paramstr := execpathstr;
 //     end
 //   else
-     paramstr:=strpas(argv[l]);
+     if (l < argc) then
+       paramstr:=strpas(argv[l])
+     else
+       paramstr:='';
  end;
 
 Procedure Randomize;

rtl/linux/system.pp

@@ -132,8 +132,10 @@ function paramstr(l: longint) : string;
      begin
        paramstr := execpathstr;
      end
+   else if (l < argc) then
+     paramstr:=strpas(argv[l])
    else
-     paramstr:=strpas(argv[l]);
+     paramstr:='';
  end;
 
 Procedure Randomize;

rtl/solaris/system.pp

@@ -83,7 +83,10 @@ function paramstr(l: longint) : string;
 //       paramstr := execpathstr;
 //     end
 //   else
-     paramstr:=strpas(argv[l]);
+     if (l < argc) then
+       paramstr:=strpas(argv[l])
+     else
+       paramstr:='';
  end;
 
 Procedure Randomize;

tests/webtbs/tw10210.pp

@@ -1,3 +1,5 @@
+{ %norun }
+
 unit tw10210;
 {$mode objfpc}
 interface

tests/webtbs/tw11169.pp

@@ -0,0 +1,7 @@
+var
+  l: longint;
+begin
+  for l:=1 to 255 do
+    if paramstr(l) <> '' then
+      halt(1);
+end.