Processing Procedure Declarations |
|
Turbo Pascal uses few procedures to process declaration of procedures and functions. The same code is also used to process methods, constructors and destructors.
The first procedure processes header.
Procedure ProcessProcedureDeclaration;
Var IdentifierDataPtr: Pointer;
ProcedureIdentifierDataPtr: PProcedureIdentifierData absolute IdentifierDataPtr;
InlineCodeSize: Word;
TypePointer: PTypeDefinition;
NewIdentifier: PIdentifier;
IdentifierOffset: Word absolute NewIdentifier;
IdentifierToken: TToken;
Saved_TemporarySymbolTablePosition: Word;
ProcTypeDef: PTypeDefinition;
Flags: TProcedureFlagsSet;
Label SetProcedureFlags;
begin
SavedToken := Token;
ProcedureStartLineNumber := CurrentSourceFile^.LineCounter;
GetNextToken;
ExpectIdentifier;
If CurrentIdentifierDeclaredInCurrentScope (IdentifierOffset, IdentifierDataPtr, IdentifierToken) then
begin
If SourceType = stUnitInterface then Error (DuplicateIdentifier);
If IdentifierToken = Token_ProcedureIdentifier then
begin
If pfMethod in ProcedureIdentifierDataPtr^.Flags then Error (DuplicateIdentifier);
ProcessAlreadyDeclaredProcedure;
Exit;
end;
If IdentifierToken = Token_TypeIdentifier then
begin
TypePointer := PointerFromOffsets (PTypeIdentifierData (ProcedureIdentifierDataPtr)^.UnitTypeOffsets);
If TypePointer^.BaseType = btObject then
begin
GetNextToken;
ExpectTokenAndGetNext (TOKEN_Period);
ExpectIdentifier;
If not IsIdentifierInSymbolTable (Ptr (Seg (TypePointer^),
PObjectTypeDefinition (TypePointer)^.FieldsListOffset),
IdentifierToken,
IdentifierDataPtr,
IdentifierOffset) then
Error (MethodIdentifierExpected);
If IdentifierToken <> Token_ProcedureIdentifier then Error (MethodIdentifierExpected);
ProcessAlreadyDeclaredProcedure;
Exit;
end;
end;
Case SavedToken of
Token_CONSTRUCTOR,
Token_DESTRUCTOR: Error (ObjectTypeExpected);
else Error (DuplicateIdentifier);
end;
end;
Case SavedToken of
Token_CONSTRUCTOR,
Token_DESTRUCTOR: Error (ObjectTypeExpected);
end;
ProcedureIdentifierDataPtr := StoreCurrentIdentifierToSymbolTable (CurrentScopeIdentifierTableAddress, 10, NewIdentifier);
NewIdentifier^.Token := Token_ProcedureIdentifier;
GetNextToken;
Saved_TemporarySymbolTablePosition := SymbolTable [stTemporary].NextRecordOffset;
ProcTypeDef := ProcessProcedureHeader (SavedToken);
ExpectTokenAndGetNext (TOKEN_Semicolon);
If CheckAndGetNextToken (TOKEN_INLINE) then
begin
Process_INLINE (InlineCodeSize);
Include (ProcedureIdentifierDataPtr^.Flags, pfInline);
ProcedureIdentifierDataPtr^.ProceduresRecordOffset := InlineCodeSize;
ExpectTokenAndGetNext (TOKEN_Semicolon);
Exit;
end;
ProcedureIdentifierDataPtr^.LocalIdentifiersList := Saved_TemporarySymbolTablePosition;
CreateProcedureRecord (NewIdentifier, ProcedureIdentifierDataPtr);
ProcedureIdentifierDataPtr^.OuterBlockProcedureIdentifier := CurrentProcedureIdentifier;
If CurrentProcedureIdentifier = 0 then
begin
Flags := [pfInterrupt];
If CompareIdentifierToDireciveAndSkipSemicolon (_INTERRUPT) then GoTo SetProcedureFlags;
end;
Flags := [pfFar];
If CompareIdentifierToDireciveAndSkipSemicolon (_FAR) then GoTo SetProcedureFlags;
If SourceType <> stUnitInterface then
begin
Flags := [];
If CompareIdentifierToDireciveAndSkipSemicolon (_NEAR) then GoTo SetProcedureFlags;
If ForceFarCalls in StatementCompilerSwitches then Flags := [pfFar];
end;
SetProcedureFlags:
ProcedureIdentifierDataPtr^.Flags := ProcedureIdentifierDataPtr^.Flags + Flags;
If SourceType = stUnitInterface then Exit;
If CompareIdentifierToDireciveAndSkipSemicolon (_FORWARD) then Exit;
ProcessProcedureDeclaractionsAndProgramBlock;
end;
This procedure processes declarations and program block.
Procedure ProcessProcedureDeclaractionsAndProgramBlock;
Var Saved_PushedParametersSize, Saved_OffsetAfterLastParameter, Saved_FunctionResultNegativeSize, Saved_MaxStackFrameOffset,
SavedProcedureIdentifierDataOffset: Word;
SavedCurrentProcedureIdentifier, SavedProceduresNextRecordOffset: Word;
Saved_ProcedureStartLineNumber: Word;
begin
With ProcedureIdentifierDataPtr^ do
begin
If (CurrentProcedureIdentifier = 0) and CompareIdentifierToDirectiveAndGetNextToken (_EXTERNAL) then
begin
Include (Flags, pfExternal);
LocalIdentifiersList := 0;
ExpectTokenAndGetNext (TOKEN_Semicolon);
Exit;
end;
If CompareIdentifierToDireciveAndSkipSemicolon (_ASSEMBLER) then Include (Flags, pfAssembler);
Saved_PushedParametersSize := PushedParametersSize;
Saved_OffsetAfterLastParameter := OffsetAfterLastParameter;
Saved_FunctionResultNegativeSize := FunctionResultNegativeSize;
Saved_MaxStackFrameOffset := ProgramBlockMaxStackFrameOffset;
SavedProcedureIdentifierDataOffset := ProcedureIdentifierDataOffset;
SavedCurrentProcedureIdentifier := CurrentProcedureIdentifier;
SavedProceduresNextRecordOffset := SymbolTable [stProcedures].UsedSize;
CurrentProcedureIdentifier := IdentifierOffset;
ProcedureIdentifierDataOffset := Ofs (ProcedureIdentifierDataPtr^);
TemporaryStoredParameters := LocalIdentifiersList;
LocalIdentifiersList := SymbolTable [stMain].UsedSize;
With PProceduresBlockRecord (Ptr (SymbolTable [stProcedures].Segment, ProceduresRecordOffset))^ do
ProgramCodeBlockRecordOffset := $FFFE;
CreateSymbolTable (4);
CreateParametersAsLocalVariables;
Saved_ProcedureStartLineNumber := ProcedureStartLineNumber;
ProcessDeclarations;
ProcedureStartLineNumber := Saved_ProcedureStartLineNumber;
PProceduresBlockRecord (Ptr (SymbolTable [stProcedures].Segment,
ProceduresRecordOffset))^.SizeOfConstants := ProcessProgramBlock;
{ SymbolTable [stProcedures].Segment might change }
PProceduresBlockRecord (Ptr (SymbolTable [stProcedures].Segment,
ProceduresRecordOffset))^.ProgramCodeBlockRecordOffset := SymbolTable [stCodeBlocks].UsedSize;
CreateProgramCodeBlockRecord;
CreateTypedConstantsBlockRecord;
CheckForUndefined_FORWARD_Or_EXTERNAL (Ptr (SymbolTable [stProcedures].Segment, SavedProceduresNextRecordOffset));
PushedParametersSize := Saved_PushedParametersSize;
OffsetAfterLastParameter := Saved_OffsetAfterLastParameter;
FunctionResultNegativeSize := Saved_FunctionResultNegativeSize;
ProgramBlockMaxStackFrameOffset := Saved_MaxStackFrameOffset;
ProcedureIdentifierDataOffset := SavedProcedureIdentifierDataOffset;
CurrentProcedureIdentifier := SavedCurrentProcedureIdentifier;
If not (LocalDebugSymbols in ModuleCompilerSwitches) then
begin
SymbolTable [stMain].UsedSize := LocalIdentifiersList;
LocalIdentifiersList := 0;
end;
ExpectTokenAndGetNext (TOKEN_Semicolon);
end;
end;
This procedure creates parameters as local variables. For methods also the implicit parameter Self is added.
Procedure CreateParametersAsLocalVariables;
Var ProcedureIdentifierData: PProcedureIdentifierData;
ProcedureParameterData: PProcedureParameterData absolute ProcedureIdentifierData;
ProcedureParameterDataOfs: Word absolute ProcedureParameterData;
AssemblerProcedure: Boolean;
CurrentParameterOffset: Integer;
Saved_TemporaryStoredParameters, Parameter, NumberOfParameters: Word;
SelfIdentifier: PIdentifier;
SelfIdentifierData: PVariableIdentifierData;
begin
ProcedureIdentifierData := Ptr (SymbolTable [stMain].Segment, ProcedureIdentifierDataOffset);
AssemblerProcedure := pfAssembler in ProcedureIdentifierData^.Flags;
PushedParametersSize := SizeOfPushedParameters (ProcedureIdentifierData, OffsetAfterLastParameter);
CurrentParameterOffset := OffsetAfterLastParameter;
FunctionResultNegativeSize := FunctionResultStackFrameSize;
ProgramBlockMaxStackFrameOffset := FunctionResultNegativeSize;
Saved_TemporaryStoredParameters := TemporaryStoredParameters;
NumberOfParameters := ProcedureIdentifierData^.ProcedureTypeDefinition.NumberOfParameters;
Inc (ProcedureParameterDataOfs, 24);
For Parameter := 1 to NumberOfParameters do
begin
CreateParameterAsLocalVariable;
Inc (ProcedureParameterData);
end;
ProcedureParameterDataOfs := ProcedureIdentifierDataOffset;
If pfMethod in ProcedureIdentifierData^.Flags then
begin
VariableData_Flags := [vfVar, vf1];
RecordTypeDefinitionOffset.TypeOffset := $0006;
RecordTypeDefinitionOffset.UnitIdentifierData := CurrentProcedureIdentifier;
VariableData_NextMemberOffset := 0;
GetTypeAndUnitIdentifierOffsets (Ptr (Seg (ProcedureIdentifierData^),
ProcedureIdentifierData^.OuterBlockProcedureIdentifier), CurrentVarUnitTypeOffsets);
CopyStringToCurrentIdentifier ('Self');
SelfIdentifierData := StoreNewIdentifierToSymbolTable (11, SelfIdentifier);
SelfIdentifier^.Token := Token_VariableIdentifier;
Move (VariableData_Flags, SelfIdentifierData^, 11);
end;
If TemporaryStoredParameters = SymbolTable [stTemporary].UsedSize then
SymbolTable [stTemporary].UsedSize := Saved_TemporaryStoredParameters;
end;
Function FunctionResultStackFrameSize: Integer;
Var ResultSize: Integer;
begin
ResultSize := 0;
With ProcedureIdentifierData^ do
If (ProcedureTypeDefinition.ResultTypeOffset.UnitIdentifierData <> 0) and not (pfAssembler in Flags) then
With PTypeDefinition (PointerFromOffsets (ProcedureIdentifierData^.ProcedureTypeDefinition.ResultTypeOffset))^ do
If BaseType <> btString then Dec (ResultSize, Size);
FunctionResultStackFrameSize := ResultSize;
end;
Procedure CreateParameterAsLocalVariable;
Var ParameterTypeDef: PTypeDefinition;
ArrayTypeDefinition: PArrayTypeDefinition;
ProcedureParameterVarFlags: TVarFlagsSet;
ValueParameterCopySize, StackFrameSizeOfPassedParameter: Word;
ParameterIdentifier: PIdentifier;
ParameterIdentifierData: PVariableIdentifierData;
Offset: Integer;
begin
ParameterTypeDef := PointerFromOffsets (ProcedureParameterData^.UnitTypeOffsets);
ProcedureParameterVarFlags := ProcedureParameterData^.VarFlags;
If vfArray in ProcedureParameterVarFlags then
begin
ArrayTypeDefinition := CreateTypeDefinition (16, 0, [], btArray);
With ArrayTypeDefinition^ do
begin
GetTypeAndUnitIdentifierOffsets (ParameterTypeDef, ElementTypeOffset);
GetTypeAndUnitIdentifierOffsets (Ptr (SystemUnitSegment, Word_TypeOffset), IndexTypeOffset);
end;
ParameterTypeDef := ArrayTypeDefinition;
end;
StackFrameSizeOfPassedParameter :=
SizeOfPassedParameter (ParameterTypeDef, ProcedureParameterVarFlags, ValueParameterCopySize, AssemblerProcedure);
Include (ProcedureParameterVarFlags, vfArray);
VariableData_Flags := ProcedureParameterVarFlags;
GetTypeAndUnitIdentifierOffsets (ParameterTypeDef, CurrentVarUnitTypeOffsets);
Dec (CurrentParameterOffset, StackFrameSizeOfPassedParameter);
If ValueParameterCopySize <> 0 then
begin
Offset := ProgramBlockMaxStackFrameOffset - ValueParameterCopySize;
If (WordAlignment in ModuleCompilerSwitches) and (ValueParameterCopySize <> 1) then Offset := Offset and $FFFE;
ProgramBlockMaxStackFrameOffset := Offset;
end else begin
Offset := CurrentParameterOffset;
If vfOpenParameter in VariableData_Flags then Inc (Offset, 2);
end;
RecordTypeDefinitionOffset.TypeOffset := Offset;
RecordTypeDefinitionOffset.UnitIdentifierData := CurrentProcedureIdentifier;
VariableData_NextMemberOffset := 0;
CopyStringFromTemporaryBlockToCurrentIdentifier (TemporaryStoredParameters);
Inc (TemporaryStoredParameters, Length (CurrentIdentifier) + 3);
ParameterIdentifierData := StoreNewIdentifierToSymbolTable (11, ParameterIdentifier);
ParameterIdentifier^.Token := Token_VariableIdentifier;
Move (VariableData_Flags, ParameterIdentifierData^, 11);
end;
Procedures can be declared in the Interface part of the unit, in the Object declaration or with the Forward directive. Such cases are handled with this procedure. Of course, header must match previous declaration. Procedure ProcessAlreadyDeclaredProcedure;
Var SavedTempSymbolTableCurrentPointerOfs: Word;
ProcTypeDefAndParametersSize: Word;
N, NewTempSymbolTableCurrentPointerOfs: Word;
ExpectedToken: TToken;
DIPtr, SIPtr: PChar;
ProceduresRecord: PProceduresBlockRecord;
begin
ProceduresRecord := Ptr (SymbolTable [stProcedures].Segment, ProcedureIdentifierDataPtr^.ProceduresRecordOffset);
If ProceduresRecord^.ProgramCodeBlockRecordOffset <> $FFFF then Error (DuplicateIdentifier);
GetNextToken;
If Word (Ptr (Seg (ProcedureIdentifierDataPtr^), Ofs (ProcedureIdentifierDataPtr^) + 18)^) = 0 then
begin
If pfConstructor in ProcedureIdentifierDataPtr^.Flags then ExpectedToken := Token_CONSTRUCTOR else
If pfDestructor in ProcedureIdentifierDataPtr^.Flags then ExpectedToken := Token_DESTRUCTOR else
ExpectedToken := Token_PROCEDURE;
end else ExpectedToken := Token_FUNCTION;
If SavedToken <> ExpectedToken then Error (HeaderDoesNotMatchPreviousDefinition);
If (Token = Token_LeftParenthesis) or (Token = Token_Colon) then
begin
SavedTempSymbolTableCurrentPointerOfs := SymbolTable [stTemporary].NextRecordOffset;
ProcTypeDef := ProcessProcedureHeader (SavedToken);
ProcTypeDefAndParametersSize := SymbolTable [stMain].UsedSize - Ofs (ProcTypeDef^);
SymbolTable [stMain].UsedSize := Ofs (ProcTypeDef^);
ProcTypeDef^.Size := ProcedureIdentifierDataPtr^.ProcedureTypeDefinition.Size;
ProcTypeDef^.W06_ := ProcedureIdentifierDataPtr^.ProcedureTypeDefinition.W06_;
For N := 0 to ProcTypeDefAndParametersSize - 1 do
If PChar (ProcTypeDef)^ <> PChar (@ProcedureIdentifierDataPtr^.ProcedureTypeDefinition)^ then
Error (HeaderDoesNotMatchPreviousDefinition);
NewTempSymbolTableCurrentPointerOfs := SymbolTable [stTemporary].UsedSize;
SymbolTable [stTemporary].UsedSize := SavedTempSymbolTableCurrentPointerOfs;
DIPtr := Ptr (SymbolTable [stTemporary].Segment, ProcedureIdentifierDataPtr^.LocalIdentifiersList);
SIPtr := Ptr (SymbolTable [stTemporary].Segment, SavedTempSymbolTableCurrentPointerOfs);
While Ofs (SIPtr^) <> NewTempSymbolTableCurrentPointerOfs do
begin
Inc (SIPtr, 2);
Inc (DIPtr, 2);
If not IdentifiersEqual (PString (DIPtr), PString (SIPtr)) then Error (HeaderDoesNotMatchPreviousDefinition);
Inc (DIPtr, Length (PString (DIPtr)^) + 1);
end;
end;
ExpectTokenAndGetNext (TOKEN_Semicolon);
ProcessProcedureDeclaractionsAndProgramBlock;
end;
|