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}