This code is more or less copied from the Orca/C for MPW code (which already supports multibyte character constants).
Eg:
char c = 'a'; int i = 'ab'; long l = 'abcd';
Unified diff:
==== Scanner.pas (text) ====
@@ -79,6 +79,7 @@
reportEOL: boolean; {report eolsy as a token?}
skipIllegalTokens: boolean; {skip flagging illegal tokens in skipped code?}
slashSlashComments: boolean; {allow // comments?}
+ allowLongIntChar: boolean; {allow long int char constants?}
token: tokenType; {next token to process}
{---------------------------------------------------------------}
@@ -595,6 +596,7 @@
112: msg := @'segment buffer overflow';
113: msg := @'all parameters must have a name';
114: msg := @'a function call was made to a non-function';
+ 115: msg := @'a character constant must contain 1 or 2 characters';
otherwise: Error(57);
end; {case}
writeln(msg^);
@@ -2738,6 +2740,7 @@
NumericDirective;
val := long(expressionValue).lsw;
skipIllegalTokens := odd(val);
+ allowLongIntChar := odd(val >> 1);
slashSlashComments := odd(val >> 3);
if token.kind <> eolsy then
Error(11);
@@ -3266,6 +3269,7 @@
begin {InitScanner}
printMacroExpansions := false; {don't print the token list}
skipIllegalTokens := false; {flag illegal tokens in skipped code}
+allowLongIntChar := true; {allow long int char constants}
slashSlashComments := true; {allow // comments}
foundFunction := false; {no functions found so far}
fileList := nil; {no included files}
@@ -3618,6 +3622,72 @@
end; {EscapeCh}
+
+ procedure CharConstant;
+
+ { Scan a single-quote character constant }
+
+ var
+ cnt: unsigned; {number of characters scanned}
+ result: longint; {character value}
+
+ begin {CharConstant}
+
+ {set up locals}
+ cnt := 0;
+ result := 0;
+
+ {skip the leading quote}
+ NextCh;
+
+ {read the characters in the constant}
+ while not (charKinds[ord(ch)] in [ch_char,ch_eol,ch_eof]) do begin
+ cnt := cnt + 1;
+ if cnt <= 4 then begin
+ result := (result << 8) | EscapeCh;
+ end; {if}
+ end; {while}
+
+ {skip the closing quote}
+ if charKinds[ord(ch)] = ch_char then
+ NextCh
+ else if (not skipping) or (not skipIllegalTokens) then
+ if allowLongIntChar then
+ Error(2)
+ else
+ Error(115);
+
+ {create the token}
+ case cnt of
+ 1, 2: begin
+ token.kind := intconst;
+ token.class := intConstant;
+ token.ival := long(result).lsw;
+ end;
+
+ 3, 4: begin
+ if not allowLongIntChar then
+ Error(115);
+ token.kind := longconst;
+ token.class := longConstant;
+ token.lval := result;
+ end;
+
+ otherwise begin
+ token.kind := intconst;
+ token.class := intConstant;
+ token.ival := 0;
+ if (not skipping) or (not skipIllegalTokens) then
+ if allowLongIntChar then
+ Error(2)
+ else
+ Error(115);
+ end;
+
+ end; {case}
+ end; {CharConstant}
+
+
begin {NextToken}
if ifList = nil then {do pending EndInclude calls}
while includeCount <> 0 do begin
@@ -3912,23 +3982,7 @@
end; {else}
end;
- ch_char : begin {character constants}
- NextCh;
- token.kind := intconst;
- token.class := intConstant;
- if ch = '''' then begin
- if (not skipping) or (not skipIllegalTokens) then
- Error(2);
- token.ival := ord(' ');
- end {if}
- else
- token.ival := EscapeCh;
- if ch = '''' then
- NextCh
- else
- if (not skipping) or (not skipIllegalTokens) then
- Error(2);
- end;
+ ch_char : CharConstant; {character constants}
ch_string: begin {string constants}