paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 09:59:08 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ source code page support

Browse Source
This commit is contained in:
florian 2002-07-20 17:11:48 +00:00
parent 576001f95b
commit 4f7b35be5b
13 changed files with 990 additions and 130 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

266
compiler/charset.pas Normal file
View File

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

0
compiler/cp337.pas → compiler/cp437.pas
View File

281
compiler/cp850.pas Normal file
View File

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

281
compiler/cp8859_1.pas Normal file
View File

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

17
compiler/globals.pas
View File

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

1
compiler/msg/errore.msg
View File

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

5
compiler/msgidx.inc
View File

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

91
compiler/msgtxt.inc
View File

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

10
compiler/ncnv.pas
View File

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

14
compiler/options.pas
View File

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

10
compiler/parser.pas
View File

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

26
compiler/scandir.pas
View File

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

118
compiler/widestr.pas
View File

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