Processing Comments and Compiler Directives
This procedure processes compiler directives and skips comment. Here also conditional compilation directives (with support for nested directives) are processed.
Procedure ProcessComment (Var NextChar: PChar; StartChar: Char);
Var SecondDirective, Directive: TDirective;
Switch: TCompilerSwitches;
FileRecord: Pointer;
UnitPtr: PUnitHeader;
IntegerNumericConstant: LongInt;
Procedure SkipComment (Var NextChar: PChar);
Var C: Char;
TwoChars: TTwoChars;
begin
If CommentCharacter = '{' then
Repeat
C := NextChar^;
Inc (NextChar);
If C = #0 then
begin
If not NextLine then Error (UnexpectedEndOfFile);
NextChar := CurrentLine;
Continue;
end;
until C = '}'
else Repeat
TwoChars := PTwoChars (NextChar - 1)^;
Inc (NextChar);
If TwoChars.Second = #0 then
begin
If not NextLine then Error (UnexpectedEndOfFile);
NextChar := CurrentLine;
Continue;
end;
until TwoChars.Both = '*)';
end;
Procedure ExpectIdentifierInDirective;
begin
SkipSeparators (NextChar);
ErrorSourcePosition := NextChar;
CopyToIdentifier (NextChar);
If Identifier = '' then Error (IdentifierExpected);
end;
Function Find_ENDIF: Boolean;
Type TDirectiveData = Record
EndsENDIF: Boolean;
IfLevelIncrement: Integer;
end;
Var IfLevel: Byte;
StringFlag: Boolean;
DirectiveData: TDirectiveData;
NewDirective: TDirective;
TwoChars: TTwoChars;
begin
IfLevel := 0;
StringFlag := False;
Repeat
Case NextChar^ of
#0: begin
If not NextLine then Error (ENDIF_directiveMissing);
NextChar := CurrentLine;
StringFlag := False;
Continue;
end;
'''': begin
StringFlag := not StringFlag;
Inc (NextChar);
Continue;
end;
end;
If StringFlag then
begin
Inc (NextChar);
Continue;
end;
TwoChars := PTwoChars (NextChar)^;
Inc (NextChar);
If (TwoChars.First = '{') or (TwoChars.Both = '(*') then
begin
If TwoChars.First <> '{' then Inc (NextChar);
CommentCharacter := TwoChars.First;
With DirectiveData do
begin
EndsENDIF := False;
IfLevelIncrement := 0;
end;
If NextChar^ = '$' then
begin
Inc (NextChar);
If IsCompilerDirective (NextChar, NewDirective) then With DirectiveData do
Case NewDirective of
Directive_ELSE: begin
EndsENDIF := True;
IfLevelIncrement := 0;
end;
Directive_ENDIF: begin
EndsENDIF := True;
IfLevelIncrement := - 1;
end;
Directive_IFDEF,
Directive_IFNDEF,
Directive_IFOPT: begin
EndsENDIF := False;
IfLevelIncrement := 1;
end;
end;
end;
SkipComment (NextChar);
If DirectiveData.EndsENDIF and (IfLevel = 0) then
begin
Find_ENDIF := DirectiveData.IfLevelIncrement <> 0;
Exit;
end;
Inc (IfLevel, DirectiveData.IfLevelIncrement);
StringFlag := False;
end;
until False;
end;
Procedure GetDirectiveFileName;
Var Len: Byte;
begin
SkipSeparators (NextChar);
ErrorSourcePosition := NextChar;
Len := 0;
Repeat
Case NextChar^ of
#0..' ',
'*', '}': Break;
else Identifier [Len] := UpCase (NextChar^);
end;
Inc (Len);
Inc (NextChar);
until Len = 79;
Identifier [Len] := #0;
end;
Procedure ProcessIF (Cond: Boolean);
begin
SkipComment (NextChar);
Inc (CurrentSourceFile^.IF_Level);
If not Cond then
If Find_ENDIF then Dec (CurrentSourceFile^.IF_Level);
end;
Function IsIntegerNumericConstantNext: Boolean;
begin
SkipSeparators (NextChar);
ErrorSourcePosition := NextChar;
IsIntegerNumericConstantNext := IsIntegerNumericConstant (NextChar);
end;
Function IsSegmentNext: Boolean;
begin
IsSegmentNext := False;
If not IsIntegerNumericConstantNext then Exit;
With IntegerNumericConstantRec do If (WordH = $FFFF) and (WordL > $FFF0) then Exit;
IntegerNumericConstant := (IntegerNumericConstant + $F) shr 4;
IsSegmentNext := IntegerNumericConstantRec.WordH = 0;
end;
Procedure RemoveConditionalDefine;
Var SrcPtr, DestPtr: PChar;
Len: Byte;
begin
If not IdentifierInConditionalDefines then Exit;
Len := Byte (DestPtr^);
SrcPtr := DestPtr + Len + 1;
Move (SrcPtr^, DestPtr^, Ofs (ConditionalDefinesEnd^) - Ofs (SrcPtr^));
ConditionalDefinesEnd := Ptr (Seg (ConditionalDefinesEnd^), Ofs (ConditionalDefinesEnd^) - Len - 1);
end;
Function UnitFound (Name: PString; Var TempUnit: PUnitHeader): Boolean;
Var UnitSegment: Word;
UnitName: PString;
begin
UnitFound := True;
UnitSegment := LastLoadedUsedUnit;
Repeat
TempUnit := Ptr (UnitSegment, 0);
UnitName := @PIdentifier (Ptr (UnitSegment, TempUnit^.UnitNameIdentifierOffset))^.Name;
If IdentifiersEqual (Name, UnitName) then Exit;
UnitSegment := TempUnit^.PreviousUnitSegment;
until UnitSegment = 0;
UnitFound := False;
end;
Function SetSwitch (CompilerSwitch: TCompilerSwitches; ReportError: Boolean): Boolean;
begin
SetSwitch := False;
If not (NextChar^ in ['+', '-']) then
Case ReportError of
True: Error (InvalidCompilerDirective);
else Exit;
end;
If ModuleHeadingEnded then If CompilerSwitch in GlobalCompilerSwitches then Error (InvalidCompilerDirective);
Case NextChar^ of
'+': Include (ModuleCompilerSwitches, CompilerSwitch);
'-': Exclude (ModuleCompilerSwitches, CompilerSwitch);
end;
SetSwitch := True;
Inc (NextChar);
end;
begin
CommentCharacter := StartChar;
If NextChar^ = '$' then
Repeat
Inc (NextChar);
If not IsCompilerDirective (NextChar, Directive) then Error (InvalidCompilerDirective);
Case Directive of
Directive_A: SetSwitch (WordAlignment, True);
Directive_B: SetSwitch (FullBooleanEval, True);
Directive_C: Break;
Directive_D: SetSwitch (DebugInformation, True);
Directive_DEFINE: begin
ExpectIdentifierInDirective;
AddConditionalDefine;
Break;
end;
Directive_E: SetSwitch (Emulation80x87, True);
Directive_ELSE: begin
If CurrentSourceFile^.IF_Level = 0 then Error (MisplacedConditionalDirective);
SkipComment (NextChar);
If Find_ENDIF then Dec (CurrentSourceFile^.IF_Level);
Exit;
end;
Directive_ENDIF: begin
If CurrentSourceFile^.IF_Level = 0 then Error (MisplacedConditionalDirective);
Dec (CurrentSourceFile^.IF_Level);
Break;
end;
Directive_F: SetSwitch (ForceFarCalls, True);
Directive_G: If not SetSwitch (Instructions80286, False) then Break;
Directive_I: begin
If SetSwitch (IOErrorChecking, False) then Continue;
GetDirectiveFileName;
SkipComment (NextChar);
CurrentSourceFile^.CurrentPosition := Ofs (NextChar^);
ErrorSourcePosition := NextChar;
CreateSourceFilesRecord;
FindFilePath (@Identifier, Dir_None or Ext_PAS);
FileRecord := StoreFileNameToFilesBlock (@Identifier, ufIncludeFile);
FindFilePath (@Identifier, Dir_Include or Ext_Original);
OpenSourceFile (FileRecord, @Identifier);
SetFileDateTime;
NextChar := Ptr (Seg (NextChar^), CurrentSourceFile^.CurrentPosition);
Exit;
end;
Directive_IFDEF: begin
ExpectIdentifierInDirective;
ProcessIF (IdentifierInConditionalDefines);
Exit;
end;
Directive_IFNDEF: begin
ExpectIdentifierInDirective;
ProcessIF (not IdentifierInConditionalDefines);
Exit;
end;
Directive_IFOPT: begin
SkipSeparators (NextChar);
If not IsCompilerDirective (NextChar, SecondDirective) then Error (InvalidCompilerDirective);
Case SecondDirective of
Directive_A: Switch := WordAlignment;
Directive_B: Switch := FullBooleanEval;
Directive_D: Switch := DebugInformation;
Directive_E: Switch := Emulation80x87;
Directive_F: Switch := ForceFarCalls;
Directive_G: Switch := Instructions80286;
Directive_I: Switch := IOErrorChecking;
Directive_K: Switch := CompilerDirective_K;
Directive_L: Switch := LocalDebugSymbols;
Directive_N: Switch := Instructions80x87;
Directive_O: Switch := OverlaysAllowed;
Directive_P: Switch := OpenStringParams;
Directive_Q: Switch := OverflowChecking;
Directive_R: Switch := RangeChecking;
Directive_S: Switch := StackChecking;
Directive_T: Switch := TypedPointers;
Directive_V: Switch := StrictVarStrings;
Directive_W: Switch := CompilerDirective_W;
Directive_X: Switch := ExtendedSyntax;
Directive_Y: Switch := CompilerDirective_Y;
else Error (InvalidCompilerDirective);
end;
Case NextChar^ of
'+': ProcessIF (Switch in ModuleCompilerSwitches);
'-': ProcessIF (not (Switch in ModuleCompilerSwitches));
else Error (InvalidCompilerDirective);
end;
Exit;
end;
Directive_K: SetSwitch (CompilerDirective_K, True);
Directive_L: begin
If SetSwitch (LocalDebugSymbols, False) then Continue;
GetDirectiveFileName;
FindFilePath (@Identifier, Dir_None or Ext_OBJ);
StoreFileNameToFilesBlock (@Identifier, ufObjectFile);
Break;
end;
Directive_M: begin
If not IsIntegerNumericConstantNext then Error (InvalidCompilerDirective);
If IntegerNumericConstantRec.WordH <> 0 then Error (InvalidCompilerDirective);
IntegerNumericConstantRec.WordL := IntegerNumericConstantRec.WordL and $FFFE;
If (IntegerNumericConstantRec.WordL < $4000) or (IntegerNumericConstantRec.WordL > $FFF0) then
Error (InvalidCompilerDirective);
ModuleStack := IntegerNumericConstantRec.WordL;
If not IsSegmentNext then Error (InvalidCompilerDirective);
If IntegerNumericConstantRec.WordL > $A000 then Error (InvalidCompilerDirective);
ModuleHeapMin := IntegerNumericConstantRec.WordL;
If not IsSegmentNext then Error (InvalidCompilerDirective);
If IntegerNumericConstantRec.WordL < ModuleHeapMin then Error (InvalidCompilerDirective);
If IntegerNumericConstantRec.WordL > $A000 then Error (InvalidCompilerDirective);
ModuleHeapMax := IntegerNumericConstantRec.WordL;
Break;
end;
Directive_N: SetSwitch (Instructions80x87, True);
Directive_O: begin
If SetSwitch (OverlaysAllowed, False) then Continue;
If SourceType >= stUnit then Error (InvalidCompilerDirective);
If not (cmoCompileToDisk in CompilerModeOptions) then Error (CannotCompileOverlaysToMemory);
ExpectIdentifierInDirective;
If not UnitFound (@Identifier, UnitPtr) then Error (UnknownIdentifier);
If not (ufOverlaysAllowed in UnitPtr^.Flags) then Error (CannotOverlayThisUnit);
UnitPtr^.OverlayedUnitCodeSize := $FFFF;
Break;
end;
Directive_P: SetSwitch (OpenStringParams, True);
Directive_Q: SetSwitch (OverflowChecking, True);
Directive_R: If not SetSwitch (RangeChecking, False) then Break;
Directive_S: If not SetSwitch (StackChecking, False) then Break;
Directive_T: SetSwitch (TypedPointers, True);
Directive_UNDEF: begin
ExpectIdentifierInDirective;
RemoveConditionalDefine;
Break;
end;
Directive_V: SetSwitch (StrictVarStrings, True);
Directive_W: SetSwitch (CompilerDirective_W, True);
Directive_X: SetSwitch (ExtendedSyntax, True);
Directive_Y: SetSwitch (CompilerDirective_Y, True);
end;
until NextChar^ <> ',';
SkipComment (NextChar);
end;This function checks if comment is actually a compiler directive.
TDirective = (
Directive_A,
Directive_B,
Directive_C,
Directive_D,
Directive_DEFINE,
Directive_E,
Directive_ELSE,
Directive_ENDIF,
Directive_F,
Directive_G,
Directive_I,
Directive_IFDEF,
Directive_IFNDEF,
Directive_IFOPT,
Directive_K,
Directive_L,
Directive_M,
Directive_N,
Directive_O,
Directive_P,
Directive_Q,
Directive_R,
Directive_S,
Directive_T,
Directive_UNDEF,
Directive_V,
Directive_W,
Directive_X,
Directive_Y,
InvalidDirective);
Function IsCompilerDirective (Var NextChar: PChar; Var Directive: TDirective): Boolean;
Const DirectiveStr: Array [Directive_A..Directive_Y] of PChar = (
'A',
'B',
'C',
'D',
'DEFINE',
'E',
'ELSE',
'ENDIF',
'F',
'G',
'I',
'IFDEF',
'IFNDEF',
'IFOPT',
'K',
'L',
'M',
'N',
'O',
'P',
'Q',
'R',
'S',
'T',
'UNDEF',
'V',
'W',
'X',
'Y');
begin
ErrorSourcePosition := NextChar;
CopyToIdentifier (NextChar);
IsCompilerDirective := True;
Directive := Directive_A;
Repeat
If Identifier = StrPas (DirectiveStr [Directive]) then Exit;
Inc (Directive);
until Directive = InvalidDirective;
IsCompilerDirective := False;
end;