diff --git a/compiler/charset.pas b/compiler/charset.pas new file mode 100644 index 0000000000..65a21acb14 --- /dev/null +++ b/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 +} diff --git a/compiler/cp337.pas b/compiler/cp437.pas similarity index 100% rename from compiler/cp337.pas rename to compiler/cp437.pas diff --git a/compiler/cp850.pas b/compiler/cp850.pas new file mode 100644 index 0000000000..e7b2d69e92 --- /dev/null +++ b/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. diff --git a/compiler/cp8859_1.pas b/compiler/cp8859_1.pas new file mode 100644 index 0000000000..b8c8534f39 --- /dev/null +++ b/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. diff --git a/compiler/globals.pas b/compiler/globals.pas index 7de2bead17..d0b0ccb89d 100644 --- a/compiler/globals.pas +++ b/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 diff --git a/compiler/msg/errore.msg b/compiler/msg/errore.msg index 1547b0626a..deec5b0664 100644 --- a/compiler/msg/errore.msg +++ b/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 diff --git a/compiler/msgidx.inc b/compiler/msgidx.inc index 3b72d0e974..fabb34d6e1 100644 --- a/compiler/msgidx.inc +++ b/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 ); diff --git a/compiler/msgtxt.inc b/compiler/msgtxt.inc index 8a04a35514..d21840971b 100644 --- a/compiler/msgtxt.inc +++ b/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+ ' bugrep@freepascal.org'#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_code generation options:'#010+ '**2CD_create also dynamic library (not supported)'#010+ '**2Ch_ 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_set stack size to '#010+ '**2Ct_stack checking'#010+ '**2CX_create also smartlinked library'#010+ '**1d_defines the symbol '#010+ - '*O1D_generate a DEF file'#010+ - '*O2Dd_set descri','ption to '#010+ + '*O1D_generate a DE','F file'#010+ + '*O2Dd_set description to '#010+ '*O2Dw_PM application'#010+ '**1e_set path to executable'#010+ '**1E_same as -Cn'#010+ '**1F_set file names and paths:'#010+ '**2FD_sets the directory where to search for compiler utilities'#010+ - '**2Fe_redirect error output to '#010+ - '**2FE_set exe/un','it output path to '#010+ + '**2Fe_redirect error output ','to '#010+ + '**2FE_set exe/unit output path to '#010+ '**2Fi_adds to include path'#010+ '**2Fl_adds to library path'#010+ '*L2FL_uses as dynamic linker'#010+ '**2Fo_adds to object path'#010+ '**2Fr_load error message file '#010+ - '**2Fu_adds to unit path'#010+ - '**2FU_set ','unit output path to , overrides -FE'#010+ + '**2Fu_adds ','to unit path'#010+ + '**2FU_set unit output path to , 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_adds to include path'#010+ - '**1k_','Pass to the linker'#010+ + '**1I_adds to include path'#010+ + '**1k_Pass to the linker'#010+ '**1l_write logo'#010+ '**1n_don'#039't read the default config file'#010+ '**1o_change the name of the executable produced to '#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_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_compiler stops after the err','ors (default is 1)'#010+ + '**2Se_compil','er stops after the 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_undefines the symbol '#010+ - '**1U_uni','t options:'#010+ + '**1u_undefin','es the symbol '#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_Be verbose. 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_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_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_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_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_Target o','perating system:'#010+ + '3*3Op3_set target processor to PPro/PII/c6x8','6/K6 (tm)'#010+ + '3*1T_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_Win32 ','target options'#010+ + '3*2TWin32_Win','dows 32 Bit'#010+ + '3*1W_Win32 target options'#010+ '3*2WB_Set Image base to Hexadecimal 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_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_assembler reading style:',#010+ + '6*1R_assembler reading style:'#010+ '6*2RMOT_read motorola style assembler'#010+ '6*1T_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 ); diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas index 7be6da66a4..c1cb7616df 100644 --- a/compiler/ncnv.pas +++ b/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 diff --git a/compiler/options.pas b/compiler/options.pas index b9a0d5d39d..7604c48d5d 100644 --- a/compiler/options.pas +++ b/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) -} \ No newline at end of file +} diff --git a/compiler/parser.pas b/compiler/parser.pas index 6878eba813..8575a5c42b 100644 --- a/compiler/parser.pas +++ b/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 diff --git a/compiler/scandir.pas b/compiler/scandir.pas index 23f1f806b9..5f41c9df61 100644 --- a/compiler/scandir.pas +++ b/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 diff --git a/compiler/widestr.pas b/compiler/widestr.pas index e2aaf0d1b0..feba9c364b 100644 --- a/compiler/widestr.pas +++ b/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 - }