+ source code page support

compiler/charset.pas

@@ -0,0 +1,266 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2000 by Florian Klaempfl
+    member of the Free Pascal development team.
+
+    This unit implements several classes for charset conversions
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+unit charset;
+
+  interface
+
+    type
+       tunicodechar = word;
+       tunicodestring = ^tunicodechar;
+
+       tcsconvert = class
+         // !!!!!!1constructor create;
+       end;
+
+       tunicodecharmappingflag = (umf_noinfo,umf_leadbyte,umf_undefined,
+         umf_unused);
+
+       punicodecharmapping = ^tunicodecharmapping;
+       tunicodecharmapping = record
+          unicode : tunicodechar;
+          flag : tunicodecharmappingflag;
+          reserved : byte;
+       end;
+
+       punicodemap = ^tunicodemap;
+       tunicodemap = record
+          cpname : string[20];
+          map : punicodecharmapping;
+          lastchar : longint;
+          next : punicodemap;
+          internalmap : boolean;
+       end;
+
+       tcp2unicode = class(tcsconvert)
+       end;
+
+    function loadunicodemapping(const cpname,f : string) : punicodemap;
+    procedure registermapping(p : punicodemap);
+    function getmap(const s : string) : punicodemap;
+    function mappingavailable(const s : string) : boolean;
+    function getunicode(c : char;p : punicodemap) : tunicodechar;
+    function getascii(c : tunicodechar;p : punicodemap) : string;
+
+  implementation
+
+    var
+       mappings : punicodemap;
+
+    function loadunicodemapping(const cpname,f : string) : punicodemap;
+
+      var
+         data : punicodecharmapping;
+         datasize : longint;
+         t : text;
+         s,hs : string;
+         scanpos,charpos,unicodevalue : longint;
+         code : word;
+         flag : tunicodecharmappingflag;
+         p : punicodemap;
+         lastchar : longint;
+
+      begin
+         lastchar:=-1;
+         loadunicodemapping:=nil;
+         datasize:=256;
+         getmem(data,sizeof(tunicodecharmapping)*datasize);
+         assign(t,f);
+         {$I-}
+         reset(t);
+         {$I+}
+         if ioresult<>0 then
+           begin
+              freemem(data,sizeof(tunicodecharmapping)*datasize);
+              exit;
+           end;
+         while not(eof(t)) do
+           begin
+              readln(t,s);
+              if (s[1]='0') and (s[2]='x') then
+                begin
+                   flag:=umf_unused;
+                   scanpos:=3;
+                   hs:='$';
+                   while s[scanpos] in ['0'..'9','A'..'F','a'..'f'] do
+                     begin
+                        hs:=hs+s[scanpos];
+                        inc(scanpos);
+                     end;
+                   val(hs,charpos,code);
+                   if code<>0 then
+                     begin
+                        freemem(data,sizeof(tunicodecharmapping)*datasize);
+                        close(t);
+                        exit;
+                     end;
+                   while not(s[scanpos] in ['0','#']) do
+                     inc(scanpos);
+                   if s[scanpos]='#' then
+                     begin
+                        { special char }
+                        unicodevalue:=$ffff;
+                        hs:=copy(s,scanpos,length(s)-scanpos+1);
+                        if hs='#DBCS LEAD BYTE' then
+                          flag:=umf_leadbyte;
+                     end
+                   else
+                     begin
+                        { C hex prefix }
+                        inc(scanpos,2);
+                        hs:='$';
+                        while s[scanpos] in ['0'..'9','A'..'F','a'..'f'] do
+                          begin
+                             hs:=hs+s[scanpos];
+                             inc(scanpos);
+                          end;
+                        val(hs,unicodevalue,code);
+                        if code<>0 then
+                          begin
+                             freemem(data,sizeof(tunicodecharmapping)*datasize);
+                             close(t);
+                             exit;
+                          end;
+                        if charpos>datasize then
+                          begin
+                             { allocate 1024 bytes more because         }
+                             { if we need more than 256 entries it's    }
+                             { probably a mbcs with a lot of            }
+                             { entries                                  }
+                             datasize:=charpos+1024;
+                             reallocmem(data,sizeof(tunicodecharmapping)*datasize);
+                          end;
+                        flag:=umf_noinfo;
+                     end;
+                   data[charpos].flag:=flag;
+                   data[charpos].unicode:=unicodevalue;
+                   if charpos>lastchar then
+                     lastchar:=charpos;
+                end;
+           end;
+         close(t);
+         new(p);
+         p^.lastchar:=lastchar;
+         p^.cpname:=cpname;
+         p^.internalmap:=false;
+         p^.next:=nil;
+         p^.map:=data;
+         loadunicodemapping:=p;
+      end;
+
+    procedure registermapping(p : punicodemap);
+
+      begin
+         p^.next:=mappings;
+         mappings:=p;
+      end;
+
+    function getmap(const s : string) : punicodemap;
+
+      var
+         hp : punicodemap;
+
+      const
+         mapcache : string = '';
+         mapcachep : punicodemap = nil;
+
+      begin
+         if (mapcache=s) and (mapcachep^.cpname=s) then
+           begin
+              getmap:=mapcachep;
+              exit;
+           end;
+         hp:=mappings;
+         while assigned(hp) do
+           begin
+              if hp^.cpname=s then
+                begin
+                   getmap:=hp;
+                   mapcache:=s;
+                   mapcachep:=hp;
+                   exit;
+                end;
+              hp:=hp^.next;
+           end;
+         getmap:=nil;
+      end;
+
+    function mappingavailable(const s : string) : boolean;
+
+      begin
+         mappingavailable:=getmap(s)<>nil;
+      end;
+
+    function getunicode(c : char;p : punicodemap) : tunicodechar;
+
+      begin
+         if ord(c)<=p^.lastchar then
+           getunicode:=p^.map[ord(c)].unicode
+         else
+           getunicode:=0;
+      end;
+
+    function getascii(c : tunicodechar;p : punicodemap) : string;
+
+      var
+         i : longint;
+
+      begin
+         { at least map to space }
+         getascii:=#32;
+         for i:=0 to p^.lastchar do
+           if p^.map[i].unicode=c then
+             begin
+                if i<256 then
+                  getascii:=chr(i)
+                else
+                  getascii:=chr(i div 256)+chr(i mod 256);
+                exit;
+             end;
+      end;
+
+  var
+     hp : punicodemap;
+
+initialization
+  mappings:=nil;
+finalization
+  while assigned(mappings) do
+    begin
+       hp:=mappings^.next;
+       if not(mappings^.internalmap) then
+         begin
+            freemem(mappings^.map);
+            dispose(mappings);
+         end;
+       mappings:=hp;
+    end;
+end.
+{
+  $Log$
+  Revision 1.1  2002-07-20 17:11:48  florian
+    + source code page support
+
+  Revision 1.2  2000/10/21 18:20:17  florian
+    * a lot of small changes:
+       - setlength is internal
+       - win32 graph unit extended
+       ....
+
+  Revision 1.1  2000/08/17 07:29:39  florian
+    + initial revision
+}

compiler/cp850.pas

@@ -0,0 +1,281 @@
+{ This is an automatically created file, so don't edit it }
+unit cp850;
+
+  interface
+
+  implementation
+
+  uses
+     charset;
+
+  const
+     map : array[0..255] of tunicodecharmapping = (
+       (unicode : 0; flag : umf_noinfo),
+       (unicode : 1; flag : umf_noinfo),
+       (unicode : 2; flag : umf_noinfo),
+       (unicode : 3; flag : umf_noinfo),
+       (unicode : 4; flag : umf_noinfo),
+       (unicode : 5; flag : umf_noinfo),
+       (unicode : 6; flag : umf_noinfo),
+       (unicode : 7; flag : umf_noinfo),
+       (unicode : 8; flag : umf_noinfo),
+       (unicode : 9; flag : umf_noinfo),
+       (unicode : 10; flag : umf_noinfo),
+       (unicode : 11; flag : umf_noinfo),
+       (unicode : 12; flag : umf_noinfo),
+       (unicode : 13; flag : umf_noinfo),
+       (unicode : 14; flag : umf_noinfo),
+       (unicode : 15; flag : umf_noinfo),
+       (unicode : 16; flag : umf_noinfo),
+       (unicode : 17; flag : umf_noinfo),
+       (unicode : 18; flag : umf_noinfo),
+       (unicode : 19; flag : umf_noinfo),
+       (unicode : 20; flag : umf_noinfo),
+       (unicode : 21; flag : umf_noinfo),
+       (unicode : 22; flag : umf_noinfo),
+       (unicode : 23; flag : umf_noinfo),
+       (unicode : 24; flag : umf_noinfo),
+       (unicode : 25; flag : umf_noinfo),
+       (unicode : 26; flag : umf_noinfo),
+       (unicode : 27; flag : umf_noinfo),
+       (unicode : 28; flag : umf_noinfo),
+       (unicode : 29; flag : umf_noinfo),
+       (unicode : 30; flag : umf_noinfo),
+       (unicode : 31; flag : umf_noinfo),
+       (unicode : 32; flag : umf_noinfo),
+       (unicode : 33; flag : umf_noinfo),
+       (unicode : 34; flag : umf_noinfo),
+       (unicode : 35; flag : umf_noinfo),
+       (unicode : 36; flag : umf_noinfo),
+       (unicode : 37; flag : umf_noinfo),
+       (unicode : 38; flag : umf_noinfo),
+       (unicode : 39; flag : umf_noinfo),
+       (unicode : 40; flag : umf_noinfo),
+       (unicode : 41; flag : umf_noinfo),
+       (unicode : 42; flag : umf_noinfo),
+       (unicode : 43; flag : umf_noinfo),
+       (unicode : 44; flag : umf_noinfo),
+       (unicode : 45; flag : umf_noinfo),
+       (unicode : 46; flag : umf_noinfo),
+       (unicode : 47; flag : umf_noinfo),
+       (unicode : 48; flag : umf_noinfo),
+       (unicode : 49; flag : umf_noinfo),
+       (unicode : 50; flag : umf_noinfo),
+       (unicode : 51; flag : umf_noinfo),
+       (unicode : 52; flag : umf_noinfo),
+       (unicode : 53; flag : umf_noinfo),
+       (unicode : 54; flag : umf_noinfo),
+       (unicode : 55; flag : umf_noinfo),
+       (unicode : 56; flag : umf_noinfo),
+       (unicode : 57; flag : umf_noinfo),
+       (unicode : 58; flag : umf_noinfo),
+       (unicode : 59; flag : umf_noinfo),
+       (unicode : 60; flag : umf_noinfo),
+       (unicode : 61; flag : umf_noinfo),
+       (unicode : 62; flag : umf_noinfo),
+       (unicode : 63; flag : umf_noinfo),
+       (unicode : 64; flag : umf_noinfo),
+       (unicode : 65; flag : umf_noinfo),
+       (unicode : 66; flag : umf_noinfo),
+       (unicode : 67; flag : umf_noinfo),
+       (unicode : 68; flag : umf_noinfo),
+       (unicode : 69; flag : umf_noinfo),
+       (unicode : 70; flag : umf_noinfo),
+       (unicode : 71; flag : umf_noinfo),
+       (unicode : 72; flag : umf_noinfo),
+       (unicode : 73; flag : umf_noinfo),
+       (unicode : 74; flag : umf_noinfo),
+       (unicode : 75; flag : umf_noinfo),
+       (unicode : 76; flag : umf_noinfo),
+       (unicode : 77; flag : umf_noinfo),
+       (unicode : 78; flag : umf_noinfo),
+       (unicode : 79; flag : umf_noinfo),
+       (unicode : 80; flag : umf_noinfo),
+       (unicode : 81; flag : umf_noinfo),
+       (unicode : 82; flag : umf_noinfo),
+       (unicode : 83; flag : umf_noinfo),
+       (unicode : 84; flag : umf_noinfo),
+       (unicode : 85; flag : umf_noinfo),
+       (unicode : 86; flag : umf_noinfo),
+       (unicode : 87; flag : umf_noinfo),
+       (unicode : 88; flag : umf_noinfo),
+       (unicode : 89; flag : umf_noinfo),
+       (unicode : 90; flag : umf_noinfo),
+       (unicode : 91; flag : umf_noinfo),
+       (unicode : 92; flag : umf_noinfo),
+       (unicode : 93; flag : umf_noinfo),
+       (unicode : 94; flag : umf_noinfo),
+       (unicode : 95; flag : umf_noinfo),
+       (unicode : 96; flag : umf_noinfo),
+       (unicode : 97; flag : umf_noinfo),
+       (unicode : 98; flag : umf_noinfo),
+       (unicode : 99; flag : umf_noinfo),
+       (unicode : 100; flag : umf_noinfo),
+       (unicode : 101; flag : umf_noinfo),
+       (unicode : 102; flag : umf_noinfo),
+       (unicode : 103; flag : umf_noinfo),
+       (unicode : 104; flag : umf_noinfo),
+       (unicode : 105; flag : umf_noinfo),
+       (unicode : 106; flag : umf_noinfo),
+       (unicode : 107; flag : umf_noinfo),
+       (unicode : 108; flag : umf_noinfo),
+       (unicode : 109; flag : umf_noinfo),
+       (unicode : 110; flag : umf_noinfo),
+       (unicode : 111; flag : umf_noinfo),
+       (unicode : 112; flag : umf_noinfo),
+       (unicode : 113; flag : umf_noinfo),
+       (unicode : 114; flag : umf_noinfo),
+       (unicode : 115; flag : umf_noinfo),
+       (unicode : 116; flag : umf_noinfo),
+       (unicode : 117; flag : umf_noinfo),
+       (unicode : 118; flag : umf_noinfo),
+       (unicode : 119; flag : umf_noinfo),
+       (unicode : 120; flag : umf_noinfo),
+       (unicode : 121; flag : umf_noinfo),
+       (unicode : 122; flag : umf_noinfo),
+       (unicode : 123; flag : umf_noinfo),
+       (unicode : 124; flag : umf_noinfo),
+       (unicode : 125; flag : umf_noinfo),
+       (unicode : 126; flag : umf_noinfo),
+       (unicode : 127; flag : umf_noinfo),
+       (unicode : 199; flag : umf_noinfo),
+       (unicode : 252; flag : umf_noinfo),
+       (unicode : 233; flag : umf_noinfo),
+       (unicode : 226; flag : umf_noinfo),
+       (unicode : 228; flag : umf_noinfo),
+       (unicode : 224; flag : umf_noinfo),
+       (unicode : 229; flag : umf_noinfo),
+       (unicode : 231; flag : umf_noinfo),
+       (unicode : 234; flag : umf_noinfo),
+       (unicode : 235; flag : umf_noinfo),
+       (unicode : 232; flag : umf_noinfo),
+       (unicode : 239; flag : umf_noinfo),
+       (unicode : 238; flag : umf_noinfo),
+       (unicode : 236; flag : umf_noinfo),
+       (unicode : 196; flag : umf_noinfo),
+       (unicode : 197; flag : umf_noinfo),
+       (unicode : 201; flag : umf_noinfo),
+       (unicode : 230; flag : umf_noinfo),
+       (unicode : 198; flag : umf_noinfo),
+       (unicode : 244; flag : umf_noinfo),
+       (unicode : 246; flag : umf_noinfo),
+       (unicode : 242; flag : umf_noinfo),
+       (unicode : 251; flag : umf_noinfo),
+       (unicode : 249; flag : umf_noinfo),
+       (unicode : 255; flag : umf_noinfo),
+       (unicode : 214; flag : umf_noinfo),
+       (unicode : 220; flag : umf_noinfo),
+       (unicode : 248; flag : umf_noinfo),
+       (unicode : 163; flag : umf_noinfo),
+       (unicode : 216; flag : umf_noinfo),
+       (unicode : 215; flag : umf_noinfo),
+       (unicode : 402; flag : umf_noinfo),
+       (unicode : 225; flag : umf_noinfo),
+       (unicode : 237; flag : umf_noinfo),
+       (unicode : 243; flag : umf_noinfo),
+       (unicode : 250; flag : umf_noinfo),
+       (unicode : 241; flag : umf_noinfo),
+       (unicode : 209; flag : umf_noinfo),
+       (unicode : 170; flag : umf_noinfo),
+       (unicode : 186; flag : umf_noinfo),
+       (unicode : 191; flag : umf_noinfo),
+       (unicode : 174; flag : umf_noinfo),
+       (unicode : 172; flag : umf_noinfo),
+       (unicode : 189; flag : umf_noinfo),
+       (unicode : 188; flag : umf_noinfo),
+       (unicode : 161; flag : umf_noinfo),
+       (unicode : 171; flag : umf_noinfo),
+       (unicode : 187; flag : umf_noinfo),
+       (unicode : 9617; flag : umf_noinfo),
+       (unicode : 9618; flag : umf_noinfo),
+       (unicode : 9619; flag : umf_noinfo),
+       (unicode : 9474; flag : umf_noinfo),
+       (unicode : 9508; flag : umf_noinfo),
+       (unicode : 193; flag : umf_noinfo),
+       (unicode : 194; flag : umf_noinfo),
+       (unicode : 192; flag : umf_noinfo),
+       (unicode : 169; flag : umf_noinfo),
+       (unicode : 9571; flag : umf_noinfo),
+       (unicode : 9553; flag : umf_noinfo),
+       (unicode : 9559; flag : umf_noinfo),
+       (unicode : 9565; flag : umf_noinfo),
+       (unicode : 162; flag : umf_noinfo),
+       (unicode : 165; flag : umf_noinfo),
+       (unicode : 9488; flag : umf_noinfo),
+       (unicode : 9492; flag : umf_noinfo),
+       (unicode : 9524; flag : umf_noinfo),
+       (unicode : 9516; flag : umf_noinfo),
+       (unicode : 9500; flag : umf_noinfo),
+       (unicode : 9472; flag : umf_noinfo),
+       (unicode : 9532; flag : umf_noinfo),
+       (unicode : 227; flag : umf_noinfo),
+       (unicode : 195; flag : umf_noinfo),
+       (unicode : 9562; flag : umf_noinfo),
+       (unicode : 9556; flag : umf_noinfo),
+       (unicode : 9577; flag : umf_noinfo),
+       (unicode : 9574; flag : umf_noinfo),
+       (unicode : 9568; flag : umf_noinfo),
+       (unicode : 9552; flag : umf_noinfo),
+       (unicode : 9580; flag : umf_noinfo),
+       (unicode : 164; flag : umf_noinfo),
+       (unicode : 240; flag : umf_noinfo),
+       (unicode : 208; flag : umf_noinfo),
+       (unicode : 202; flag : umf_noinfo),
+       (unicode : 203; flag : umf_noinfo),
+       (unicode : 200; flag : umf_noinfo),
+       (unicode : 305; flag : umf_noinfo),
+       (unicode : 205; flag : umf_noinfo),
+       (unicode : 206; flag : umf_noinfo),
+       (unicode : 207; flag : umf_noinfo),
+       (unicode : 9496; flag : umf_noinfo),
+       (unicode : 9484; flag : umf_noinfo),
+       (unicode : 9608; flag : umf_noinfo),
+       (unicode : 9604; flag : umf_noinfo),
+       (unicode : 166; flag : umf_noinfo),
+       (unicode : 204; flag : umf_noinfo),
+       (unicode : 9600; flag : umf_noinfo),
+       (unicode : 211; flag : umf_noinfo),
+       (unicode : 223; flag : umf_noinfo),
+       (unicode : 212; flag : umf_noinfo),
+       (unicode : 210; flag : umf_noinfo),
+       (unicode : 245; flag : umf_noinfo),
+       (unicode : 213; flag : umf_noinfo),
+       (unicode : 181; flag : umf_noinfo),
+       (unicode : 254; flag : umf_noinfo),
+       (unicode : 222; flag : umf_noinfo),
+       (unicode : 218; flag : umf_noinfo),
+       (unicode : 219; flag : umf_noinfo),
+       (unicode : 217; flag : umf_noinfo),
+       (unicode : 253; flag : umf_noinfo),
+       (unicode : 221; flag : umf_noinfo),
+       (unicode : 175; flag : umf_noinfo),
+       (unicode : 180; flag : umf_noinfo),
+       (unicode : 173; flag : umf_noinfo),
+       (unicode : 177; flag : umf_noinfo),
+       (unicode : 8215; flag : umf_noinfo),
+       (unicode : 190; flag : umf_noinfo),
+       (unicode : 182; flag : umf_noinfo),
+       (unicode : 167; flag : umf_noinfo),
+       (unicode : 247; flag : umf_noinfo),
+       (unicode : 184; flag : umf_noinfo),
+       (unicode : 176; flag : umf_noinfo),
+       (unicode : 168; flag : umf_noinfo),
+       (unicode : 183; flag : umf_noinfo),
+       (unicode : 185; flag : umf_noinfo),
+       (unicode : 179; flag : umf_noinfo),
+       (unicode : 178; flag : umf_noinfo),
+       (unicode : 9632; flag : umf_noinfo),
+       (unicode : 160; flag : umf_noinfo)
+     );
+
+     unicodemap : tunicodemap = (
+       cpname : 'cp850';
+       map : @map;
+       lastchar : 255;
+       next : nil;
+       internalmap : true
+     );
+
+  begin
+     registermapping(@unicodemap)
+  end.

compiler/cp8859_1.pas

@@ -0,0 +1,281 @@
+{ This is an automatically created file, so don't edit it }
+unit cp8859_1;
+
+  interface
+
+  implementation
+
+  uses
+     charset;
+
+  const
+     map : array[0..255] of tunicodecharmapping = (
+       (unicode : 0; flag : umf_noinfo),
+       (unicode : 1; flag : umf_noinfo),
+       (unicode : 2; flag : umf_noinfo),
+       (unicode : 3; flag : umf_noinfo),
+       (unicode : 4; flag : umf_noinfo),
+       (unicode : 5; flag : umf_noinfo),
+       (unicode : 6; flag : umf_noinfo),
+       (unicode : 7; flag : umf_noinfo),
+       (unicode : 8; flag : umf_noinfo),
+       (unicode : 9; flag : umf_noinfo),
+       (unicode : 10; flag : umf_noinfo),
+       (unicode : 11; flag : umf_noinfo),
+       (unicode : 12; flag : umf_noinfo),
+       (unicode : 13; flag : umf_noinfo),
+       (unicode : 14; flag : umf_noinfo),
+       (unicode : 15; flag : umf_noinfo),
+       (unicode : 16; flag : umf_noinfo),
+       (unicode : 17; flag : umf_noinfo),
+       (unicode : 18; flag : umf_noinfo),
+       (unicode : 19; flag : umf_noinfo),
+       (unicode : 20; flag : umf_noinfo),
+       (unicode : 21; flag : umf_noinfo),
+       (unicode : 22; flag : umf_noinfo),
+       (unicode : 23; flag : umf_noinfo),
+       (unicode : 24; flag : umf_noinfo),
+       (unicode : 25; flag : umf_noinfo),
+       (unicode : 26; flag : umf_noinfo),
+       (unicode : 27; flag : umf_noinfo),
+       (unicode : 28; flag : umf_noinfo),
+       (unicode : 29; flag : umf_noinfo),
+       (unicode : 30; flag : umf_noinfo),
+       (unicode : 31; flag : umf_noinfo),
+       (unicode : 32; flag : umf_noinfo),
+       (unicode : 33; flag : umf_noinfo),
+       (unicode : 34; flag : umf_noinfo),
+       (unicode : 35; flag : umf_noinfo),
+       (unicode : 36; flag : umf_noinfo),
+       (unicode : 37; flag : umf_noinfo),
+       (unicode : 38; flag : umf_noinfo),
+       (unicode : 39; flag : umf_noinfo),
+       (unicode : 40; flag : umf_noinfo),
+       (unicode : 41; flag : umf_noinfo),
+       (unicode : 42; flag : umf_noinfo),
+       (unicode : 43; flag : umf_noinfo),
+       (unicode : 44; flag : umf_noinfo),
+       (unicode : 45; flag : umf_noinfo),
+       (unicode : 46; flag : umf_noinfo),
+       (unicode : 47; flag : umf_noinfo),
+       (unicode : 48; flag : umf_noinfo),
+       (unicode : 49; flag : umf_noinfo),
+       (unicode : 50; flag : umf_noinfo),
+       (unicode : 51; flag : umf_noinfo),
+       (unicode : 52; flag : umf_noinfo),
+       (unicode : 53; flag : umf_noinfo),
+       (unicode : 54; flag : umf_noinfo),
+       (unicode : 55; flag : umf_noinfo),
+       (unicode : 56; flag : umf_noinfo),
+       (unicode : 57; flag : umf_noinfo),
+       (unicode : 58; flag : umf_noinfo),
+       (unicode : 59; flag : umf_noinfo),
+       (unicode : 60; flag : umf_noinfo),
+       (unicode : 61; flag : umf_noinfo),
+       (unicode : 62; flag : umf_noinfo),
+       (unicode : 63; flag : umf_noinfo),
+       (unicode : 64; flag : umf_noinfo),
+       (unicode : 65; flag : umf_noinfo),
+       (unicode : 66; flag : umf_noinfo),
+       (unicode : 67; flag : umf_noinfo),
+       (unicode : 68; flag : umf_noinfo),
+       (unicode : 69; flag : umf_noinfo),
+       (unicode : 70; flag : umf_noinfo),
+       (unicode : 71; flag : umf_noinfo),
+       (unicode : 72; flag : umf_noinfo),
+       (unicode : 73; flag : umf_noinfo),
+       (unicode : 74; flag : umf_noinfo),
+       (unicode : 75; flag : umf_noinfo),
+       (unicode : 76; flag : umf_noinfo),
+       (unicode : 77; flag : umf_noinfo),
+       (unicode : 78; flag : umf_noinfo),
+       (unicode : 79; flag : umf_noinfo),
+       (unicode : 80; flag : umf_noinfo),
+       (unicode : 81; flag : umf_noinfo),
+       (unicode : 82; flag : umf_noinfo),
+       (unicode : 83; flag : umf_noinfo),
+       (unicode : 84; flag : umf_noinfo),
+       (unicode : 85; flag : umf_noinfo),
+       (unicode : 86; flag : umf_noinfo),
+       (unicode : 87; flag : umf_noinfo),
+       (unicode : 88; flag : umf_noinfo),
+       (unicode : 89; flag : umf_noinfo),
+       (unicode : 90; flag : umf_noinfo),
+       (unicode : 91; flag : umf_noinfo),
+       (unicode : 92; flag : umf_noinfo),
+       (unicode : 93; flag : umf_noinfo),
+       (unicode : 94; flag : umf_noinfo),
+       (unicode : 95; flag : umf_noinfo),
+       (unicode : 96; flag : umf_noinfo),
+       (unicode : 97; flag : umf_noinfo),
+       (unicode : 98; flag : umf_noinfo),
+       (unicode : 99; flag : umf_noinfo),
+       (unicode : 100; flag : umf_noinfo),
+       (unicode : 101; flag : umf_noinfo),
+       (unicode : 102; flag : umf_noinfo),
+       (unicode : 103; flag : umf_noinfo),
+       (unicode : 104; flag : umf_noinfo),
+       (unicode : 105; flag : umf_noinfo),
+       (unicode : 106; flag : umf_noinfo),
+       (unicode : 107; flag : umf_noinfo),
+       (unicode : 108; flag : umf_noinfo),
+       (unicode : 109; flag : umf_noinfo),
+       (unicode : 110; flag : umf_noinfo),
+       (unicode : 111; flag : umf_noinfo),
+       (unicode : 112; flag : umf_noinfo),
+       (unicode : 113; flag : umf_noinfo),
+       (unicode : 114; flag : umf_noinfo),
+       (unicode : 115; flag : umf_noinfo),
+       (unicode : 116; flag : umf_noinfo),
+       (unicode : 117; flag : umf_noinfo),
+       (unicode : 118; flag : umf_noinfo),
+       (unicode : 119; flag : umf_noinfo),
+       (unicode : 120; flag : umf_noinfo),
+       (unicode : 121; flag : umf_noinfo),
+       (unicode : 122; flag : umf_noinfo),
+       (unicode : 123; flag : umf_noinfo),
+       (unicode : 124; flag : umf_noinfo),
+       (unicode : 125; flag : umf_noinfo),
+       (unicode : 126; flag : umf_noinfo),
+       (unicode : 127; flag : umf_noinfo),
+       (unicode : 128; flag : umf_noinfo),
+       (unicode : 129; flag : umf_noinfo),
+       (unicode : 130; flag : umf_noinfo),
+       (unicode : 131; flag : umf_noinfo),
+       (unicode : 132; flag : umf_noinfo),
+       (unicode : 133; flag : umf_noinfo),
+       (unicode : 134; flag : umf_noinfo),
+       (unicode : 135; flag : umf_noinfo),
+       (unicode : 136; flag : umf_noinfo),
+       (unicode : 137; flag : umf_noinfo),
+       (unicode : 138; flag : umf_noinfo),
+       (unicode : 139; flag : umf_noinfo),
+       (unicode : 140; flag : umf_noinfo),
+       (unicode : 141; flag : umf_noinfo),
+       (unicode : 142; flag : umf_noinfo),
+       (unicode : 143; flag : umf_noinfo),
+       (unicode : 144; flag : umf_noinfo),
+       (unicode : 145; flag : umf_noinfo),
+       (unicode : 146; flag : umf_noinfo),
+       (unicode : 147; flag : umf_noinfo),
+       (unicode : 148; flag : umf_noinfo),
+       (unicode : 149; flag : umf_noinfo),
+       (unicode : 150; flag : umf_noinfo),
+       (unicode : 151; flag : umf_noinfo),
+       (unicode : 152; flag : umf_noinfo),
+       (unicode : 153; flag : umf_noinfo),
+       (unicode : 154; flag : umf_noinfo),
+       (unicode : 155; flag : umf_noinfo),
+       (unicode : 156; flag : umf_noinfo),
+       (unicode : 157; flag : umf_noinfo),
+       (unicode : 158; flag : umf_noinfo),
+       (unicode : 159; flag : umf_noinfo),
+       (unicode : 160; flag : umf_noinfo),
+       (unicode : 161; flag : umf_noinfo),
+       (unicode : 162; flag : umf_noinfo),
+       (unicode : 163; flag : umf_noinfo),
+       (unicode : 164; flag : umf_noinfo),
+       (unicode : 165; flag : umf_noinfo),
+       (unicode : 166; flag : umf_noinfo),
+       (unicode : 167; flag : umf_noinfo),
+       (unicode : 168; flag : umf_noinfo),
+       (unicode : 169; flag : umf_noinfo),
+       (unicode : 170; flag : umf_noinfo),
+       (unicode : 171; flag : umf_noinfo),
+       (unicode : 172; flag : umf_noinfo),
+       (unicode : 173; flag : umf_noinfo),
+       (unicode : 174; flag : umf_noinfo),
+       (unicode : 175; flag : umf_noinfo),
+       (unicode : 176; flag : umf_noinfo),
+       (unicode : 177; flag : umf_noinfo),
+       (unicode : 178; flag : umf_noinfo),
+       (unicode : 179; flag : umf_noinfo),
+       (unicode : 180; flag : umf_noinfo),
+       (unicode : 181; flag : umf_noinfo),
+       (unicode : 182; flag : umf_noinfo),
+       (unicode : 183; flag : umf_noinfo),
+       (unicode : 184; flag : umf_noinfo),
+       (unicode : 185; flag : umf_noinfo),
+       (unicode : 186; flag : umf_noinfo),
+       (unicode : 187; flag : umf_noinfo),
+       (unicode : 188; flag : umf_noinfo),
+       (unicode : 189; flag : umf_noinfo),
+       (unicode : 190; flag : umf_noinfo),
+       (unicode : 191; flag : umf_noinfo),
+       (unicode : 192; flag : umf_noinfo),
+       (unicode : 193; flag : umf_noinfo),
+       (unicode : 194; flag : umf_noinfo),
+       (unicode : 195; flag : umf_noinfo),
+       (unicode : 196; flag : umf_noinfo),
+       (unicode : 197; flag : umf_noinfo),
+       (unicode : 198; flag : umf_noinfo),
+       (unicode : 199; flag : umf_noinfo),
+       (unicode : 200; flag : umf_noinfo),
+       (unicode : 201; flag : umf_noinfo),
+       (unicode : 202; flag : umf_noinfo),
+       (unicode : 203; flag : umf_noinfo),
+       (unicode : 204; flag : umf_noinfo),
+       (unicode : 205; flag : umf_noinfo),
+       (unicode : 206; flag : umf_noinfo),
+       (unicode : 207; flag : umf_noinfo),
+       (unicode : 208; flag : umf_noinfo),
+       (unicode : 209; flag : umf_noinfo),
+       (unicode : 210; flag : umf_noinfo),
+       (unicode : 211; flag : umf_noinfo),
+       (unicode : 212; flag : umf_noinfo),
+       (unicode : 213; flag : umf_noinfo),
+       (unicode : 214; flag : umf_noinfo),
+       (unicode : 215; flag : umf_noinfo),
+       (unicode : 216; flag : umf_noinfo),
+       (unicode : 217; flag : umf_noinfo),
+       (unicode : 218; flag : umf_noinfo),
+       (unicode : 219; flag : umf_noinfo),
+       (unicode : 220; flag : umf_noinfo),
+       (unicode : 221; flag : umf_noinfo),
+       (unicode : 222; flag : umf_noinfo),
+       (unicode : 223; flag : umf_noinfo),
+       (unicode : 224; flag : umf_noinfo),
+       (unicode : 225; flag : umf_noinfo),
+       (unicode : 226; flag : umf_noinfo),
+       (unicode : 227; flag : umf_noinfo),
+       (unicode : 228; flag : umf_noinfo),
+       (unicode : 229; flag : umf_noinfo),
+       (unicode : 230; flag : umf_noinfo),
+       (unicode : 231; flag : umf_noinfo),
+       (unicode : 232; flag : umf_noinfo),
+       (unicode : 233; flag : umf_noinfo),
+       (unicode : 234; flag : umf_noinfo),
+       (unicode : 235; flag : umf_noinfo),
+       (unicode : 236; flag : umf_noinfo),
+       (unicode : 237; flag : umf_noinfo),
+       (unicode : 238; flag : umf_noinfo),
+       (unicode : 239; flag : umf_noinfo),
+       (unicode : 240; flag : umf_noinfo),
+       (unicode : 241; flag : umf_noinfo),
+       (unicode : 242; flag : umf_noinfo),
+       (unicode : 243; flag : umf_noinfo),
+       (unicode : 244; flag : umf_noinfo),
+       (unicode : 245; flag : umf_noinfo),
+       (unicode : 246; flag : umf_noinfo),
+       (unicode : 247; flag : umf_noinfo),
+       (unicode : 248; flag : umf_noinfo),
+       (unicode : 249; flag : umf_noinfo),
+       (unicode : 250; flag : umf_noinfo),
+       (unicode : 251; flag : umf_noinfo),
+       (unicode : 252; flag : umf_noinfo),
+       (unicode : 253; flag : umf_noinfo),
+       (unicode : 254; flag : umf_noinfo),
+       (unicode : 255; flag : umf_noinfo)
+     );
+
+     unicodemap : tunicodemap = (
+       cpname : '8859-1';
+       map : @map;
+       lastchar : 255;
+       next : nil;
+       internalmap : true
+     );
+
+  begin
+     registermapping(@unicodemap)
+  end.

compiler/globals.pas

@@ -88,11 +88,12 @@ interface
          function  FindFile(const f : string;var foundfile:string):boolean;
        end;
 
+       tcodepagestring = string[20];
 
-   {# the ordinal type used when evaluating constant integer expressions }
-   TConstExprInt = int64;
-   { ... the same unsigned }
-   TConstExprUInt = {$ifdef fpc}qword{$else}int64{$endif};
+       { the ordinal type used when evaluating constant integer expressions }
+       TConstExprInt = int64;
+       { ... the same unsigned }
+       TConstExprUInt = {$ifdef fpc}qword{$else}int64{$endif};
 
     var
        { specified inputfile }
@@ -171,6 +172,7 @@ interface
        initinterfacetype  : tinterfacetypes;
        initoutputformat   : tasm;
        initdefproccall    : tproccalloption;
+       initsourcecodepage : tcodepagestring;
 
      { current state values }
        aktglobalswitches  : tglobalswitches;
@@ -191,6 +193,7 @@ interface
        aktinterfacetype   : tinterfacetypes;
        aktoutputformat    : tasm;
        aktdefproccall     : tproccalloption;
+       aktsourcecodepage : tcodepagestring;
 
      { Memory sizes }
        heapsize,
@@ -1419,6 +1422,7 @@ implementation
         initmodeswitches:=fpcmodeswitches;
         initlocalswitches:=[cs_check_io,cs_typed_const_writable];
         initmoduleswitches:=[cs_extsyntax,cs_browser];
+        initsourcecodepage:='8859-1';
         initglobalswitches:=[cs_check_unit_name,cs_link_static{$ifdef INTERNALLINKER},cs_link_internal,cs_link_map{$endif}];
         initoutputformat:=target_asm.id;
         fillchar(initalignment,sizeof(talignmentinfo),0);
@@ -1469,7 +1473,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.60  2002-07-01 18:46:22  peter
+  Revision 1.61  2002-07-20 17:12:42  florian
+    + source code page support
+
+  Revision 1.60  2002/07/01 18:46:22  peter
     * internal linker
     * reorganized aasm layer
 

compiler/msg/errore.msg

@@ -1849,6 +1849,7 @@ option_using_env=11027_T_Reading options from environment $1
 option_handling_option=11028_D_Handling option "$1"
 % Debug info that an option is found and will be handled
 option_help_press_enter=11029__*** press enter ***
+option_code_page_not_available=11030_E_Unknown code page
 %\end{description}
 # EndOfTeX
 

compiler/msgidx.inc

@@ -603,13 +603,14 @@ const
   option_using_env=11027;
   option_handling_option=11028;
   option_help_press_enter=11029;
+  option_code_page_not_available=11030;
   option_logo=11023;
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 34091;
+  MsgTxtSize = 34117;
 
   MsgIdxMax : array[1..20] of longint=(
     17,62,184,42,41,41,98,17,35,42,
-    30,1,1,1,1,1,1,1,1,1
+    31,1,1,1,1,1,1,1,1,1
   );

compiler/msgtxt.inc

@@ -657,7 +657,8 @@ const msgtxt : array[0..000142,1..240] of char=(
   '11027_T_Reading options from environment $1'#000+
   '11028_D_Handling option "$1"'#000+
   '11029__*** press enter ***'#000+
-  '11023_Free Pascal Compiler version $FPCVER [$FP','CDATE] for $FPCTARGET'+
+  '11030_E_Unknown code page'#000+
+  '11023_Free Pascal Com','piler version $FPCVER [$FPCDATE] for $FPCTARGET'+
   #010+
   'Copyright (c) 1993-2002 by Florian Klaempfl'#000+
   '11024_Free Pascal Compiler version $FPCVER'#010+
@@ -668,54 +669,54 @@ const msgtxt : array[0..000142,1..240] of char=(
   'Supported targets:'#010+
   '  $OSTARGETS'#010+
   #010+
-  'This program comes under the GNU General P','ublic Licence'#010+
+  'This program com','es under the GNU General Public Licence'#010+
   'For more information read COPYING.FPC'#010+
   #010+
   'Report bugs,suggestions etc to:'#010+
   '                 [email protected]'#000+
   '11025_**0*_put + after a boolean switch option to enable it, - to disa'+
   'ble it'#010+
-  '**1a_the compiler doesn'#039't delete the ge','nerated assembler file'#010+
+  '**1a_the comp','iler doesn'#039't delete the generated assembler file'#010+
   '**2al_list sourcecode lines in assembler file'#010+
   '**2ar_list register allocation/release info in assembler file'#010+
   '**2at_list temp allocation/release info in assembler file'#010+
-  '**1b_generate browser info'#010+
-  '**2bl_generate local sym','bol info'#010+
+  '**1b_generate browser inf','o'#010+
+  '**2bl_generate local symbol info'#010+
   '**1B_build all modules'#010+
   '**1C<x>_code generation options:'#010+
   '**2CD_create also dynamic library (not supported)'#010+
   '**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#010+
   '**2Ci_IO-checking'#010+
   '**2Cn_omit linking stage'#010+
-  '**2Co_check overflow of intege','r operations'#010+
+  '**2C','o_check overflow of integer operations'#010+
   '**2Cr_range checking'#010+
   '**2CR_verify object method call validity'#010+
   '**2Cs<n>_set stack size to <n>'#010+
   '**2Ct_stack checking'#010+
   '**2CX_create also smartlinked library'#010+
   '**1d<x>_defines the symbol <x>'#010+
-  '*O1D_generate a DEF file'#010+
-  '*O2Dd<x>_set descri','ption to <x>'#010+
+  '*O1D_generate a DE','F file'#010+
+  '*O2Dd<x>_set description to <x>'#010+
   '*O2Dw_PM application'#010+
   '**1e<x>_set path to executable'#010+
   '**1E_same as -Cn'#010+
   '**1F<x>_set file names and paths:'#010+
   '**2FD<x>_sets the directory where to search for compiler utilities'#010+
-  '**2Fe<x>_redirect error output to <x>'#010+
-  '**2FE<x>_set exe/un','it output path to <x>'#010+
+  '**2Fe<x>_redirect error output ','to <x>'#010+
+  '**2FE<x>_set exe/unit output path to <x>'#010+
   '**2Fi<x>_adds <x> to include path'#010+
   '**2Fl<x>_adds <x> to library path'#010+
   '*L2FL<x>_uses <x> as dynamic linker'#010+
   '**2Fo<x>_adds <x> to object path'#010+
   '**2Fr<x>_load error message file <x>'#010+
-  '**2Fu<x>_adds <x> to unit path'#010+
-  '**2FU<x>_set ','unit output path to <x>, overrides -FE'#010+
+  '**2Fu<x>_adds <x> ','to unit path'#010+
+  '**2FU<x>_set unit output path to <x>, overrides -FE'#010+
   '*g1g_generate debugger information:'#010+
   '*g2gg_use gsym'#010+
   '*g2gd_use dbx'#010+
   '*g2gh_use heap trace unit (for memory leak debugging)'#010+
-  '*g2gl_use line info unit to show more info for backtraces'#010+
-  '*g2gc_generate checks fo','r pointers'#010+
+  '*g2gl_use line info unit to show more info for backtrace','s'#010+
+  '*g2gc_generate checks for pointers'#010+
   '**1i_information'#010+
   '**2iD_return compiler date'#010+
   '**2iV_return compiler version'#010+
@@ -723,108 +724,108 @@ const msgtxt : array[0..000142,1..240] of char=(
   '**2iSP_return compiler processor'#010+
   '**2iTO_return target OS'#010+
   '**2iTP_return target processor'#010+
-  '**1I<x>_adds <x> to include path'#010+
-  '**1k<x>_','Pass <x> to the linker'#010+
+  '**1I<x>_adds <x','> to include path'#010+
+  '**1k<x>_Pass <x> to the linker'#010+
   '**1l_write logo'#010+
   '**1n_don'#039't read the default config file'#010+
   '**1o<x>_change the name of the executable produced to <x>'#010+
   '**1pg_generate profile code for gprof (defines FPC_PROFILE)'#010+
-  '*L1P_use pipes instead of creating temporar','y assembler files'#010+
+  '*L1P_use pipes in','stead of creating temporary assembler files'#010+
   '**1S<x>_syntax options:'#010+
   '**2S2_switch some Delphi 2 extensions on'#010+
   '**2Sc_supports operators like C (*=,+=,/= and -=)'#010+
   '**2Sa_include assertion code.'#010+
   '**2Sd_tries to be Delphi compatible'#010+
-  '**2Se<x>_compiler stops after the <x> err','ors (default is 1)'#010+
+  '**2Se<x>_compil','er stops after the <x> errors (default is 1)'#010+
   '**2Sg_allow LABEL and GOTO'#010+
   '**2Sh_Use ansistrings'#010+
   '**2Si_support C++ styled INLINE'#010+
   '**2Sm_support macros like C (global)'#010+
   '**2So_tries to be TP/BP 7.0 compatible'#010+
   '**2Sp_tries to be gpc compatible'#010+
-  '**2Ss_constructor name must be ','init (destructor must be done)'#010+
+  '**2Ss','_constructor name must be init (destructor must be done)'#010+
   '**2St_allow static keyword in objects'#010+
   '**1s_don'#039't call assembler and linker (only with -a)'#010+
   '**2st_Generate script to link on target'#010+
   '**2sh_Generate script to link on host'#010+
-  '**1u<x>_undefines the symbol <x>'#010+
-  '**1U_uni','t options:'#010+
+  '**1u<x>_undefin','es the symbol <x>'#010+
+  '**1U_unit options:'#010+
   '**2Un_don'#039't check the unit name'#010+
   '**2Ur_generate release unit files'#010+
   '**2Us_compile a system unit'#010+
   '**1v<x>_Be verbose. <x> is a combination of the following letters:'#010+
-  '**2*_e : Show errors (default)       d : Show debug info'#010+
-  '**2*_w : Sh','ow warnings               u : Show unit info'#010+
+  '**2*_e : Show errors (default)       d : S','how debug info'#010+
+  '**2*_w : Show warnings               u : Show unit info'#010+
   '**2*_n : Show notes                  t : Show tried/used files'#010+
   '**2*_h : Show hints                  m : Show defined macros'#010+
-  '**2*_i : Show general info           p : Show compiled procedures'#010+
-  '**2*_','l : Show linenumbers            c : Show conditionals'#010+
+  '**2*_i : Show general info           p : Show',' compiled procedures'#010+
+  '**2*_l : Show linenumbers            c : Show conditionals'#010+
   '**2*_a : Show everything             0 : Show nothing (except errors)'#010+
   '**2*_b : Show all procedure          r : Rhide/GCC compatibility mode'#010+
-  '**2*_    declarations if an error    x : Execu','table info (Win32 only'+
+  '**2*_    declaration','s if an error    x : Executable info (Win32 only'+
   ')'#010+
   '**2*_    occurs'#010+
   '**1X_executable options:'#010+
   '*L2Xc_link with the c library'#010+
   '**2Xs_strip all symbols from executable'#010+
   '**2XD_try to link dynamic          (defines FPC_LINK_DYNAMIC)'#010+
-  '**2XS_try to link static (default) (defines',' FPC_LINK_STATIC)'#010+
+  '**2XS_try to link',' static (default) (defines FPC_LINK_STATIC)'#010+
   '**2XX_try to link smart            (defines FPC_LINK_SMART)'#010+
   '**0*_Processor specific options:'#010+
   '3*1A<x>_output format:'#010+
   '3*2Aas_assemble using GNU AS'#010+
-  '3*2Aasaout_assemble using GNU AS for aout (Go32v1)'#010+
-  '3*2Anasmcoff_coff (Go32v2)',' file using Nasm'#010+
+  '3*2Aasaout_assemble using GNU AS for aout (Go32v1)'#010,
+  '3*2Anasmcoff_coff (Go32v2) file using Nasm'#010+
   '3*2Anasmelf_elf32 (Linux) file using Nasm'#010+
   '3*2Anasmobj_obj file using Nasm'#010+
   '3*2Amasm_obj file using Masm (Microsoft)'#010+
   '3*2Atasm_obj file using Tasm (Borland)'#010+
-  '3*2Acoff_coff (Go32v2) using internal writer'#010+
-  '3*2Apecoff_pecoff (Win32',') using internal writer'#010+
+  '3*2Acoff_coff (Go32v2) using internal write','r'#010+
+  '3*2Apecoff_pecoff (Win32) using internal writer'#010+
   '3*1R<x>_assembler reading style:'#010+
   '3*2Ratt_read AT&T style assembler'#010+
   '3*2Rintel_read Intel style assembler'#010+
   '3*2Rdirect_copy assembler text directly to assembler file'#010+
   '3*1O<x>_optimizations:'#010+
-  '3*2Og_generate smaller code'#010+
-  '3*2','OG_generate faster code (default)'#010+
+  '3*2Og','_generate smaller code'#010+
+  '3*2OG_generate faster code (default)'#010+
   '3*2Or_keep certain variables in registers'#010+
   '3*2Ou_enable uncertain optimizations (see docs)'#010+
   '3*2O1_level 1 optimizations (quick optimizations)'#010+
-  '3*2O2_level 2 optimizations (-O1 + slower optimizations)'#010+
-  '3*2O3_lev','el 3 optimizations (-O2 repeatedly, max 5 times)'#010+
+  '3*2O2_level 2 optimizations (-O1 + slowe','r optimizations)'#010+
+  '3*2O3_level 3 optimizations (-O2 repeatedly, max 5 times)'#010+
   '3*2Op<x>_target processor:'#010+
   '3*3Op1_set target processor to 386/486'#010+
   '3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#010+
-  '3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#010+
-  '3*1T<x>_Target o','perating system:'#010+
+  '3*3Op3_set target processor to PPro/PII/c6x8','6/K6 (tm)'#010+
+  '3*1T<x>_Target operating system:'#010+
   '3*2TGO32V2_version 2 of DJ Delorie DOS extender'#010+
   '3*2TWDOSX DOS 32 Bit Extender'#010+
   '3*2TLINUX_Linux'#010+
   '3*2Tnetware_Novell Netware Module (experimental)'#010+
   '3*2TOS2_OS/2 2.x'#010+
   '3*2TSUNOS_SunOS/Solaris'#010+
-  '3*2TWin32_Windows 32 Bit'#010+
-  '3*1W<x>_Win32 ','target options'#010+
+  '3*2TWin32_Win','dows 32 Bit'#010+
+  '3*1W<x>_Win32 target options'#010+
   '3*2WB<x>_Set Image base to Hexadecimal <x> value'#010+
   '3*2WC_Specify console type application'#010+
   '3*2WD_Use DEFFILE to export functions of DLL or EXE'#010+
   '3*2WF_Specify full-screen type application (OS/2 only)'#010+
-  '3*2WG_Specify graphic type app','lication'#010+
+  '3*2W','G_Specify graphic type application'#010+
   '3*2WN_Do not generate relocation code (necessary for debugging)'#010+
   '3*2WR_Generate relocation code'#010+
   '6*1A<x>_output format'#010+
   '6*2Aas_Unix o-file using GNU AS'#010+
   '6*2Agas_GNU Motorola assembler'#010+
-  '6*2Amit_MIT Syntax (old GAS)'#010+
-  '6*2Amot_Standard Motor','ola assembler'#010+
+  '6*2Amit_MIT Syntax (old G','AS)'#010+
+  '6*2Amot_Standard Motorola assembler'#010+
   '6*1O_optimizations:'#010+
   '6*2Oa_turn on the optimizer'#010+
   '6*2Og_generate smaller code'#010+
   '6*2OG_generate faster code (default)'#010+
   '6*2Ox_optimize maximum (still BUGGY!!!)'#010+
   '6*2O2_set target processor to a MC68020+'#010+
-  '6*1R<x>_assembler reading style:',#010+
+  '6*1R<x','>_assembler reading style:'#010+
   '6*2RMOT_read motorola style assembler'#010+
   '6*1T<x>_Target operating system:'#010+
   '6*2TAMIGA_Commodore Amiga'#010+
@@ -833,6 +834,6 @@ const msgtxt : array[0..000142,1..240] of char=(
   '6*2TLINUX_Linux-68k'#010+
   '6*2TPALMOS_PalmOS'#010+
   '**1*_'#010+
-  '**1?_shows this help'#010+
-  '**1h_shows this help witho','ut waiting'#000
+  '**1?_shows this help'#010,
+  '**1h_shows this help without waiting'#000
 );

compiler/ncnv.pas

@@ -1191,7 +1191,10 @@ implementation
           end;
 
         { ordinal contants can be directly converted }
-        if (left.nodetype=ordconstn) and is_ordinal(resulttype.def)  then
+        if (left.nodetype=ordconstn) and is_ordinal(resulttype.def) and
+        { but not char to char because it is a widechar to char or via versa }
+        { which needs extra code to do the code page transistion             }
+          not(convtype=tc_char_2_char) then
           begin
              { replace the resulttype and recheck the range }
              left.resulttype:=resulttype;
@@ -1755,7 +1758,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.60  2002-07-20 11:57:54  florian
+  Revision 1.61  2002-07-20 17:16:02  florian
+    + source code page support
+
+  Revision 1.60  2002/07/20 11:57:54  florian
     * types.pas renamed to defbase.pas because D6 contains a types
       unit so this would conflicts if D6 programms are compiled
     + Willamette/SSE2 instructions to assembler added

compiler/options.pas

@@ -69,6 +69,7 @@ procedure read_arguments(cmd:string);
 implementation
 
 uses
+  widestr,
 {$ifdef Delphi}
   dmisc,
 {$else Delphi}
@@ -558,6 +559,12 @@ begin
                       Delete(more,1,1);
                       DefaultReplacements(More);
                       case c of
+                       'c' : begin
+                                if not(cpavailable(more)) then
+                                  Message1(option_code_page_not_available,more)
+                                else
+                                  initsourcecodepage:=more;
+                             end;
                        'D' : utilsdirectory:=FixPath(More,true);
                        'e' : SetRedirectFile(More);
                        'E' : OutputExeDir:=FixPath(More,true);
@@ -1670,7 +1677,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.76  2002-07-04 20:43:01  florian
+  Revision 1.77  2002-07-20 17:16:03  florian
+    + source code page support
+
+  Revision 1.76  2002/07/04 20:43:01  florian
     * first x86-64 patches
 
   Revision 1.75  2002/07/01 18:46:24  peter
@@ -1734,4 +1744,4 @@ end.
   Revision 1.65  2002/04/04 18:39:45  carl
   + added wdosx support (patch from Pavel)
 
-}
+}

compiler/parser.pas

@@ -82,6 +82,8 @@ implementation
          { global switches }
          aktglobalswitches:=initglobalswitches;
 
+         aktsourcecodepage:=initsourcecodepage;
+
          { initialize scanner }
          InitScanner;
          InitScannerDirectives;
@@ -277,6 +279,7 @@ implementation
          oldaktmodeswitches : tmodeswitches;
          old_compiled_module : tmodule;
          oldaktdefproccall : tproccalloption;
+         oldsourcecodepage : tcodepagestring;
 {        will only be increased once we start parsing blocks in the }
 {         implementation, so doesn't need to be saved/restored (JM) }
 {          oldexceptblockcounter  : integer;                        }
@@ -315,6 +318,7 @@ implementation
          old_block_type:=block_type;
          oldtokenpos:=akttokenpos;
          oldcurrent_scanner:=current_scanner;
+         oldsourcecodepage:=aktsourcecodepage;
        { save cg }
          oldnextlabelnr:=nextlabelnr;
          oldparse_only:=parse_only;
@@ -542,6 +546,7 @@ implementation
               aktprocsym:=oldaktprocsym;
               aktprocdef:=oldaktprocdef;
               move(oldoverloaded_operators,overloaded_operators,sizeof(toverloaded_operators));
+              aktsourcecodepage:=oldsourcecodepage;
               aktlocalswitches:=oldaktlocalswitches;
               aktmoduleswitches:=oldaktmoduleswitches;
               aktalignment:=oldaktalignment;
@@ -630,7 +635,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.34  2002-07-01 18:46:24  peter
+  Revision 1.35  2002-07-20 17:16:03  florian
+    + source code page support
+
+  Revision 1.34  2002/07/01 18:46:24  peter
     * internal linker
     * reorganized aasm layer
 

compiler/scandir.pas

@@ -33,7 +33,7 @@ implementation
 
     uses
       cutils,
-      globtype,globals,systems,
+      globtype,globals,systems,widestr,
       verbose,comphook,
       scanner,switches,
       fmodule;
@@ -839,6 +839,24 @@ implementation
       begin
       end;
 
+    procedure dir_codepage;
+      var
+         s : string;
+      begin
+        if not current_module.in_global then
+          Message(scan_w_switch_is_global)
+        else
+          begin
+             current_scanner.skipspace;
+             s:=current_scanner.readcomment;
+             if not(cpavailable(s)) then
+               Message1(option_code_page_not_available,s)
+             else
+               aktsourcecodepage:=s;
+          end;
+      end;
+
+
 {****************************************************************************
                          Initialize Directives
 ****************************************************************************}
@@ -855,6 +873,7 @@ implementation
         AddDirective('ASSERTIONS',{$ifdef FPCPROCVAR}@{$endif}dir_assertions);
         AddDirective('BOOLEVAL',{$ifdef FPCPROCVAR}@{$endif}dir_booleval);
         AddDirective('CALLING',{$ifdef FPCPROCVAR}@{$endif}dir_calling);
+        AddDirective('CODEPAGE',{$ifdef FPCPROCVAR}@{$endif}dir_codepage);
         AddDirective('COPYRIGHT',{$ifdef FPCPROCVAR}@{$endif}dir_copyright);
         AddDirective('D',{$ifdef FPCPROCVAR}@{$endif}dir_description);
         AddDirective('DEBUGINFO',{$ifdef FPCPROCVAR}@{$endif}dir_debuginfo);
@@ -929,7 +948,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.16  2002-07-16 15:37:58  florian
+  Revision 1.17  2002-07-20 17:16:03  florian
+    + source code page support
+
+  Revision 1.16  2002/07/16 15:37:58  florian
     + Directive $EXTERNALSYM added, it is ignored for now
 
   Revision 1.15  2002/05/18 13:34:17  peter

compiler/widestr.pas

@@ -26,9 +26,9 @@ unit widestr;
 
   interface
 
-{    uses
+    uses
        charset;
-}
+
 
     type
        tcompilerwidechar = word;
@@ -44,32 +44,31 @@ unit widestr;
        pcompilerwidestring = ^_tcompilerwidestring;
        _tcompilerwidestring = record
           data : pcompilerwidechar;
-          maxlen,len : longint;
+          maxlen,len : StrLenInt;
        end;
 
     procedure initwidestring(var r : pcompilerwidestring);
     procedure donewidestring(var r : pcompilerwidestring);
-    procedure setlengthwidestring(r : pcompilerwidestring;l : longint);
-    function getlengthwidestring(r : pcompilerwidestring) : longint;
+    procedure setlengthwidestring(r : pcompilerwidestring;l : StrLenInt);
+    function getlengthwidestring(r : pcompilerwidestring) : StrLenInt;
     procedure concatwidestringchar(r : pcompilerwidestring;c : tcompilerwidechar);
     procedure concatwidestrings(s1,s2 : pcompilerwidestring);
-    function comparewidestrings(s1,s2 : pcompilerwidestring) : longint;
+    function comparewidestrings(s1,s2 : pcompilerwidestring) : StrLenInt;
     procedure copywidestring(s,d : pcompilerwidestring);
     function asciichar2unicode(c : char) : tcompilerwidechar;
     function unicode2asciichar(c : tcompilerwidechar) : char;
-    procedure ascii2unicode(p:pchar; l:longint;r : pcompilerwidestring);
-    procedure unicode2ascii(r : pcompilerwidestring;p:pchar);
-    function getcharwidestring(r : pcompilerwidestring;l : longint) : tcompilerwidechar;
+    procedure ascii2unicode(p : pchar;l : StrLenInt;r : pcompilerwidestring);
+    procedure unicode2ascii(r : pcompilerwidestring;p : pchar);
+    function getcharwidestring(r : pcompilerwidestring;l : StrLenInt) : tcompilerwidechar;
     function cpavailable(const s : string) : boolean;
 
   implementation
 
-{    uses
-       i8869_1,cp850,cp437; }
-
     uses
+       cp8859_1,cp850,cp437,
        globals;
 
+
     procedure initwidestring(var r : pcompilerwidestring);
 
       begin
@@ -88,19 +87,19 @@ unit widestr;
          r:=nil;
       end;
 
-    function getcharwidestring(r : pcompilerwidestring;l : longint) : tcompilerwidechar;
+    function getcharwidestring(r : pcompilerwidestring;l : StrLenInt) : tcompilerwidechar;
 
       begin
          getcharwidestring:=r^.data[l];
       end;
 
-    function getlengthwidestring(r : pcompilerwidestring) : longint;
+    function getlengthwidestring(r : pcompilerwidestring) : StrLenInt;
 
       begin
          getlengthwidestring:=r^.len;
       end;
 
-    procedure setlengthwidestring(r : pcompilerwidestring;l : longint);
+    procedure setlengthwidestring(r : pcompilerwidestring;l : StrLenInt);
 
       begin
          if r^.maxlen>=l then
@@ -127,13 +126,6 @@ unit widestr;
          move(s2^.data^,s1^.data[s1^.len],s2^.len*sizeof(tcompilerwidechar));
       end;
 
-    function comparewidestringwidestring(s1,s2 : pcompilerwidestring) : longint;
-
-      begin
-        {$ifdef fpc}{$warning todo}{$endif}
-        comparewidestringwidestring:=0;
-      end;
-
     procedure copywidestring(s,d : pcompilerwidestring);
 
       begin
@@ -142,27 +134,32 @@ unit widestr;
          move(s^.data^,d^.data^,s^.len*sizeof(tcompilerwidechar));
       end;
 
-    function comparewidestrings(s1,s2 : pcompilerwidestring) : longint;
-
+    function comparewidestrings(s1,s2 : pcompilerwidestring) : StrLenInt;
+      var
+         maxi,temp : StrLenInt;
       begin
-         {!!!!!! FIXME }
-         comparewidestrings:=0;
+         if pointer(s1)=pointer(s2) then
+           begin
+              comparewidestrings:=0;
+              exit;
+           end;
+         maxi:=s1^.len;
+         temp:=s2^.len;
+         if maxi>temp then
+           maxi:=Temp;
+         temp:=compareword(s1^.data^,s2^.data^,maxi);
+         if temp=0 then
+           temp:=s1^.len-s2^.len;
+         comparewidestrings:=temp;
       end;
 
     function asciichar2unicode(c : char) : tcompilerwidechar;
-{!!!!!!!!
       var
          m : punicodemap;
-
       begin
          m:=getmap(aktsourcecodepage);
          asciichar2unicode:=getunicode(c,m);
       end;
-}
-      begin
-        {$ifdef fpc}{$warning todo}{$endif}
-        asciichar2unicode:=0;
-      end;
 
     function unicode2asciichar(c : tcompilerwidechar) : char;
 
@@ -171,42 +168,25 @@ unit widestr;
         unicode2asciichar:=#0;
       end;
 
-    procedure ascii2unicode(p:pchar; l:longint;r : pcompilerwidestring);
-(*
+    procedure ascii2unicode(p : pchar;l : StrLenInt;r : pcompilerwidestring);
       var
-         m : punicodemap;
-         i : longint;
-
+         source : pchar;
+         dest   : tcompilerwidecharptr;
+         i      : StrLenInt;
+         m      : punicodemap;
       begin
          m:=getmap(aktsourcecodepage);
-         { should be a very good estimation :) }
-         setlengthwidestring(r,length(s));
-         // !!!! MBCS
-         for i:=1 to length(s) do
+         setlengthwidestring(r,l);
+         source:=p;
+         r^.len:=l;
+         dest:=tcompilerwidecharptr(r^.data);
+         for i:=1 to l do
            begin
+              dest^:=getunicode(source^,m);
+              inc(dest);
+              inc(source);
            end;
       end;
-*)
-      var
-        source : pchar;
-        dest   : tcompilerwidecharptr;
-        i      : longint;
-      begin
-        setlengthwidestring(r,l);
-        source:=p;
-        r^.len:=l;
-        dest:=tcompilerwidecharptr(r^.data);
-        for i:=1 to l do
-         begin
-           if byte(source^)<128 then
-            dest^:=tcompilerwidechar(byte(source^))
-           else
-            dest^:=32;
-           inc(dest);
-           inc(source);
-         end;
-      end;
-
 
     procedure unicode2ascii(r : pcompilerwidestring;p:pchar);
 (*
@@ -244,20 +224,17 @@ unit widestr;
 
 
     function cpavailable(const s : string) : boolean;
-{!!!!!!
       begin
           cpavailable:=mappingavailable(s);
       end;
-}
-
-      begin
-        cpavailable:=false;
-      end;
 
 end.
 {
   $Log$
-  Revision 1.10  2002-05-18 13:34:21  peter
+  Revision 1.11  2002-07-20 17:16:03  florian
+    + source code page support
+
+  Revision 1.10  2002/05/18 13:34:21  peter
     * readded missing revisions
 
   Revision 1.9  2002/05/16 19:46:47  carl
@@ -265,5 +242,4 @@ end.
   + try to fix temp allocation (still in ifdef)
   + generic constructor calls
   + start of tassembler / tmodulebase class cleanup
-
 }