Apple-2gs-SW
/
ORCA-C
mirror of https://github.com/byteworksinc/ORCA-C.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Add initial support for universal character names. 

This currently only works in character constants or strings, not identifiers.
This commit is contained in:
Stephen Heumann 2020-01-19 22:00:05 -06:00
parent 6f46078108
commit d24dacf01a
6 changed files with 198 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
Charset.pas Normal file
View File

@ -0,0 +1,95 @@
{$optimize 7}
{---------------------------------------------------------------}
{ }
{ Character set handling routines }
{ }
{ This module handles different character sets and performs }
{ conversions between them. }
{ }
{ Externally available procedures: }
{ }
{ ConvertMacRomanToUCS - convert MacRoman character to UCS }
{ ConvertUCSToMacRoman - convert UCS character to MacRoman }
{ }
{---------------------------------------------------------------}
unit Charset;
{$LibPrefix '0/obj/'}
interface
{$segment 'SCANNER'}
uses CCommon, Table;
const
maxUCSCodePoint = $10ffff;
type
ucsCodePoint = 0..maxUCSCodePoint;
function ConvertMacRomanToUCS(ch: char): ucsCodePoint;
{ convert a character from MacRoman charset to UCS (Unicode) }
{ }
{ Returns UCS code point value for the character. }
function ConvertUCSToMacRoman(ch: ucsCodePoint): integer;
{ convert a character from UCS (Unicode) to MacRoman charset }
{ }
{ Returns ordinal value of the character, or -1 if it can't be }
{ converted. }
implementation
function ConvertMacRomanToUCS{(ch: char): ucsCodePoint};
{ convert a character from MacRoman charset to UCS (Unicode) }
{ }
{ Returns UCS code point value for the character. }
begin {ConvertMacRomanToUCS}
if ord(ch) < $80 then
ConvertMacRomanToUCS := ord(ch)
else if ord(ch) <= $ff then
ConvertMacRomanToUCS := ord4(macRomanToUCS[ord(ch)]) & $0000ffff
else
ConvertMacRomanToUCS := $00fffd; {invalid input => REPLACEMENT CHARACTER}
end; {ConvertMacRomanToUCS}
function ConvertUCSToMacRoman{(ch: ucsCodePoint): integer};
{ convert a character from UCS (Unicode) to MacRoman charset }
{ }
{ Returns ordinal value of the character, or -1 if it can't be }
{ converted. }
label 1;
var
i: $80..$ff; {loop index}
ch16bit: integer; {16-bit version of ch (maybe negative)}
begin {ConvertUCSToMacRoman}
if ch < $80 then
ConvertUCSToMacRoman := ord(ch)
else begin
if ch <= $00ffff then begin
ch16bit := ord(ch);
for i := $80 to $ff do begin
if macRomanToUCS[i] = ch16Bit then begin
ConvertUCSToMacRoman := i;
goto 1;
end {if}
end; {for}
end; {if}
ConvertUCSToMacRoman := -1;
end; {else}
1:
end; {ConvertUCSToMacRoman}
end.

70
Scanner.pas
View File

@ -29,7 +29,7 @@ interface
{$LibPrefix '0/obj/'}
uses CCommon, Table, CGI, MM;
uses CCommon, Table, CGI, MM, Charset;
{$segment 'SCANNER'}
@ -666,6 +666,8 @@ if list or (numErr <> 0) then begin
142: msg := @'_Alignas may not be used in this declaration or type name';
143: msg := @'only object pointer types may be restrict-qualified';
144: msg := @'generic selection expressions are not supported by ORCA/C';
145: msg := @'invalid universal character name';
146: msg := @'Unicode character cannot be represented in execution character set';
otherwise: Error(57);
end; {case}
writeln(msg^);
@ -3309,6 +3311,57 @@ if scanWork then {make sure we read all characters}
end; {DoNumber}
function UniversalCharacterName : ucsCodePoint;
{ Scan a universal character name. }
{ The current character should be the 'u' or 'U'. }
{ }
{ Returns the code point value of the UCN. }
var
digits: integer; {number of hex digits (4 or 8)}
codePoint: longint; {the code point specified by this UCN}
dig: 0..15; {value of a hex digit}
begin {UniversalCharacterName}
codePoint := 0;
if ch = 'u' then
digits := 4
else {if ch = 'U' then}
digits := 8;
NextCh;
while digits > 0 do begin
if ch in ['0'..'9','a'..'f','A'..'F'] then begin
if ch in ['0'..'9'] then
dig := ord(ch) & $0F
else begin
ch := chr(ord(ch)&$5F);
dig := ord(ch)-ord('A')+10;
end; {else}
codePoint := (codePoint << 4) | dig;
NextCh;
digits := digits - 1;
end {while}
else begin
Error(145);
codePoint := ord('$');
digits := 0;
end; {else}
end; {while}
if (codePoint < 0) or (codePoint > maxUCSCodePoint)
or ((codePoint >= $00D800) and (codePoint <= $00DFFF))
or ((codePoint < $A0) and not (ord(codePoint) in [$24,$40,$60]))
then begin
Error(145);
UniversalCharacterName := ord('$');
end {if}
else
UniversalCharacterName := codePoint;
end; {UniversalCharacterName}
procedure InitScanner {start, end: ptr};
{ initialize the scanner }
@ -3790,12 +3843,14 @@ var
dig: 0..15; {value of a hex digit}
skipChar: boolean; {get next char when done?}
val: 0..4095; {hex escape code value (scaled to 0..255)}
codePoint: ucsCodePoint; {code point given by UCN}
chFromUCN: integer; {character given by UCN (converted)}
begin {EscapeCh}
1: skipChar := true;
if ch = '\' then begin
NextCh;
if ch in ['0'..'7','a','b','t','n','v','f','p','r','x'] then
if ch in ['0'..'7','a','b','t','n','v','f','p','r','x','u','U'] then
case ch of
'0','1','2','3','4','5','6','7': begin
val := 0;
@ -3835,6 +3890,17 @@ var
skipChar := false;
EscapeCh := val & $FF;
end;
'u','U': begin
codePoint := UniversalCharacterName;
chFromUCN := ConvertUCSToMacRoman(codePoint);
skipChar := false;
if chFromUCN >= 0 then
EscapeCh := chFromUCN
else begin
EscapeCh := 0;
Error(146);
end; {else}
end;
otherwise: Error(57);
end {case}
else

19
Table.asm
View File

@ -913,3 +913,22 @@ wordHash start reserved word hash table
dc i'pascalsy,pascalsy,pascalsy,pascalsy,registersy,registersy'
dc i'shortsy,typedefsy,unionsy,voidsy,whilesy,succwhilesy'
end
macRomanToUCS start
dc i2'$00C4, $00C5, $00C7, $00C9, $00D1, $00D6, $00DC, $00E1'
dc i2'$00E0, $00E2, $00E4, $00E3, $00E5, $00E7, $00E9, $00E8'
dc i2'$00EA, $00EB, $00ED, $00EC, $00EE, $00EF, $00F1, $00F3'
dc i2'$00F2, $00F4, $00F6, $00F5, $00FA, $00F9, $00FB, $00FC'
dc i2'$2020, $00B0, $00A2, $00A3, $00A7, $2022, $00B6, $00DF'
dc i2'$00AE, $00A9, $2122, $00B4, $00A8, $2260, $00C6, $00D8'
dc i2'$221E, $00B1, $2264, $2265, $00A5, $00B5, $2202, $2211'
dc i2'$220F, $03C0, $222B, $00AA, $00BA, $03A9, $00E6, $00F8'
dc i2'$00BF, $00A1, $00AC, $221A, $0192, $2248, $2206, $00AB'
dc i2'$00BB, $2026, $00A0, $00C0, $00C3, $00D5, $0152, $0153'
dc i2'$2013, $2014, $201C, $201D, $2018, $2019, $00F7, $25CA'
dc i2'$00FF, $0178, $2044, $00A4, $2039, $203A, $FB01, $FB02'
dc i2'$2021, $00B7, $201A, $201E, $2030, $00C2, $00CA, $00C1'
dc i2'$00CB, $00C8, $00CD, $00CE, $00CF, $00CC, $00D3, $00D4'
dc i2'$F8FF, $00D2, $00DA, $00DB, $00D9, $0131, $02C6, $02DC'
dc i2'$00AF, $02D8, $02D9, $02DA, $00B8, $02DD, $02DB, $02C7'
end

3
Table.pas
View File

@ -38,6 +38,9 @@ var
icp: array[tokenEnum] of byte; {in-commong priorities}
isp: array[tokenEnum] of byte; {in-stack priorities}
{from Charset.pas}
{----------------}
macRomanToUCS: array[$80..$FF] of integer; {mapping from MacRoman charset to UCS}
implementation
end.

1
linkit
View File

@ -15,5 +15,6 @@ obj/dag
obj/gen
obj/header
obj/printf
obj/charset
keep=16/cc

15
make
View File

@ -43,6 +43,7 @@ if {#} == 0
set gen gen
set header header
set printf printf
set charset charset
end
Newer obj/cgc.a cgc.pas cgc.asm
@ -134,6 +135,7 @@ if {#} == 0
set expression expression
set parser parser
set scanner scanner
set charset charset
end
Newer obj/dag.a dag.pas
@ -161,6 +163,13 @@ if {#} == 0
set expression expression
end
Newer obj/charset.a charset.pas
if {status} != 0
set cc cc
set scanner scanner
set charset charset
end
else
for i
set {i} {i}
@ -184,9 +193,9 @@ if "{table}" == table
end
set list ""
set list {ccommon} {mm} {cgi} {scanner} {symbol} {header} {printf}
set list {list} {expression} {cgc} {asm} {parser} {cc} {objout} {native}
set list {list} {gen} {dag}
set list {ccommon} {mm} {cgi} {charset} {scanner} {symbol} {header}
set list {list} {printf} {expression} {cgc} {asm} {parser} {cc}
set list {list} {objout} {native} {gen} {dag}
if "{list}" != ""
for i in {list}